From f3819dcf2ca7680a3e6184fd947112779f77dd16 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Wed, 13 Dec 2017 23:23:44 +0100 Subject: [PATCH] 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. --- chicken-syntax.scm | 28 ++++++++++++++++++---------- chicken.syntax.import.scm | 42 ++++++++++++++++++++++++++++++++++++++++++ defaults.make | 6 +++--- expand.scm | 3 ++- internal.scm | 3 +++ rules.make | 4 +--- tests/meta-syntax-test.scm | 6 +++--- tests/module-tests.scm | 2 +- tests/scrutiny.expected | 4 ++-- 9 files changed, 75 insertions(+), 23 deletions(-) create mode 100644 chicken.syntax.import.scm diff --git a/chicken-syntax.scm b/chicken-syntax.scm index d423371a..715e45d3 100644 --- a/chicken-syntax.scm +++ b/chicken-syntax.scm @@ -261,12 +261,20 @@ (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 (lambda (x r c) @@ -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 f258836f..5d5da250 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: -- 2.11.0