Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2025-01-21 19:27:27 +01:00
Code Issues Projects Releases Packages Wiki Activity

bindings replaced with locations!

Browse source
This commit is contained in:
ESL 2023-04-15 21:03:39 -04:00
parent 3476c64553
commit 7cc993e16b
4 changed files with 2790 additions and 2719 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5150
k.c
View file

File diff suppressed because it is too large Load diff

128
src/k.sf
View file

@ -216,17 +216,16 @@
; 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. The denotation of an identifier is its
; binding, which is a pair of the current value and the identifier's
; name (needed by quote). Biding's value can be changed later.
; An environment is a procedure that accepts any identifier and returns a denotation.
; 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.
; Special forms are either a symbol naming a builtin, or a transformer procedure
; that takes two arguments: a macro use and the environment of the macro use.
; <identifier> -> <symbol> | <thunk returning (sym . den)>
; <denotation> -> <binding>
; <binding> -> (<symbol> . <value>)
; <denotation> -> <location>
; <location> -> #&<value>
; <value> -> <special> | <core>
; <special> -> <builtin> | <transformer>
; <builtin> -> syntax | quote | set! | set& | if | lambda | lambda* |
@ -236,14 +235,11 @@
(define-inline (val-core? val) (pair? val))
(define-inline (binding? x) (pair? x))
(define-inline (make-binding s v) (cons s v))
(define-inline (binding-val bnd) (cdr bnd))
(define-inline (binding-special? bnd) (not (pair? (cdr bnd))))
(define-inline (binding-sym bnd) (car bnd))
(define-inline (binding-set-val! bnd val) (set-cdr! bnd val))
(define-inline (find-top-binding s blist) (assq s blist))
(define-inline (make-location v) (box v))
(define-inline (location-val l) (unbox l))
(define-inline (location-set-val! l v) (set-box! l v))
(define (location-special? l) (not (pair? (unbox l))))
(define (new-id sym den) (define p (cons sym den)) (lambda () p))
(define (old-sym id) (car (id)))
(define (old-den id) (cdr (id)))
@ -252,11 +248,11 @@
(define (extend-xenv env id bnd) (lambda (i) (if (eq? id i) bnd (env i))))
(define (add-binding key val env) ; adds as-is
(extend-xenv env key (make-binding (id->sym key) val)))
(define (add-location key val env) ; adds as-is
(extend-xenv env key (make-location val)))
(define (add-var var val env) ; adds renamed var as <core>
(extend-xenv env var (make-binding (id->sym var) (list 'ref val))))
(extend-xenv env var (make-location (list 'ref val))))
(define (xform-sexp->datum sexp)
(let conv ([sexp sexp])
@ -281,9 +277,9 @@
(list 'ref (integrable-global hval))]
[(procedure? hval) ; id-syntax
(xform appos? (hval sexp env) env)]
[(not (pair? hval))
[(not (pair? hval)) ; special used out of context
(x-error "improper use of syntax form" hval)]
[else hval]))]
[else hval]))] ; core
[(not (pair? sexp))
(xform-quote (list sexp) env)]
[else
@ -314,8 +310,8 @@
(define (xform-ref id env)
(let ([den (env id)])
(cond [(eq? (binding-val den) '...) (x-error "improper use of ...")]
[else (binding-val den)])))
(cond [(eq? (location-val den) '...) (x-error "improper use of ...")]
[else (location-val den)])))
(define (xform-quote tail env)
(if (list1? tail)
@ -325,8 +321,8 @@
(define (xform-set! tail env)
(if (and (list2? tail) (id? (car tail)))
(let ([den (env (car tail))] [xexp (xform #f (cadr tail) env)])
(cond [(binding-special? den) (binding-set-val! den xexp) '(begin)]
[else (let ([val (binding-val den)])
(cond [(location-special? den) (location-set-val! den xexp) '(begin)]
[else (let ([val (location-val den)])
(if (eq? (car val) 'ref)
(list 'set! (cadr val) xexp)
(x-error "set! to non-identifier form")))]))
@ -335,8 +331,8 @@
(define (xform-set& tail env)
(if (list1? tail)
(let ([den (env (car tail))])
(cond [(binding-special? den) (x-error "set& of a non-variable")]
[else (let ([val (binding-val den)])
(cond [(location-special? den) (x-error "set& of a non-variable")]
[else (let ([val (location-val den)])
(if (eq? (car val) 'ref)
(list 'set& (cadr val))
(x-error "set& of a non-variable")))]))
@ -442,7 +438,7 @@
[nid (gensym (id->sym id))] [env (add-var id nid env)])
(loop env (cons id ids) (cons init inits) (cons nid nids) rest))]
[(and (list2+? tail) (pair? (car tail)) (id? (caar tail)) (idslist? (cdar tail)))
(let* ([id (caar tail)] [lambda-id (new-id 'lambda (make-binding 'lambda 'lambda))]
(let* ([id (caar tail)] [lambda-id (new-id 'lambda (make-location 'lambda))]
[init (cons lambda-id (cons (cdar tail) (cdr tail)))]
[nid (gensym (id->sym id))] [env (add-var id nid env)])
(loop env (cons id ids) (cons init inits) (cons nid nids) rest))]
@ -450,7 +446,7 @@
[(define-syntax) ; internal
(if (and (list2? tail) (id? (car tail)))
(let* ([id (car tail)] [init (cadr tail)]
[env (add-binding id '(undefined) env)])
[env (add-location id '(undefined) env)])
(loop env (cons id ids) (cons init inits) (cons #t nids) rest))
(x-error "improper define-syntax form" first))]
[else
@ -475,7 +471,7 @@
(cons (xform-set! (list (car ids) (car inits)) env) sets)
(cons (car nids) lids))]
[else ; define-syntax
(binding-set-val! (env (car ids)) (xform #t (car inits) env))
(location-set-val! (env (car ids)) (xform #t (car inits) env))
(loop (cdr ids) (cdr inits) (cdr nids) sets lids)])))
(define (xform-begin tail env) ; top-level
@ -513,7 +509,7 @@
(if (null? vars)
(list 'syntax (xform-body forms env))
(loop (cdr vars) (cdr exps)
(add-binding (car vars)
(add-location (car vars)
(xform #t (car exps) useenv) env))))
(x-error "invalif syntax-lambda application" use))))
(x-error "improper syntax-lambda body" (cons 'syntax-lambda tail))))
@ -537,43 +533,53 @@
(apply x-error args)
(x-error "improper syntax-error form" (cons 'syntax-error tail)))))
(define *transformers*
(define *transformers*
(list
(make-binding 'syntax 'syntax)
(make-binding 'quote 'quote)
(make-binding 'set! 'set!)
(make-binding 'set& 'set&)
(make-binding 'if 'if)
(make-binding 'lambda 'lambda)
(make-binding 'lambda* 'lambda*)
(make-binding 'letcc 'letcc)
(make-binding 'withcc 'withcc)
(make-binding 'body 'body)
(make-binding 'begin 'begin)
(make-binding 'define 'define)
(make-binding 'define-syntax 'define-syntax)
(make-binding 'syntax-lambda 'syntax-lambda)
(make-binding 'syntax-rules 'syntax-rules)
(make-binding 'syntax-length 'syntax-length)
(make-binding 'syntax-error 'syntax-error)
(make-binding '... '...)))
(cons 'syntax 'syntax)
(cons 'quote 'quote)
(cons 'set! 'set!)
(cons 'set& 'set&)
(cons 'if 'if)
(cons 'lambda 'lambda)
(cons 'lambda* 'lambda*)
(cons 'letcc 'letcc)
(cons 'withcc 'withcc)
(cons 'body 'body)
(cons 'begin 'begin)
(cons 'define 'define)
(cons 'define-syntax 'define-syntax)
(cons 'syntax-lambda 'syntax-lambda)
(cons 'syntax-rules 'syntax-rules)
(cons 'syntax-length 'syntax-length)
(cons 'syntax-error 'syntax-error)
(cons '... '...)))
(define *top-transformer-env* #f)
(define (top-transformer-env id)
(let ([bnd (find-top-binding id *transformers*)])
(cond [(binding? bnd)
; special case: syntax-rules in sexp form (left by init)
(let ([val (binding-val bnd)])
(if (and (pair? val) (eq? (car val) 'syntax-rules))
(binding-set-val! bnd (transform #t val))))
bnd]
[(symbol? id)
(let ([bnd (make-binding id (or (lookup-integrable id) (list 'ref id)))])
(set! *transformers* (cons bnd *transformers*))
bnd)]
[else (old-den id)])))
(unless *top-transformer-env*
(set! *top-transformer-env*
(map (lambda (bnd)
(let ([v (cdr bnd)])
(when (and (pair? v) (eq? (car v) 'syntax-rules))
(set! v
(if (id? (cadr v))
(syntax-rules* top-transformer-env (cadr v) (caddr v) (cdddr v))
(syntax-rules* top-transformer-env #f (cadr v) (cddr v)))))
(cons (car bnd) (make-location v))))
*transformers*)))
(if (procedure? id)
(old-den id) ; nonsymbolic ids can't be globally bound
(cond [(assq id *top-transformer-env*)
=> cdr]
[else
(let ([loc (make-location (or (lookup-integrable id) (list 'ref id)))])
(set! *top-transformer-env* (cons (cons id loc) *top-transformer-env*))
loc)])))
(define (install-transformer! s t)
(binding-set-val! (top-transformer-env s) t))
(location-set-val! (top-transformer-env s) t))
(define (transform appos? sexp . optenv)
; (gensym #f) ; reset gs counter to make results reproducible
@ -589,7 +595,7 @@
(define (ellipsis-pair? x)
(and (pair? x) (ellipsis? (car x))))
(define (ellipsis-denotation? den)
(and (binding? den) (eq? (binding-val den) '...)))
(eq? (location-val den) '...)) ; fixme: need eq? with correct #&...
(define (ellipsis? x)
(if ellipsis
(eq? x ellipsis)

86
src/t.scm
View file

@ -181,17 +181,16 @@
; 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. The denotation of an identifier is its
; binding, which is a pair of the current value and the identifier's
; name (needed by quote). Biding's value can be changed later.
; An environment is a procedure that accepts any identifier and returns a denotation.
; 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.
; Special forms are either a symbol naming a builtin, or a transformer procedure
; that takes two arguments: a macro use and the environment of the macro use.
; <identifier> -> <symbol> | <thunk returning (sym . den)>
; <denotation> -> <binding>
; <binding> -> (<symbol> . <value>)
; <denotation> -> <location>
; <location> -> #&<value>
; <value> -> <special> | <core>
; <special> -> <builtin> | <transformer>
; <builtin> -> syntax | quote | set! | set& | if | lambda | lambda* |
@ -199,14 +198,13 @@
; syntax-lambda | syntax-rules | syntax-length | syntax-error
; <transformer> -> <procedure of exp and env returning exp>
(define-syntax val-core? pair?)
(define-syntax binding? pair?)
(define-syntax make-binding cons)
(define-syntax binding-val cdr)
(define (binding-special? bnd) (not (pair? (cdr bnd))))
(define-syntax binding-sym car)
(define-syntax binding-set-val! set-cdr!)
(define-syntax val-core? pair?)
(define-syntax make-location box)
(define-syntax location-val unbox)
(define-syntax location-set-val! set-box!)
(define (location-special? l) (not (pair? (unbox l))))
(define (new-id sym den) (define p (cons sym den)) (lambda () p))
(define (old-sym id) (car (id)))
(define (old-den id) (cdr (id)))
@ -215,11 +213,11 @@
(define (extend-xenv env id bnd) (lambda (i) (if (eq? id i) bnd (env i))))
(define (add-binding key val env) ; adds as-is
(extend-xenv env key (make-binding (id->sym key) val)))
(define (add-location key val env) ; adds as-is
(extend-xenv env key (make-location val)))
(define (add-var var val env) ; adds renamed var as <core>
(extend-xenv env var (make-binding (id->sym var) (list 'ref val))))
(extend-xenv env var (make-location (list 'ref val))))
(define (xform-sexp->datum sexp)
(let conv ([sexp sexp])
@ -239,16 +237,14 @@
(define (xform appos? sexp env)
(cond [(id? sexp)
(let ([hval (xform-ref sexp env)])
(cond [appos? ; app position: anything goes
hval]
(cond [appos? hval]
[(integrable? hval) ; integrable id-syntax
(list 'ref (integrable-global hval))]
[(procedure? hval) ; id-syntax
(xform appos? (hval sexp env) env)]
[(not (pair? hval)) ; special used out of context
(x-error "improper use of syntax form" hval)]
[else ; core
hval]))]
[else hval]))] ; core
[(not (pair? sexp))
(xform-quote (list sexp) env)]
[else
@ -279,8 +275,8 @@
(define (xform-ref id env)
(let ([den (env id)])
(cond [(eq? (binding-val den) '...) (x-error "improper use of ...")]
[else (binding-val den)])))
(cond [(eq? (location-val den) '...) (x-error "improper use of ...")]
[else (location-val den)])))
(define (xform-quote tail env)
(if (list1? tail)
@ -290,8 +286,8 @@
(define (xform-set! tail env)
(if (and (list2? tail) (id? (car tail)))
(let ([den (env (car tail))] [xexp (xform #f (cadr tail) env)])
(cond [(binding-special? den) (binding-set-val! den xexp) '(begin)]
[else (let ([val (binding-val den)])
(cond [(location-special? den) (location-set-val! den xexp) '(begin)]
[else (let ([val (location-val den)])
(if (eq? (car val) 'ref)
(list 'set! (cadr val) xexp)
(x-error "set! to non-identifier form")))]))
@ -300,8 +296,8 @@
(define (xform-set& tail env)
(if (list1? tail)
(let ([den (env (car tail))])
(cond [(binding-special? den) (x-error "set& of a non-variable")]
[else (let ([val (binding-val den)])
(cond [(location-special? den) (x-error "set& of a non-variable")]
[else (let ([val (location-val den)])
(if (eq? (car val) 'ref)
(list 'set& (cadr val))
(x-error "set& of a non-variable")))]))
@ -407,7 +403,7 @@
[nid (gensym (id->sym id))] [env (add-var id nid env)])
(loop env (cons id ids) (cons init inits) (cons nid nids) rest))]
[(and (list2+? tail) (pair? (car tail)) (id? (caar tail)) (idslist? (cdar tail)))
(let* ([id (caar tail)] [lambda-id (new-id 'lambda (make-binding 'lambda 'lambda))]
(let* ([id (caar tail)] [lambda-id (new-id 'lambda (make-location 'lambda))]
[init (cons lambda-id (cons (cdar tail) (cdr tail)))]
[nid (gensym (id->sym id))] [env (add-var id nid env)])
(loop env (cons id ids) (cons init inits) (cons nid nids) rest))]
@ -415,7 +411,7 @@
[(define-syntax) ; internal
(if (and (list2? tail) (id? (car tail)))
(let* ([id (car tail)] [init (cadr tail)]
[env (add-binding id '(undefined) env)])
[env (add-location id '(undefined) env)])
(loop env (cons id ids) (cons init inits) (cons #t nids) rest))
(x-error "improper define-syntax form" first))]
[else
@ -440,7 +436,7 @@
(cons (xform-set! (list (car ids) (car inits)) env) sets)
(cons (car nids) lids))]
[else ; define-syntax
(binding-set-val! (env (car ids)) (xform #t (car inits) env))
(location-set-val! (env (car ids)) (xform #t (car inits) env))
(loop (cdr ids) (cdr inits) (cdr nids) sets lids)])))
(define (xform-begin tail env) ; top-level
@ -478,7 +474,7 @@
(if (null? vars)
(list 'syntax (xform-body forms env))
(loop (cdr vars) (cdr exps)
(add-binding (car vars)
(add-location (car vars)
(xform #t (car exps) useenv) env))))
(x-error "invalif syntax-lambda application" use))))
(x-error "improper syntax-lambda body" (cons 'syntax-lambda tail))))
@ -512,7 +508,7 @@
(define (ellipsis-pair? x)
(and (pair? x) (ellipsis? (car x))))
(define (ellipsis-denotation? den)
(and (binding? den) (eq? (binding-val den) '...)))
(eq? (location-val den) '...)) ; fixme: need eq? with correct #&...
(define (ellipsis? x)
(if ellipsis
(eq? x ellipsis)
@ -624,27 +620,25 @@
[else (loop (cdr rules))])))))
; experimental lookup procedure for alist-like macro environments
; new lookup procedure for alist-like macro environments
(define (lookup-in-transformer-env id env) ;=> binding | #f
(define (lookup-in-transformer-env id env) ;=> location (| #f)
(if (procedure? id)
(old-den id) ; nonsymbolic ids can't be globally bound
(let loop ([env env])
(cond [(pair? env)
(if (eq? (caar env) id)
(car env)
(cdar env) ; location
(loop (cdr env)))]
[(eq? env #t)
; implicitly append integrables and "naked" globals
(let ([bnd (make-binding id (or (lookup-integrable id) (list 'ref id)))])
(set! *root-env* (cons bnd *root-env*))
bnd)]
;[(procedure? env)
; (env id)]
[else ; finite env
(let ([loc (make-location (or (lookup-integrable id) (list 'ref id)))])
(set! *root-env* (cons (cons id loc) *root-env*))
loc)]
[else ; (future) finite env
#f]))))
; make root env from a list of initial transformers
; make root env from alist of initial transformers
(define *root-env*
(let loop ([l (initial-transformers)] [env #t])
@ -653,7 +647,7 @@
(let ([k (car p)] [v (cdr p)])
(cond
[(or (symbol? v) (number? v))
(loop l (cons (cons k v) env))]
(loop l (cons (cons k (make-location v)) env))]
[(and (pair? v) (eq? (car v) 'syntax-rules))
(body
(define (sr-env id)
@ -662,9 +656,7 @@
(if (id? (cadr v))
(syntax-rules* sr-env (cadr v) (caddr v) (cdddr v))
(syntax-rules* sr-env #f (cadr v) (cddr v))))
(loop l (cons (cons k sr-v) env)))]
[else
(loop l (cons (list k '? v) env))]))))))
(loop l (cons (cons k (make-location sr-v)) env)))]))))))
(define (root-env id)
(lookup-in-transformer-env id *root-env*))
@ -675,8 +667,8 @@
(define (transform! x)
(let ([t (xform #t x root-env)])
(when (and (syntax-match? '(define-syntax * *) t) (id? (cadr t))) ; (procedure? (caddr t))
(let ([b (lookup-in-transformer-env (cadr t) *root-env*)])
(when b (binding-set-val! b (caddr t)))))
(let ([loc (lookup-in-transformer-env (cadr t) *root-env*)])
(when loc (location-set-val! loc (caddr t)))))
t))
(define (visit f)

145
t.c
View file

@ -83,18 +83,14 @@ char *t_code[] = {
"A", "val-core?", "pair?",
"A", "binding?", "pair?",
"A", "make-location", "box",
"A", "make-binding", "cons",
"A", "location-val", "unbox",
"A", "binding-val", "cdr",
"A", "location-set-val!", "set-box!",
"P", "binding-special?",
"%1.0dp~]1",
"A", "binding-sym", "car",
"A", "binding-set-val!", "set-cdr!",
"P", "location-special?",
"%1.0zp~]1",
"P", "new-id",
"%2,#0.2,.2c.!0.0,&1{%0:0^]0}]3",
@ -114,11 +110,11 @@ char *t_code[] = {
"P", "extend-xenv",
"%3.0,.3,.3,&3{%1.0,:0q?{:1]1}.0,:2[11}]3",
"P", "add-binding",
"%3.1,${.3,@(y7:id->sym)[01}c,.1,.4,@(y11:extend-xenv)[33",
"P", "add-location",
"%3.1b,.1,.4,@(y11:extend-xenv)[33",
"P", "add-var",
"%3.1,'(y3:ref),l2,${.3,@(y7:id->sym)[01}c,.1,.4,@(y11:extend-xenv)[33",
"%3.1,'(y3:ref),l2b,.1,.4,@(y11:extend-xenv)[33",
"P", "xform-sexp->datum",
"%1.0,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@(y7:id->sym)[11}.0p?{${.2d,:0^"
@ -149,8 +145,8 @@ char *t_code[] = {
"orm-call)[73",
"P", "xform-ref",
"%2${.2,.4[01},'(y3:...),.1dq?{'(s19:improper use of ...),@(y7:x-error)"
"[31}.0d]3",
"%2${.2,.4[01},'(y3:...),.1zq?{'(s19:improper use of ...),@(y7:x-error)"
"[31}.0z]3",
"P", "xform-quote",
"%2${.2,@(y6:list1?)[01}?{${.2a,@(y17:xform-sexp->datum)[01},'(y5:quote"
@ -158,16 +154,16 @@ char *t_code[] = {
"P", "xform-set!",
"%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,f,@(y5:xfo"
"rm)[03},${.3a,.5[01},${.2,@(y16:binding-special?)[01}?{.1,.1sd'(l1:y5:"
"begin;)]4}.0d,'(y3:ref),.1aq?{.2,.1da,'(y4:set!),l3]5}'(s27:set! to no"
"n-identifier form),@(y7:x-error)[51}.0,'(y4:set!)c,'(s18:improper set!"
" form),@(y7:x-error)[22",
"rm)[03},${.3a,.5[01},${.2,@(y17:location-special?)[01}?{.1,.1sz'(l1:y5"
":begin;)]4}.0z,'(y3:ref),.1aq?{.2,.1da,'(y4:set!),l3]5}'(s27:set! to n"
"on-identifier form),@(y7:x-error)[51}.0,'(y4:set!)c,'(s18:improper set"
"! form),@(y7:x-error)[22",
"P", "xform-set&",
"%2${.2,@(y6:list1?)[01}?{${.2a,.4[01},${.2,@(y16:binding-special?)[01}"
"?{'(s22:set& of a non-variable),@(y7:x-error)[31}.0d,'(y3:ref),.1aq?{."
"0da,'(y4:set&),l2]4}'(s22:set& of a non-variable),@(y7:x-error)[41}.0,"
"'(y4:set&)c,'(s18:improper set& form),@(y7:x-error)[22",
"%2${.2,@(y6:list1?)[01}?{${.2a,.4[01},${.2,@(y17:location-special?)[01"
"}?{'(s22:set& of a non-variable),@(y7:x-error)[31}.0z,'(y3:ref),.1aq?{"
".0da,'(y4:set&),l2]4}'(s22:set& of a non-variable),@(y7:x-error)[41}.0"
",'(y4:set&)c,'(s18:improper set& form),@(y7:x-error)[22",
"P", "xform-if",
"%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0g,'2,"
@ -230,17 +226,16 @@ char *t_code[] = {
"}{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}"
"${.4,@(y7:list2+?)[01}?{.2ap?{${.4aa,@(y3:id?)[01}?{${.4ad,@(y8:idslis"
"t?)[01}}{f}}{f}}{f}?{.2aa,${'(y6:lambda),'(y6:lambda)c,'(y6:lambda),@("
"y6:new-id)[02},.4d,.5adc,.1c,${${.6,@(y7:id->sym)[01},@(y6:gensym)[01}"
",${.(i12),.3,.7,@(y7:add-var)[03},.(i10),.(i15),.3c,.(i15),.5c,.(i15),"
".8c,.4,:0^[(i16)5}.4,'(s20:improper define form),@(y7:x-error)[(i11)2}"
"'(y13:define-syntax),.1v?{${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01}}{"
"f}?{.2a,.3da,${.(i10),'(l1:y9:undefined;),.5,@(y11:add-binding)[03},.8"
",.(i13),tc,.(i13),.4c,.(i13),.6c,.4,:0^[(i14)5}.4,'(s27:improper defin"
"e-syntax form),@(y7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6[02}c,.(i10),.("
"i10),.(i10),.(i10),:0^[(i11)5}.6,.(i11),.(i11)A8,.(i11)A8,.(i11)A8,@(y"
"12:xform-labels)[(i11)5}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels)[55}.!"
"0.0^_1[25",
"t?)[01}}{f}}{f}}{f}?{.2aa,${'(y6:lambda)b,'(y6:lambda),@(y6:new-id)[02"
"},.4d,.5adc,.1c,${${.6,@(y7:id->sym)[01},@(y6:gensym)[01},${.(i12),.3,"
".7,@(y7:add-var)[03},.(i10),.(i15),.3c,.(i15),.5c,.(i15),.8c,.4,:0^[(i"
"16)5}.4,'(s20:improper define form),@(y7:x-error)[(i11)2}'(y13:define-"
"syntax),.1v?{${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01}}{f}?{.2a,.3da,"
"${.(i10),'(l1:y9:undefined;),.5,@(y12:add-location)[03},.8,.(i13),tc,."
"(i13),.4c,.(i13),.6c,.4,:0^[(i14)5}.4,'(s27:improper define-syntax for"
"m),@(y7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6[02}c,.(i10),.(i10),.(i10),"
".(i10),:0^[(i11)5}.6,.(i11),.(i11)A8,.(i11)A8,.(i11)A8,@(y12:xform-lab"
"els)[(i11)5}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels)[55}.!0.0^_1[25",
"P", "xform-labels",
"%5n,n,.4,.4,.4,,#0.0,.(i11),.(i11),&3{%5.0u?{${:0,:1,&1{%1:0,.1,f,@(y5"
@ -249,7 +244,7 @@ char *t_code[] = {
"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"
"2,@(y10:xform-set!)[02}c,.4d,.4d,.4d,:2^[55}${:1,.4a,t,@(y5:xform)[03}"
",${.3a,:1[01}sd.4,.4,.4d,.4d,.4d,:2^[55}.!0.0^_1[55",
",${.3a,:1[01}sz.4,.4,.4d,.4d,.4d,:2^[55}.!0.0^_1[55",
"P", "xform-begin",
"%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0p?{.0"
@ -273,10 +268,10 @@ char *t_code[] = {
"%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,,"
"#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,@(y11:add-binding)[03},.2d,.2d,:1^["
"33}.!0.0^_1[23}.0,'(s33:invalif syntax-lambda application),@(y7:x-erro"
"r)[22}]5}.0,'(y13:syntax-lambda)c,'(s27:improper syntax-lambda body),@"
"(y7:x-error)[22",
"{.4,${:2,.7a,t,@(y5:xform)[03},.4a,@(y12:add-location)[03},.2d,.2d,:1^"
"[33}.!0.0^_1[23}.0,'(s33:invalif syntax-lambda application),@(y7:x-err"
"or)[22}]5}.0,'(y13:syntax-lambda)c,'(s27:improper syntax-lambda body),"
"@(y7:x-error)[22",
"P", "xform-syntax-rules",
"%2${.2,@(y7:list2+?)[01}?{${.2a,@(y3:id?)[01}?{${.2da,@(y3:id?),@(y6:a"
@ -296,47 +291,47 @@ char *t_code[] = {
"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"
"}~]1}.!1.4,&1{%1.0p?{.0a,:0^[11}f]1}.!2&0{%1.0p?{'(y3:...),.1dq]1}f]1}"
".!3.3,.9,.(i11),&3{%1:0?{:0,.1q]1}${.2,@(y3:id?)[01}?{${.2,:1[01},:2^["
"11}f]1}.!4.2,&1{%3n,.2,.2,,#0:0,.1,.8,&3{%3${.2,@(y3:id?)[01}?{.1?{${."
"2,:0[01}}{f}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2X0,:1^[33}.0p?{${.2d,:2^[01}"
"?{${.4,.4,.4dd,:1^[03},t,.2a,:1^[33}${.4,.4,.4d,:1^[03},.2,.2a,:1^[33}"
".2]3}.!0.0^_1[33}.!5.5,.2,.4,.3,.(i12),&5{%3k3,.0,,#0.1,&1{%0f,:0[01}."
"!0n,.5,.5,,#0.4,.1,:4,:3,:2,:1,:0,.(i16),&8{%3,#0:7,.4,&2{%1.0?{:0]1}:"
"1^[10}.!0${.3,@(y3:id?)[01}?{${.3,:2^[01}?{${.4,@(y3:id?)[01}?{${.3,:1"
"[01},${.5,:0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{${:7^[00}"
"}_1.3,.3X0,.3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1ddg,.3L0?{"
".3g}{${:7^[00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${:4^,t,.("
"i10)a,:5^[03},,#0:6,.9,&2{%1${n,.3,:0a,:1^[03},@(y3:cdr),@(y5:%25map1)"
"[12}.!0${.(i12),.6,.(i12)dd,:6^[03},${${.7,.6^,@(y5:%25map1)[02},.5c,@"
"(y4:list)c,@(y4:%25map),@(y13:apply-to-list)[02}L6](i11)}.2p?{${.5,.5d"
",.5d,:6^[03},.3a,.3a,:6^[43}:7^[40}.!0.0^_1[63}.!6.8,.2,.7,.5,&4{%3,,,"
"#0#1#2${${.9,&1{%1:0,.1A3~]1},t,.(i10),:1^[03},:3,&1{%1${${.4,:0[01},$"
"{.5,@(y7:id->sym)[01},@(y6:new-id)[02},.1c]1},@(y5:%25map1)[02}.!0${:2"
"^,f,.7,:1^[03}.!1.1,:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,"
"#0.8,.4,:0,.8,.4,&5{%2.0,,#0.0,.4,:0,:1,:2,:3,:4,&7{%1${.2,@(y3:id?)[0"
"1}?{:5,.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:6^"
"[01}X1]1}.0p?{${.2d,:2^[01}}{f}?{${.2a,:3^[01},,,#0#1:5,&1{%1:0,.1A3d]"
"1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y4:cons),@(y5:%25map2)[03},:1a,:0^[12}.!"
"1.2u?{${.5dd,:6^[01},${.6a,:6^[01}c]4}${.4,.3^,@(y5:%25map1)[02},${.6d"
"d,:6^[01},${.3,.6^c,@(y4:%25map),@(y13:apply-to-list)[02}L6]5}.0p?{${."
"2d,:6^[01},${.3a,:6^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!7.(i11),.8,"
".8,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syntax),@(y7"
":x-error)[02}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}."
"4d,:0^[51}.!0.0^_1[21}](i12)",
"}~]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}.!"
"4.2,&1{%3n,.2,.2,,#0:0,.1,.8,&3{%3${.2,@(y3:id?)[01}?{.1?{${.2,:0[01}}"
"{f}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2X0,:1^[33}.0p?{${.2d,:2^[01}?{${.4,.4"
",.4dd,:1^[03},t,.2a,:1^[33}${.4,.4,.4d,:1^[03},.2,.2a,:1^[33}.2]3}.!0."
"0^_1[33}.!5.5,.2,.4,.3,.(i12),&5{%3k3,.0,,#0.1,&1{%0f,:0[01}.!0n,.5,.5"
",,#0.4,.1,:4,:3,:2,:1,:0,.(i16),&8{%3,#0:7,.4,&2{%1.0?{:0]1}:1^[10}.!0"
"${.3,@(y3:id?)[01}?{${.3,:2^[01}?{${.4,@(y3:id?)[01}?{${.3,:1[01},${.5"
",:0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{${:7^[00}}_1.3,.3X"
"0,.3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1ddg,.3L0?{.3g}{${:7"
"^[00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${:4^,t,.(i10)a,:5^"
"[03},,#0:6,.9,&2{%1${n,.3,:0a,:1^[03},@(y3:cdr),@(y5:%25map1)[12}.!0${"
".(i12),.6,.(i12)dd,:6^[03},${${.7,.6^,@(y5:%25map1)[02},.5c,@(y4:list)"
"c,@(y4:%25map),@(y13:apply-to-list)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^["
"03},.3a,.3a,:6^[43}:7^[40}.!0.0^_1[63}.!6.8,.2,.7,.5,&4{%3,,,#0#1#2${$"
"{.9,&1{%1:0,.1A3~]1},t,.(i10),:1^[03},:3,&1{%1${${.4,:0[01},${.5,@(y7:"
"id->sym)[01},@(y6:new-id)[02},.1c]1},@(y5:%25map1)[02}.!0${:2^,f,.7,:1"
"^[03}.!1.1,:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,:"
"0,.8,.4,&5{%2.0,,#0.0,.4,:0,:1,:2,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:5,.1"
"A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:6^[01}X1]1}"
".0p?{${.2d,:2^[01}}{f}?{${.2a,:3^[01},,,#0#1:5,&1{%1:0,.1A3d]1}.!0.2,."
"4,:4,&3{%!0${.2,:2,@(y4:cons),@(y5:%25map2)[03},:1a,:0^[12}.!1.2u?{${."
"5dd,:6^[01},${.6a,:6^[01}c]4}${.4,.3^,@(y5:%25map1)[02},${.6dd,:6^[01}"
",${.3,.6^c,@(y4:%25map),@(y13:apply-to-list)[02}L6]5}.0p?{${.2d,:6^[01"
"},${.3a,:6^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!7.(i11),.8,.8,&3{%2:"
"2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syntax),@(y7:x-error)"
"[02}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51"
"}.!0.0^_1[21}](i12)",
"P", "lookup-in-transformer-env",
"%2.0K0?{.0,@(y7:old-den)[21}.1,,#0.2,.1,&2{%1.0p?{:1,.1aaq?{.0a]1}.0d,"
":0^[11}t,.1q?{:1U5,.0?{.0}{:1,'(y3:ref),l2}_1,:1c,@(y10:*root-env*),.1"
"c@!(y10:*root-env*).0]2}f]1}.!0.0^_1[21",
"%2.0K0?{.0,@(y7:old-den)[21}.1,,#0.2,.1,&2{%1.0p?{:1,.1aaq?{.0ad]1}.0d"
",:0^[11}t,.1q?{:1U5,.0?{.0}{:1,'(y3:ref),l2}_1b,@(y10:*root-env*),.1,:"
"1cc@!(y10:*root-env*).0]2}f]1}.!0.0^_1[21",
"C", 0,
"${t,U1,,#0.0,&1{%2.0u?{.1]2}.0d,.1a,.0d,.1a,.1Y0,.0?{.0}{.2N0}_1?{.5,."
"2,.2cc,.4,:0^[62}.1p?{'(y12:syntax-rules),.2aq}{f}?{,,#0#1&0{%1@(y10:*"
"root-env*),.1,@(y25:lookup-in-transformer-env)[12}.!0${.5da,@(y3:id?)["
"01}?{${.5ddd,.6dda,.7da,.5^,@(y13:syntax-rules*)[04}}{${.5dd,.6da,f,.5"
"^,@(y13:syntax-rules*)[04}}.!1.7,.2^,.4cc,.6,:0^[82}.5,.2,'(y1:?),.3,l"
"3c,.4,:0^[62}.!0.0^_1[02}@!(y10:*root-env*)",
"2b,.2cc,.4,:0^[62}.1p?{'(y12:syntax-rules),.2aq}{f}?{,,#0#1&0{%1@(y10:"
"*root-env*),.1,@(y25:lookup-in-transformer-env)[12}.!0${.5da,@(y3:id?)"
"[01}?{${.5ddd,.6dda,.7da,.5^,@(y13:syntax-rules*)[04}}{${.5dd,.6da,f,."
"5^,@(y13:syntax-rules*)[04}}.!1.7,.2^b,.4cc,.6,:0^[82}f]6}.!0.0^_1[02}"
"@!(y10:*root-env*)",
"P", "root-env",
"%1@(y10:*root-env*),.1,@(y25:lookup-in-transformer-env)[12",
@ -347,7 +342,7 @@ char *t_code[] = {
"P", "transform!",
"%1${@(y8:root-env),.3,t,@(y5:xform)[03},${.2,'(l3:y13:define-syntax;y1"
":*;y1:*;),@(y13:syntax-match?)[02}?{${.2da,@(y3:id?)[01}}{f}?{${@(y10:"
"*root-env*),.3da,@(y25:lookup-in-transformer-env)[02},.0?{.1dda,.1sd}_"
"*root-env*),.3da,@(y25:lookup-in-transformer-env)[02},.0?{.1dda,.1sz}_"
"1}.0]2",
"P", "visit",