1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-28 22:10:29 +02:00
guile/module/ice-9/compile-psyntax.scm
Andy Wingo 71f46dbd5e sc-expand in compile mode produces (ice-9 expand-support) structures
* module/ice-9/psyntax.scm (*mode*): New moving part, a fluid.
  (sc-expand): Dynamically bind *mode* to the expansion mode.
  (build-global-reference): Change to be a procedure instead of local
  syntax. Import the logic about when to make a @ or @@ form to here,
  from boot-9.scm. If we are compiling, build output using (ice-9
  expand-support)'s make-module-ref, otherwise just making the familiar
  s-expressions. (This will allow us to correctly expand in modules in
  which @ or @@ are not bound, at least when we are compiling.)
  (build-global-assignment): Use the result of build-global-reference. A
  bit hacky, but hey.
  (top-level-eval-hook, local-eval-hook): Strip expansion structures
  before evalling.

* module/ice-9/boot-9.scm (make-module-ref): Remove, this logic is now
  back in psyntax.scm.

* module/ice-9/compile-psyntax.scm (source): Since we expand in compile
  mode, we need to strip expansion structures.

* module/ice-9/expand-support.scm (strip-expansion-structures): Remove
  the logic about whether and how to strip @/@@ from here, as it's part
  of psyntax now.

* module/ice-9/psyntax-pp.scm: Regenerated.

* module/language/scheme/compile-ghil.scm (compile-ghil): Strip expansion
  structures -- for now. In the future, we might translate directly from
  these structures into GHIL.
2009-05-04 11:57:36 +02:00

20 lines
734 B
Scheme

(use-modules (ice-9 expand-support))
(let ((source (list-ref (command-line) 1))
(target (list-ref (command-line) 2)))
(let ((in (open-input-file source))
(out (open-output-file (string-append target ".tmp"))))
(write '(eval-when (compile) (set-current-module (resolve-module '(guile))))
out)
(newline out)
(let loop ((x (read in)))
(if (eof-object? x)
(begin
(close-port out)
(close-port in))
(begin
(write (strip-expansion-structures
(sc-expand x 'c '(compile load eval)))
out)
(newline out)
(loop (read in))))))
(system (format #f "mv -f ~s.tmp ~s" target target)))