summaryrefslogtreecommitdiff
path: root/module/ice-9/compile-psyntax.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/ice-9/compile-psyntax.scm')
-rw-r--r--module/ice-9/compile-psyntax.scm47
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)))