summaryrefslogtreecommitdiff
path: root/module/ice-9/compile-psyntax.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-05-29 16:01:43 +0200
committerAndy Wingo <wingo@pobox.com>2009-05-29 16:01:43 +0200
commit938d46a35d39ec5d7b5fa858a8783136ce24d10d (patch)
tree17153f062515c4ae74815f65c4aa1f30a92e1ce4 /module/ice-9/compile-psyntax.scm
parent1ee2c72eafaae5f91f4c899bc4b4853af5c16f28 (diff)
parente3c5df539640a36eb1493f581087d54a4714f337 (diff)
downloadguile-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.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)))