~ chicken-core (chicken-5) 0be9d247a57da082bb2126b2e91958ea191c5513
commit 0be9d247a57da082bb2126b2e91958ea191c5513
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Wed Jun 13 19:35:24 2018 +1200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Jun 18 20:21:03 2018 +0200
Splice includes into body contexts so definitions are handled correctly
Now that non-toplevel definitions outside a "body" context are no longer
allowed, we have to expand include forms during body canonicalisation so
that any definitions in the included file are correctly spliced into the
surrounding context. Otherwise, they won't be recognised as internal
definitions and the compiler will reject them as "toplevel definitions
in non-toplevel context".
So, whenever a `##core#include' node is encountered, it's now extended
to include the remainder of the forms in the surrounding body and
control is handed back to the compiler. Then, whenever the compiler
reads forms from an included file, it checks for a body and, if one is
present, it knows it should return to the canonicalisation routine with
the included forms (as well as the remainder of the original body
context). If no body is present, included forms are treated as usual,
i.e. as a normal sequence that gets inserted into a `##core#begin' node.
This treatment is similar to what we currently do for modules, which
must also be handled as a special case during body canonicalisation.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/NEWS b/NEWS
index 40ff4aec..df0efd7f 100644
--- a/NEWS
+++ b/NEWS
@@ -120,6 +120,9 @@
predicates no longer return #t for records with the same tag
defined in another module. This tag is now also available under
an identifier that matches the record type name (fixes #1342).
+ - `include` now splices included expressions in the context in which
+ the inclusion appears and does not treat the expressions as toplevel
+ expressions by default.
- Eggs management
- Egg-installation and building has been completely overhauled.
diff --git a/core.scm b/core.scm
index a09ba4af..2bbed0b2 100644
--- a/core.scm
+++ b/core.scm
@@ -111,7 +111,7 @@
; (##core#set! <variable> <exp>)
; (##core#ensure-toplevel-definition <variable>)
; (##core#begin <exp> ...)
-; (##core#include <string> <string> | #f)
+; (##core#include <string> <string> | #f [<body>])
; (##core#loop-lambda <llist> <body>)
; (##core#undefined)
; (##core#primitive <name>)
@@ -951,7 +951,13 @@
(cadr x)
(caddr x)
(lambda (forms)
- (walk `(##core#begin ,@forms) e dest ldest h ln tl?)))))
+ (walk (if (pair? (cdddr x)) ; body?
+ (canonicalize-body/ln
+ ln
+ (append forms (cadddr x))
+ compiler-syntax-enabled)
+ `(##core#begin ,@forms))
+ e dest ldest h ln tl?)))))
((##core#let-module-alias)
(##sys#with-module-aliases
diff --git a/eval.scm b/eval.scm
index ae70f888..7aad9636 100644
--- a/eval.scm
+++ b/eval.scm
@@ -519,7 +519,13 @@
(cadr x)
(caddr x)
(lambda (forms)
- (compile `(##core#begin ,@forms) e #f tf cntr tl?))))
+ (compile
+ (if (pair? (cdddr x)) ; body?
+ (##sys#canonicalize-body
+ (append forms (cadddr x))
+ (##sys#current-environment))
+ `(##core#begin ,@forms))
+ e #f tf cntr tl?))))
((##core#let-module-alias)
(##sys#with-module-aliases
diff --git a/expand.scm b/expand.scm
index b2f97d4b..c228735d 100644
--- a/expand.scm
+++ b/expand.scm
@@ -511,18 +511,20 @@
(##sys#append (reverse exps) (list (expand body)))))
(let ((x2 (##sys#expand-0 x se cs?)))
(if (eq? x x2)
- ;; Modules must be registered before we
- ;; can continue with other forms, so
- ;; hand back control to the compiler
+ ;; Modules and includes must be processed before
+ ;; we can continue with other forms, so hand
+ ;; control back to the compiler
(if (and (pair? x)
(symbol? (car x))
- (comp '##core#module (car x)))
+ (or (comp '##core#module (car x))
+ (comp '##core#include (car x))))
`(##core#begin
,@(reverse exps)
- ,x
- ,@(if (null? rest)
- '()
- `((##core#let () ,@rest))))
+ ,@(if (comp '##core#module (car x))
+ (if (null? rest)
+ `(,x)
+ `(,x (##core#let () ,@rest)))
+ `((##core#include ,@(cdr x) ,rest))))
(loop rest (cons x exps)))
(loop2 (cons x2 rest)) )) ))) ))
;; We saw defines. Translate to letrec, and let compiler
diff --git a/manual/Module (chicken base) b/manual/Module (chicken base)
index 4d8396c9..763de5ed 100644
--- a/manual/Module (chicken base)
+++ b/manual/Module (chicken base)
@@ -1215,7 +1215,7 @@ s ==> "#,(foo 1 2 3)"
<macro>(include STRING)</macro>
-Include toplevel-expressions from the given source file in the currently
+Include expressions from the given source file in the currently
compiled/interpreted program. If the included file has the extension
{{.scm}}, then it may be omitted. The file is searched for in the
current directory and all directories specified by the {{-include-path}}
diff --git a/tests/runtests.bat b/tests/runtests.bat
index f6856ccc..6030d387 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -22,7 +22,7 @@ set compile_r=..\%PROGRAM_PREFIX%csc%PROGRAM_SUFFIX% %COMPILE_OPTIONS% -o a.out
set compile_s=..\%PROGRAM_PREFIX%csc%PROGRAM_SUFFIX% %COMPILE_OPTIONS% -s -types %TYPESDB% -ignore-repository
set interpret=..\%PROGRAM_PREFIX%csi%PROGRAM_SUFFIX% -n -include-path %TEST_DIR%/..
-del /f /q /s *.exe *.so *.o *.import.* ..\foo.import.* %CHICKEN_INSTALL_REPOSITORY%
+del /f /q /s *.exe *.so *.o *.out *.import.* ..\foo.import.* %CHICKEN_INSTALL_REPOSITORY%
rmdir /q /s %CHICKEN_INSTALL_REPOSITORY%
mkdir %CHICKEN_INSTALL_REPOSITORY%
copy %TYPESDB% %CHICKEN_INSTALL_REPOSITORY%
diff --git a/tests/runtests.sh b/tests/runtests.sh
index a9e8a5b1..06279127 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -59,7 +59,7 @@ $time true >/dev/null 2>/dev/null
test $? -eq 127 && time=
set -e
-rm -fr *.exe *.so *.o *.import.* a.out ../foo.import.* test-repository
+rm -fr *.exe *.so *.o *.out *.import.* ../foo.import.* test-repository
mkdir -p test-repository
cp $TYPESDB test-repository/types.db
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index d01d8883..38ae5978 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -1239,6 +1239,22 @@ other-eval
(assert (eq? req 1)))
+;; Includes should be spliced into the surrounding body context:
+
+(begin-for-syntax
+ (with-output-to-file "x.out" (cut pp '(define x 2))))
+
+(let ()
+ (define x 1)
+ (include "x.out")
+ (t 2 x))
+
+(let ()
+ (define x 1)
+ (let ()
+ (include "x.out"))
+ (t 1 x))
+
;; letrec vs. letrec*
;;XXX this fails - the optimizer substitutes "foo" for it's known constant value
Trap