diff options
author | Andy Wingo <wingo@pobox.com> | 2009-05-29 16:01:43 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-05-29 16:01:43 +0200 |
commit | 938d46a35d39ec5d7b5fa858a8783136ce24d10d (patch) | |
tree | 17153f062515c4ae74815f65c4aa1f30a92e1ce4 /module/ice-9/compile-psyntax.scm | |
parent | 1ee2c72eafaae5f91f4c899bc4b4853af5c16f28 (diff) | |
parent | e3c5df539640a36eb1493f581087d54a4714f337 (diff) | |
download | guile-938d46a35d39ec5d7b5fa858a8783136ce24d10d.tar.gz |
Merge branch 'syncase-in-boot-9'
Conflicts:
module/Makefile.am
Diffstat (limited to 'module/ice-9/compile-psyntax.scm')
-rw-r--r-- | module/ice-9/compile-psyntax.scm | 47 |
1 files changed, 20 insertions, 27 deletions
diff --git a/module/ice-9/compile-psyntax.scm b/module/ice-9/compile-psyntax.scm index 10a307be1..2b8eec0d2 100644 --- a/module/ice-9/compile-psyntax.scm +++ b/module/ice-9/compile-psyntax.scm @@ -1,27 +1,20 @@ -(use-modules (ice-9 syncase)) - -;; XXX - We need to be inside (ice-9 syncase) since psyntax.ss calls -;; `eval' int he `interaction-environment' aka the current module and -;; it expects to have `andmap' there. The reason for this escapes me -;; at the moment. -;; -(define-module (ice-9 syncase)) - -(define source (list-ref (command-line) 1)) -(define target (list-ref (command-line) 2)) - -(let ((in (open-input-file source)) - (out (open-output-file (string-append target ".tmp")))) - (let loop ((x (read in))) - (if (eof-object? x) - (begin - (close-port out) - (close-port in)) - (begin - (write (strip-expansion-structures - (sc-expand3 x 'c '(compile load eval))) - out) - (newline out) - (loop (read in)))))) - -(system (format #f "mv -f ~s.tmp ~s" target target)) +(use-modules (language tree-il)) +(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 (tree-il->scheme + (sc-expand x 'c '(compile load eval))) + out) + (newline out) + (loop (read in)))))) + (system (format #f "mv -f ~s.tmp ~s" target target))) |