new env protocol; visit/x passes R7RS tests

This commit is contained in:
ESL 2024-05-28 17:40:54 -04:00
parent 715d633ad0
commit 00bc579327
2 changed files with 150 additions and 134 deletions

View file

@ -190,7 +190,8 @@
; Macro transformer (from Scheme to Scheme Core) derived from Al Petrofsky's EIOD 1.17 ; Macro transformer (from Scheme to Scheme Core) derived from Al Petrofsky's EIOD 1.17
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; An environment is a procedure that accepts any identifier and returns a denotation. ; An environment is a procedure that accepts any identifier and access type and returns a
; denotation. Access type is one of these symbols: ref, set!, define, define-syntax.
; The denotation of an identifier is its macro location, which is a cell storing the ; The denotation of an identifier is its macro location, which is a cell storing the
; identifier's current syntactic value. Location's value can be changed later. ; identifier's current syntactic value. Location's value can be changed later.
@ -225,15 +226,23 @@
; containing either a <special> or a <core> value. In normal case, <core> value is (ref <gid>), ; containing either a <special> or a <core> value. In normal case, <core> value is (ref <gid>),
; where <gid> is a key in run-time store, aka *globals*. Environments should allocate new locations ; where <gid> is a key in run-time store, aka *globals*. Environments should allocate new locations
; as needed, so every identifier gets mapped to one. Expand-time environments are represented as ; as needed, so every identifier gets mapped to one. Expand-time environments are represented as
; one-argument procedures. ; two-argument procedures, where the second argument is an access type symbol.
(define (extend-xenv env id bnd) (lambda (i) (if (eq? id i) bnd (env i)))) (define (extend-xenv-local id val env)
(let ([loc (make-location val)])
(lambda (i at)
(if (eq? id i)
(case at [(ref set!) loc] [else #f])
(env i at)))))
(define (add-location key val env) ; adds as-is (define (add-local-var id gid env)
(extend-xenv env key (make-location val))) (extend-xenv-local id (list 'ref gid) env))
(define (add-var var val env) ; adds renamed var as <core> (define (xenv-lookup env id at)
(extend-xenv env var (make-location (list 'ref val)))) (or (env id at)
(error* "transformer: invalid identifier access" (list id at))))
(define (xenv-ref env id) (xenv-lookup env id 'ref))
(define (xform-sexp->datum sexp) (define (xform-sexp->datum sexp)
(let conv ([sexp sexp]) (let conv ([sexp sexp])
@ -290,7 +299,7 @@
(xform-call hval tail env)))]))])) (xform-call hval tail env)))]))]))
(define (xform-ref id env) (define (xform-ref id env)
(let ([den (env id)]) (let ([den (xenv-ref env id)])
(cond [(eq? (location-val den) '...) (x-error "improper use of ...")] (cond [(eq? (location-val den) '...) (x-error "improper use of ...")]
[else (location-val den)]))) [else (location-val den)])))
@ -301,7 +310,7 @@
(define (xform-set! tail env) (define (xform-set! tail env)
(if (and (list2? tail) (id? (car tail))) (if (and (list2? tail) (id? (car tail)))
(let ([den (env (car tail))] [xexp (xform #f (cadr tail) env)]) (let ([den (xenv-lookup env (car tail) 'set!)] [xexp (xform #f (cadr tail) env)])
(cond [(location-special? den) (location-set-val! den xexp) '(begin)] (cond [(location-special? den) (location-set-val! den xexp) '(begin)]
[else (let ([val (location-val den)]) [else (let ([val (location-val den)])
(if (eq? (car val) 'ref) (if (eq? (car val) 'ref)
@ -311,7 +320,7 @@
(define (xform-set& tail env) (define (xform-set& tail env)
(if (list1? tail) (if (list1? tail)
(let ([den (env (car tail))]) (let ([den (xenv-lookup env (car tail) 'set!)])
(cond [(location-special? den) (x-error "set& of a non-variable")] (cond [(location-special? den) (x-error "set& of a non-variable")]
[else (let ([val (location-val den)]) [else (let ([val (location-val den)])
(if (eq? (car val) 'ref) (if (eq? (car val) 'ref)
@ -354,12 +363,12 @@
(let loop ([vars (car tail)] [ienv env] [ipars '()]) (let loop ([vars (car tail)] [ienv env] [ipars '()])
(cond [(pair? vars) (cond [(pair? vars)
(let* ([var (car vars)] [nvar (gensym (id->sym var))]) (let* ([var (car vars)] [nvar (gensym (id->sym var))])
(loop (cdr vars) (add-var var nvar ienv) (cons nvar ipars)))] (loop (cdr vars) (add-local-var var nvar ienv) (cons nvar ipars)))]
[(null? vars) [(null? vars)
(list 'lambda (reverse ipars) (xform-body (cdr tail) ienv))] (list 'lambda (reverse ipars) (xform-body (cdr tail) ienv))]
[else ; improper [else ; improper
(let* ([var vars] [nvar (gensym (id->sym var))] (let* ([var vars] [nvar (gensym (id->sym var))]
[ienv (add-var var nvar ienv)]) [ienv (add-local-var var nvar ienv)])
(list 'lambda (append (reverse ipars) nvar) (list 'lambda (append (reverse ipars) nvar)
(xform-body (cdr tail) ienv)))])) (xform-body (cdr tail) ienv)))]))
(x-error "improper lambda body" (cons 'lambda tail)))) (x-error "improper lambda body" (cons 'lambda tail))))
@ -383,7 +392,7 @@
(if (and (list2+? tail) (id? (car tail))) (if (and (list2+? tail) (id? (car tail)))
(let* ([var (car tail)] [nvar (gensym (id->sym var))]) (let* ([var (car tail)] [nvar (gensym (id->sym var))])
(list 'letcc nvar (list 'letcc nvar
(xform-body (cdr tail) (add-var var nvar env)))) (xform-body (cdr tail) (add-local-var var nvar env))))
(x-error "improper letcc form" (cons 'letcc tail)))) (x-error "improper letcc form" (cons 'letcc tail))))
(define (xform-withcc tail env) (define (xform-withcc tail env)
@ -416,18 +425,18 @@
(loop env (cons #f ids) (cons init inits) (cons #f nids) rest))] (loop env (cons #f ids) (cons init inits) (cons #f nids) rest))]
[(and (list2? tail) (id? (car tail))) [(and (list2? tail) (id? (car tail)))
(let* ([id (car tail)] [init (cadr tail)] (let* ([id (car tail)] [init (cadr tail)]
[nid (gensym (id->sym id))] [env (add-var id nid env)]) [nid (gensym (id->sym id))] [env (add-local-var id nid env)])
(loop env (cons id ids) (cons init inits) (cons nid nids) rest))] (loop env (cons id ids) (cons init inits) (cons nid nids) rest))]
[(and (list2+? tail) (pair? (car tail)) (id? (caar tail)) (idslist? (cdar tail))) [(and (list2+? tail) (pair? (car tail)) (id? (caar tail)) (idslist? (cdar tail)))
(let* ([id (caar tail)] [lambda-id (new-id 'lambda (make-location 'lambda))] (let* ([id (caar tail)] [lambda-id (new-id 'lambda (make-location 'lambda))]
[init (cons lambda-id (cons (cdar tail) (cdr tail)))] [init (cons lambda-id (cons (cdar tail) (cdr tail)))]
[nid (gensym (id->sym id))] [env (add-var id nid env)]) [nid (gensym (id->sym id))] [env (add-local-var id nid env)])
(loop env (cons id ids) (cons init inits) (cons nid nids) rest))] (loop env (cons id ids) (cons init inits) (cons nid nids) rest))]
[else (x-error "improper define form" first)])] [else (x-error "improper define form" first)])]
[(define-syntax) ; internal [(define-syntax) ; internal
(if (and (list2? tail) (id? (car tail))) (if (and (list2? tail) (id? (car tail)))
(let* ([id (car tail)] [init (cadr tail)] (let* ([id (car tail)] [init (cadr tail)]
[env (add-location id '(undefined) env)]) [env (extend-xenv-local id '(undefined) env)])
(loop env (cons id ids) (cons init inits) (cons #t nids) rest)) (loop env (cons id ids) (cons init inits) (cons #t nids) rest))
(x-error "improper define-syntax form" first))] (x-error "improper define-syntax form" first))]
[else [else
@ -452,7 +461,7 @@
(cons (xform-set! (list (car ids) (car inits)) env) sets) (cons (xform-set! (list (car ids) (car inits)) env) sets)
(cons (car nids) lids))] (cons (car nids) lids))]
[else ; define-syntax [else ; define-syntax
(location-set-val! (env (car ids)) (xform #t (car inits) env)) (location-set-val! (xenv-lookup env (car ids) 'set!) (xform #t (car inits) env))
(loop (cdr ids) (cdr inits) (cdr nids) sets lids)]))) (loop (cdr ids) (cdr inits) (cdr nids) sets lids)])))
(define (xform-begin tail env) ; non-internal (define (xform-begin tail env) ; non-internal
@ -491,7 +500,7 @@
(if (null? vars) (if (null? vars)
(list 'syntax (xform-body forms env)) (list 'syntax (xform-body forms env))
(loop (cdr vars) (cdr exps) (loop (cdr vars) (cdr exps)
(add-location (car vars) (extend-xenv-local (car vars)
(xform #t (car exps) useenv) env)))) (xform #t (car exps) useenv) env))))
(x-error "invalid syntax-lambda application" use)))) (x-error "invalid syntax-lambda application" use))))
(x-error "improper syntax-lambda body" (cons 'syntax-lambda tail)))) (x-error "improper syntax-lambda body" (cons 'syntax-lambda tail))))
@ -529,7 +538,7 @@
(define (ellipsis? x) (define (ellipsis? x)
(if ellipsis (if ellipsis
(eq? x ellipsis) (eq? x ellipsis)
(and (id? x) (ellipsis-denotation? (mac-env x))))) (and (id? x) (ellipsis-denotation? (xenv-ref mac-env x)))))
; List-ids returns a list of the non-ellipsis ids in a ; List-ids returns a list of the non-ellipsis ids in a
; pattern or template for which (pred? id) is true. If ; pattern or template for which (pred? id) is true. If
@ -558,7 +567,8 @@
(cond (cond
[(id? pat) [(id? pat)
(if (pat-literal? pat) (if (pat-literal? pat)
(continue-if (and (id? sexp) (eq? (use-env sexp) (mac-env pat)))) (continue-if
(and (id? sexp) (eq? (xenv-ref use-env sexp) (xenv-ref mac-env pat))))
(cons (cons pat sexp) bindings))] (cons (cons pat sexp) bindings))]
[(vector? pat) [(vector? pat)
(or (vector? sexp) (fail)) (or (vector? sexp) (fail))
@ -589,7 +599,7 @@
; fresh ids, but that's okay because when we go to retrieve a ; fresh ids, but that's okay because when we go to retrieve a
; fresh id, assq will always retrieve the first one. ; fresh id, assq will always retrieve the first one.
(define new-literals (define new-literals
(map (lambda (id) (cons id (new-id (id->sym id) (mac-env id)))) (map (lambda (id) (cons id (new-id (id->sym id) (xenv-ref mac-env id))))
(list-ids tmpl #t (list-ids tmpl #t
(lambda (id) (not (assq id top-bindings)))))) (lambda (id) (not (assq id top-bindings))))))
@ -1125,17 +1135,18 @@
; Environments ; Environments
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; new lookup procedure for alist-like macro environments ; new lookup procedure for explicit macro environments
(define (env-lookup id env full?) ;=> location (| #f) (define (env-lookup id env at) ;=> location (| #f)
(if (procedure? id) (if (procedure? id)
(old-den id) ; nonsymbolic ids can't be globally bound ; nonsymbolic ids can't be (re)defined
(case at [(ref set!) (old-den id)] [else #f])
(let loop ([env env]) (let loop ([env env])
(cond [(pair? env) (cond [(pair? env) ; imported
(if (eq? (caar env) id) (if (eq? (caar env) id)
(cdar env) ; location (case at [(ref set!) (cdar env)] [else #f])
(loop (cdr env)))] (loop (cdr env)))]
[(vector? env) ; root [(vector? env) ; root (can be extended)
(let* ([n (vector-length env)] [i (immediate-hash id n)] (let* ([n (vector-length env)] [i (immediate-hash id n)]
[al (vector-ref env i)] [p (assq id al)]) [al (vector-ref env i)] [p (assq id al)])
(if p (cdr p) (if p (cdr p)
@ -1144,9 +1155,9 @@
(vector-set! env i (cons (cons id loc) al)) (vector-set! env i (cons (cons id loc) al))
loc)))] loc)))]
[(string? env) ; module prefix [(string? env) ; module prefix
(and full? (and (memq at '(define define-syntax))
(let ([gid (string->symbol (string-append env (symbol->string id)))]) (let ([gid (string->symbol (string-append env (symbol->string id)))])
(env-lookup gid *root-environment* #t)))] (env-lookup gid *root-environment* 'ref)))]
[else ; finite env [else ; finite env
#f])))) #f]))))
@ -1170,8 +1181,8 @@
(loop l)] (loop l)]
[(and (pair? v) (eq? (car v) 'syntax-rules)) [(and (pair? v) (eq? (car v) 'syntax-rules))
(body (body
(define (sr-env id) (define (sr-env id at)
(env-lookup id *root-environment* #t)) (env-lookup id *root-environment* at))
(define sr-v (define sr-v
(if (id? (cadr v)) (if (id? (cadr v))
(syntax-rules* sr-env (cadr v) (caddr v) (cdddr v)) (syntax-rules* sr-env (cadr v) (caddr v) (cdddr v))
@ -1179,13 +1190,8 @@
(put! k (make-location sr-v)) (put! k (make-location sr-v))
(loop l))]))))))) (loop l))])))))))
(define (root-environment id) (define (root-environment id at)
; new protocol for top-level envs (env-lookup id *root-environment* at))
(if (pair? id)
(record-case id
[define (i) i]
[define-syntax (i) (env-lookup i *root-environment* #t)])
(env-lookup id *root-environment* #t)))
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
@ -1210,17 +1216,18 @@
[(eq? hval 'define) [(eq? hval 'define)
; new protocol for top-level envs ; new protocol for top-level envs
(let* ([core (xform-define (cdr x) env)] (let* ([core (xform-define (cdr x) env)]
[res (env (list 'define (cadr core)))]) [loc (xenv-lookup env (cadr core) 'define)])
(if res ; symbol (runtime store key) or #f (if (and loc (syntax-match? '(ref *) (location-val loc)))
(compile-and-run-core-expr (list 'set! res (caddr core))) (compile-and-run-core-expr
(x-error "identifier cannot be (re)defined in env" (list 'set! (cadr (location-val loc)) (caddr core)))
(x-error "identifier cannot be (re)defined in env"
(cadr core) env)))] (cadr core) env)))]
[(eq? hval 'define-syntax) [(eq? hval 'define-syntax)
; new protocol for top-level envs ; new protocol for top-level envs
(let* ([core (xform-define-syntax (cdr x) env)] (let* ([core (xform-define-syntax (cdr x) env)]
[res (env (list 'define-syntax (cadr core)))]) [loc (xenv-lookup env (cadr core) 'define-syntax)])
(if res ; macro location or #f (if loc ; location or #f
(location-set-val! res (caddr core)) (location-set-val! loc (caddr core))
(x-error "identifier cannot be (re)defined as syntax in env" (x-error "identifier cannot be (re)defined as syntax in env"
(cadr core) env)))] (cadr core) env)))]
[(procedure? hval) [(procedure? hval)

187
t.c
View file

@ -107,14 +107,19 @@ char *t_code[] = {
"P", "id->sym", "P", "id->sym",
"%1.0Y0?{.0]1}.0,@(y7:old-sym)[11", "%1.0Y0?{.0]1}.0,@(y7:old-sym)[11",
"P", "extend-xenv", "P", "extend-xenv-local",
"%3.0,.3,.3,&3{%1.0,:0q?{:1]1}.0,:2[11}]3", "%3.1b,.3,.1,.3,&3{%2.0,:0q?{.1,'(l2:y3:ref;y4:set!;),.1A1?{:1]3}f]3}.1"
",.1,:2[22}]4",
"P", "add-location", "P", "add-local-var",
"%3.1b,.1,.4,@(y11:extend-xenv)[33", "%3.2,.2,'(y3:ref),l2,.2,@(y17:extend-xenv-local)[33",
"P", "add-var", "P", "xenv-lookup",
"%3.1,'(y3:ref),l2b,.1,.4,@(y11:extend-xenv)[33", "%3${.4,.4,.4[02},.0?{.0]4}.3,.3,l2,'(s38:transformer: invalid identifi"
"er access),@(y6:error*)[42",
"P", "xenv-ref",
"%2'(y3:ref),.2,.2,@(y11:xenv-lookup)[23",
"P", "xform-sexp->datum", "P", "xform-sexp->datum",
"%1.0,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@(y7:id->sym)[11}.0p?{${.2d,:0^" "%1.0,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@(y7:id->sym)[11}.0p?{${.2d,:0^"
@ -145,8 +150,8 @@ char *t_code[] = {
"orm-call)[73", "orm-call)[73",
"P", "xform-ref", "P", "xform-ref",
"%2${.2,.4[01},'(y3:...),.1zq?{'(s19:improper use of ...),@(y7:x-error)" "%2${.2,.4,@(y8:xenv-ref)[02},'(y3:...),.1zq?{'(s19:improper use of ..."
"[31}.0z]3", "),@(y7:x-error)[31}.0z]3",
"P", "xform-quote", "P", "xform-quote",
"%2${.2,@(y6:list1?)[01}?{${.2a,@(y17:xform-sexp->datum)[01},'(y5:quote" "%2${.2,@(y6:list1?)[01}?{${.2a,@(y17:xform-sexp->datum)[01},'(y5:quote"
@ -154,16 +159,17 @@ char *t_code[] = {
"P", "xform-set!", "P", "xform-set!",
"%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,f,@(y5:xfo" "%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,f,@(y5:xfo"
"rm)[03},${.3a,.5[01},${.2,@(y17:location-special?)[01}?{.1,.1sz'(l1:y5" "rm)[03},${'(y4:set!),.4a,.6,@(y11:xenv-lookup)[03},${.2,@(y17:location"
":begin;)]4}.0z,'(y3:ref),.1aq?{.2,.1da,'(y4:set!),l3]5}'(s27:set! to n" "-special?)[01}?{.1,.1sz'(l1:y5:begin;)]4}.0z,'(y3:ref),.1aq?{.2,.1da,'"
"on-identifier form),@(y7:x-error)[51}.0,'(y4:set!)c,'(s18:improper set" "(y4:set!),l3]5}'(s27:set! to non-identifier form),@(y7:x-error)[51}.0,"
"! form),@(y7:x-error)[22", "'(y4:set!)c,'(s18:improper set! form),@(y7:x-error)[22",
"P", "xform-set&", "P", "xform-set&",
"%2${.2,@(y6:list1?)[01}?{${.2a,.4[01},${.2,@(y17:location-special?)[01" "%2${.2,@(y6:list1?)[01}?{${'(y4:set!),.3a,.5,@(y11:xenv-lookup)[03},${"
"}?{'(s22:set& of a non-variable),@(y7:x-error)[31}.0z,'(y3:ref),.1aq?{" ".2,@(y17:location-special?)[01}?{'(s22:set& of a non-variable),@(y7:x-"
".0da,'(y4:set&),l2]4}'(s22:set& of a non-variable),@(y7:x-error)[41}.0" "error)[31}.0z,'(y3:ref),.1aq?{.0da,'(y4:set&),l2]4}'(s22:set& of a non"
",'(y4:set&)c,'(s18:improper set& form),@(y7:x-error)[22", "-variable),@(y7:x-error)[41}.0,'(y4:set&)c,'(s18:improper set& form),@"
"(y7:x-error)[22",
"P", "xform-if", "P", "xform-if",
"%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0g,'2," "%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0g,'2,"
@ -191,11 +197,11 @@ char *t_code[] = {
"P", "xform-lambda", "P", "xform-lambda",
"%2${.2,@(y7:list1+?)[01}?{${.2a,@(y8:idslist?)[01}}{f}?{n,.2,.2a,,#0.4" "%2${.2,@(y7:list1+?)[01}?{${.2a,@(y8:idslist?)[01}}{f}?{n,.2,.2a,,#0.4"
",.1,&2{%3.0p?{.0a,${${.4,@(y7:id->sym)[01},@(y6:gensym)[01},.4,.1c,${." ",.1,&2{%3.0p?{.0a,${${.4,@(y7:id->sym)[01},@(y6:gensym)[01},.4,.1c,${."
"6,.4,.6,@(y7:add-var)[03},.4d,:0^[53}.0u?{${.3,:1d,@(y10:xform-body)[0" "6,.4,.6,@(y13:add-local-var)[03},.4d,:0^[53}.0u?{${.3,:1d,@(y10:xform-"
"2},.3A8,'(y6:lambda),l3]3}.0,${${.4,@(y7:id->sym)[01},@(y6:gensym)[01}" "body)[02},.3A8,'(y6:lambda),l3]3}.0,${${.4,@(y7:id->sym)[01},@(y6:gens"
",${.5,.3,.5,@(y7:add-var)[03},${.2,:1d,@(y10:xform-body)[02},.2,.7A8L6" "ym)[01},${.5,.3,.5,@(y13:add-local-var)[03},${.2,:1d,@(y10:xform-body)"
",'(y6:lambda),l3]6}.!0.0^_1[23}.0,'(y6:lambda)c,'(s20:improper lambda " "[02},.2,.7A8L6,'(y6:lambda),l3]6}.!0.0^_1[23}.0,'(y6:lambda)c,'(s20:im"
"body),@(y7:x-error)[22", "proper lambda body),@(y7:x-error)[22",
"P", "xform-lambda*", "P", "xform-lambda*",
"%2.0L0?{${.2,.4,&1{%1${.2,@(y6:list2?)[01}?{${.2a,@(y6:list2?)[01}?{.0" "%2.0L0?{${.2,.4,&1{%1${.2,@(y6:list2?)[01}?{${.2a,@(y6:list2?)[01}?{.0"
@ -206,9 +212,9 @@ char *t_code[] = {
"P", "xform-letcc", "P", "xform-letcc",
"%2${.2,@(y7:list2+?)[01}?{${.2a,@(y3:id?)[01}}{f}?{.0a,${${.4,@(y7:id-" "%2${.2,@(y7:list2+?)[01}?{${.2a,@(y3:id?)[01}}{f}?{.0a,${${.4,@(y7:id-"
">sym)[01},@(y6:gensym)[01},${${.7,.5,.7,@(y7:add-var)[03},.5d,@(y10:xf" ">sym)[01},@(y6:gensym)[01},${${.7,.5,.7,@(y13:add-local-var)[03},.5d,@"
"orm-body)[02},.1,'(y5:letcc),l3]4}.0,'(y5:letcc)c,'(s19:improper letcc" "(y10:xform-body)[02},.1,'(y5:letcc),l3]4}.0,'(y5:letcc)c,'(s19:imprope"
" form),@(y7:x-error)[22", "r letcc form),@(y7:x-error)[22",
"P", "xform-withcc", "P", "xform-withcc",
"%2${.2,@(y7:list2+?)[01}?{${.3,.3d,@(y10:xform-body)[02},${.4,.4a,f,@(" "%2${.2,@(y7:list2+?)[01}?{${.3,.3d,@(y10:xform-body)[02},${.4,.4a,f,@("
@ -224,18 +230,19 @@ char *t_code[] = {
"e),.1v?{${.4,@(y6:list2?)[01}?{.2au}{f}?{.2da,.6,.(i11),fc,.(i11),.3c," "e),.1v?{${.4,@(y6:list2?)[01}?{.2au}{f}?{.2da,.6,.(i11),fc,.(i11),.3c,"
".(i11),fc,.(i11),:0^[(i12)5}${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01}" ".(i11),fc,.(i11),:0^[(i12)5}${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01}"
"}{f}?{.2a,.3da,${${.5,@(y7:id->sym)[01},@(y6:gensym)[01},${.(i11),.3,." "}{f}?{.2a,.3da,${${.5,@(y7:id->sym)[01},@(y6:gensym)[01},${.(i11),.3,."
"6,@(y7:add-var)[03},.9,.(i14),.3c,.(i14),.5c,.(i14),.7c,.4,:0^[(i15)5}" "6,@(y13:add-local-var)[03},.9,.(i14),.3c,.(i14),.5c,.(i14),.7c,.4,:0^["
"${.4,@(y7:list2+?)[01}?{.2ap?{${.4aa,@(y3:id?)[01}?{${.4ad,@(y8:idslis" "(i15)5}${.4,@(y7:list2+?)[01}?{.2ap?{${.4aa,@(y3:id?)[01}?{${.4ad,@(y8"
"t?)[01}}{f}}{f}}{f}?{.2aa,${'(y6:lambda)b,'(y6:lambda),@(y6:new-id)[02" ":idslist?)[01}}{f}}{f}}{f}?{.2aa,${'(y6:lambda)b,'(y6:lambda),@(y6:new"
"},.4d,.5adc,.1c,${${.6,@(y7:id->sym)[01},@(y6:gensym)[01},${.(i12),.3," "-id)[02},.4d,.5adc,.1c,${${.6,@(y7:id->sym)[01},@(y6:gensym)[01},${.(i"
".7,@(y7:add-var)[03},.(i10),.(i15),.3c,.(i15),.5c,.(i15),.8c,.4,:0^[(i" "12),.3,.7,@(y13:add-local-var)[03},.(i10),.(i15),.3c,.(i15),.5c,.(i15)"
"16)5}.4,'(s20:improper define form),@(y7:x-error)[(i11)2}'(y13:define-" ",.8c,.4,:0^[(i16)5}.4,'(s20:improper define form),@(y7:x-error)[(i11)2"
"syntax),.1v?{${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01}}{f}?{.2a,.3da," "}'(y13:define-syntax),.1v?{${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01}}"
"${.(i10),'(l1:y9:undefined;),.5,@(y12:add-location)[03},.8,.(i13),tc,." "{f}?{.2a,.3da,${.(i10),'(l1:y9:undefined;),.5,@(y17:extend-xenv-local)"
"(i13),.4c,.(i13),.6c,.4,:0^[(i14)5}.4,'(s27:improper define-syntax for" "[03},.8,.(i13),tc,.(i13),.4c,.(i13),.6c,.4,:0^[(i14)5}.4,'(s27:imprope"
"m),@(y7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6[02}c,.(i10),.(i10),.(i10)," "r define-syntax form),@(y7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6[02}c,.("
".(i10),:0^[(i11)5}.6,.(i11),.(i11)A8,.(i11)A8,.(i11)A8,@(y12:xform-lab" "i10),.(i10),.(i10),.(i10),:0^[(i11)5}.6,.(i11),.(i11)A8,.(i11)A8,.(i11"
"els)[(i11)5}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels)[55}.!0.0^_1[25", ")A8,@(y12:xform-labels)[(i11)5}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels"
")[55}.!0.0^_1[25",
"P", "xform-labels", "P", "xform-labels",
"%5n,n,.4,.4,.4,,#0.0,.(i11),.(i11),&3{%5.0u?{${:0,:1,&1{%1:0,.1,f,@(y5" "%5n,n,.4,.4,.4,,#0.0,.(i11),.(i11),&3{%5.0u?{${:0,:1,&1{%1:0,.1,f,@(y5"
@ -244,7 +251,8 @@ char *t_code[] = {
"1,.8A8,'(y6:lambda),l3,'(y4:call),@(y5:pair*)[73}.0a~?{.4,.4,${:1,.6a," "1,.8A8,'(y6:lambda),l3,'(y4:call),@(y5:pair*)[73}.0a~?{.4,.4,${:1,.6a,"
"f,@(y5:xform)[03}c,.4d,.4d,.4d,:2^[55}.2aY0?{.4,.3ac,.4,${:1,.6a,.6a,l" "f,@(y5:xform)[03}c,.4d,.4d,.4d,:2^[55}.2aY0?{.4,.3ac,.4,${:1,.6a,.6a,l"
"2,@(y10:xform-set!)[02}c,.4d,.4d,.4d,:2^[55}${:1,.4a,t,@(y5:xform)[03}" "2,@(y10:xform-set!)[02}c,.4d,.4d,.4d,:2^[55}${:1,.4a,t,@(y5:xform)[03}"
",${.3a,:1[01}sz.4,.4,.4d,.4d,.4d,:2^[55}.!0.0^_1[55", ",${'(y4:set!),.4a,:1,@(y11:xenv-lookup)[03}sz.4,.4,.4d,.4d,.4d,:2^[55}"
".!0.0^_1[55",
"P", "xform-begin", "P", "xform-begin",
"%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0p?{.0" "%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0p?{.0"
@ -268,10 +276,10 @@ char *t_code[] = {
"%2${.2,@(y7:list2+?)[01}?{${.2a,@(y3:id?),@(y6:andmap)[02}}{f}?{.0d,.2" "%2${.2,@(y7:list2+?)[01}?{${.2a,@(y3:id?),@(y6:andmap)[02}}{f}?{.0d,.2"
",.2a,.2,.1,.3,&3{%2${.2,@(y7:list1+?)[01}?{.0dg,:1gI=}{f}?{:0,.1d,:1,," ",.2a,.2,.1,.3,&3{%2${.2,@(y7:list1+?)[01}?{.0dg,:1gI=}{f}?{:0,.1d,:1,,"
"#0.5,.1,:2,&3{%3.0u?{${.4,:0,@(y10:xform-body)[02},'(y6:syntax),l2]3}$" "#0.5,.1,:2,&3{%3.0u?{${.4,:0,@(y10:xform-body)[02},'(y6:syntax),l2]3}$"
"{.4,${:2,.7a,t,@(y5:xform)[03},.4a,@(y12:add-location)[03},.2d,.2d,:1^" "{.4,${:2,.7a,t,@(y5:xform)[03},.4a,@(y17:extend-xenv-local)[03},.2d,.2"
"[33}.!0.0^_1[23}.0,'(s33:invalif syntax-lambda application),@(y7:x-err" "d,:1^[33}.!0.0^_1[23}.0,'(s33:invalid syntax-lambda application),@(y7:"
"or)[22}]5}.0,'(y13:syntax-lambda)c,'(s27:improper syntax-lambda body)," "x-error)[22}]5}.0,'(y13:syntax-lambda)c,'(s27:improper syntax-lambda b"
"@(y7:x-error)[22", "ody),@(y7:x-error)[22",
"P", "xform-syntax-rules", "P", "xform-syntax-rules",
"%2${.2,@(y7:list2+?)[01}?{${.2a,@(y3:id?)[01}?{${.2da,@(y3:id?),@(y6:a" "%2${.2,@(y7:list2+?)[01}?{${.2a,@(y3:id?)[01}?{${.2da,@(y3:id?),@(y6:a"
@ -292,33 +300,34 @@ char *t_code[] = {
"P", "syntax-rules*", "P", "syntax-rules*",
"%4,,,,,,,,#0#1#2#3#4#5#6#7.(i10),&1{%1:0,.1A0]1}.!0.0,&1{%1${.2,:0^[01" "%4,,,,,,,,#0#1#2#3#4#5#6#7.(i10),&1{%1:0,.1A0]1}.!0.0,&1{%1${.2,:0^[01"
"}~]1}.!1.4,&1{%1.0p?{.0a,:0^[11}f]1}.!2&0{%1'(y3:...),.1zq]1}.!3.3,.9," "}~]1}.!1.4,&1{%1.0p?{.0a,:0^[11}f]1}.!2&0{%1'(y3:...),.1zq]1}.!3.3,.9,"
".(i11),&3{%1:0?{:0,.1q]1}${.2,@(y3:id?)[01}?{${.2,:1[01},:2^[11}f]1}.!" ".(i11),&3{%1:0?{:0,.1q]1}${.2,@(y3:id?)[01}?{${.2,:1,@(y8:xenv-ref)[02"
"4.2,&1{%3n,.2,.2,,#0:0,.1,.8,&3{%3${.2,@(y3:id?)[01}?{.1?{${.2,:0[01}}" "},:2^[11}f]1}.!4.2,&1{%3n,.2,.2,,#0:0,.1,.8,&3{%3${.2,@(y3:id?)[01}?{."
"{f}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2X0,:1^[33}.0p?{${.2d,:2^[01}?{${.4,.4" "1?{${.2,:0[01}}{f}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2X0,:1^[33}.0p?{${.2d,:"
",.4dd,:1^[03},t,.2a,:1^[33}${.4,.4,.4d,:1^[03},.2,.2a,:1^[33}.2]3}.!0." "2^[01}?{${.4,.4,.4dd,:1^[03},t,.2a,:1^[33}${.4,.4,.4d,:1^[03},.2,.2a,:"
"0^_1[33}.!5.5,.2,.4,.3,.(i12),&5{%3k3,.0,,#0.1,&1{%0f,:0[01}.!0n,.5,.5" "1^[33}.2]3}.!0.0^_1[33}.!5.5,.2,.4,.3,.(i12),&5{%3k3,.0,,#0.1,&1{%0f,:"
",,#0.4,.1,:4,:3,:2,:1,:0,.(i16),&8{%3,#0:7,.4,&2{%1.0?{:0]1}:1^[10}.!0" "0[01}.!0n,.5,.5,,#0.4,.1,:4,:3,:2,:1,:0,.(i16),&8{%3,#0:7,.4,&2{%1.0?{"
"${.3,@(y3:id?)[01}?{${.3,:2^[01}?{${.4,@(y3:id?)[01}?{${.3,:1[01},${.5" ":0]1}:1^[10}.!0${.3,@(y3:id?)[01}?{${.3,:2^[01}?{${.4,@(y3:id?)[01}?{$"
",:0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{${:7^[00}}_1.3,.3X" "{.3,:1,@(y8:xenv-ref)[02},${.5,:0,@(y8:xenv-ref)[02}q}{f},.1^[41}.3,.3"
"0,.3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1ddg,.3L0?{.3g}{${:7" ",.3cc]4}.1V0?{.2V0,.0?{.0}{${:7^[00}}_1.3,.3X0,.3X0,:6^[43}.1p~?{.2,.2"
"^[00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${:4^,t,.(i10)a,:5^" "e,.1^[41}${.3d,:3^[01}?{.1ddg,.3L0?{.3g}{${:7^[00}},.1,.1I-,.0<0?{${:7"
"[03},,#0:6,.9,&2{%1${n,.3,:0a,:1^[03},@(y3:cdr),@(y5:%25map1)[12}.!0${" "^[00}}.0,.6A6,.3,.7A8A6A8,${:4^,t,.(i10)a,:5^[03},,#0:6,.9,&2{%1${n,.3"
".(i12),.6,.(i12)dd,:6^[03},${${.7,.6^,@(y5:%25map1)[02},.5c,@(y4:list)" ",:0a,:1^[03},@(y3:cdr),@(y5:%25map1)[12}.!0${.(i12),.6,.(i12)dd,:6^[03"
"c,@(y4:%25map),@(y13:apply-to-list)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^[" "},${${.7,.6^,@(y5:%25map1)[02},.5c,@(y4:list)c,@(y4:%25map),@(y13:appl"
"03},.3a,.3a,:6^[43}:7^[40}.!0.0^_1[63}.!6.8,.2,.7,.5,&4{%3,,,#0#1#2${$" "y-to-list)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^[03},.3a,.3a,:6^[43}:7^[40"
"{.9,&1{%1:0,.1A3~]1},t,.(i10),:1^[03},:3,&1{%1${${.4,:0[01},${.5,@(y7:" "}.!0.0^_1[63}.!6.8,.2,.7,.5,&4{%3,,,#0#1#2${${.9,&1{%1:0,.1A3~]1},t,.("
"id->sym)[01},@(y6:new-id)[02},.1c]1},@(y5:%25map1)[02}.!0${:2^,f,.7,:1" "i10),:1^[03},:3,&1{%1${${.4,:0,@(y8:xenv-ref)[02},${.5,@(y7:id->sym)[0"
"^[03}.!1.1,:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,:" "1},@(y6:new-id)[02},.1c]1},@(y5:%25map1)[02}.!0${:2^,f,.7,:1^[03}.!1.1"
"0,.8,.4,&5{%2.0,,#0.0,.4,:0,:1,:2,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:5,.1" ",:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,:0,.8,.4,&5"
"A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:6^[01}X1]1}" "{%2.0,,#0.0,.4,:0,:1,:2,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:5,.1A3,.0?{.0}"
".0p?{${.2d,:2^[01}}{f}?{${.2a,:3^[01},,,#0#1:5,&1{%1:0,.1A3d]1}.!0.2,." "{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:6^[01}X1]1}.0p?{${.2d"
"4,:4,&3{%!0${.2,:2,@(y4:cons),@(y5:%25map2)[03},:1a,:0^[12}.!1.2u?{${." ",:2^[01}}{f}?{${.2a,:3^[01},,,#0#1:5,&1{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!"
"5dd,:6^[01},${.6a,:6^[01}c]4}${.4,.3^,@(y5:%25map1)[02},${.6dd,:6^[01}" "0${.2,:2,@(y4:cons),@(y5:%25map2)[03},:1a,:0^[12}.!1.2u?{${.5dd,:6^[01"
",${.3,.6^c,@(y4:%25map),@(y13:apply-to-list)[02}L6]5}.0p?{${.2d,:6^[01" "},${.6a,:6^[01}c]4}${.4,.3^,@(y5:%25map1)[02},${.6dd,:6^[01},${.3,.6^c"
"},${.3a,:6^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!7.(i11),.8,.8,&3{%2:" ",@(y4:%25map),@(y13:apply-to-list)[02}L6]5}.0p?{${.2d,:6^[01},${.3a,:6"
"2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syntax),@(y7:x-error)" "^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!7.(i11),.8,.8,&3{%2:2,,#0:0,.3"
"[02}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51" ",.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syntax),@(y7:x-error)[02}}.0a,."
"}.!0.0^_1[21}](i12)", "0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1["
"21}](i12)",
"P", "write-serialized-char", "P", "write-serialized-char",
"%2'(c%25),.1C=,.0?{.0}{'(c%22),.2C=,.0?{.0}{'(c%5c),.3C=,.0?{.0}{'(c )" "%2'(c%25),.1C=,.0?{.0}{'(c%22),.2C=,.0?{.0}{'(c%5c),.3C=,.0?{.0}{'(c )"
@ -542,25 +551,24 @@ char *t_code[] = {
"90]2", "90]2",
"P", "env-lookup", "P", "env-lookup",
"%3.0K0?{.0,@(y7:old-den)[31}.1,,#0.4,.3,.2,&3{%1.0p?{:1,.1aaq?{.0ad]1}" "%3.0K0?{.2,'(l2:y3:ref;y4:set!;),.1A1?{.1,@(y7:old-den)[41}f]4}.1,,#0."
"4,.3,.2,&3{%1.0p?{:1,.1aaq?{:2,'(l2:y3:ref;y4:set!;),.1A1?{.1ad]2}f]2}"
".0d,:0^[11}.0V0?{.0V3,.0,:1H2,.0,.3V4,.0,:1A3,.0?{.0d]5}:1U5,.0?{.0}{:" ".0d,:0^[11}.0V0?{.0V3,.0,:1H2,.0,.3V4,.0,:1A3,.0?{.0d]5}:1U5,.0?{.0}{:"
"1,'(y3:ref),l2}_1b,.2,.1,:1cc,.4,.7V5.0]6}.0S0?{:2?{:1X4,.1S6X5,t,@(y1" "1,'(y3:ref),l2}_1b,.2,.1,:1cc,.4,.7V5.0]6}.0S0?{'(l2:y6:define;y13:def"
"8:*root-environment*),.2,@(y10:env-lookup)[23}f]1}f]1}.!0.0^_1[31", "ine-syntax;),:2A0?{:1X4,.1S6X5,'(y3:ref),@(y18:*root-environment*),.2,"
"@(y10:env-lookup)[23}f]1}f]1}.!0.0^_1[31",
"C", 0, "C", 0,
"'(i101),n,.1V2,,#0.2,.2,&2{%2:1,.1H2,.0,:0V4,.0,.3A3,.0?{.4,.1sd]5}.1," "'(i101),n,.1V2,,#0.2,.2,&2{%2:1,.1H2,.0,:0V4,.0,.3A3,.0?{.4,.1sd]5}.1,"
".5,.5cc,.3,:0V5]5}.!0${U1,,#0.0,.5,.7,&3{%1.0u?{:0]1}.0d,.1a,.0d,.1a,." ".5,.5cc,.3,:0V5]5}.!0${U1,,#0.0,.5,.7,&3{%1.0u?{:0]1}.0d,.1a,.0d,.1a,."
"1Y0,.0?{.0}{.2N0}_1?{${.3b,.3,:1^[02}.3,:2^[51}.1p?{'(y12:syntax-rules" "1Y0,.0?{.0}{.2N0}_1?{${.3b,.3,:1^[02}.3,:2^[51}.1p?{'(y12:syntax-rules"
"),.2aq}{f}?{,,#0#1&0{%1t,@(y18:*root-environment*),.2,@(y10:env-lookup" "),.2aq}{f}?{,,#0#1&0{%2.1,@(y18:*root-environment*),.2,@(y10:env-looku"
")[13}.!0${.5da,@(y3:id?)[01}?{${.5ddd,.6dda,.7da,.5^,@(y13:syntax-rule" "p)[23}.!0${.5da,@(y3:id?)[01}?{${.5ddd,.6dda,.7da,.5^,@(y13:syntax-rul"
"s*)[04}}{${.5dd,.6da,f,.5^,@(y13:syntax-rules*)[04}}.!1${.3^b,.5,:1^[0" "es*)[04}}{${.5dd,.6da,f,.5^,@(y13:syntax-rules*)[04}}.!1${.3^b,.5,:1^["
"2}.5,:2^[71}f]5}.!0.0^_1[01}_1_1_1@!(y18:*root-environment*)", "02}.5,:2^[71}f]5}.!0.0^_1[01}_1_1_1@!(y18:*root-environment*)",
"P", "root-environment", "P", "root-environment",
"%1.0p?{'(y6:define),.1aq?{.0d,&0{%1.0]1},@(y13:apply-to-list)[12}'(y13" "%2.1,@(y18:*root-environment*),.2,@(y10:env-lookup)[23",
":define-syntax),.1aq?{.0d,&0{%1t,@(y18:*root-environment*),.2,@(y10:en"
"v-lookup)[13},@(y13:apply-to-list)[12}'(y16:record-case-miss)]1}t,@(y1"
"8:*root-environment*),.2,@(y10:env-lookup)[13",
"P", "error*", "P", "error*",
"%2.1,.1c,@(y5:error),@(y13:apply-to-list)[22", "%2.1,.1c,@(y5:error),@(y13:apply-to-list)[22",
@ -568,16 +576,17 @@ char *t_code[] = {
"P", "eval-top-form", "P", "eval-top-form",
"%2.0p?{${.3,.3a,t,@(y5:xform)[03},'(y5:begin),.1q?{.1d,,#0.4,.1,&2{%1." "%2.0p?{${.3,.3a,t,@(y5:xform)[03},'(y5:begin),.1q?{.1d,,#0.4,.1,&2{%1."
"0p?{${:1,.3a,@(y13:eval-top-form)[02}.0d,:0^[11}]1}.!0.0^_1[31}'(y6:de" "0p?{${:1,.3a,@(y13:eval-top-form)[02}.0d,:0^[11}]1}.!0.0^_1[31}'(y6:de"
"fine),.1q?{${.4,.4d,@(y12:xform-define)[02},${.2da,'(y6:define),l2,.6[" "fine),.1q?{${.4,.4d,@(y12:xform-define)[02},${'(y6:define),.3da,.7,@(y"
"01},.0?{.1dda,.1,'(y4:set!),l3,@(y25:compile-and-run-core-expr)[51}.4," "11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y13:syntax-match?)["
".2da,'(s39:identifier cannot be (re)defined in env),@(y7:x-error)[53}'" "02}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y25:compile-and-run-core-expr)[51"
"(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-syntax)[02},${.2d" "}.4,.2da,'(s39:identifier cannot be (re)defined in env),@(y7:x-error)["
"a,'(y13:define-syntax),l2,.6[01},.0?{.1dda,.1sz]5}.4,.2da,'(s49:identi" "53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-syntax)[02},$"
"fier cannot be (re)defined as syntax in env),@(y7:x-error)[53}.0K0?{.2" "{'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{.1dda,.1sz]5}"
",${.5,.5,.5[02},@(y13:eval-top-form)[32}.0U0?{${.4,.4d,.4,@(y16:xform-" ".4,.2da,'(s49:identifier cannot be (re)defined as syntax in env),@(y7:"
"integrable)[03},@(y25:compile-and-run-core-expr)[31}${.4,.4,f,@(y5:xfo" "x-error)[53}.0K0?{.2,${.5,.5,.5[02},@(y13:eval-top-form)[32}.0U0?{${.4"
"rm)[03},@(y25:compile-and-run-core-expr)[31}${.3,.3,f,@(y5:xform)[03}," ",.4d,.4,@(y16:xform-integrable)[03},@(y25:compile-and-run-core-expr)[3"
"@(y25:compile-and-run-core-expr)[21", "1}${.4,.4,f,@(y5:xform)[03},@(y25:compile-and-run-core-expr)[31}${.3,."
"3,f,@(y5:xform)[03},@(y25:compile-and-run-core-expr)[21",
"C", 0, "C", 0,
"f@!(y9:*verbose*)", "f@!(y9:*verbose*)",