~ chicken-r7rs (master) 1ef24da8d6add8a524bbf0385b1ee0299f08dd49

commit 1ef24da8d6add8a524bbf0385b1ee0299f08dd49
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Mon Jun 9 06:30:37 2014 +0000
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Jun 9 06:30:37 2014 +0000

    Expand library forms in toplevel begins

diff --git a/r7rs-compile-time.scm b/r7rs-compile-time.scm
index 2a3e022..58d4ff7 100644
--- a/r7rs-compile-time.scm
+++ b/r7rs-compile-time.scm
@@ -72,9 +72,16 @@
   (cond (##sys#current-source-filename => pathname-directory)
         (else #f)))
 
+(define (expand/begin e)
+  (match (expand e '())
+    (('##core#begin . rest)
+     (cons '##core#begin
+           (map expand/begin rest)))
+    (e* e*)))
+
 (define (expand-toplevel-r7rs-library-forms exps)
   (parameterize ((##sys#macro-environment (r7rs-library-macro-environment)))
-    (map (cut expand <> '()) exps)))
+    (map expand/begin exps)))
 
 (define (read-forms filename ci?)
   (let ((path (##sys#resolve-include-filename filename #t)))
@@ -213,11 +220,17 @@
 (define r7rs-import-for-syntax
   (import-transformer 'import-for-syntax))
 
+;; NOTE Not really "r7rs" -- just the core begin rewrapped in
+;; a transformer. Used when expanding toplevel library forms.
+(define r7rs-begin
+  (##sys#make-structure 'transformer (macro-handler 'begin)))
+
 (define (r7rs-library-macro-environment)
   (filter (lambda (p)
             (memv (caddr p)
                   (map (cut ##sys#slot <> 1)
-                       (list r7rs-cond-expand
+                       (list r7rs-begin
+                             r7rs-cond-expand
                              r7rs-define-library
                              r7rs-include
                              r7rs-include-ci))))
diff --git a/r7rs-support.scm b/r7rs-support.scm
index abefc0d..feadb9c 100644
--- a/r7rs-support.scm
+++ b/r7rs-support.scm
@@ -6,9 +6,13 @@
 
   (import scheme chicken)
 
+  (define (macro-handler name)
+    (cond ((assq name (##sys#macro-environment)) => caddr)
+          (else #f)))
+
   (define (wrap-er-macro-transformer name handler)
     (er-macro-transformer
-     (let ((orig (caddr (assq name (##sys#macro-environment)))))
+     (let ((orig (macro-handler name)))
        (lambda (x r c)
          (let ((e (##sys#current-environment)))
            (handler x r c (lambda (x*) (orig x* '() e))))))))