From 828ad1e73c0476411088f916a619a372a5db7382 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 18 Jun 2017 19:24:50 +0200 Subject: [PATCH] Rename (chicken expand) to (chicken syntax) This adds a small hack to the chicken.import.scm import library to define chicken.syntax#er-macro-transformer and friends as aliases for their chicken.expand# version, if those are defined. This is required when building the new chicken with an old one, because the old compiler will load "chicken.import.scm", but the name mappings aren't right for anything that happens at expansion time if there are no definition from the chicken.syntax module inside that compiler's libchicken. We also make some internal definitions in expand.scm explicit, namely match-expression and expand-curried-define. This happened to work because the macros that use these definitions live inside the same unit of compilation. If we were to move them, things would mysteriously start breaking. --- README | 2 +- chicken-ffi-syntax.scm | 24 ++++++++++++------------ chicken-syntax.scm | 46 +++++++++++++++++++++++----------------------- chicken.import.scm | 21 +++++++++++++++------ core.scm | 8 ++++---- csi.scm | 3 ++- defaults.make | 4 ++-- distribution/manifest | 4 ++-- eval.scm | 4 ++-- expand.scm | 43 ++++++++++++++++++++++--------------------- irregex.scm | 4 +++- modules.scm | 8 ++++---- rules.make | 25 +++++++++++++------------ scrutinizer.scm | 4 ++-- srfi-4.scm | 4 ++-- support.scm | 2 +- tests/compiler-tests.scm | 2 +- types.db | 30 +++++++++++++++--------------- 18 files changed, 126 insertions(+), 112 deletions(-) diff --git a/README b/README index 00eca60e..e8df7e3a 100644 --- a/README +++ b/README @@ -292,7 +292,6 @@ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/_/ | | |-- chicken.data-structures.import.so | | |-- chicken.errno.import.so | | |-- chicken.eval.import.so - | | |-- chicken.expand.import.so | | |-- chicken.file.import.so | | |-- chicken.file.posix.import.so | | |-- chicken.fixnum.import.so @@ -319,6 +318,7 @@ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/_/ | | |-- chicken.random.import.so | | |-- chicken.repl.import.so | | |-- chicken.read-syntax.import.so + | | |-- chicken.syntax.import.so | | |-- chicken.tcp.import.so | | |-- chicken.time.import.so | | |-- chicken.time.posix.import.so diff --git a/chicken-ffi-syntax.scm b/chicken-ffi-syntax.scm index a825a221..fc9ebbcd 100644 --- a/chicken-ffi-syntax.scm +++ b/chicken-ffi-syntax.scm @@ -180,7 +180,7 @@ "bad argument type - not a string or symbol" code)))) (##core#the ,(chicken.compiler.support#foreign-type->scrutiny-type - (chicken.expand#strip-syntax (caddr form)) + (chicken.syntax#strip-syntax (caddr form)) 'result) #f ,tmp) ) ) ) ) ) @@ -221,8 +221,8 @@ (lambda (form r c) (##sys#check-syntax 'foreign-primitive form '(_ _ . _)) (let* ((hasrtype (and (pair? (cddr form)) (not (string? (caddr form))))) - (rtype (and hasrtype (chicken.expand#strip-syntax (cadr form)))) - (args (chicken.expand#strip-syntax (if hasrtype (caddr form) (cadr form)))) + (rtype (and hasrtype (chicken.syntax#strip-syntax (cadr form)))) + (args (chicken.syntax#strip-syntax (if hasrtype (caddr form) (cadr form)))) (argtypes (map car args))) `(##core#the (procedure ,(map (cut chicken.compiler.support#foreign-type->scrutiny-type <> 'arg) @@ -241,9 +241,9 @@ (##sys#check-syntax 'foreign-lambda form '(_ _ _ . _)) `(##core#the (procedure ,(map (cut chicken.compiler.support#foreign-type->scrutiny-type <> 'arg) - (chicken.expand#strip-syntax (cdddr form))) + (chicken.syntax#strip-syntax (cdddr form))) ,(chicken.compiler.support#foreign-type->scrutiny-type - (chicken.expand#strip-syntax (cadr form)) 'result)) + (chicken.syntax#strip-syntax (cadr form)) 'result)) #f (##core#foreign-lambda ,@(cdr form)))))) @@ -258,9 +258,9 @@ (chicken.compiler.support#foreign-type->scrutiny-type (car a) 'arg)) - (chicken.expand#strip-syntax (caddr form))) + (chicken.syntax#strip-syntax (caddr form))) ,(chicken.compiler.support#foreign-type->scrutiny-type - (chicken.expand#strip-syntax (cadr form)) 'result)) + (chicken.syntax#strip-syntax (cadr form)) 'result)) #f (##core#foreign-lambda* ,@(cdr form)))))) @@ -272,9 +272,9 @@ (##sys#check-syntax 'foreign-safe-lambda form '(_ _ _ . _)) `(##core#the (procedure ,(map (cut chicken.compiler.support#foreign-type->scrutiny-type <> 'arg) - (chicken.expand#strip-syntax (cdddr form))) + (chicken.syntax#strip-syntax (cdddr form))) ,(chicken.compiler.support#foreign-type->scrutiny-type - (chicken.expand#strip-syntax (cadr form)) 'result)) + (chicken.syntax#strip-syntax (cadr form)) 'result)) #f (##core#foreign-safe-lambda ,@(cdr form)))))) @@ -287,9 +287,9 @@ `(##core#the (procedure ,(map (lambda (a) (chicken.compiler.support#foreign-type->scrutiny-type (car a) 'arg)) - (chicken.expand#strip-syntax (caddr form))) + (chicken.syntax#strip-syntax (caddr form))) ,(chicken.compiler.support#foreign-type->scrutiny-type - (chicken.expand#strip-syntax (cadr form)) 'result)) + (chicken.syntax#strip-syntax (cadr form)) 'result)) #f (##core#foreign-safe-lambda* ,@(cdr form)))))) @@ -299,7 +299,7 @@ (##sys#er-transformer (lambda (form r c) (##sys#check-syntax 'foreign-type-size form '(_ _)) - (let* ((t (chicken.expand#strip-syntax (cadr form))) + (let* ((t (chicken.syntax#strip-syntax (cadr form))) (tmp (gensym "code_")) (decl (if (string? t) diff --git a/chicken-syntax.scm b/chicken-syntax.scm index 0c4db9d1..7a461726 100644 --- a/chicken-syntax.scm +++ b/chicken-syntax.scm @@ -140,7 +140,7 @@ (null? (cddr slot))) (cadr slot)) (else - (chicken.expand#syntax-error + (chicken.syntax#syntax-error 'define-record "invalid slot specification" slot)))) slots))) `(##core#begin @@ -249,7 +249,7 @@ (msg (optional msg-and-args "assertion failed")) (tmp (r 'tmp))) (when (string? msg) - (and-let* ((ln (chicken.expand#get-line-number form))) + (and-let* ((ln (chicken.syntax#get-line-number form))) (set! msg (string-append "(" ln ") " msg)))) `(##core#let ((,tmp ,exp)) (##core#if (##core#check ,tmp) @@ -258,7 +258,7 @@ ,msg ,@(if (pair? msg-and-args) (cdr msg-and-args) - `((##core#quote ,(chicken.expand#strip-syntax exp)))))))))))) + `((##core#quote ,(chicken.syntax#strip-syntax exp)))))))))))) (##sys#extend-macro-environment 'ensure @@ -420,7 +420,7 @@ (##sys#check-syntax 'set!-values form '(_ lambda-list _)) (##sys#expand-multiple-values-assignment (cadr form) (caddr form))))) -(set! chicken.expand#define-values-definition +(set! chicken.syntax#define-values-definition (##sys#extend-macro-environment 'define-values '() (##sys#er-transformer @@ -552,7 +552,7 @@ (when (or (not (pair? val)) (and (not (eq? '##core#lambda (car val))) (not (c (r 'lambda) (car val))))) - (chicken.expand#syntax-error + (chicken.syntax#syntax-error 'define-inline "invalid substitution form - must be lambda" name val) ) (list name val) ) ) ] ) @@ -594,7 +594,7 @@ (cond ((null? clauses) '(##core#undefined) ) ((not (pair? clauses)) - (chicken.expand#syntax-error 'select "invalid syntax" clauses)) + (chicken.syntax#syntax-error 'select "invalid syntax" clauses)) (else (let ((clause (##sys#slot clauses 0)) (rclauses (##sys#slot clauses 1)) ) @@ -605,7 +605,7 @@ (else? (##sys#notice "non-`else' clause following `else' clause in `select'" - (chicken.expand#strip-syntax clause)) + (chicken.syntax#strip-syntax clause)) (expand rclauses #t) '(##core#begin)) (else @@ -1012,7 +1012,7 @@ (%<...> (r '<...>)) (%apply (r 'apply))) (when (null? (cdr form)) - (chicken.expand#syntax-error 'cut "you need to supply at least a procedure" form)) + (chicken.syntax#syntax-error 'cut "you need to supply at least a procedure" form)) (let loop ([xs (cdr form)] [vars '()] [vals '()] [rest #f]) (if (null? xs) (let ([rvars (reverse vars)] @@ -1030,7 +1030,7 @@ ((c %<...> (car xs)) (if (null? (cdr xs)) (loop '() vars vals #t) - (chicken.expand#syntax-error + (chicken.syntax#syntax-error 'cut "tail patterns after <...> are not supported" form))) @@ -1045,7 +1045,7 @@ (%<> (r '<>)) (%<...> (r '<...>))) (when (null? (cdr form)) - (chicken.expand#syntax-error 'cute "you need to supply at least a procedure" form)) + (chicken.syntax#syntax-error 'cute "you need to supply at least a procedure" form)) (let loop ([xs (cdr form)] [vars '()] [bs '()] [vals '()] [rest #f]) (if (null? xs) (let ([rvars (reverse vars)] @@ -1064,7 +1064,7 @@ ((c %<...> (car xs)) (if (null? (cdr xs)) (loop '() vars bs vals #t) - (chicken.expand#syntax-error + (chicken.syntax#syntax-error 'cute "tail patterns after <...> are not supported" form))) @@ -1145,7 +1145,7 @@ (##sys#er-transformer (lambda (x r c) (##sys#check-syntax 'define-interface x '(_ variable _)) - (let ((name (chicken.expand#strip-syntax (cadr x))) + (let ((name (chicken.syntax#strip-syntax (cadr x))) (%quote (r 'quote))) (when (eq? '* name) (syntax-error-hook @@ -1155,7 +1155,7 @@ (,%quote ,name) (,%quote ##core#interface) (,%quote - ,(let ((exps (chicken.expand#strip-syntax (caddr x)))) + ,(let ((exps (chicken.syntax#strip-syntax (caddr x)))) (cond ((eq? '* exps) '*) ((symbol? exps) `(#:interface ,exps)) ((list? exps) @@ -1173,7 +1173,7 @@ (##sys#er-transformer (lambda (x r c) (##sys#check-syntax 'functor x '(_ (_ . #((_ _) 0)) _ . _)) - (let* ((x (chicken.expand#strip-syntax x)) + (let* ((x (chicken.syntax#strip-syntax x)) (head (cadr x)) (name (car head)) (args (cdr head)) @@ -1211,16 +1211,16 @@ (##sys#check-syntax ': x '(_ symbol _ . _)) (if (not (memq #:compiling ##sys#features)) '(##core#undefined) - (let* ((type1 (chicken.expand#strip-syntax (caddr x))) + (let* ((type1 (chicken.syntax#strip-syntax (caddr x))) (name1 (cadr x))) ;; we need pred/pure info, so not using ;; "chicken.compiler.scrutinizer#check-and-validate-type" (let-values (((type pred pure) (chicken.compiler.scrutinizer#validate-type type1 - (chicken.expand#strip-syntax name1)))) + (chicken.syntax#strip-syntax name1)))) (cond ((not type) - (chicken.expand#syntax-error ': "invalid type syntax" name1 type1)) + (chicken.syntax#syntax-error ': "invalid type syntax" name1 type1)) (else `(##core#declare (type (,name1 ,type1 ,@(cdddr x))) @@ -1257,7 +1257,7 @@ (args (cdr head)) (alias (gensym name)) (galias (##sys#globalize alias '())) ;XXX and this? - (rtypes (and (pair? (cdddr x)) (chicken.expand#strip-syntax (caddr x)))) + (rtypes (and (pair? (cdddr x)) (chicken.syntax#strip-syntax (caddr x)))) (%define (r 'define)) (body (if rtypes (cadddr x) (caddr x)))) (let loop ((args args) (anames '()) (atypes '())) @@ -1304,7 +1304,7 @@ (cadr arg) 'define-specialization) atypes))) - (else (chicken.expand#syntax-error + (else (chicken.syntax#syntax-error 'define-specialization "invalid argument syntax" arg head))))))))))))) @@ -1315,13 +1315,13 @@ (##sys#check-syntax 'compiler-typecase x '(_ _ . #((_ . #(_ 1)) 1))) (let ((val (memq #:compiling ##sys#features)) (var (gensym)) - (ln (chicken.expand#get-line-number x))) + (ln (chicken.syntax#get-line-number x))) `(##core#let ((,var ,(cadr x))) (##core#typecase ,ln ,var ; must be variable (see: CPS transform) ,@(map (lambda (clause) - (let ((hd (chicken.expand#strip-syntax (car clause)))) + (let ((hd (chicken.syntax#strip-syntax (car clause)))) (list (if (eq? hd 'else) 'else @@ -1340,9 +1340,9 @@ (##sys#check-syntax 'define-type x '(_ variable _)) (cond ((not (memq #:compiling ##sys#features)) '(##core#undefined)) (else - (let ((name (chicken.expand#strip-syntax (cadr x))) + (let ((name (chicken.syntax#strip-syntax (cadr x))) (%quote (r 'quote)) - (t0 (chicken.expand#strip-syntax (caddr x)))) + (t0 (chicken.syntax#strip-syntax (caddr x)))) `(##core#elaborationtimeonly (##sys#put/restore! (,%quote ,name) diff --git a/chicken.import.scm b/chicken.import.scm index 3b20bb7a..8a5f28f8 100644 --- a/chicken.import.scm +++ b/chicken.import.scm @@ -23,6 +23,15 @@ ; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ; POSSIBILITY OF SUCH DAMAGE. +;; OBSOLETE: This can be removed after bootstrapping +(if (not (##sys#symbol-has-toplevel-binding? 'chicken.syntax#expand)) + (begin + (set! chicken.syntax#expand chicken.expand#expand) + (set! chicken.syntax#er-macro-transformer chicken.expand#er-macro-transformer) + (set! chicken.syntax#ir-macro-transformer chicken.expand#ir-macro-transformer) + (set! chicken.syntax#strip-syntax chicken.expand#strip-syntax) + (set! chicken.syntax#syntax-error chicken.expand#syntax-error) + (set! chicken.syntax#get-line-number chicken.expand#get-line-number))) (##sys#register-primitive-module 'chicken @@ -55,7 +64,7 @@ (dynamic-load-libraries . chicken.load#dynamic-load-libraries) enable-warnings equal=? - (er-macro-transformer . chicken.expand#er-macro-transformer) + (er-macro-transformer . chicken.syntax#er-macro-transformer) errno error (eval-handler . chicken.eval#eval-handler) @@ -65,7 +74,7 @@ executable-pathname exit exit-handler - (expand . chicken.expand#expand) + (expand . chicken.syntax#expand) (feature? . chicken.platform#feature?) (features . chicken.platform#features) file-exists? @@ -108,7 +117,7 @@ (get-call-chain . chicken.condition#get-call-chain) (get-condition-property . chicken.condition#get-condition-property) get-environment-variable - (get-line-number . chicken.expand#get-line-number) + (get-line-number . chicken.syntax#get-line-number) get-output-string get-properties getter-with-setter @@ -116,7 +125,7 @@ infinite? input-port-open? (installation-repository . chicken.platform#installation-repository) - (ir-macro-transformer . chicken.expand#ir-macro-transformer) + (ir-macro-transformer . chicken.syntax#ir-macro-transformer) keyword-style (load-extension . chicken.load#load-extension) (load-library . chicken.load#load-library) @@ -176,13 +185,13 @@ (software-version . chicken.platform#software-version) string->blob string->uninterned-symbol - (strip-syntax . chicken.expand#strip-syntax) + (strip-syntax . chicken.syntax#strip-syntax) sub1 subvector symbol-append symbol-escape symbol-plist - (syntax-error . chicken.expand#syntax-error) + (syntax-error . chicken.syntax#syntax-error) system (unregister-feature! . chicken.platform#unregister-feature!) vector-resize diff --git a/core.scm b/core.scm index e6f3c399..c2632cd4 100644 --- a/core.scm +++ b/core.scm @@ -327,7 +327,6 @@ chicken.compiler.support chicken.data-structures chicken.eval - chicken.expand chicken.foreign chicken.format chicken.internal @@ -335,7 +334,8 @@ chicken.keyword chicken.load chicken.pretty-print - chicken.pathname) + chicken.pathname + chicken.syntax) (define (d arg1 . more) (when (##sys#debug-mode?) @@ -525,7 +525,7 @@ output)) (define (canonicalize-body/ln ln body se cs?) - (fluid-let ((chicken.expand#expansion-result-hook + (fluid-let ((chicken.syntax#expansion-result-hook (handle-expansion-result ln))) (##sys#canonicalize-body body se cs?))) @@ -622,7 +622,7 @@ (let* ((name0 (lookup (car x) se)) (name (or (and (symbol? name0) (##sys#get name0 '##core#primitive)) name0)) (xexpanded - (fluid-let ((chicken.expand#expansion-result-hook + (fluid-let ((chicken.syntax#expansion-result-hook (handle-expansion-result ln))) (expand x se compiler-syntax-enabled)))) (cond ((not (eq? x xexpanded)) diff --git a/csi.scm b/csi.scm index 583b495b..55f8ec3f 100644 --- a/csi.scm +++ b/csi.scm @@ -57,7 +57,8 @@ EOF chicken.platform chicken.port chicken.pretty-print - chicken.repl) + chicken.repl + chicken.syntax) (include "banner.scm") (include "mini-srfi-1.scm") diff --git a/defaults.make b/defaults.make index c9789f6e..69ca7330 100644 --- a/defaults.make +++ b/defaults.make @@ -268,10 +268,10 @@ DYNAMIC_IMPORT_LIBRARIES = srfi-4 DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise errno file.posix \ fixnum flonum format gc io keyword load locative memory \ platform posix pretty-print process process.signal \ - process-context random time time.posix + process-context random syntax time time.posix DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \ - eval expand file internal irregex lolevel pathname port \ + eval file internal irregex lolevel pathname port \ read-syntax repl tcp # targets diff --git a/distribution/manifest b/distribution/manifest index 9e71bddf..fcdc89c7 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -279,8 +279,6 @@ chicken.errno.import.scm chicken.errno.import.c chicken.eval.import.scm chicken.eval.import.c -chicken.expand.import.scm -chicken.expand.import.c chicken.file.import.scm chicken.file.import.c chicken.file.posix.import.scm @@ -333,6 +331,8 @@ chicken.read-syntax.import.scm chicken.read-syntax.import.c chicken.repl.import.scm chicken.repl.import.c +chicken.syntax.import.scm +chicken.syntax.import.c chicken.tcp.import.scm chicken.tcp.import.c chicken.time.import.scm diff --git a/eval.scm b/eval.scm index 2c62136e..0b4736f5 100644 --- a/eval.scm +++ b/eval.scm @@ -53,9 +53,9 @@ ;; Exclude bindings defined within this module. (import (except scheme eval interaction-environment null-environment scheme-report-environment) (except chicken eval-handler) - chicken.expand chicken.internal - chicken.keyword) + chicken.keyword + chicken.syntax) (include "common-declarations.scm") diff --git a/expand.scm b/expand.scm index 57a3a5a2..91ab9a2c 100644 --- a/expand.scm +++ b/expand.scm @@ -35,7 +35,7 @@ (hide check-for-multiple-bindings) (not inline ##sys#syntax-error-hook ##sys#compiler-syntax-hook)) -(module chicken.expand +(module chicken.syntax (expand get-line-number strip-syntax @@ -43,7 +43,7 @@ er-macro-transformer ir-macro-transformer) -(import scheme chicken +(import scheme (except chicken expand get-line-number strip-syntax syntax-error er-macro-transformer ir-macro-transformer) chicken.condition chicken.internal chicken.keyword @@ -606,7 +606,7 @@ (##sys#check-syntax 'define x '(_ (_ . lambda-list) . #(_ 1)) #f se) (loop2 - (expand-curried-define head (cddr x) se))) + (chicken.syntax#expand-curried-define head (cddr x) se))) (else (##sys#check-syntax 'define x @@ -638,7 +638,8 @@ ;;; A simple expression matcher -(define match-expression +;; Used by "quasiquote", below +(define chicken.syntax#match-expression (lambda (exp pat vars) (let ((env '())) (define (mwalk x p) @@ -657,7 +658,8 @@ ;;; Expand "curried" lambda-list syntax for `define' -(define (expand-curried-define head body se) +;; Used by "define", below +(define (chicken.syntax#expand-curried-define head body se) (let ((name #f)) (define (loop head body) (if (symbol? (car head)) @@ -949,17 +951,16 @@ ;; Expose some internals for use in core.scm and chicken-syntax.scm: -(define chicken.expand#define-definition define-definition) -(define chicken.expand#define-syntax-definition define-syntax-definition) -(define chicken.expand#define-values-definition define-values-definition) -(define chicken.expand#expansion-result-hook expansion-result-hook) - -) ; chicken.expand module +(define chicken.syntax#define-definition define-definition) +(define chicken.syntax#define-syntax-definition define-syntax-definition) +(define chicken.syntax#define-values-definition define-values-definition) +(define chicken.syntax#expansion-result-hook expansion-result-hook) +) ; chicken.syntax module ;;; Macro definitions: -(import chicken chicken.expand chicken.internal) +(import chicken chicken.syntax chicken.internal) (##sys#extend-macro-environment 'import-syntax '() @@ -975,7 +976,7 @@ ##sys#current-meta-environment ##sys#meta-macro-environment #t #f 'import-syntax-for-syntax))) -(set! chicken.expand#import-definition +(set! chicken.syntax#import-definition (##sys#extend-macro-environment 'import '() (##sys#er-transformer @@ -1126,7 +1127,7 @@ (##sys#check-syntax 'begin x '(_ . #(_ 0))) `(##core#begin ,@(cdr x))))) -(set! chicken.expand#define-definition +(set! chicken.syntax#define-definition (##sys#extend-macro-environment 'define '() @@ -1141,7 +1142,7 @@ (let ((name (or (getp head '##core#macro-alias) head))) (##sys#register-export name (##sys#current-module))) (when (c (r 'define) head) - (chicken.expand#defjam-error x)) + (chicken.syntax#defjam-error x)) `(##core#begin (##core#ensure-toplevel-definition ,head) (##core#set! @@ -1149,12 +1150,12 @@ ,(if (pair? body) (car body) '(##core#undefined))))) ((pair? (car head)) (##sys#check-syntax 'define form '(_ (_ . lambda-list) . #(_ 1))) - (loop (chicken.expand#expand-curried-define head body '()))) ;XXX '() should be se + (loop (chicken.syntax#expand-curried-define head body '()))) ;XXX '() should be se (else (##sys#check-syntax 'define form '(_ (symbol . lambda-list) . #(_ 1))) (loop (list (car x) (car head) `(##core#lambda ,(cdr head) ,@body))))))))))) -(set! chicken.expand#define-syntax-definition +(set! chicken.syntax#define-syntax-definition (##sys#extend-macro-environment 'define-syntax '() @@ -1166,7 +1167,7 @@ (let ((name (or (getp head '##core#macro-alias) head))) (##sys#register-export name (##sys#current-module))) (when (c (r 'define-syntax) head) - (chicken.expand#defjam-error form)) + (chicken.syntax#defjam-error form)) `(##core#define-syntax ,head ,body)))))) (define (check-for-multiple-bindings bindings form loc) @@ -1457,16 +1458,16 @@ (else `(##sys#cons ,(walk head n) ,(walk tail n)) ) ) ) ) ) ) (define (simplify x) - (cond ((chicken.expand#match-expression x '(##sys#cons a (##core#quote ())) '(a)) + (cond ((chicken.syntax#match-expression x '(##sys#cons a (##core#quote ())) '(a)) => (lambda (env) (simplify `(##sys#list ,(cdr (assq 'a env))))) ) - ((chicken.expand#match-expression x '(##sys#cons a (##sys#list . b)) '(a b)) + ((chicken.syntax#match-expression x '(##sys#cons a (##sys#list . b)) '(a b)) => (lambda (env) (let ((bxs (assq 'b env))) (if (fx< (length bxs) 32) (simplify `(##sys#list ,(cdr (assq 'a env)) ,@(cdr bxs) ) ) x) ) ) ) - ((chicken.expand#match-expression x '(##sys#append a (##core#quote ())) '(a)) + ((chicken.syntax#match-expression x '(##sys#append a (##core#quote ())) '(a)) => (lambda (env) (cdr (assq 'a env))) ) (else x) ) ) (##sys#check-syntax 'quasiquote form '(_ _)) diff --git a/irregex.scm b/irregex.scm index 738d93b1..b215240b 100644 --- a/irregex.scm +++ b/irregex.scm @@ -58,7 +58,9 @@ ;; Utilities sre->string irregex-opt irregex-quote) -(import scheme chicken) +(import scheme + chicken + chicken.syntax) (include "common-declarations.scm") diff --git a/modules.scm b/modules.scm index 637eda0c..28cab3d6 100644 --- a/modules.scm +++ b/modules.scm @@ -39,11 +39,11 @@ (define-syntax d (syntax-rules () ((_ . _) (void)))) -(import chicken.expand - chicken.internal +(import chicken.internal chicken.keyword chicken.load - chicken.platform) + chicken.platform + chicken.syntax) (define-alias dd d) (define-alias dm d) @@ -958,7 +958,6 @@ (##sys#register-module-alias 'data-structures 'chicken.data-structures) (##sys#register-module-alias 'errno 'chicken.errno) (##sys#register-module-alias 'eval 'chicken.eval) -(##sys#register-module-alias 'expand 'chicken.expand) (##sys#register-module-alias 'file 'chicken.file) (##sys#register-module-alias 'fixnum 'chicken.fixnum) (##sys#register-module-alias 'flonum 'chicken.flonum) @@ -980,6 +979,7 @@ (##sys#register-module-alias 'random 'chicken.random) (##sys#register-module-alias 'read-syntax 'chicken.read-syntax) (##sys#register-module-alias 'repl 'chicken.repl) +(##sys#register-module-alias 'syntax 'chicken.syntax) (##sys#register-module-alias 'tcp 'chicken.tcp) (##sys#register-module-alias 'time 'chicken.time) diff --git a/rules.make b/rules.make index 954fde45..0db3fa6b 100644 --- a/rules.make +++ b/rules.make @@ -519,6 +519,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.pretty-print,extras) $(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.syntax,expand)) chicken.c: chicken.scm mini-srfi-1.scm \ chicken.compiler.batch-driver.import.scm \ @@ -566,12 +567,12 @@ core.c: core.scm mini-srfi-1.scm \ chicken.compiler.support.import.scm \ chicken.data-structures.import.scm \ chicken.eval.import.scm \ - chicken.expand.import.scm \ chicken.format.import.scm \ chicken.io.import.scm \ chicken.keyword.import.scm \ chicken.load.import.scm \ - chicken.pretty-print.import.scm + chicken.pretty-print.import.scm \ + chicken.syntax.import.scm optimizer.c: optimizer.scm mini-srfi-1.scm \ chicken.compiler.support.import.scm \ chicken.data-structures.import.scm \ @@ -581,14 +582,14 @@ scheduler.c: scheduler.scm \ scrutinizer.c: scrutinizer.scm mini-srfi-1.scm \ chicken.compiler.support.import.scm \ chicken.data-structures.import.scm \ - chicken.expand.import.scm \ chicken.format.import.scm \ chicken.internal.import.scm \ chicken.io.import.scm \ chicken.pathname.import.scm \ chicken.platform.import.scm \ chicken.port.import.scm \ - chicken.pretty-print.import.scm + chicken.pretty-print.import.scm \ + chicken.syntax.import.scm lfa2.c: lfa2.scm mini-srfi-1.scm \ chicken.compiler.support.import.scm \ chicken.format.import.scm @@ -604,7 +605,6 @@ support.c: support.scm mini-srfi-1.scm \ chicken.bitwise.import.scm \ chicken.condition.import.scm \ chicken.data-structures.import.scm \ - chicken.expand.import.scm \ chicken.file.import.scm \ chicken.foreign.import.scm \ chicken.format.import.scm \ @@ -616,13 +616,14 @@ support.c: support.scm mini-srfi-1.scm \ chicken.port.import.scm \ chicken.pretty-print.import.scm \ chicken.random.import.scm \ + chicken.syntax.import.scm \ chicken.time.import.scm modules.c: modules.scm \ - chicken.expand.import.scm \ chicken.internal.import.scm \ chicken.keyword.import.scm \ chicken.load.import.scm \ - chicken.platform.import.scm + chicken.platform.import.scm \ + chicken.syntax.import.scm csc.c: csc.scm \ chicken.data-structures.import.scm \ chicken.format.import.scm \ @@ -692,10 +693,10 @@ chicken-syntax.c: chicken-syntax.scm \ chicken.platform.import.scm srfi-4.c: srfi-4.scm \ chicken.bitwise.import.scm \ - chicken.expand.import.scm \ chicken.foreign.import.scm \ chicken.gc.import.scm \ - chicken.platform.import.scm + chicken.platform.import.scm \ + chicken.syntax.import.scm posixunix.c: posixunix.scm \ chicken.bitwise.import.scm \ chicken.condition.import.scm \ @@ -729,11 +730,11 @@ extras.c: extras.scm \ chicken.time.import.scm eval.c: eval.scm \ chicken.condition.import.scm \ - chicken.expand.import.scm \ chicken.foreign.import.scm \ chicken.internal.import.scm \ chicken.keyword.import.scm \ - chicken.platform.import.scm + chicken.platform.import.scm \ + chicken.syntax.import.scm repl.c: repl.scm \ chicken.eval.import.scm file.c: file.scm \ @@ -786,7 +787,7 @@ repl.c: $(SRCDIR)repl.scm $(SRCDIR)common-declarations.scm expand.c: $(SRCDIR)expand.scm $(SRCDIR)synrules.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) \ -no-module-registration \ - -emit-import-library chicken.expand + -emit-import-library chicken.syntax 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/scrutinizer.scm b/scrutinizer.scm index ee50a535..966a4a6f 100644 --- a/scrutinizer.scm +++ b/scrutinizer.scm @@ -37,14 +37,14 @@ (import chicken scheme chicken.compiler.support chicken.data-structures - chicken.expand chicken.format chicken.internal chicken.io chicken.pathname chicken.platform chicken.port - chicken.pretty-print) + chicken.pretty-print + chicken.syntax) (include "tweaks") (include "mini-srfi-1.scm") diff --git a/srfi-4.scm b/srfi-4.scm index bd6d727d..14c0f080 100644 --- a/srfi-4.scm +++ b/srfi-4.scm @@ -80,10 +80,10 @@ EOF (import scheme chicken) (import chicken.bitwise - chicken.expand chicken.foreign chicken.gc - chicken.platform) + chicken.platform + chicken.syntax) (include "common-declarations.scm") diff --git a/support.scm b/support.scm index 233ad961..6ddb47c6 100644 --- a/support.scm +++ b/support.scm @@ -79,7 +79,6 @@ chicken.bitwise chicken.condition chicken.data-structures - chicken.expand chicken.file chicken.foreign chicken.format @@ -91,6 +90,7 @@ chicken.port chicken.pretty-print chicken.random + chicken.syntax chicken.time) (include "tweaks") diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm index d753beea..348a0fbc 100644 --- a/tests/compiler-tests.scm +++ b/tests/compiler-tests.scm @@ -3,7 +3,7 @@ (import (chicken bitwise) (chicken flonum) (chicken foreign) (chicken condition) (srfi 4)) -(import-for-syntax data-structures expand) +(import-for-syntax (chicken syntax) data-structures) ;; test dropping of previous toplevel assignments diff --git a/types.db b/types.db index dfc1d0bf..40a5e05e 100644 --- a/types.db +++ b/types.db @@ -1020,12 +1020,6 @@ ((* (or symbol char eof null undefined)) (eq? #(1) #(2))) ((number number) (= #(1) #(2)))) -(chicken.expand#er-macro-transformer - (#(procedure #:clean #:enforce) - chicken.expand#er-macro-transformer - ((procedure (* (procedure (*) *) (procedure (* *) *)) *)) - (struct transformer))) - (errno (#(procedure #:clean) errno () fixnum)) (error (procedure error (* #!rest) noreturn)) (##sys#error (procedure ##sys#error (* #!rest) noreturn)) @@ -1035,7 +1029,6 @@ (executable-pathname (#(procedure #:pure) executable-pathname () (or string false))) (exit (procedure exit (#!optional fixnum) noreturn)) (exit-handler (#(procedure #:clean #:enforce) exit-handler (#!optional (procedure (fixnum) . *)) procedure)) -(chicken.expand#expand (procedure chicken.expand#expand (* #!optional list) *)) (file-exists? (#(procedure #:clean #:enforce) file-exists? (string) (or false string))) (directory-exists? (#(procedure #:clean #:enforce) directory-exists? (string) (or false string))) @@ -1252,12 +1245,6 @@ (implicit-exit-handler (#(procedure #:clean #:enforce) implicit-exit-handler (#!optional (procedure () . *)) procedure)) -(chicken.expand#ir-macro-transformer - (#(procedure #:clean #:enforce) - chicken.expand#ir-macro-transformer - ((procedure (* (procedure (*) *) (procedure (* *) *)) *)) - (struct transformer))) - (keyword-style (#(procedure #:clean) keyword-style (#!optional symbol) symbol)) (make-blob (#(procedure #:clean #:enforce) make-blob (fixnum) blob) @@ -1336,7 +1323,6 @@ (sleep (#(procedure #:clean #:enforce) sleep (fixnum) undefined)) (string->blob (#(procedure #:clean #:enforce) string->blob (string) blob)) (string->uninterned-symbol (#(procedure #:clean #:enforce) string->uninterned-symbol (string) symbol)) -(chicken.expand#strip-syntax (#(procedure #:clean) chicken.expand#strip-syntax (*) *)) (sub1 (#(procedure #:clean #:enforce #:foldable) sub1 (number) number) ((fixnum) (integer) @@ -1354,7 +1340,6 @@ (symbol-plist (#(procedure #:clean #:enforce) symbol-plist (symbol) list) ((symbol) (##sys#slot #(1) '2))) -(chicken.expand#syntax-error (procedure chicken.expand#syntax-error (* #!rest) noreturn)) (system (#(procedure #:clean #:enforce) system (string) fixnum)) (vector-resize (forall (a b) (#(procedure #:clean #:enforce) vector-resize ((vector-of a) fixnum #!optional b) @@ -2293,6 +2278,21 @@ (srfi-4#number-vector? (#(procedure #:pure #:predicate (or (struct u8vector) (struct u16vector) (struct s8vector) (struct s16vector) (struct u32vector) (struct s32vector) (struct u64vector) (struct s64vector) (struct f32vector) (struct f64vector))) srfi-4#number-vector? (*) boolean)) (##sys#srfi-4-vector? (#(procedure #:pure #:predicate (or (struct u8vector) (struct u16vector) (struct s8vector) (struct s16vector) (struct u32vector) (struct s32vector) (struct u64vector) (struct s64vector) (struct f32vector) (struct f64vector))) ##sys#srfi-4-vector? (*) boolean)) +;; syntax + +(chicken.syntax#er-macro-transformer + (#(procedure #:clean #:enforce) + chicken.syntax#er-macro-transformer + ((procedure (* (procedure (*) *) (procedure (* *) *)) *)) + (struct transformer))) +(chicken.syntax#expand (procedure chicken.syntax#expand (* #!optional list) *)) +(chicken.syntax#ir-macro-transformer + (#(procedure #:clean #:enforce) + chicken.syntax#ir-macro-transformer + ((procedure (* (procedure (*) *) (procedure (* *) *)) *)) + (struct transformer))) +(chicken.syntax#strip-syntax (#(procedure #:clean) chicken.syntax#strip-syntax (*) *)) +(chicken.syntax#syntax-error (procedure chicken.syntax#syntax-error (* #!rest) noreturn)) ;; tcp -- 2.11.0