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

transformers for basic forms moved from k to s

Browse source
This commit is contained in:
ESL 2023-03-22 14:20:17 -04:00
parent f458d436b9
commit 463d3622dd
6 changed files with 1634 additions and 4652 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5760
k.c
View file

File diff suppressed because it is too large Load diff

92
s.c
View file

@ -2,6 +2,90 @@
char *s_code[] = { char *s_code[] = {
"let-syntax",
"l4:y12:syntax-rules;n;l2:l2:y1:_;l2:l2:y2:kw;y4:init;;y3:...;;;l1:y5:b"
"egin;;;l2:py1:_;pl2:l2:y2:kw;y4:init;;y3:...;;y5:forms;;;l3:py13:synta"
"x-lambda;pl2:y2:kw;y3:...;;y5:forms;;;y4:init;y3:...;;;",
"letrec-syntax",
"l3:y12:syntax-rules;n;l2:py1:_;pl2:l2:y3:key;y5:trans;;y3:...;;y5:form"
"s;;;py4:body;pl3:y13:define-syntax;y3:key;y5:trans;;py3:...;y5:forms;;"
";;;",
"letrec",
"l3:y12:syntax-rules;n;l2:py1:_;pl2:l2:y3:var;y4:init;;y3:...;;y5:forms"
";;;py4:body;pl3:y6:define;y3:var;y4:init;;py3:...;y5:forms;;;;;",
"let",
"l4:y12:syntax-rules;n;l2:py1:_;pl2:l2:y3:var;y4:init;;y3:...;;y5:forms"
";;;l3:py6:lambda;pl2:y3:var;y3:...;;y5:forms;;;y4:init;y3:...;;;l2:py1"
":_;py4:name;pl2:l2:y3:var;y4:init;;y3:...;;y5:forms;;;;l3:l3:y6:letrec"
";l1:l2:y4:name;py6:lambda;pl2:y3:var;y3:...;;y5:forms;;;;;y4:name;;y4:"
"init;y3:...;;;",
"let*",
"l4:y12:syntax-rules;n;l2:py1:_;pn;y5:forms;;;py4:body;y5:forms;;;l2:py"
"1:_;ppy5:first;y4:more;;y5:forms;;;l3:y3:let;l1:y5:first;;py4:let*;py4"
":more;y5:forms;;;;;",
"and",
"l5:y12:syntax-rules;n;l2:l1:y1:_;;t;;l2:l2:y1:_;y4:test;;y4:test;;l2:p"
"y1:_;py4:test;y5:tests;;;l4:y2:if;y4:test;py3:and;y5:tests;;f;;;",
"or",
"l5:y12:syntax-rules;n;l2:l1:y1:_;;f;;l2:l2:y1:_;y4:test;;y4:test;;l2:p"
"y1:_;py4:test;y5:tests;;;l3:y3:let;l1:l2:y1:x;y4:test;;;l4:y2:if;y1:x;"
"y1:x;py2:or;y5:tests;;;;;",
"cond",
"l7:y12:syntax-rules;l2:y4:else;y2:=>;;l2:l1:y1:_;;f;;l2:l2:y1:_;py4:el"
"se;y4:exps;;;py5:begin;y4:exps;;;l2:py1:_;pl1:y1:x;;y4:rest;;;l3:y2:or"
";y1:x;py4:cond;y4:rest;;;;l2:py1:_;pl3:y1:x;y2:=>;y4:proc;;y4:rest;;;l"
"3:y3:let;l1:l2:y3:tmp;y1:x;;;py4:cond;pl2:y3:tmp;l2:y4:proc;y3:tmp;;;y"
"4:rest;;;;;l2:py1:_;ppy1:x;y4:exps;;y4:rest;;;l4:y2:if;y1:x;py5:begin;"
"y4:exps;;py4:cond;y4:rest;;;;",
"case-test",
"l4:y12:syntax-rules;l1:y4:else;;l2:l3:y1:_;y1:k;y4:else;;t;;l2:l3:y1:_"
";y1:k;y5:atoms;;l3:y4:memv;y1:k;l2:y5:quote;y5:atoms;;;;",
"case",
"l3:y12:syntax-rules;n;l2:l4:y1:_;y1:x;py4:test;y5:exprs;;y3:...;;l3:y3"
":let;l1:l2:y3:key;y1:x;;;l3:y4:cond;pl3:y9:case-test;y3:key;y4:test;;y"
"5:exprs;;y3:...;;;;",
"do",
"l3:y12:syntax-rules;n;l2:l5:y1:_;l2:py3:var;py4:init;y4:step;;;y3:...;"
";y6:ending;y4:expr;y3:...;;l4:y3:let;y4:loop;l2:l2:y3:var;y4:init;;y3:"
"...;;l3:y4:cond;y6:ending;l4:y4:else;y4:expr;y3:...;l3:y4:loop;py5:beg"
"in;py3:var;y4:step;;;y3:...;;;;;;",
"quasiquote",
"l10:y12:syntax-rules;l3:y7:unquote;y16:unquote-splicing;y10:quasiquote"
";;l2:l2:y1:_;l2:y7:unquote;y1:x;;;y1:x;;l2:l2:y1:_;pl2:y16:unquote-spl"
"icing;y1:x;;y1:y;;;l3:y6:append;y1:x;l2:y10:quasiquote;y1:y;;;;l2:py1:"
"_;pl2:y10:quasiquote;y1:x;;y1:d;;;l3:y4:cons;l2:y5:quote;y10:quasiquot"
"e;;l3:y10:quasiquote;l1:y1:x;;y1:d;;;;l2:l3:y1:_;l2:y7:unquote;y1:x;;y"
"1:d;;l3:y4:cons;l2:y5:quote;y7:unquote;;py10:quasiquote;pl1:y1:x;;y1:d"
";;;;;l2:l3:y1:_;l2:y16:unquote-splicing;y1:x;;y1:d;;l3:y4:cons;l2:y5:q"
"uote;y16:unquote-splicing;;py10:quasiquote;pl1:y1:x;;y1:d;;;;;l2:py1:_"
";ppy1:x;y1:y;;y1:d;;;l3:y4:cons;py10:quasiquote;py1:x;y1:d;;;py10:quas"
"iquote;py1:y;y1:d;;;;;l2:py1:_;pv2:y1:x;y3:...;;y1:d;;;l2:y12:list->ve"
"ctor;py10:quasiquote;pl2:y1:x;y3:...;;y1:d;;;;;l2:py1:_;py1:x;y1:d;;;l"
"2:y5:quote;y1:x;;;",
"when",
"l3:y12:syntax-rules;n;l2:py1:_;py4:test;y4:rest;;;l3:y2:if;y4:test;py5"
":begin;y4:rest;;;;",
"unless",
"l3:y12:syntax-rules;n;l2:py1:_;py4:test;y4:rest;;;l3:y2:if;l2:y3:not;y"
"4:test;;py5:begin;y4:rest;;;;",
"case-lambda",
"l3:y12:syntax-rules;n;l2:l3:y1:_;py4:args;y4:body;;y3:...;;l3:y7:lambd"
"a*;l2:y4:args;py6:lambda;py4:args;y4:body;;;;y3:...;;;",
0, 0,
"&0{%2.1,.1G4,.2,.2G3,@(y6:values)[22}@!(y6:floor/)", "&0{%2.1,.1G4,.2,.2G3,@(y6:values)[22}@!(y6:floor/)",
@ -34,13 +118,9 @@ char *s_code[] = {
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y2:al;;l3:y4:asse;y1:v;y2:al;;;l" "l5:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y2:al;;l3:y4:asse;y1:v;y2:al;;;l"
"2:py1:_;y4:args;;py6:%25assoc;y4:args;;;l2:y1:_;y6:%25assoc;;", "2:py1:_;y4:args;;py6:%25assoc;y4:args;;;l2:y1:_;y6:%25assoc;;",
"list-copy",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y5:%25lcat;y1:x;l2:y5:quote;"
"n;;;;l2:py1:_;y12:syntax-rules;;py19:%25residual-list-copy;y12:syntax-"
"rules;;;l2:y1:_;y19:%25residual-list-copy;;",
0, 0,
"&0{%1n,.1,@(y5:%25lcat)[12}@!(y19:%25residual-list-copy)", "&0{%1.0,,#0.0,&1{%1.0p?{${.2d,:0^[01},.1ac]1}.0]1}.!0.0^_1[11}@!(y9:li"
"st-copy)",
0, 0,
"&0{%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[22}@" "&0{%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[22}@"

106
src/k.sf
View file

@ -277,6 +277,8 @@
(list 'ref (integrable-global hval))] (list 'ref (integrable-global hval))]
[(procedure? hval) ; id-syntax [(procedure? hval) ; id-syntax
(xform appos? (hval sexp env) env)] (xform appos? (hval sexp env) env)]
[(not (pair? hval))
(x-error "improper use of syntax form" hval)]
[else hval]))] [else hval]))]
[(not (pair? sexp)) [(not (pair? sexp))
(xform-quote (list sexp) env)] (xform-quote (list sexp) env)]
@ -677,109 +679,6 @@
[(_ name exp) [(_ name exp)
(define name exp)])))) (define name exp)]))))
; Remaining transformers are made with the help of syntax-rules*
; NB: order of installation is important -- each transformer can
; be self-recursive but can't use transformers defined later!
(define-syntax install-sr-transformer!
(syntax-rules (quote syntax-rules)
[(_ 'name (syntax-rules (lit ...) . rules))
(install-transformer-rules! 'name #f '(lit ...) 'rules)]
[(_ 'name (syntax-rules ellipsis (lit ...) . rules))
(install-transformer-rules! 'name 'ellipsis '(lit ...) 'rules)]))
(install-sr-transformer! 'letrec-syntax
(syntax-rules ()
[(_ ([key trans] ...) . forms) ; non-splicing!
(body (define-syntax key trans) ... . forms)]))
(install-sr-transformer! 'let-syntax
(syntax-rules ()
[(_ () . forms)
(body . forms)]
[(_ ([key trans] . bindings) . forms)
(letrec-syntax ([temp trans])
(let-syntax bindings
(letrec-syntax ([key temp]) . forms)))]))
(install-sr-transformer! 'letrec
(syntax-rules ()
[(_ ([var init] ...) . forms)
(body (define var init) ... . forms)]))
(install-sr-transformer! 'let
(syntax-rules ()
[(_ ([var init] ...) . forms)
((lambda (var ...) . forms) init ...)]
[(_ name ([var init] ...) . forms)
((letrec ((name (lambda (var ...) . forms))) name) init ...)]))
(install-sr-transformer! 'let*
(syntax-rules ()
[(_ () . forms)
(body . forms)]
[(_ (first . more) . forms)
(let (first) (let* more . forms))]))
(install-sr-transformer! 'and
(syntax-rules ()
[(_) #t]
[(_ test) test]
[(_ test . tests) (if test (and . tests) #f)]))
(install-sr-transformer! 'or
(syntax-rules ()
[(_) #f]
[(_ test) test]
[(_ test . tests) (let ([x test]) (if x x (or . tests)))]))
(install-sr-transformer! 'cond
(syntax-rules (else =>)
[(_) #f]
[(_ (else . exps)) (begin . exps)]
[(_ (x) . rest) (or x (cond . rest))]
[(_ (x => proc) . rest) (let ([tmp x]) (cond [tmp (proc tmp)] . rest))]
[(_ (x . exps) . rest) (if x (begin . exps) (cond . rest))]))
(install-sr-transformer! 'case-test
(syntax-rules (else)
[(_ k else) #t]
[(_ k atoms) (memv k 'atoms)]))
(install-sr-transformer! 'case
(syntax-rules ()
[(_ x (test . exprs) ...)
(let ([key x]) (cond ((case-test key test) . exprs) ...))]))
(install-sr-transformer! 'do
(syntax-rules ()
[(_ ((var init . step) ...) ending expr ...)
(let loop ([var init] ...)
(cond ending [else expr ... (loop (begin var . step) ...)]))]))
(install-sr-transformer! 'quasiquote
(syntax-rules (unquote unquote-splicing quasiquote)
[(_ ,x) x]
[(_ (,@x . y)) (append x `y)]
[(_ `x . d) (cons 'quasiquote (quasiquote (x) d))]
[(_ ,x d) (cons 'unquote (quasiquote (x) . d))]
[(_ ,@x d) (cons 'unquote-splicing (quasiquote (x) . d))]
[(_ (x . y) . d) (cons (quasiquote x . d) (quasiquote y . d))]
[(_ #(x ...) . d) (list->vector (quasiquote (x ...) . d))]
[(_ x . d) 'x]))
(install-sr-transformer! 'when
(syntax-rules ()
[(_ test . rest) (if test (begin . rest))]))
(install-sr-transformer! 'unless
(syntax-rules ()
[(_ test . rest) (if (not test) (begin . rest))]))
(install-sr-transformer! 'case-lambda
(syntax-rules ()
[(_ [args . body] ...) (lambda* [args (lambda args . body)] ...)]))
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; Runtime ; Runtime
@ -1582,6 +1481,7 @@
(set! *reset* catch) (set! *reset* catch)
(let ([xexp (transform #f x)]) (let ([xexp (transform #f x)])
(when *verbose* (display "TRANSFORM =>") (newline) (write xexp) (newline)) (when *verbose* (display "TRANSFORM =>") (newline) (write xexp) (newline))
(unless (pair? xexp) (x-error "unexpected transformed output" xexp))
(if (eq? (car xexp) 'define) (set-car! xexp 'set!)) (if (eq? (car xexp) 'define) (set-car! xexp 'set!))
(when *verbose* (display "COMPILE-TO-STRING =>") (newline)) (when *verbose* (display "COMPILE-TO-STRING =>") (newline))
(let ([cstr (compile-to-string xexp)] [start #f]) (let ([cstr (compile-to-string xexp)] [start #f])

12
src/s.scm
View file

@ -1,6 +1,6 @@
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; SCHEME LIBRARY FUNCTIONS ; SCHEME LIBRARY
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
@ -8,7 +8,6 @@
; Derived expression types ; Derived expression types
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
#|
(define-syntax let-syntax (define-syntax let-syntax
(syntax-rules () (syntax-rules ()
[(_ ([kw init] ...)) [(_ ([kw init] ...))
@ -17,15 +16,9 @@
((syntax-lambda (kw ...) . forms) ((syntax-lambda (kw ...) . forms)
init ...)])) init ...)]))
(define-syntax syntax-lambda
(let-syntax ([org-sl syntax-lambda])
(syntax-rules ()
[(_ (v ...) form) (org-sl (v ...) form)]
[(_ (v ...) . forms) (org-sl (v ...) (block . forms))])))
(define-syntax letrec-syntax (define-syntax letrec-syntax
(syntax-rules () (syntax-rules ()
[(_ ([key trans] ...) . forms) ; non-splicing! [(_ ([key trans] ...) . forms)
(body (define-syntax key trans) ... . forms)])) (body (define-syntax key trans) ... . forms)]))
(define-syntax letrec (define-syntax letrec
@ -105,7 +98,6 @@
(define-syntax case-lambda (define-syntax case-lambda
(syntax-rules () (syntax-rules ()
[(_ [args . body] ...) (lambda* [args (lambda args . body)] ...)])) [(_ [args . body] ...) (lambda* [args (lambda args . body)] ...)]))
|#
;cond ;cond
;case ;case

123
src/t.scm
View file

@ -134,6 +134,7 @@
; <core> -> (set& <id>) ; <core> -> (set& <id>)
; <core> -> (lambda <ids> <core>) where <ids> -> (<id> ...) | (<id> ... . <id>) | <id> ; <core> -> (lambda <ids> <core>) where <ids> -> (<id> ...) | (<id> ... . <id>) | <id>
; <core> -> (lambda* (<arity> <core>) ...) where <arity> -> (<cnt> <rest?>) ; <core> -> (lambda* (<arity> <core>) ...) where <arity> -> (<cnt> <rest?>)
; <core> -> (syntax-lambda (<id> ...) <core>)
; <core> -> (letcc <id> <core>) ; <core> -> (letcc <id> <core>)
; <core> -> (withcc <core> <core>) ; <core> -> (withcc <core> <core>)
; <core> -> (begin <core> ...) ; <core> -> (begin <core> ...)
@ -194,8 +195,9 @@
; <binding> -> (<symbol> . <value>) ; <binding> -> (<symbol> . <value>)
; <value> -> <special> | <core> ; <value> -> <special> | <core>
; <special> -> <builtin> | <transformer> ; <special> -> <builtin> | <transformer>
; <builtin> -> syntax | define | define-syntax | ; <builtin> -> syntax | quote | set! | set& | begin | if | lambda |
; quote | set! | begin | if | lambda | body ; lambda* | syntax-lambda | letcc | withcc | body |
; define | define-syntax ; top-level only
; <transformer> -> <procedure of exp and env returning exp> ; <transformer> -> <procedure of exp and env returning exp>
(define val-core? pair?) (define val-core? pair?)
@ -224,9 +226,13 @@
(define (add-var var val env) ; adds renamed var as <core> (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-binding (id->sym var) (list 'ref val))))
(define (x-error msg . args)
(error* (string-append "transformer: " msg) args))
; xform receives Scheme s-expressions and returns either Core Scheme <core> ; xform receives Scheme s-expressions and returns either Core Scheme <core>
; (always a pair) or special-form, which is either a builtin (a symbol) or ; (always a pair) or special-form, which is either a builtin (a symbol) or
; a transformer (a procedure) ; a transformer (a procedure). Appos? flag is true when the context can
; allow xform to return a transformer; otherwise, only <core> is accepted.
(define (xform appos? sexp env) (define (xform appos? sexp env)
(cond [(id? sexp) (cond [(id? sexp)
@ -236,63 +242,70 @@
(list 'ref (integrable-global hval))] (list 'ref (integrable-global hval))]
[(procedure? hval) ; id-syntax [(procedure? hval) ; id-syntax
(xform appos? (hval sexp env) env)] (xform appos? (hval sexp env) env)]
[(not (pair? hval))
(x-error "improper use of syntax form" hval)]
[else hval]))] [else hval]))]
[(not (pair? sexp)) [(not (pair? sexp))
(xform-quote sexp env)] (xform-quote (list sexp) env)]
[else [else
(let* ([head (car sexp)] [tail (cdr sexp)] [hval (xform #t head env)]) (let* ([head (car sexp)] [tail (cdr sexp)] [hval (xform #t head env)])
(case hval (case hval
[(syntax) (car tail)] ; internal use only [(syntax) (car tail)] ; internal use only
[(quote) (xform-quote (car tail) env)] [(quote) (xform-quote tail env)]
[(set!) (xform-set! (car tail) (cadr tail) env)] [(set!) (xform-set! tail env)]
[(set&) (xform-set& tail env)] [(set&) (xform-set& tail env)]
[(begin) (xform-begin tail env)] [(begin) (xform-begin tail env)]
[(if) (xform-if tail env)] [(if) (xform-if tail env)]
[(lambda) (xform-lambda tail env)] [(lambda) (xform-lambda tail env)]
[(lambda*) (xform-lambda* tail env)] [(lambda*) (xform-lambda* tail env)]
[(syntax-lambda) (xform-syntax-lambda tail env)]
[(letcc) (xform-letcc tail env)] [(letcc) (xform-letcc tail env)]
[(withcc) (xform-withcc tail env)] [(withcc) (xform-withcc tail env)]
[(body) (xform-body tail env)] [(body) (xform-body tail env)]
[(define) (xform-define (car tail) (cadr tail) env)] [(define) (xform-define tail env)]
[(define-syntax) (xform-define-syntax (car tail) (cadr tail) env)] [(define-syntax) (xform-define-syntax tail env)]
[else (if (integrable? hval) [else (if (integrable? hval)
(xform-integrable hval tail env) (xform-integrable hval tail env)
(if (procedure? hval) (if (procedure? hval)
(xform appos? (hval sexp env) env) (xform appos? (hval sexp env) env)
(xform-call hval tail env)))]))])) (xform-call hval tail env)))]))]))
(define (xform-quote sexp env)
(list 'quote
(let conv ([sexp sexp])
(cond [(id? sexp) (id->sym sexp)]
[(pair? sexp) (cons (conv (car sexp)) (conv (cdr sexp)))]
[(vector? sexp) (list->vector (map conv (vector->list sexp)))]
[else sexp]))))
(define (xform-ref id env) (define (xform-ref id env)
(let ([den (env id)]) (let ([den (env id)])
(cond [(symbol? den) (list 'ref den)] (cond [(symbol? den) (list 'ref den)]
[else (binding-val den)]))) [else (binding-val den)])))
(define (xform-set! id exp env) (define (xform-quote tail env)
(let ([den (env id)] [xexp (xform #f exp env)]) (if (list1? tail)
(list 'quote
(let conv ([sexp (car tail)])
(cond [(id? sexp) (id->sym sexp)]
[(pair? sexp) (cons (conv (car sexp)) (conv (cdr sexp)))]
[(vector? sexp) (list->vector (map conv (vector->list sexp)))]
[else sexp])))
(x-error "improper quote form" (cons 'quote tail))))
(define (xform-set! tail env)
(if (and (list2? tail) (id? (car tail)))
(let ([den (env (car tail))] [xexp (xform #f (cadr tail) env)])
(cond [(symbol? den) (list 'set! den xexp)] (cond [(symbol? den) (list 'set! den xexp)]
[(binding-special? den) (binding-set-val! den xexp) '(begin)] [(binding-special? den) (binding-set-val! den xexp) '(begin)]
[else (let ([val (binding-val den)]) [else (let ([val (binding-val den)])
(if (eq? (car val) 'ref) (if (eq? (car val) 'ref)
(list 'set! (cadr val) xexp) (list 'set! (cadr val) xexp)
(error 'transform "set! to non-identifier form")))]))) (x-error "set! to non-identifier form")))]))
(x-error "improper set! form" (cons 'set! tail))))
(define (xform-set& tail env) (define (xform-set& tail env)
(if (list1? tail) (if (list1? tail)
(let ([den (env (car tail))]) (let ([den (env (car tail))])
(cond [(symbol? den) (list 'set& den)] (cond [(symbol? den) (list 'set& den)]
[(binding-special? den) (error 'transform "set& of a non-variable")] [(binding-special? den) (x-error "set& of a non-variable")]
[else (let ([val (binding-val den)]) [else (let ([val (binding-val den)])
(if (eq? (car val) 'ref) (if (eq? (car val) 'ref)
(list 'set& (cadr val)) (list 'set& (cadr val))
(error 'transform "set& of a non-variable")))])) (x-error "set& of a non-variable")))]))
(error 'transform "improper set& form"))) (x-error "improper set& form" (cons 'set& tail))))
(define (xform-begin tail env) (define (xform-begin tail env)
(if (list? tail) (if (list? tail)
@ -300,7 +313,7 @@
(if (and (pair? xexps) (null? (cdr xexps))) (if (and (pair? xexps) (null? (cdr xexps)))
(car xexps) ; (begin x) => x (car xexps) ; (begin x) => x
(cons 'begin xexps))) (cons 'begin xexps)))
(error 'transform "improper begin form"))) (x-error "improper begin form" (cons 'begin! tail))))
(define (xform-if tail env) (define (xform-if tail env)
(if (list? tail) (if (list? tail)
@ -308,8 +321,8 @@
(case (length xexps) (case (length xexps)
[(2) (cons 'if (append xexps '((begin))))] [(2) (cons 'if (append xexps '((begin))))]
[(3) (cons 'if xexps)] [(3) (cons 'if xexps)]
[else (error 'transform "malformed if form")])) [else (x-error "malformed if form" (cons 'if tail))]))
(error 'transform "improper if form"))) (x-error "improper if form" (cons 'if tail))))
(define (xform-call xexp tail env) (define (xform-call xexp tail env)
(if (list? tail) (if (list? tail)
@ -317,7 +330,7 @@
(if (and (null? xexps) (eq? (car xexp) 'lambda) (null? (cadr xexp))) (if (and (null? xexps) (eq? (car xexp) 'lambda) (null? (cadr xexp)))
(caddr xexp) ; ((let () x)) => x (caddr xexp) ; ((let () x)) => x
(pair* 'call xexp xexps))) (pair* 'call xexp xexps)))
(error 'transform "improper application"))) (x-error "improper application" (cons xexp tail))))
(define (integrable-argc-match? igt n) (define (integrable-argc-match? igt n)
(case igt (case igt
@ -345,33 +358,50 @@
[ienv (add-var var nvar ienv)]) [ienv (add-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)))]))
(error 'transform "improper lambda body" tail))) (x-error "improper lambda body" (cons 'lambda tail))))
(define (xform-lambda* tail env) (define (xform-lambda* tail env)
(if (list? tail) (if (list? tail)
(cons 'lambda* (cons 'lambda*
(map (lambda (aexp) (map (lambda (aexp)
(if (and (list2? aexp) (if (and (list2? aexp)
(or (and (list2? (car aexp)) (fixnum? (caar aexp)) (boolean? (cadar aexp))) (or (and (list2? (car aexp))
(fixnum? (caar aexp))
(boolean? (cadar aexp)))
(idslist? (car aexp)))) (idslist? (car aexp))))
(list (normalize-arity (car aexp)) (list (normalize-arity (car aexp))
(xform #f (cadr aexp) env)) (xform #f (cadr aexp) env))
(error 'transform "improper lambda* clause"))) (x-error "improper lambda* clause" aexp)))
tail)) tail))
(error 'transform "improper lambda* form"))) (x-error "improper lambda* form" (cons 'lambda* tail))))
(define (xform-syntax-lambda tail env)
(if (and (list2+? tail) (andmap id? (car tail)))
(let ([vars (car tail)] [macenv env] [forms (cdr tail)])
; return a transformer that wraps xformed body in (syntax ...)
(lambda (use useenv)
(if (and (list1+? use) (fx=? (length vars) (length (cdr use))))
(let loop ([vars vars] [exps (cdr use)] [env macenv])
(if (null? vars)
(list 'syntax (xform-body forms env))
(loop (cdr vars) (cdr exps)
(add-binding (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))))
(define (xform-letcc tail env) (define (xform-letcc tail env)
(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-var var nvar env))))
(error 'transform "improper letcc form"))) (x-error "improper letcc form" (cons 'letcc tail))))
(define (xform-withcc tail env) (define (xform-withcc tail env)
(if (list2+? tail) (if (list2+? tail)
(list 'withcc (xform #f (car tail) env) (list 'withcc (xform #f (car tail) env)
(xform-body (cdr tail) env)) (xform-body (cdr tail) env))
(error 'transform "improper withcc form"))) (x-error "improper withcc form" (cons 'withcc tail))))
(define (xform-body tail env) (define (xform-body tail env)
(if (null? tail) (if (null? tail)
@ -411,27 +441,27 @@
(map (lambda (lid) '(begin)) lids))))] (map (lambda (lid) '(begin)) lids))))]
[(symbol? (car nids)) ; define [(symbol? (car nids)) ; define
(loop (cdr ids) (cdr inits) (cdr nids) (loop (cdr ids) (cdr inits) (cdr nids)
(cons (xform-set! (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
(binding-set-val! (env (car ids)) (xform #t (car inits) env)) (binding-set-val! (env (car ids)) (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-define id exp env) ; top-level only (define (xform-define tail env) ; top-level only
(if (id? id) (if (and (list2? tail) (id? (car tail)))
(list 'define (id->sym id) (xform #f exp env)) (list 'define (id->sym (car tail)) (xform #f (cadr tail) env))
(error 'transform "define of non-identifier form"))) (x-error "improper define form" (cons 'define tail))))
(define (xform-define-syntax id exp env) ; top-level only (define (xform-define-syntax tail env) ; top-level only
(if (id? id) (if (and (list2? tail) (id? (car tail)))
(list 'define-syntax (id->sym id) (xform #t exp env)) (list 'define-syntax (id->sym (car tail)) (xform #t (cadr tail) env))
(error 'transform "define-syntax of non-identifier form"))) (x-error "improper define-syntax form" (cons 'define-syntax tail))))
; ellipsis denotation is used for comparisons only ; ellipsis denotation is used for comparisons only
(define denotation-of-default-ellipsis (define denotation-of-default-ellipsis
(make-binding '... (lambda (sexp env) (error '... sexp)))) (make-binding '... (lambda (sexp env) (x-error "improper use of ..." sexp))))
(define *transformers* (define *transformers*
(list (list
@ -443,6 +473,7 @@
(make-binding 'set& 'set&) (make-binding 'set& 'set&)
(make-binding 'lambda 'lambda) (make-binding 'lambda 'lambda)
(make-binding 'lambda* 'lambda*) (make-binding 'lambda* 'lambda*)
(make-binding 'syntax-lambda 'syntax-lambda)
(make-binding 'letcc 'letcc) (make-binding 'letcc 'letcc)
(make-binding 'withcc 'withcc) (make-binding 'withcc 'withcc)
(make-binding 'begin 'begin) (make-binding 'begin 'begin)
@ -587,7 +618,7 @@
(lambda (use use-env) (lambda (use use-env)
(let loop ([rules rules]) (let loop ([rules rules])
(if (null? rules) (error 'transform "invalid syntax" use)) (if (null? rules) (x-error "invalid syntax" use))
(let* ([rule (car rules)] [pat (car rule)] [tmpl (cadr rule)]) (let* ([rule (car rules)] [pat (car rule)] [tmpl (cadr rule)])
(cond [(match-pattern pat use use-env) => (cond [(match-pattern pat use use-env) =>
(lambda (bindings) (expand-template pat tmpl bindings))] (lambda (bindings) (expand-template pat tmpl bindings))]
@ -633,10 +664,8 @@
(syntax-rules () (syntax-rules ()
[(_ () . forms) [(_ () . forms)
(body . forms)] (body . forms)]
[(_ ([key trans] . bindings) . forms) [(_ ([key trans] ...) . forms)
(letrec-syntax ([temp trans]) ((syntax-lambda (key ...) . forms) trans ...)]))
(let-syntax bindings
(letrec-syntax ([key temp]) . forms)))]))
(install-sr-transformer! 'letrec (install-sr-transformer! 'letrec
(syntax-rules () (syntax-rules ()

157
t.c
View file

@ -145,63 +145,68 @@ char *t_code[] = {
".1,.4,@(y11:extend-xenv)[33}@!(y7:add-var)", ".1,.4,@(y11:extend-xenv)[33}@!(y7:add-var)",
0, 0,
"&0{%3${.3,@(y3:id?)[01}?{${.4,.4,@(y9:xform-ref)[02},.1?{.0]4}.0U0?{.0" "&0{%!1.0,.2,'(s13:transformer: )S6,@(y6:error*)[22}@!(y7:x-error)",
"U7,'(y3:ref),l2]4}.0K0?{.3,${.6,.6,.5[02},.3,@(y5:xform)[43}.0]4}.1p~?"
"{.2,.2,@(y11:xform-quote)[32}.1a,.2d,${.6,.4,t,@(y5:xform)[03},.0,'(l1"
":y6:syntax;),.1A1?{.2a]7}'(l1:y5:quote;),.1A1?{.6,.3a,@(y11:xform-quot"
"e)[72}'(l1:y4:set!;),.1A1?{.6,.3da,.4a,@(y10:xform-set!)[73}'(l1:y4:se"
"t&;),.1A1?{.6,.3,@(y10:xform-set&)[72}'(l1:y5:begin;),.1A1?{.6,.3,@(y1"
"1:xform-begin)[72}'(l1:y2:if;),.1A1?{.6,.3,@(y8:xform-if)[72}'(l1:y6:l"
"ambda;),.1A1?{.6,.3,@(y12:xform-lambda)[72}'(l1:y7:lambda*;),.1A1?{.6,"
".3,@(y13:xform-lambda*)[72}'(l1:y5:letcc;),.1A1?{.6,.3,@(y11:xform-let"
"cc)[72}'(l1:y6:withcc;),.1A1?{.6,.3,@(y12:xform-withcc)[72}'(l1:y4:bod"
"y;),.1A1?{.6,.3,@(y10:xform-body)[72}'(l1:y6:define;),.1A1?{.6,.3da,.4"
"a,@(y12:xform-define)[73}'(l1:y13:define-syntax;),.1A1?{.6,.3da,.4a,@("
"y19:xform-define-syntax)[73}t?{.1U0?{.6,.3,.3,@(y16:xform-integrable)["
"73}.1K0?{.6,${.9,.9,.6[02},.6,@(y5:xform)[73}.6,.3,.3,@(y10:xform-call"
")[73}f]7}@!(y5:xform)",
0, 0,
"&0{%2${.2,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@(y7:id->sym)[11}.0p?{${.2" "&0{%3${.3,@(y3:id?)[01}?{${.4,.4,@(y9:xform-ref)[02},.1?{.0]4}.0U0?{.0"
"d,:0^[01},${.3a,:0^[01}c]1}.0V0?{${.2X0,:0^,@(y5:%25map1)[02}X1]1}.0]1" "U7,'(y3:ref),l2]4}.0K0?{.3,${.6,.6,.5[02},.3,@(y5:xform)[43}.0p~?{.0,'"
"}.!0.0^_1[01},'(y5:quote),l2]2}@!(y11:xform-quote)", "(s27:improper use of syntax form),@(y7:x-error)[42}.0]4}.1p~?{.2,.2,l1"
",@(y11:xform-quote)[32}.1a,.2d,${.6,.4,t,@(y5:xform)[03},.0,'(l1:y6:sy"
"ntax;),.1A1?{.2a]7}'(l1:y5:quote;),.1A1?{.6,.3,@(y11:xform-quote)[72}'"
"(l1:y4:set!;),.1A1?{.6,.3,@(y10:xform-set!)[72}'(l1:y4:set&;),.1A1?{.6"
",.3,@(y10:xform-set&)[72}'(l1:y5:begin;),.1A1?{.6,.3,@(y11:xform-begin"
")[72}'(l1:y2:if;),.1A1?{.6,.3,@(y8:xform-if)[72}'(l1:y6:lambda;),.1A1?"
"{.6,.3,@(y12:xform-lambda)[72}'(l1:y7:lambda*;),.1A1?{.6,.3,@(y13:xfor"
"m-lambda*)[72}'(l1:y13:syntax-lambda;),.1A1?{.6,.3,@(y19:xform-syntax-"
"lambda)[72}'(l1:y5:letcc;),.1A1?{.6,.3,@(y11:xform-letcc)[72}'(l1:y6:w"
"ithcc;),.1A1?{.6,.3,@(y12:xform-withcc)[72}'(l1:y4:body;),.1A1?{.6,.3,"
"@(y10:xform-body)[72}'(l1:y6:define;),.1A1?{.6,.3,@(y12:xform-define)["
"72}'(l1:y13:define-syntax;),.1A1?{.6,.3,@(y19:xform-define-syntax)[72}"
"t?{.1U0?{.6,.3,.3,@(y16:xform-integrable)[73}.1K0?{.6,${.9,.9,.6[02},."
"6,@(y5:xform)[73}.6,.3,.3,@(y10:xform-call)[73}f]7}@!(y5:xform)",
0, 0,
"&0{%2${.2,.4[01},.0Y0?{.0,'(y3:ref),l2]3}.0,@(y11:binding-val)[31}@!(y" "&0{%2${.2,.4[01},.0Y0?{.0,'(y3:ref),l2]3}.0,@(y11:binding-val)[31}@!(y"
"9:xform-ref)", "9:xform-ref)",
0, 0,
"&0{%3${.4,.4,f,@(y5:xform)[03},${.3,.6[01},.0Y0?{.1,.1,'(y4:set!),l3]5" "&0{%2${.2,@(y6:list1?)[01}?{${.2a,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@("
"}${.2,@(y16:binding-special?)[01}?{${.3,.3,@(y16:binding-set-val!)[02}" "y7:id->sym)[11}.0p?{${.2d,:0^[01},${.3a,:0^[01}c]1}.0V0?{${.2X0,:0^,@("
"'(l1:y5:begin;)]5}${.2,@(y11:binding-val)[01},'(y3:ref),.1aq?{.2,.1da," "y5:%25map1)[02}X1]1}.0]1}.!0.0^_1[01},'(y5:quote),l2]2}.0,'(y5:quote)c"
"'(y4:set!),l3]6}'(s27:set! to non-identifier form),'(y9:transform),@(y" ",'(s19:improper quote form),@(y7:x-error)[22}@!(y11:xform-quote)",
"5:error)[62}@!(y10:xform-set!)",
0,
"&0{%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,f,@(y5:"
"xform)[03},${.3a,.5[01},.0Y0?{.1,.1,'(y4:set!),l3]4}${.2,@(y16:binding"
"-special?)[01}?{${.3,.3,@(y16:binding-set-val!)[02}'(l1:y5:begin;)]4}$"
"{.2,@(y11:binding-val)[01},'(y3:ref),.1aq?{.2,.1da,'(y4:set!),l3]5}'(s"
"27:set! to non-identifier form),@(y7:x-error)[51}.0,'(y4:set!)c,'(s18:"
"improper set! form),@(y7:x-error)[22}@!(y10:xform-set!)",
0, 0,
"&0{%2${.2,@(y6:list1?)[01}?{${.2a,.4[01},.0Y0?{.0,'(y4:set&),l2]3}${.2" "&0{%2${.2,@(y6:list1?)[01}?{${.2a,.4[01},.0Y0?{.0,'(y4:set&),l2]3}${.2"
",@(y16:binding-special?)[01}?{'(s22:set& of a non-variable),'(y9:trans" ",@(y16:binding-special?)[01}?{'(s22:set& of a non-variable),@(y7:x-err"
"form),@(y5:error)[32}${.2,@(y11:binding-val)[01},'(y3:ref),.1aq?{.0da," "or)[31}${.2,@(y11:binding-val)[01},'(y3:ref),.1aq?{.0da,'(y4:set&),l2]"
"'(y4:set&),l2]4}'(s22:set& of a non-variable),'(y9:transform),@(y5:err" "4}'(s22:set& of a non-variable),@(y7:x-error)[41}.0,'(y4:set&)c,'(s18:"
"or)[42}'(s18:improper set& form),'(y9:transform),@(y5:error)[22}@!(y10" "improper set& form),@(y7:x-error)[22}@!(y10:xform-set&)",
":xform-set&)",
0, 0,
"&0{%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?"
"{.0du}{f}?{.0a]3}.0,'(y5:begin)c]3}'(s19:improper begin form),'(y9:tra" "{.0du}{f}?{.0a]3}.0,'(y5:begin)c]3}.0,'(y6:begin!)c,'(s19:improper beg"
"nsform),@(y5:error)[22}@!(y11:xform-begin)", "in form),@(y7:x-error)[22}@!(y11:xform-begin)",
0, 0,
"&0{%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0g," "&0{%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0g,"
"'(l1:i2;),.1A1?{'(l1:l1:y5:begin;;),.2L6,'(y2:if)c]4}'(l1:i3;),.1A1?{." "'(l1:i2;),.1A1?{'(l1:l1:y5:begin;;),.2L6,'(y2:if)c]4}'(l1:i3;),.1A1?{."
"1,'(y2:if)c]4}t?{'(s17:malformed if form),'(y9:transform),@(y5:error)[" "1,'(y2:if)c]4}t?{.2,'(y2:if)c,'(s17:malformed if form),@(y7:x-error)[4"
"42}f]4}'(s16:improper if form),'(y9:transform),@(y5:error)[22}@!(y8:xf" "2}f]4}.0,'(y2:if)c,'(s16:improper if form),@(y7:x-error)[22}@!(y8:xfor"
"orm-if)", "m-if)",
0, 0,
"&0{%3.1L0?{${.3,.5,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0u?" "&0{%3.1L0?{${.3,.5,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0u?"
"{'(y6:lambda),.2aq?{.1dau}{f}}{f}?{.1dda]4}.0,.2,'(y4:call),@(y5:pair*" "{'(y6:lambda),.2aq?{.1dau}{f}}{f}?{.1dda]4}.0,.2,'(y4:call),@(y5:pair*"
")[43}'(s20:improper application),'(y9:transform),@(y5:error)[32}@!(y10" ")[43}.1,.1c,'(s20:improper application),@(y7:x-error)[32}@!(y10:xform-"
":xform-call)", "call)",
0, 0,
"&0{%2.0,'(l1:c0;),.1A1?{'0,.3=]3}'(l1:c1;),.1A1?{'1,.3=]3}'(l1:c2;),.1" "&0{%2.0,'(l1:c0;),.1A1?{'0,.3=]3}'(l1:c1;),.1A1?{'1,.3=]3}'(l1:c2;),.1"
@ -222,27 +227,36 @@ char *t_code[] = {
"${.6,.4,.6,@(y7:add-var)[03},.4d,:0^[53}.0u?{${.3,:1d,@(y10:xform-body" "${.6,.4,.6,@(y7:add-var)[03},.4d,:0^[53}.0u?{${.3,:1d,@(y10:xform-body"
")[02},.3A8,'(y6:lambda),l3]3}.0,${${.4,@(y7:id->sym)[01},@(y6:gensym)[" ")[02},.3A8,'(y6:lambda),l3]3}.0,${${.4,@(y7:id->sym)[01},@(y6:gensym)["
"01},${.5,.3,.5,@(y7:add-var)[03},${.2,:1d,@(y10:xform-body)[02},.2,.7A" "01},${.5,.3,.5,@(y7:add-var)[03},${.2,:1d,@(y10:xform-body)[02},.2,.7A"
"8L6,'(y6:lambda),l3]6}.!0.0^_1[23}.0,'(s20:improper lambda body),'(y9:" "8L6,'(y6:lambda),l3]6}.!0.0^_1[23}.0,'(y6:lambda)c,'(s20:improper lamb"
"transform),@(y5:error)[23}@!(y12:xform-lambda)", "da body),@(y7:x-error)[22}@!(y12:xform-lambda)",
0, 0,
"&0{%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}?"
"{.0aaI0?{.0adaY1}{f}}{f},.0?{.0}{${.3a,@(y8:idslist?)[01}}_1}{f}?{${:0" "{.0aaI0?{.0adaY1}{f}}{f},.0?{.0}{${.3a,@(y8:idslist?)[01}}_1}{f}?{${:0"
",.3da,f,@(y5:xform)[03},${.3a,@(y15:normalize-arity)[01},l2]1}'(s23:im" ",.3da,f,@(y5:xform)[03},${.3a,@(y15:normalize-arity)[01},l2]1}.0,'(s23"
"proper lambda* clause),'(y9:transform),@(y5:error)[12},@(y5:%25map1)[0" ":improper lambda* clause),@(y7:x-error)[12},@(y5:%25map1)[02},'(y7:lam"
"2},'(y7:lambda*)c]2}'(s21:improper lambda* form),'(y9:transform),@(y5:" "bda*)c]2}.0,'(y7:lambda*)c,'(s21:improper lambda* form),@(y7:x-error)["
"error)[22}@!(y13:xform-lambda*)", "22}@!(y13:xform-lambda*)",
0,
"&0{%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-e"
"rror)[22}]5}.0,'(y13:syntax-lambda)c,'(s27:improper syntax-lambda body"
"),@(y7:x-error)[22}@!(y19:xform-syntax-lambda)",
0, 0,
"&0{%2${.2,@(y7:list2+?)[01}?{${.2a,@(y3:id?)[01}}{f}?{.0a,${${.4,@(y7:" "&0{%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" "id->sym)[01},@(y6:gensym)[01},${${.7,.5,.7,@(y7:add-var)[03},.5d,@(y10"
":xform-body)[02},.1,'(y5:letcc),l3]4}'(s19:improper letcc form),'(y9:t" ":xform-body)[02},.1,'(y5:letcc),l3]4}.0,'(y5:letcc)c,'(s19:improper le"
"ransform),@(y5:error)[22}@!(y11:xform-letcc)", "tcc form),@(y7:x-error)[22}@!(y11:xform-letcc)",
0, 0,
"&0{%2${.2,@(y7:list2+?)[01}?{${.3,.3d,@(y10:xform-body)[02},${.4,.4a,f" "&0{%2${.2,@(y7:list2+?)[01}?{${.3,.3d,@(y10:xform-body)[02},${.4,.4a,f"
",@(y5:xform)[03},'(y6:withcc),l3]2}'(s20:improper withcc form),'(y9:tr" ",@(y5:xform)[03},'(y6:withcc),l3]2}.0,'(y6:withcc)c,'(s20:improper wit"
"ansform),@(y5:error)[22}@!(y12:xform-withcc)", "hcc form),@(y7:x-error)[22}@!(y12:xform-withcc)",
0, 0,
"&0{%2.0u?{'(y5:begin),l1]2}.0,n,n,n,.5,,#0.0,&1{%5.4p?{.4ap}{f}?{.4d,." "&0{%2.0u?{'(y5:begin),l1]2}.0,n,n,n,.5,,#0.0,&1{%5.4p?{.4ap}{f}?{.4d,."
@ -261,36 +275,38 @@ char *t_code[] = {
"(y5:xform)[13},@(y5:%25map1)[02},.4A8L6,.0p?{.0du}{f}?{.0a}{.0,'(y5:be" "(y5:xform)[13},@(y5:%25map1)[02},.4A8L6,.0p?{.0du}{f}?{.0a}{.0,'(y5:be"
"gin)c},.6u?{.0]7}${.8,&0{%1'(l1:y5:begin;)]1},@(y5:%25map1)[02},.1,.8A" "gin)c},.6u?{.0]7}${.8,&0{%1'(l1:y5:begin;)]1},@(y5:%25map1)[02},.1,.8A"
"8,'(y6:lambda),l3,'(y4:call),@(y5:pair*)[73}.2aY0?{.4,.3ac,.4,${:1,.6a" "8,'(y6:lambda),l3,'(y4:call),@(y5:pair*)[73}.2aY0?{.4,.3ac,.4,${:1,.6a"
",.6a,@(y10:xform-set!)[03}c,.4d,.4d,.4d,:2^[55}${${:1,.6a,t,@(y5:xform" ",.6a,l2,@(y10:xform-set!)[02}c,.4d,.4d,.4d,:2^[55}${${:1,.6a,t,@(y5:xf"
")[03},${.5a,:1[01},@(y16:binding-set-val!)[02}.4,.4,.4d,.4d,.4d,:2^[55" "orm)[03},${.5a,:1[01},@(y16:binding-set-val!)[02}.4,.4,.4d,.4d,.4d,:2^"
"}.!0.0^_1[55}@!(y12:xform-labels)", "[55}.!0.0^_1[55}@!(y12:xform-labels)",
0, 0,
"&0{%3${.2,@(y3:id?)[01}?{${.4,.4,f,@(y5:xform)[03},${.3,@(y7:id->sym)[" "&0{%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,f,@(y5:"
"01},'(y6:define),l3]3}'(s29:define of non-identifier form),'(y9:transf" "xform)[03},${.3a,@(y7:id->sym)[01},'(y6:define),l3]2}.0,'(y6:define)c,"
"orm),@(y5:error)[32}@!(y12:xform-define)", "'(s20:improper define form),@(y7:x-error)[22}@!(y12:xform-define)",
0, 0,
"&0{%3${.2,@(y3:id?)[01}?{${.4,.4,t,@(y5:xform)[03},${.3,@(y7:id->sym)[" "&0{%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,t,@(y5:"
"01},'(y13:define-syntax),l3]3}'(s36:define-syntax of non-identifier fo" "xform)[03},${.3a,@(y7:id->sym)[01},'(y13:define-syntax),l3]2}.0,'(y13:"
"rm),'(y9:transform),@(y5:error)[32}@!(y19:xform-define-syntax)", "define-syntax)c,'(s27:improper define-syntax form),@(y7:x-error)[22}@!"
"(y19:xform-define-syntax)",
0, 0,
"${&0{%2.0,'(y3:...),@(y5:error)[22},'(y3:...),@(y12:make-binding)[02}@" "${&0{%2.0,'(s19:improper use of ...),@(y7:x-error)[22},'(y3:...),@(y12"
"!(y30:denotation-of-default-ellipsis)", ":make-binding)[02}@!(y30:denotation-of-default-ellipsis)",
0, 0,
"@(y30:denotation-of-default-ellipsis),${'(y4:body),'(y4:body),@(y12:ma" "@(y30:denotation-of-default-ellipsis),${'(y4:body),'(y4:body),@(y12:ma"
"ke-binding)[02},${'(y2:if),'(y2:if),@(y12:make-binding)[02},${'(y5:beg" "ke-binding)[02},${'(y2:if),'(y2:if),@(y12:make-binding)[02},${'(y5:beg"
"in),'(y5:begin),@(y12:make-binding)[02},${'(y6:withcc),'(y6:withcc),@(" "in),'(y5:begin),@(y12:make-binding)[02},${'(y6:withcc),'(y6:withcc),@("
"y12:make-binding)[02},${'(y5:letcc),'(y5:letcc),@(y12:make-binding)[02" "y12:make-binding)[02},${'(y5:letcc),'(y5:letcc),@(y12:make-binding)[02"
"},${'(y7:lambda*),'(y7:lambda*),@(y12:make-binding)[02},${'(y6:lambda)" "},${'(y13:syntax-lambda),'(y13:syntax-lambda),@(y12:make-binding)[02},"
",'(y6:lambda),@(y12:make-binding)[02},${'(y4:set&),'(y4:set&),@(y12:ma" "${'(y7:lambda*),'(y7:lambda*),@(y12:make-binding)[02},${'(y6:lambda),'"
"ke-binding)[02},${'(y4:set!),'(y4:set!),@(y12:make-binding)[02},${'(y5" "(y6:lambda),@(y12:make-binding)[02},${'(y4:set&),'(y4:set&),@(y12:make"
":quote),'(y5:quote),@(y12:make-binding)[02},${'(y13:define-syntax),'(y" "-binding)[02},${'(y4:set!),'(y4:set!),@(y12:make-binding)[02},${'(y5:q"
"13:define-syntax),@(y12:make-binding)[02},${'(y6:define),'(y6:define)," "uote),'(y5:quote),@(y12:make-binding)[02},${'(y13:define-syntax),'(y13"
"@(y12:make-binding)[02},${'(y6:syntax),'(y6:syntax),@(y12:make-binding" ":define-syntax),@(y12:make-binding)[02},${'(y6:define),'(y6:define),@("
")[02},l(i14)@!(y14:*transformers*)", "y12:make-binding)[02},${'(y6:syntax),'(y6:syntax),@(y12:make-binding)["
"02},l(i15)@!(y14:*transformers*)",
0, 0,
"&0{%1${@(y14:*transformers*),.3,@(y16:find-top-binding)[02},${.2,@(y8:" "&0{%1${@(y14:*transformers*),.3,@(y16:find-top-binding)[02},${.2,@(y8:"
@ -339,9 +355,9 @@ char *t_code[] = {
"c]4}${.4,.3^,@(y5:%25map1)[02},${.6dd,:6^[01},${.3,.6^c,@(y4:%25map),@" "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}." "(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}.!6.(i10),.7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1" "!0.0^_1[21}.!0.0^_1[62}.!6.(i10),.7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1"
".0u?{${:3,'(s14:invalid syntax),'(y9:transform),@(y5:error)[03}}.0a,.0" ".0u?{${:3,'(s14:invalid syntax),@(y7:x-error)[02}}.0a,.0a,.1da,${:2,:3"
"a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[2" ",.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}](i11)}@!(y1"
"1}](i11)}@!(y13:syntax-rules*)", "3:syntax-rules*)",
0, 0,
"${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n" "${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n"
@ -371,11 +387,10 @@ char *t_code[] = {
"letrec-syntax),@(y26:install-transformer-rules!)[04}", "letrec-syntax),@(y26:install-transformer-rules!)[04}",
0, 0,
"${'(l2:l2:py1:_;pn;y5:forms;;;py4:body;y5:forms;;;l2:py1:_;ppl2:y3:key" "${'(l2:l2:py1:_;pn;y5:forms;;;py4:body;y5:forms;;;l2:py1:_;pl2:l2:y3:k"
";y5:trans;;y8:bindings;;y5:forms;;;l3:y13:letrec-syntax;l1:l2:y4:temp;" "ey;y5:trans;;y3:...;;y5:forms;;;l3:py13:syntax-lambda;pl2:y3:key;y3:.."
"y5:trans;;;l3:y10:let-syntax;y8:bindings;py13:letrec-syntax;pl1:l2:y3:" ".;;y5:forms;;;y5:trans;y3:...;;;),n,f,'(y10:let-syntax),@(y26:install-"
"key;y4:temp;;;y5:forms;;;;;;),n,f,'(y10:let-syntax),@(y26:install-tran" "transformer-rules!)[04}",
"sformer-rules!)[04}",
0, 0,
"${'(l1:l2:py1:_;pl2:l2:y3:var;y4:init;;y3:...;;y5:forms;;;py4:body;pl3" "${'(l1:l2:py1:_;pl2:l2:y3:var;y4:init;;y3:...;;y5:forms;;;py4:body;pl3"