From e874d2d0a0e5fa2ea8de8e587017550d60c934fb Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Wed, 5 Dec 2007 03:26:56 -0500
Subject: [PATCH] Added "include-into" macro.   (include-into ctxt "filename")
 included the contents of the file   as if they were present in the context
 ctxt (which must be an   identifier).   (include-into here "filename") would
 do the same thing as   (include "filename")

---
 scheme/last-revision       |  2 +-
 scheme/makefile.ss         |  2 ++
 scheme/psyntax.expander.ss | 44 +++++++++++++++++++++++++-------------
 3 files changed, 32 insertions(+), 16 deletions(-)

diff --git a/scheme/last-revision b/scheme/last-revision
index 73a426e..3fe2180 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1185
+1186
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index 19220e1..51b29d2 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -130,6 +130,7 @@
     [record-constructor-descriptor (core-macro . record-constructor-descriptor)]
     [define-struct       (macro . define-struct)]
     [include             (macro . include)]
+    [include-into        (macro . include-into)]
     [syntax-rules        (macro . syntax-rules)]
     [quasiquote          (macro . quasiquote)]
     [quasisyntax         (macro . quasisyntax)]
@@ -271,6 +272,7 @@
     [parameterize                                i parameters]
     [define-struct                               i]
     [include                                     i]
+    [include-into                                i]
     [time                                        i]
     [trace-lambda                                i]
     [trace-define                                i]
diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss
index 9593e29..f1d310c 100644
--- a/scheme/psyntax.expander.ss
+++ b/scheme/psyntax.expander.ss
@@ -1275,21 +1275,34 @@
                   ((e e* ...) `(if ,e (begin . ,e*) ,(f (car cls*) (cdr cls*))))
                   (_ (stx-error stx "invalid last clause")))))))))))
   
-  (define include-macro
-    (lambda (e)
-      (syntax-match e ()
-        ((id filename)
-         (let ((filename (stx->datum filename)))
-           (unless (string? filename) (stx-error e))
-           (with-input-from-file filename
-             (lambda ()
-               (let f ((ls '()))
-                 (let ((x (read)))
-                   (cond
-                     ((eof-object? x)
-                      (cons (bless 'begin)
-                        (datum->stx id (reverse ls))))
-                     (else (f (cons x ls)))))))))))))
+  (begin ; module (include-macro include-into-macro)
+         ; no module to keep portable! 
+         ; dump everything in top-level, sure.
+    (define (do-include stx id filename)
+      (let ((filename (stx->datum filename)))
+        (unless (and (string? filename) (id? id))
+          (stx-error stx))
+        (cons 
+          (bless 'begin)
+          (with-input-from-file filename
+            (lambda ()
+              (let f ((ls '()))
+                (let ((x (read)))
+                  (cond
+                    ((eof-object? x) (reverse ls))
+                    (else
+                     (f (cons (datum->stx id x) ls)))))))))))
+    (define include-macro
+      (lambda (e)
+        (syntax-match e ()
+          ((id filename)
+           (do-include e id filename)))))
+    (define include-into-macro
+      (lambda (e)
+        (syntax-match e ()
+          ((_ id filename)
+           (do-include e id filename))))))
+
   
   (define syntax-rules-macro
     (lambda (e)
@@ -2298,6 +2311,7 @@
            ((trace-lambda)          trace-lambda-macro)
            ((trace-define)          trace-define-macro)
            ((define-condition-type) define-condition-type-macro)
+           ((include-into)          include-into-macro)
            ((eol-style)
             (lambda (x) 
               (symbol-macro x '(none lf cr crlf nel crnel ls))))