~ chicken-core (chicken-5) 6a0ac898e44787f7ecbde865ef7b185ca2fcd357
commit 6a0ac898e44787f7ecbde865ef7b185ca2fcd357
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Wed Dec 13 23:23:44 2017 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Dec 14 10:27:09 2017 +0100
Add hand-written (chicken syntax) module.
This fixes bootstrapping issues because we inject (import chicken.syntax)
into each and every toplevel, which means this fails hard when that
import library is missing.
It also implements the final two identifiers needed for the chicken.syntax
module to be finalized as per the library reorganisation.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index d423371a..715e45d3 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -261,11 +261,19 @@
(macro-subset me0 ##sys#default-macro-environment)))
-;;; Non-standard macros that provide core/"base" functionality:
+;;; Syntax-related syntax (for use in macro transformers)
-(set! ##sys#chicken.base-macro-environment
+(set! ##sys#chicken.syntax-macro-environment
(let ((me0 (##sys#macro-environment)))
+(##sys#extend-macro-environment
+ 'syntax
+ '()
+ (##sys#er-transformer
+ (lambda (x r c)
+ (##sys#check-syntax 'syntax x '(_ _))
+ `(##core#syntax ,(cadr x)))))
+
(##sys#extend-macro-environment
'begin-for-syntax '()
(##sys#er-transformer
@@ -274,6 +282,14 @@
(##sys#register-meta-expression `(##core#begin ,@(cdr x)))
`(##core#elaborationtimeonly (##core#begin ,@(cdr x))))))
+(macro-subset me0 ##sys#default-macro-environment)))
+
+
+;;; Non-standard macros that provide core/"base" functionality:
+
+(set! ##sys#chicken.base-macro-environment
+ (let ((me0 (##sys#macro-environment)))
+
(##sys#extend-macro-environment
'define-constant
'()
@@ -526,14 +542,6 @@
(##sys#check-syntax 'set!-values form '(_ lambda-list _))
(##sys#expand-multiple-values-assignment (cadr form) (caddr form)))))
-(##sys#extend-macro-environment
- 'syntax
- '()
- (##sys#er-transformer
- (lambda (x r c)
- (##sys#check-syntax 'syntax x '(_ _))
- `(##core#syntax ,(cadr x)))))
-
(set! chicken.syntax#define-values-definition
(##sys#extend-macro-environment
'define-values '()
diff --git a/chicken.syntax.import.scm b/chicken.syntax.import.scm
new file mode 100644
index 00000000..12120427
--- /dev/null
+++ b/chicken.syntax.import.scm
@@ -0,0 +1,42 @@
+;;;; chicken.syntax.import.scm - import library for "chicken.syntax" module
+;
+; Copyright (c) 2017, The CHICKEN Team
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
+; conditions are met:
+;
+; Redistributions of source code must retain the above copyright notice, this list of conditions and the following
+; disclaimer.
+; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
+; disclaimer in the documentation and/or other materials provided with the distribution.
+; Neither the name of the author nor the names of its contributors may be used to endorse or promote
+; products derived from this software without specific prior written permission.
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
+; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+; POSSIBILITY OF SUCH DAMAGE.
+
+;; NOTE: This library is currently injected in every toplevel including
+;; the default macro environment, so the import library _must_ be
+;; predefined (it cannot be emitted, as the compiler needs it already)
+
+(##sys#register-core-module
+ 'chicken.syntax
+ 'expand
+ '((expand . chicken.syntax#expand)
+ (get-line-number . chicken.syntax#get-line-number)
+ (strip-syntax . chicken.syntax#strip-syntax)
+ (syntax-error . chicken.syntax#syntax-error)
+ (er-macro-transformer . chicken.syntax#er-macro-transformer)
+ (ir-macro-transformer . chicken.syntax#ir-macro-transformer))
+ ;; OBSOLETE: This can be removed after bootstrapping
+ (if (##sys#symbol-has-toplevel-binding? '##sys#chicken.syntax-macro-environment)
+ ##sys#chicken.syntax-macro-environment
+ ##sys#chicken-macro-environment))
diff --git a/defaults.make b/defaults.make
index 24b787be..7e40ec45 100644
--- a/defaults.make
+++ b/defaults.make
@@ -263,13 +263,13 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile)
# import libraries
PRIMITIVE_IMPORT_LIBRARIES = chicken chicken.base chicken.condition \
- chicken.csi chicken.foreign
+ chicken.csi chicken.foreign chicken.syntax
DYNAMIC_IMPORT_LIBRARIES = srfi-4
DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise blob errno file.posix \
fixnum flonum format gc io keyword load locative memory \
memory.representation platform plist posix pretty-print \
- process process.signal process-context random syntax \
- sort string time time.posix
+ process process.signal process-context random sort string \
+ time time.posix
DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass
DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
eval file internal irregex pathname port read-syntax repl tcp
diff --git a/expand.scm b/expand.scm
index b2e33683..9b837bb8 100644
--- a/expand.scm
+++ b/expand.scm
@@ -174,6 +174,7 @@
(define ##sys#chicken-ffi-macro-environment '()) ; used later in foreign.import.scm
(define ##sys#chicken.condition-macro-environment '()) ; used later in chicken.condition.import.scm
(define ##sys#chicken.type-macro-environment '()) ; used later in chicken.type.import.scm
+(define ##sys#chicken.syntax-macro-environment '()) ; used later in chicken.syntax.import.scm
(define ##sys#chicken.base-macro-environment '()) ; used later in chicken.base.import.scm
(define (##sys#ensure-transformer t #!optional loc)
@@ -1171,7 +1172,7 @@
(##core#quote ,body))))
`(##core#module ,(library-id name)
#t
- (import scheme chicken)
+ (import scheme chicken.syntax) ;; TODO: Is this correct?
(begin-for-syntax ,registration))))))
;;; interface definition
diff --git a/internal.scm b/internal.scm
index 5df9e561..51722c44 100644
--- a/internal.scm
+++ b/internal.scm
@@ -209,6 +209,9 @@
;;; Modules that are made available to code by default:
+;; WARNING: These import libs must all exist. They cannot be emitted,
+;; because the compiler itself needs them to expand macros!
+
(define default-imports '(scheme chicken.base chicken.syntax))
(define default-syntax-imports '(scheme chicken.base chicken.syntax))
diff --git a/rules.make b/rules.make
index 168ae1fd..7025bb86 100644
--- a/rules.make
+++ b/rules.make
@@ -494,7 +494,6 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.random,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.locative,lolevel))
$(eval $(call declare-emitted-import-lib-dependency,chicken.memory,lolevel))
$(eval $(call declare-emitted-import-lib-dependency,chicken.memory.representation,lolevel))
-$(eval $(call declare-emitted-import-lib-dependency,chicken.syntax,expand))
$(eval $(call declare-emitted-import-lib-dependency,chicken.sort,data-structures))
$(eval $(call declare-emitted-import-lib-dependency,chicken.string,data-structures))
@@ -783,8 +782,7 @@ repl.c: $(SRCDIR)repl.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.repl
expand.c: $(SRCDIR)expand.scm $(SRCDIR)synrules.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) \
- -no-module-registration \
- -emit-import-library chicken.syntax
+ -no-module-registration
modules.c: $(SRCDIR)modules.scm $(SRCDIR)common-declarations.scm $(SRCDIR)mini-srfi-1.scm
$(bootstrap-lib)
extras.c: $(SRCDIR)extras.scm $(SRCDIR)common-declarations.scm
diff --git a/tests/meta-syntax-test.scm b/tests/meta-syntax-test.scm
index b53d7a3f..5fc654ad 100755
--- a/tests/meta-syntax-test.scm
+++ b/tests/meta-syntax-test.scm
@@ -11,7 +11,7 @@
;;
(module foo (bar listify)
- (import scheme chicken)
+ (import scheme chicken.syntax)
(begin-for-syntax
(define (baz x)
(list (cadr x))))
@@ -30,7 +30,7 @@
(call-it-123 list)))))
(module test-import-syntax-for-syntax (test)
- (import chicken scheme)
+ (import scheme chicken.syntax)
(import-syntax-for-syntax (prefix foo foo:))
(define-syntax test-import-syntax-for-syntax
(er-macro-transformer
@@ -40,7 +40,7 @@
(test-import-syntax-for-syntax)))
(module test-begin-for-syntax (test)
- (import chicken scheme)
+ (import scheme chicken.syntax)
(begin-for-syntax
(import-syntax (prefix foo foo:)))
(define-syntax test-begin-for-syntax
diff --git a/tests/module-tests.scm b/tests/module-tests.scm
index 0901ea19..7eb852f4 100644
--- a/tests/module-tests.scm
+++ b/tests/module-tests.scm
@@ -225,7 +225,7 @@
(test-equal
"local module alias scope"
(module m21 ()
- (import scheme chicken)
+ (import scheme (chicken syntax))
(begin-for-syntax ; XXX s.a.
(##sys#register-module-alias 'm18 'm19))
(import m18)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 1caf8ea6..44afef85 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -43,10 +43,10 @@ Warning: at toplevel:
assignment of value of type `fixnum' to toplevel variable `scheme#car' does not match declared type `(forall (a) (procedure scheme#car ((pair a *)) a))'
Warning: at toplevel:
- expected a single result in `let' binding of `g39', but received 2 results
+ expected a single result in `let' binding of `g19', but received 2 results
Warning: at toplevel:
- in procedure call to `g39', expected a value of type `(procedure () *)' but was given a value of type `fixnum'
+ in procedure call to `g19', expected a value of type `(procedure () *)' but was given a value of type `fixnum'
Note: in toplevel procedure `foo':
expected a value of type boolean in conditional, but was given a value of type `(procedure bar () *)' which is always true:
Trap