diff options
Diffstat (limited to 'module/ice-9/psyntax.scm')
| -rw-r--r-- | module/ice-9/psyntax.scm | 340 |
1 files changed, 170 insertions, 170 deletions
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 40b228c07..67491bbaa 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -857,17 +857,17 @@ ;; expanding - (define chi-sequence + (define expand-sequence (lambda (body r w s mod) (build-sequence s (let dobody ((body body) (r r) (w w) (mod mod)) (if (null? body) '() - (let ((first (chi (car body) r w mod))) + (let ((first (expand (car body) r w mod))) (cons first (dobody (cdr body) r w mod)))))))) ;; At top-level, we allow mixed definitions and expressions. Like - ;; chi-body we expand in two passes. + ;; expand-body we expand in two passes. ;; ;; First, from left to right, we expand just enough to know what ;; expressions are definitions, syntax definitions, and splicing @@ -880,7 +880,7 @@ ;; expansions of all normal definitions and expressions in the ;; sequence. ;; - (define chi-top-sequence + (define expand-top-sequence (lambda (body r w s m esew mod) (define (scan body r w s m esew mod exps) (cond @@ -902,13 +902,13 @@ ((_ e1 e2 ...) (scan #'(e1 e2 ...) r w s m esew mod exps)))) ((local-syntax-form) - (chi-local-syntax value e r w s mod - (lambda (body r w s mod) - (scan body r w s m esew mod exps)))) + (expand-local-syntax value e r w s mod + (lambda (body r w s mod) + (scan body r w s m esew mod exps)))) ((eval-when-form) (syntax-case e () ((_ (x ...) e1 e2 ...) - (let ((when-list (chi-when-list e #'(x ...) w)) + (let ((when-list (expand-when-list e #'(x ...) w)) (body #'(e1 e2 ...))) (cond ((eq? m 'e) @@ -920,7 +920,7 @@ (begin (if (memq 'expand when-list) (top-level-eval-hook - (chi-top-sequence body r w s 'e '(eval) mod) + (expand-top-sequence body r w s 'e '(eval) mod) mod)) (values exps)))) ((memq 'load when-list) @@ -935,7 +935,7 @@ (memq 'expand when-list) (and (eq? m 'c&e) (memq 'eval when-list))) (top-level-eval-hook - (chi-top-sequence body r w s 'e '(eval) mod) + (expand-top-sequence body r w s 'e '(eval) mod) mod) (values exps)) (else @@ -945,23 +945,23 @@ (case m ((c) (if (memq 'compile esew) - (let ((e (chi-install-global n (chi e r w mod)))) + (let ((e (expand-install-global n (expand e r w mod)))) (top-level-eval-hook e mod) (if (memq 'load esew) (values (cons e exps)) (values exps))) (if (memq 'load esew) - (values (cons (chi-install-global n (chi e r w mod)) + (values (cons (expand-install-global n (expand e r w mod)) exps)) (values exps)))) ((c&e) - (let ((e (chi-install-global n (chi e r w mod)))) + (let ((e (expand-install-global n (expand e r w mod)))) (top-level-eval-hook e mod) (values (cons e exps)))) (else (if (memq 'eval esew) (top-level-eval-hook - (chi-install-global n (chi e r w mod)) + (expand-install-global n (expand e r w mod)) mod)) (values exps))))) ((define-form) @@ -983,11 +983,11 @@ (values (cons (if (eq? m 'c&e) - (let ((x (build-global-definition s n (chi e r w mod)))) + (let ((x (build-global-definition s n (expand e r w mod)))) (top-level-eval-hook x mod) x) (lambda () - (build-global-definition s n (chi e r w mod)))) + (build-global-definition s n (expand e r w mod)))) exps))) ((displaced-lexical) (syntax-violation #f "identifier out of context" @@ -998,11 +998,11 @@ (else (values (cons (if (eq? m 'c&e) - (let ((x (chi-expr type value e r w s mod))) + (let ((x (expand-expr type value e r w s mod))) (top-level-eval-hook x mod) x) (lambda () - (chi-expr type value e r w s mod))) + (expand-expr type value e r w s mod))) exps))))))) (lambda (exps) (scan (cdr body) r w s m esew mod exps)))))) @@ -1020,7 +1020,7 @@ (lp (cdr in) (cons (if (procedure? e) (e) e) out))))))))))) - (define chi-install-global + (define expand-install-global (lambda (name e) (build-global-definition no-source @@ -1032,7 +1032,7 @@ (build-data no-source 'macro) e))))) - (define chi-when-list + (define expand-when-list (lambda (e when-list w) ;; when-list is syntax'd version of list of situations (let f ((when-list when-list) (situations '())) @@ -1044,7 +1044,7 @@ ((free-id=? x #'compile) 'compile) ((free-id=? x #'load) 'load) ((free-id=? x #'eval) 'eval) - ((free-id=? x #'expand) 'expand) + ((eq? (syntax->datum x) 'expand) 'expand) (else (syntax-violation 'eval-when "invalid situation" e (wrap x w #f))))) @@ -1099,7 +1099,7 @@ ((macro) (if for-car? (values type (binding-value b) e w s mod) - (syntax-type (chi-macro (binding-value b) e r w s rib mod) + (syntax-type (expand-macro (binding-value b) e r w s rib mod) r empty-wrap s rib mod #f))) (else (values type (binding-value b) e w s mod))))) ((pair? e) @@ -1117,7 +1117,7 @@ (values 'global-call (make-syntax-object fval w fmod) e w s mod)) ((macro) - (syntax-type (chi-macro fval e r w s rib mod) + (syntax-type (expand-macro fval e r w s rib mod) r empty-wrap s rib mod for-car?)) ((module-ref) (call-with-values (lambda () (fval e r w)) @@ -1167,14 +1167,14 @@ ((self-evaluating? e) (values 'constant #f e w s mod)) (else (values 'other #f e w s mod))))) - (define chi + (define expand (lambda (e r w mod) (call-with-values (lambda () (syntax-type e r w (source-annotation e) #f mod #f)) (lambda (type value e w s mod) - (chi-expr type value e r w s mod))))) + (expand-expr type value e r w s mod))))) - (define chi-expr + (define expand-expr (lambda (type value e r w s mod) (case type ((lexical) @@ -1185,9 +1185,9 @@ ((module-ref) (call-with-values (lambda () (value e r w)) (lambda (e r w s mod) - (chi e r w mod)))) + (expand e r w mod)))) ((lexical-call) - (chi-application + (expand-application (let ((id (car e))) (build-lexical-reference 'fun (source-annotation id) (if (syntax-object? id) @@ -1196,7 +1196,7 @@ value)) e r w s mod)) ((global-call) - (chi-application + (expand-application (build-global-reference (source-annotation (car e)) (if (syntax-object? value) (syntax-object-expression value) @@ -1207,19 +1207,19 @@ e r w s mod)) ((constant) (build-data s (strip (source-wrap e w s mod) empty-wrap))) ((global) (build-global-reference s value mod)) - ((call) (chi-application (chi (car e) r w mod) e r w s mod)) + ((call) (expand-application (expand (car e) r w mod) e r w s mod)) ((begin-form) (syntax-case e () - ((_ e1 e2 ...) (chi-sequence #'(e1 e2 ...) r w s mod)))) + ((_ e1 e2 ...) (expand-sequence #'(e1 e2 ...) r w s mod)))) ((local-syntax-form) - (chi-local-syntax value e r w s mod chi-sequence)) + (expand-local-syntax value e r w s mod expand-sequence)) ((eval-when-form) (syntax-case e () ((_ (x ...) e1 e2 ...) - (let ((when-list (chi-when-list e #'(x ...) w))) + (let ((when-list (expand-when-list e #'(x ...) w))) (if (memq 'eval when-list) - (chi-sequence #'(e1 e2 ...) r w s mod) - (chi-void)))))) + (expand-sequence #'(e1 e2 ...) r w s mod) + (expand-void)))))) ((define-form define-syntax-form) (syntax-violation #f "definition in expression context" e (wrap value w mod))) @@ -1232,12 +1232,12 @@ (else (syntax-violation #f "unexpected syntax" (source-wrap e w s mod)))))) - (define chi-application + (define expand-application (lambda (x e r w s mod) (syntax-case e () ((e0 e1 ...) (build-application s x - (map (lambda (e) (chi e r w mod)) #'(e1 ...))))))) + (map (lambda (e) (expand e r w mod)) #'(e1 ...))))))) ;; (What follows is my interpretation of what's going on here -- Andy) ;; @@ -1272,7 +1272,7 @@ ;; really nice if we could also annotate introduced expressions with the ;; locations corresponding to the macro definition, but that is not yet ;; possible. - (define chi-macro + (define expand-macro (lambda (p e r w s rib mod) (define rebuild-macro-output (lambda (x m) @@ -1313,7 +1313,7 @@ (rebuild-macro-output (p (source-wrap e (anti-mark w) s mod)) (new-mark)))) - (define chi-body + (define expand-body ;; In processing the forms of the body, we create a new, empty wrap. ;; This wrap is augmented (destructively) each time we discover that ;; the next form is a definition. This is done: @@ -1393,19 +1393,19 @@ (f (cdr forms))))) ids labels var-ids vars vals bindings)))) ((local-syntax-form) - (chi-local-syntax value e er w s mod - (lambda (forms er w s mod) - (parse (let f ((forms forms)) - (if (null? forms) - (cdr body) - (cons (cons er (wrap (car forms) w mod)) - (f (cdr forms))))) - ids labels var-ids vars vals bindings)))) + (expand-local-syntax value e er w s mod + (lambda (forms er w s mod) + (parse (let f ((forms forms)) + (if (null? forms) + (cdr body) + (cons (cons er (wrap (car forms) w mod)) + (f (cdr forms))))) + ids labels var-ids vars vals bindings)))) (else ; found a non-definition (if (null? ids) (build-sequence no-source (map (lambda (x) - (chi (cdr x) (car x) empty-wrap mod)) + (expand (cdr x) (car x) empty-wrap mod)) (cons (cons er (source-wrap e w s mod)) (cdr body)))) (begin @@ -1424,7 +1424,7 @@ (macros-only-env er)))) (set-cdr! b (eval-local-transformer - (chi (cddr b) r-cache empty-wrap mod) + (expand (cddr b) r-cache empty-wrap mod) mod)) (loop (cdr bs) er r-cache)) (loop (cdr bs) er-cache r-cache))))) @@ -1433,15 +1433,15 @@ (reverse (map syntax->datum var-ids)) (reverse vars) (map (lambda (x) - (chi (cdr x) (car x) empty-wrap mod)) + (expand (cdr x) (car x) empty-wrap mod)) (reverse vals)) (build-sequence no-source (map (lambda (x) - (chi (cdr x) (car x) empty-wrap mod)) + (expand (cdr x) (car x) empty-wrap mod)) (cons (cons er (source-wrap e w s mod)) (cdr body))))))))))))))))) - (define chi-local-syntax + (define expand-local-syntax (lambda (rec? e r w s mod k) (syntax-case e () ((_ ((id val) ...) e1 e2 ...) @@ -1458,7 +1458,7 @@ (map (lambda (x) (make-binding 'macro (eval-local-transformer - (chi x trans-r w mod) + (expand x trans-r w mod) mod))) #'(val ...))) r) @@ -1475,7 +1475,7 @@ p (syntax-violation #f "nonprocedure transformer" p))))) - (define chi-void + (define expand-void (lambda () (build-void no-source))) @@ -1505,7 +1505,7 @@ orig-args)))) (req orig-args '()))) - (define chi-simple-lambda + (define expand-simple-lambda (lambda (e r w s mod req rest meta body) (let* ((ids (if rest (append req (list rest)) req)) (vars (map gen-var ids)) @@ -1514,10 +1514,10 @@ s (map syntax->datum req) (and rest (syntax->datum rest)) vars meta - (chi-body body (source-wrap e w s mod) - (extend-var-env labels vars r) - (make-binding-wrap ids labels w) - mod))))) + (expand-body body (source-wrap e w s mod) + (extend-var-env labels vars r) + (make-binding-wrap ids labels w) + mod))))) (define lambda*-formals (lambda (orig-args) @@ -1600,16 +1600,16 @@ orig-args)))) (req orig-args '()))) - (define chi-lambda-case + (define expand-lambda-case (lambda (e r w s mod get-formals clauses) - (define (expand-req req opt rest kw body) + (define (parse-req req opt rest kw body) (let ((vars (map gen-var req)) (labels (gen-labels req))) (let ((r* (extend-var-env labels vars r)) (w* (make-binding-wrap req labels w))) - (expand-opt (map syntax->datum req) - opt rest kw body (reverse vars) r* w* '() '())))) - (define (expand-opt req opt rest kw body vars r* w* out inits) + (parse-opt (map syntax->datum req) + opt rest kw body (reverse vars) r* w* '() '())))) + (define (parse-opt req opt rest kw body vars r* w* out inits) (cond ((pair? opt) (syntax-case (car opt) () @@ -1618,27 +1618,27 @@ (l (gen-labels (list v))) (r** (extend-var-env l (list v) r*)) (w** (make-binding-wrap (list #'id) l w*))) - (expand-opt req (cdr opt) rest kw body (cons v vars) - r** w** (cons (syntax->datum #'id) out) - (cons (chi #'i r* w* mod) inits)))))) + (parse-opt req (cdr opt) rest kw body (cons v vars) + r** w** (cons (syntax->datum #'id) out) + (cons (expand #'i r* w* mod) inits)))))) (rest (let* ((v (gen-var rest)) (l (gen-labels (list v))) (r* (extend-var-env l (list v) r*)) (w* (make-binding-wrap (list rest) l w*))) - (expand-kw req (if (pair? out) (reverse out) #f) - (syntax->datum rest) - (if (pair? kw) (cdr kw) kw) - body (cons v vars) r* w* - (if (pair? kw) (car kw) #f) - '() inits))) + (parse-kw req (if (pair? out) (reverse out) #f) + (syntax->datum rest) + (if (pair? kw) (cdr kw) kw) + body (cons v vars) r* w* + (if (pair? kw) (car kw) #f) + '() inits))) (else - (expand-kw req (if (pair? out) (reverse out) #f) #f - (if (pair? kw) (cdr kw) kw) - body vars r* w* - (if (pair? kw) (car kw) #f) - '() inits)))) - (define (expand-kw req opt rest kw body vars r* w* aok out inits) + (parse-kw req (if (pair? out) (reverse out) #f) #f + (if (pair? kw) (cdr kw) kw) + body vars r* w* + (if (pair? kw) (car kw) #f) + '() inits)))) + (define (parse-kw req opt rest kw body vars r* w* aok out inits) (cond ((pair? kw) (syntax-case (car kw) () @@ -1647,31 +1647,31 @@ (l (gen-labels (list v))) (r** (extend-var-env l (list v) r*)) (w** (make-binding-wrap (list #'id) l w*))) - (expand-kw req opt rest (cdr kw) body (cons v vars) - r** w** aok - (cons (list (syntax->datum #'k) - (syntax->datum #'id) - v) - out) - (cons (chi #'i r* w* mod) inits)))))) + (parse-kw req opt rest (cdr kw) body (cons v vars) + r** w** aok + (cons (list (syntax->datum #'k) + (syntax->datum #'id) + v) + out) + (cons (expand #'i r* w* mod) inits)))))) (else - (expand-body req opt rest - (if (or aok (pair? out)) (cons aok (reverse out)) #f) - body (reverse vars) r* w* (reverse inits) '())))) - (define (expand-body req opt rest kw body vars r* w* inits meta) + (parse-body req opt rest + (if (or aok (pair? out)) (cons aok (reverse out)) #f) + body (reverse vars) r* w* (reverse inits) '())))) + (define (parse-body req opt rest kw body vars r* w* inits meta) (syntax-case body () ((docstring e1 e2 ...) (string? (syntax->datum #'docstring)) - (expand-body req opt rest kw #'(e1 e2 ...) vars r* w* inits - (append meta - `((documentation - . ,(syntax->datum #'docstring)))))) + (parse-body req opt rest kw #'(e1 e2 ...) vars r* w* inits + (append meta + `((documentation + . ,(syntax->datum #'docstring)))))) ((#((k . v) ...) e1 e2 ...) - (expand-body req opt rest kw #'(e1 e2 ...) vars r* w* inits - (append meta (syntax->datum #'((k . v) ...))))) + (parse-body req opt rest kw #'(e1 e2 ...) vars r* w* inits + (append meta (syntax->datum #'((k . v) ...))))) ((e1 e2 ...) (values meta req opt rest kw inits vars - (chi-body #'(e1 e2 ...) (source-wrap e w s mod) - r* w* mod))))) + (expand-body #'(e1 e2 ...) (source-wrap e w s mod) + r* w* mod))))) (syntax-case clauses () (() (values '() #f)) @@ -1679,12 +1679,12 @@ (call-with-values (lambda () (get-formals #'args)) (lambda (req opt rest kw) (call-with-values (lambda () - (expand-req req opt rest kw #'(e1 e2 ...))) + (parse-req req opt rest kw #'(e1 e2 ...))) (lambda (meta req opt rest kw inits vars body) (call-with-values (lambda () - (chi-lambda-case e r w s mod get-formals - #'((args* e1* e2* ...) ...))) + (expand-lambda-case e r w s mod get-formals + #'((args* e1* e2* ...) ...))) (lambda (meta* else*) (values (append meta meta*) @@ -1768,7 +1768,7 @@ (source-wrap id w s mod))))) #'(var ...) names) - (chi-body + (expand-body #'(e1 e2 ...) (source-wrap e w s mod) (extend-env @@ -1776,7 +1776,7 @@ (let ((trans-r (macros-only-env r))) (map (lambda (x) (make-binding 'macro - (eval-local-transformer (chi x trans-r w mod) + (eval-local-transformer (expand x trans-r w mod) mod))) #'(val ...))) r) @@ -1970,7 +1970,7 @@ ((#((k . v) ...) e1 e2 ...) (lp #'(e1 e2 ...) (append meta (syntax->datum #'((k . v) ...))))) - (_ (chi-simple-lambda e r w s mod req rest meta body))))))) + (_ (expand-simple-lambda e r w s mod req rest meta body))))))) (_ (syntax-violation 'lambda "bad lambda" e))))) (global-extend 'core 'lambda* @@ -1979,8 +1979,8 @@ ((_ args e1 e2 ...) (call-with-values (lambda () - (chi-lambda-case e r w s mod - lambda*-formals #'((args e1 e2 ...)))) + (expand-lambda-case e r w s mod + lambda*-formals #'((args e1 e2 ...)))) (lambda (meta lcase) (build-case-lambda s meta lcase)))) (_ (syntax-violation 'lambda "bad lambda*" e))))) @@ -1991,9 +1991,9 @@ ((_ (args e1 e2 ...) (args* e1* e2* ...) ...) (call-with-values (lambda () - (chi-lambda-case e r w s mod - lambda-formals - #'((args e1 e2 ...) (args* e1* e2* ...) ...))) + (expand-lambda-case e r w s mod + lambda-formals + #'((args e1 e2 ...) (args* e1* e2* ...) ...))) (lambda (meta lcase) (build-case-lambda s meta lcase)))) (_ (syntax-violation 'case-lambda "bad case-lambda" e))))) @@ -2004,16 +2004,16 @@ ((_ (args e1 e2 ...) (args* e1* e2* ...) ...) (call-with-values (lambda () - (chi-lambda-case e r w s mod - lambda*-formals - #'((args e1 e2 ...) (args* e1* e2* ...) ...))) + (expand-lambda-case e r w s mod + lambda*-formals + #'((args e1 e2 ...) (args* e1* e2* ...) ...))) (lambda (meta lcase) (build-case-lambda s meta lcase)))) (_ (syntax-violation 'case-lambda "bad case-lambda*" e))))) (global-extend 'core 'let (let () - (define (chi-let e r w s mod constructor ids vals exps) + (define (expand-let e r w s mod constructor ids vals exps) (if (not (valid-bound-ids? ids)) (syntax-violation 'let "duplicate bound variable" e) (let ((labels (gen-labels ids)) @@ -2023,25 +2023,25 @@ (constructor s (map syntax->datum ids) new-vars - (map (lambda (x) (chi x r w mod)) vals) - (chi-body exps (source-wrap e nw s mod) - nr nw mod)))))) + (map (lambda (x) (expand x r w mod)) vals) + (expand-body exps (source-wrap e nw s mod) + nr nw mod)))))) (lambda (e r w s mod) (syntax-case e () ((_ ((id val) ...) e1 e2 ...) (and-map id? #'(id ...)) - (chi-let e r w s mod - build-let - #'(id ...) - #'(val ...) - #'(e1 e2 ...))) + (expand-let e r w s mod + build-let + #'(id ...) + #'(val ...) + #'(e1 e2 ...))) ((_ f ((id val) ...) e1 e2 ...) (and (id? #'f) (and-map id? #'(id ...))) - (chi-let e r w s mod - build-named-let - #'(f id ...) - #'(val ...) - #'(e1 e2 ...))) + (expand-let e r w s mod + build-named-let + #'(f id ...) + #'(val ...) + #'(e1 e2 ...))) (_ (syntax-violation 'let "bad let" (source-wrap e w s mod))))))) @@ -2060,9 +2060,9 @@ (build-letrec s #f (map syntax->datum ids) new-vars - (map (lambda (x) (chi x r w mod)) #'(val ...)) - (chi-body #'(e1 e2 ...) - (source-wrap e w s mod) r w mod))))))) + (map (lambda (x) (expand x r w mod)) #'(val ...)) + (expand-body #'(e1 e2 ...) + (source-wrap e w s mod) r w mod))))))) (_ (syntax-violation 'letrec "bad letrec" (source-wrap e w s mod)))))) @@ -2081,9 +2081,9 @@ (build-letrec s #t (map syntax->datum ids) new-vars - (map (lambda (x) (chi x r w mod)) #'(val ...)) - (chi-body #'(e1 e2 ...) - (source-wrap e w s mod) r w mod))))))) + (map (lambda (x) (expand x r w mod)) #'(val ...)) + (expand-body #'(e1 e2 ...) + (source-wrap e w s mod) r w mod))))))) (_ (syntax-violation 'letrec* "bad letrec*" (source-wrap e w s mod)))))) @@ -2103,15 +2103,15 @@ (build-lexical-assignment s (syntax->datum #'id) (binding-value b) - (chi #'val r w mod))) + (expand #'val r w mod))) ((global) - (build-global-assignment s n (chi #'val r w mod) id-mod)) + (build-global-assignment s n (expand #'val r w mod) id-mod)) ((macro) (let ((p (binding-value b))) (if (procedure-property p 'variable-transformer) - ;; As syntax-type does, call chi-macro with + ;; As syntax-type does, call expand-macro with ;; the mod of the expression. Hmm. - (chi (chi-macro p e r w s #f mod) r empty-wrap mod) + (expand (expand-macro p e r w s #f mod) r empty-wrap mod) (syntax-violation 'set! "not a variable transformer" (wrap e w mod) (wrap #'id w id-mod))))) @@ -2126,7 +2126,7 @@ (lambda (type value ee ww ss modmod) (case type ((module-ref) - (let ((val (chi #'val r w mod))) + (let ((val (expand #'val r w mod))) (call-with-values (lambda () (value #'(head tail ...) r w)) (lambda (e r w s* mod) (syntax-case e () @@ -2135,8 +2135,8 @@ val mod))))))) (else (build-application s - (chi #'(setter head) r w mod) - (map (lambda (e) (chi e r w mod)) + (expand #'(setter head) r w mod) + (map (lambda (e) (expand e r w mod)) #'(tail ... val)))))))) (_ (syntax-violation 'set! "bad set!" (source-wrap e w s mod)))))) @@ -2182,15 +2182,15 @@ ((_ test then) (build-conditional s - (chi #'test r w mod) - (chi #'then r w mod) + (expand #'test r w mod) + (expand #'then r w mod) (build-void no-source))) ((_ test then else) (build-conditional s - (chi #'test r w mod) - (chi #'then r w mod) - (chi #'else r w mod)))))) + (expand #'test r w mod) + (expand #'then r w mod) + (expand #'else r w mod)))))) (global-extend 'core 'with-fluids (lambda (e r w s mod) @@ -2198,10 +2198,10 @@ ((_ ((fluid val) ...) b b* ...) (build-dynlet s - (map (lambda (x) (chi x r w mod)) #'(fluid ...)) - (map (lambda (x) (chi x r w mod)) #'(val ...)) - (chi-body #'(b b* ...) - (source-wrap e w s mod) r w mod)))))) + (map (lambda (x) (expand x r w mod)) #'(fluid ...)) + (map (lambda (x) (expand x r w mod)) #'(val ...)) + (expand-body #'(b b* ...) + (source-wrap e w s mod) r w mod)))))) (global-extend 'begin 'begin '()) @@ -2289,16 +2289,16 @@ (build-application no-source (build-primref no-source 'apply) (list (build-simple-lambda no-source (map syntax->datum ids) #f new-vars '() - (chi exp - (extend-env - labels - (map (lambda (var level) - (make-binding 'syntax `(,var . ,level))) - new-vars - (map cdr pvars)) - r) - (make-binding-wrap ids labels empty-wrap) - mod)) + (expand exp + (extend-env + labels + (map (lambda (var level) + (make-binding 'syntax `(,var . ,level))) + new-vars + (map cdr pvars)) + r) + (make-binding-wrap ids labels empty-wrap) + mod)) y)))))) (define gen-clause @@ -2350,20 +2350,20 @@ (and-map (lambda (x) (not (free-id=? #'pat x))) (cons #'(... ...) keys))) (if (free-id=? #'pad #'_) - (chi #'exp r empty-wrap mod) + (expand #'exp r empty-wrap mod) (let ((labels (list (gen-label))) (var (gen-var #'pat))) (build-application no-source (build-simple-lambda no-source (list (syntax->datum #'pat)) #f (list var) '() - (chi #'exp - (extend-env labels - (list (make-binding 'syntax `(,var . 0))) - r) - (make-binding-wrap #'(pat) - labels empty-wrap) - mod)) + (expand #'exp + (extend-env labels + (list (make-binding 'syntax `(,var . 0))) + r) + (make-binding-wrap #'(pat) + labels empty-wrap) + mod)) (list x)))) (gen-clause x keys (cdr clauses) r #'pat #t #'exp mod))) @@ -2388,10 +2388,10 @@ #'(key ...) #'(m ...) r mod)) - (list (chi #'val r empty-wrap mod)))) + (list (expand #'val r empty-wrap mod)))) (syntax-violation 'syntax-case "invalid literals list" e)))))))) - ;; The portable macroexpand seeds chi-top's mode m with 'e (for + ;; The portable macroexpand seeds expand-top's mode m with 'e (for ;; evaluating) and esew (which stands for "eval syntax expanders ;; when") with '(eval). In Chez Scheme, m is set to 'c instead of e ;; if we are compiling a file, and esew is set to @@ -2402,8 +2402,8 @@ ;; the object file if we are compiling a file. (set! macroexpand (lambda* (x #:optional (m 'e) (esew '(eval))) - (chi-top-sequence (list x) null-env top-wrap #f m esew - (cons 'hygiene (module-name (current-module)))))) + (expand-top-sequence (list x) null-env top-wrap #f m esew + (cons 'hygiene (module-name (current-module)))))) (set! identifier? (lambda (x) |