>From 0fc32324836fdfa78f44493f9c59425b267eb196 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Wed, 13 Jun 2018 19:35:24 +1200 Subject: [PATCH] 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. --- core.scm | 10 ++++++++-- eval.scm | 8 +++++++- expand.scm | 18 ++++++++++-------- tests/runtests.bat | 2 +- tests/runtests.sh | 2 +- tests/syntax-tests.scm | 16 ++++++++++++++++ 6 files changed, 43 insertions(+), 13 deletions(-) diff --git a/core.scm b/core.scm index a09ba4af..2bbed0b2 100644 --- a/core.scm +++ b/core.scm @@ -111,7 +111,7 @@ ; (##core#set! ) ; (##core#ensure-toplevel-definition ) ; (##core#begin ...) -; (##core#include | #f) +; (##core#include | #f []) ; (##core#loop-lambda ) ; (##core#undefined) ; (##core#primitive ) @@ -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..6c83dc66 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 processes 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/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 -- 2.11.0