mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-25 21:58:54 +01:00
transformers for basic forms moved from k to s
This commit is contained in:
ESL
parent
f458d436b9
commit
463d3622dd
6 changed files with 1634 additions and 4652 deletions
92
s.c
92
s.c
|
|
@ -2,6 +2,90 @@
|
|||
|
||||
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{%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"
|
||||
"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{%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{%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[22}@"
|
||||
|
|
|
|||
106
src/k.sf
106
src/k.sf
|
|
@ -277,6 +277,8 @@
|
|||
(list 'ref (integrable-global hval))]
|
||||
[(procedure? hval) ; id-syntax
|
||||
(xform appos? (hval sexp env) env)]
|
||||
[(not (pair? hval))
|
||||
(x-error "improper use of syntax form" hval)]
|
||||
[else hval]))]
|
||||
[(not (pair? sexp))
|
||||
(xform-quote (list sexp) env)]
|
||||
|
|
@ -677,109 +679,6 @@
|
|||
[(_ 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
|
||||
|
|
@ -1582,6 +1481,7 @@
|
|||
(set! *reset* catch)
|
||||
(let ([xexp (transform #f x)])
|
||||
(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!))
|
||||
(when *verbose* (display "COMPILE-TO-STRING =>") (newline))
|
||||
(let ([cstr (compile-to-string xexp)] [start #f])
|
||||
|
|
|
|||
12
src/s.scm
12
src/s.scm
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; SCHEME LIBRARY FUNCTIONS
|
||||
; SCHEME LIBRARY
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
|
||||
|
|
@ -8,7 +8,6 @@
|
|||
; Derived expression types
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
(define-syntax let-syntax
|
||||
(syntax-rules ()
|
||||
[(_ ([kw init] ...))
|
||||
|
|
@ -17,15 +16,9 @@
|
|||
((syntax-lambda (kw ...) . forms)
|
||||
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
|
||||
(syntax-rules ()
|
||||
[(_ ([key trans] ...) . forms) ; non-splicing!
|
||||
[(_ ([key trans] ...) . forms)
|
||||
(body (define-syntax key trans) ... . forms)]))
|
||||
|
||||
(define-syntax letrec
|
||||
|
|
@ -105,7 +98,6 @@
|
|||
(define-syntax case-lambda
|
||||
(syntax-rules ()
|
||||
[(_ [args . body] ...) (lambda* [args (lambda args . body)] ...)]))
|
||||
|#
|
||||
|
||||
;cond
|
||||
;case
|
||||
|
|
|
|||
159
src/t.scm
159
src/t.scm
|
|
@ -134,6 +134,7 @@
|
|||
; <core> -> (set& <id>)
|
||||
; <core> -> (lambda <ids> <core>) where <ids> -> (<id> ...) | (<id> ... . <id>) | <id>
|
||||
; <core> -> (lambda* (<arity> <core>) ...) where <arity> -> (<cnt> <rest?>)
|
||||
; <core> -> (syntax-lambda (<id> ...) <core>)
|
||||
; <core> -> (letcc <id> <core>)
|
||||
; <core> -> (withcc <core> <core>)
|
||||
; <core> -> (begin <core> ...)
|
||||
|
|
@ -194,8 +195,9 @@
|
|||
; <binding> -> (<symbol> . <value>)
|
||||
; <value> -> <special> | <core>
|
||||
; <special> -> <builtin> | <transformer>
|
||||
; <builtin> -> syntax | define | define-syntax |
|
||||
; quote | set! | begin | if | lambda | body
|
||||
; <builtin> -> syntax | quote | set! | set& | begin | if | lambda |
|
||||
; lambda* | syntax-lambda | letcc | withcc | body |
|
||||
; define | define-syntax ; top-level only
|
||||
; <transformer> -> <procedure of exp and env returning exp>
|
||||
|
||||
(define val-core? pair?)
|
||||
|
|
@ -224,9 +226,13 @@
|
|||
(define (add-var var val env) ; adds renamed var as <core>
|
||||
(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>
|
||||
; (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)
|
||||
(cond [(id? sexp)
|
||||
|
|
@ -236,63 +242,70 @@
|
|||
(list 'ref (integrable-global hval))]
|
||||
[(procedure? hval) ; id-syntax
|
||||
(xform appos? (hval sexp env) env)]
|
||||
[(not (pair? hval))
|
||||
(x-error "improper use of syntax form" hval)]
|
||||
[else hval]))]
|
||||
[(not (pair? sexp))
|
||||
(xform-quote sexp env)]
|
||||
(xform-quote (list sexp) env)]
|
||||
[else
|
||||
(let* ([head (car sexp)] [tail (cdr sexp)] [hval (xform #t head env)])
|
||||
(case hval
|
||||
[(syntax) (car tail)] ; internal use only
|
||||
[(quote) (xform-quote (car tail) env)]
|
||||
[(set!) (xform-set! (car tail) (cadr tail) env)]
|
||||
[(set&) (xform-set& tail env)]
|
||||
[(begin) (xform-begin tail env)]
|
||||
[(if) (xform-if tail env)]
|
||||
[(lambda) (xform-lambda tail env)]
|
||||
[(lambda*) (xform-lambda* tail env)]
|
||||
[(letcc) (xform-letcc tail env)]
|
||||
[(withcc) (xform-withcc tail env)]
|
||||
[(body) (xform-body tail env)]
|
||||
[(define) (xform-define (car tail) (cadr tail) env)]
|
||||
[(define-syntax) (xform-define-syntax (car tail) (cadr tail) env)]
|
||||
[(quote) (xform-quote tail env)]
|
||||
[(set!) (xform-set! tail env)]
|
||||
[(set&) (xform-set& tail env)]
|
||||
[(begin) (xform-begin tail env)]
|
||||
[(if) (xform-if tail env)]
|
||||
[(lambda) (xform-lambda tail env)]
|
||||
[(lambda*) (xform-lambda* tail env)]
|
||||
[(syntax-lambda) (xform-syntax-lambda tail env)]
|
||||
[(letcc) (xform-letcc tail env)]
|
||||
[(withcc) (xform-withcc tail env)]
|
||||
[(body) (xform-body tail env)]
|
||||
[(define) (xform-define tail env)]
|
||||
[(define-syntax) (xform-define-syntax tail env)]
|
||||
[else (if (integrable? hval)
|
||||
(xform-integrable hval tail env)
|
||||
(if (procedure? hval)
|
||||
(xform appos? (hval sexp env) 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)
|
||||
(let ([den (env id)])
|
||||
(cond [(symbol? den) (list 'ref den)]
|
||||
[else (binding-val den)])))
|
||||
|
||||
(define (xform-set! id exp env)
|
||||
(let ([den (env id)] [xexp (xform #f exp env)])
|
||||
(cond [(symbol? den) (list 'set! den xexp)]
|
||||
[(binding-special? den) (binding-set-val! den xexp) '(begin)]
|
||||
[else (let ([val (binding-val den)])
|
||||
(if (eq? (car val) 'ref)
|
||||
(list 'set! (cadr val) xexp)
|
||||
(error 'transform "set! to non-identifier form")))])))
|
||||
(define (xform-quote tail 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)]
|
||||
[(binding-special? den) (binding-set-val! den xexp) '(begin)]
|
||||
[else (let ([val (binding-val den)])
|
||||
(if (eq? (car val) 'ref)
|
||||
(list 'set! (cadr val) xexp)
|
||||
(x-error "set! to non-identifier form")))]))
|
||||
(x-error "improper set! form" (cons 'set! tail))))
|
||||
|
||||
(define (xform-set& tail env)
|
||||
(if (list1? tail)
|
||||
(let ([den (env (car tail))])
|
||||
(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)])
|
||||
(if (eq? (car val) 'ref)
|
||||
(list 'set& (cadr val))
|
||||
(error 'transform "set& of a non-variable")))]))
|
||||
(error 'transform "improper set& form")))
|
||||
(x-error "set& of a non-variable")))]))
|
||||
(x-error "improper set& form" (cons 'set& tail))))
|
||||
|
||||
(define (xform-begin tail env)
|
||||
(if (list? tail)
|
||||
|
|
@ -300,7 +313,7 @@
|
|||
(if (and (pair? xexps) (null? (cdr xexps)))
|
||||
(car xexps) ; (begin x) => x
|
||||
(cons 'begin xexps)))
|
||||
(error 'transform "improper begin form")))
|
||||
(x-error "improper begin form" (cons 'begin! tail))))
|
||||
|
||||
(define (xform-if tail env)
|
||||
(if (list? tail)
|
||||
|
|
@ -308,8 +321,8 @@
|
|||
(case (length xexps)
|
||||
[(2) (cons 'if (append xexps '((begin))))]
|
||||
[(3) (cons 'if xexps)]
|
||||
[else (error 'transform "malformed if form")]))
|
||||
(error 'transform "improper if form")))
|
||||
[else (x-error "malformed if form" (cons 'if tail))]))
|
||||
(x-error "improper if form" (cons 'if tail))))
|
||||
|
||||
(define (xform-call xexp tail env)
|
||||
(if (list? tail)
|
||||
|
|
@ -317,7 +330,7 @@
|
|||
(if (and (null? xexps) (eq? (car xexp) 'lambda) (null? (cadr xexp)))
|
||||
(caddr xexp) ; ((let () x)) => x
|
||||
(pair* 'call xexp xexps)))
|
||||
(error 'transform "improper application")))
|
||||
(x-error "improper application" (cons xexp tail))))
|
||||
|
||||
(define (integrable-argc-match? igt n)
|
||||
(case igt
|
||||
|
|
@ -336,42 +349,59 @@
|
|||
(if (and (list1+? tail) (idslist? (car tail)))
|
||||
(let loop ([vars (car tail)] [ienv env] [ipars '()])
|
||||
(cond [(pair? vars)
|
||||
(let* ([var (car vars)] [nvar (gensym (id->sym var))])
|
||||
(loop (cdr vars) (add-var var nvar ienv) (cons nvar ipars)))]
|
||||
(let* ([var (car vars)] [nvar (gensym (id->sym var))])
|
||||
(loop (cdr vars) (add-var var nvar ienv) (cons nvar ipars)))]
|
||||
[(null? vars)
|
||||
(list 'lambda (reverse ipars) (xform-body (cdr tail) ienv))]
|
||||
(list 'lambda (reverse ipars) (xform-body (cdr tail) ienv))]
|
||||
[else ; improper
|
||||
(let* ([var vars] [nvar (gensym (id->sym var))]
|
||||
[ienv (add-var var nvar ienv)])
|
||||
(list 'lambda (append (reverse ipars) nvar)
|
||||
(xform-body (cdr tail) ienv)))]))
|
||||
(error 'transform "improper lambda body" tail)))
|
||||
(list 'lambda (append (reverse ipars) nvar)
|
||||
(xform-body (cdr tail) ienv)))]))
|
||||
(x-error "improper lambda body" (cons 'lambda tail))))
|
||||
|
||||
(define (xform-lambda* tail env)
|
||||
(if (list? tail)
|
||||
(cons 'lambda*
|
||||
(map (lambda (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))))
|
||||
(list (normalize-arity (car aexp))
|
||||
(xform #f (cadr aexp) env))
|
||||
(error 'transform "improper lambda* clause")))
|
||||
(x-error "improper lambda* clause" aexp)))
|
||||
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)
|
||||
(if (and (list2+? tail) (id? (car tail)))
|
||||
(let* ([var (car tail)] [nvar (gensym (id->sym var))])
|
||||
(list 'letcc nvar
|
||||
(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)
|
||||
(if (list2+? tail)
|
||||
(list 'withcc (xform #f (car 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)
|
||||
(if (null? tail)
|
||||
|
|
@ -411,27 +441,27 @@
|
|||
(map (lambda (lid) '(begin)) lids))))]
|
||||
[(symbol? (car nids)) ; define
|
||||
(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))]
|
||||
[else ; define-syntax
|
||||
(binding-set-val! (env (car ids)) (xform #t (car inits) env))
|
||||
(loop (cdr ids) (cdr inits) (cdr nids) sets lids)])))
|
||||
|
||||
(define (xform-define id exp env) ; top-level only
|
||||
(if (id? id)
|
||||
(list 'define (id->sym id) (xform #f exp env))
|
||||
(error 'transform "define of non-identifier form")))
|
||||
(define (xform-define tail env) ; top-level only
|
||||
(if (and (list2? tail) (id? (car tail)))
|
||||
(list 'define (id->sym (car tail)) (xform #f (cadr tail) env))
|
||||
(x-error "improper define form" (cons 'define tail))))
|
||||
|
||||
(define (xform-define-syntax id exp env) ; top-level only
|
||||
(if (id? id)
|
||||
(list 'define-syntax (id->sym id) (xform #t exp env))
|
||||
(error 'transform "define-syntax of non-identifier form")))
|
||||
(define (xform-define-syntax tail env) ; top-level only
|
||||
(if (and (list2? tail) (id? (car tail)))
|
||||
(list 'define-syntax (id->sym (car tail)) (xform #t (cadr tail) env))
|
||||
(x-error "improper define-syntax form" (cons 'define-syntax tail))))
|
||||
|
||||
|
||||
; ellipsis denotation is used for comparisons only
|
||||
|
||||
(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*
|
||||
(list
|
||||
|
|
@ -443,6 +473,7 @@
|
|||
(make-binding 'set& 'set&)
|
||||
(make-binding 'lambda 'lambda)
|
||||
(make-binding 'lambda* 'lambda*)
|
||||
(make-binding 'syntax-lambda 'syntax-lambda)
|
||||
(make-binding 'letcc 'letcc)
|
||||
(make-binding 'withcc 'withcc)
|
||||
(make-binding 'begin 'begin)
|
||||
|
|
@ -587,7 +618,7 @@
|
|||
|
||||
(lambda (use use-env)
|
||||
(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)])
|
||||
(cond [(match-pattern pat use use-env) =>
|
||||
(lambda (bindings) (expand-template pat tmpl bindings))]
|
||||
|
|
@ -633,10 +664,8 @@
|
|||
(syntax-rules ()
|
||||
[(_ () . forms)
|
||||
(body . forms)]
|
||||
[(_ ([key trans] . bindings) . forms)
|
||||
(letrec-syntax ([temp trans])
|
||||
(let-syntax bindings
|
||||
(letrec-syntax ([key temp]) . forms)))]))
|
||||
[(_ ([key trans] ...) . forms)
|
||||
((syntax-lambda (key ...) . forms) trans ...)]))
|
||||
|
||||
(install-sr-transformer! 'letrec
|
||||
(syntax-rules ()
|
||||
|
|
|
|||
157
t.c
157
t.c
|
|
@ -145,63 +145,68 @@ char *t_code[] = {
|
|||
".1,.4,@(y11:extend-xenv)[33}@!(y7:add-var)",
|
||||
|
||||
0,
|
||||
"&0{%3${.3,@(y3:id?)[01}?{${.4,.4,@(y9:xform-ref)[02},.1?{.0]4}.0U0?{.0"
|
||||
"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{%!1.0,.2,'(s13:transformer: )S6,@(y6:error*)[22}@!(y7:x-error)",
|
||||
|
||||
0,
|
||||
"&0{%2${.2,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@(y7:id->sym)[11}.0p?{${.2"
|
||||
"d,:0^[01},${.3a,:0^[01}c]1}.0V0?{${.2X0,:0^,@(y5:%25map1)[02}X1]1}.0]1"
|
||||
"}.!0.0^_1[01},'(y5:quote),l2]2}@!(y11:xform-quote)",
|
||||
"&0{%3${.3,@(y3:id?)[01}?{${.4,.4,@(y9:xform-ref)[02},.1?{.0]4}.0U0?{.0"
|
||||
"U7,'(y3:ref),l2]4}.0K0?{.3,${.6,.6,.5[02},.3,@(y5:xform)[43}.0p~?{.0,'"
|
||||
"(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{%2${.2,.4[01},.0Y0?{.0,'(y3:ref),l2]3}.0,@(y11:binding-val)[31}@!(y"
|
||||
"9:xform-ref)",
|
||||
|
||||
0,
|
||||
"&0{%3${.4,.4,f,@(y5:xform)[03},${.3,.6[01},.0Y0?{.1,.1,'(y4:set!),l3]5"
|
||||
"}${.2,@(y16:binding-special?)[01}?{${.3,.3,@(y16:binding-set-val!)[02}"
|
||||
"'(l1:y5:begin;)]5}${.2,@(y11:binding-val)[01},'(y3:ref),.1aq?{.2,.1da,"
|
||||
"'(y4:set!),l3]6}'(s27:set! to non-identifier form),'(y9:transform),@(y"
|
||||
"5:error)[62}@!(y10:xform-set!)",
|
||||
"&0{%2${.2,@(y6:list1?)[01}?{${.2a,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@("
|
||||
"y7:id->sym)[11}.0p?{${.2d,:0^[01},${.3a,:0^[01}c]1}.0V0?{${.2X0,:0^,@("
|
||||
"y5:%25map1)[02}X1]1}.0]1}.!0.0^_1[01},'(y5:quote),l2]2}.0,'(y5:quote)c"
|
||||
",'(s19:improper quote form),@(y7:x-error)[22}@!(y11:xform-quote)",
|
||||
|
||||
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{%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"
|
||||
"form),@(y5:error)[32}${.2,@(y11:binding-val)[01},'(y3:ref),.1aq?{.0da,"
|
||||
"'(y4:set&),l2]4}'(s22:set& of a non-variable),'(y9:transform),@(y5:err"
|
||||
"or)[42}'(s18:improper set& form),'(y9:transform),@(y5:error)[22}@!(y10"
|
||||
":xform-set&)",
|
||||
",@(y16:binding-special?)[01}?{'(s22:set& of a non-variable),@(y7:x-err"
|
||||
"or)[31}${.2,@(y11:binding-val)[01},'(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}@!(y10:xform-set&)",
|
||||
|
||||
0,
|
||||
"&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"
|
||||
"nsform),@(y5:error)[22}@!(y11:xform-begin)",
|
||||
"{.0du}{f}?{.0a]3}.0,'(y5:begin)c]3}.0,'(y6:begin!)c,'(s19:improper beg"
|
||||
"in form),@(y7:x-error)[22}@!(y11:xform-begin)",
|
||||
|
||||
0,
|
||||
"&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?{."
|
||||
"1,'(y2:if)c]4}t?{'(s17:malformed if form),'(y9:transform),@(y5:error)["
|
||||
"42}f]4}'(s16:improper if form),'(y9:transform),@(y5:error)[22}@!(y8:xf"
|
||||
"orm-if)",
|
||||
"1,'(y2:if)c]4}t?{.2,'(y2:if)c,'(s17:malformed if form),@(y7:x-error)[4"
|
||||
"2}f]4}.0,'(y2:if)c,'(s16:improper if form),@(y7:x-error)[22}@!(y8:xfor"
|
||||
"m-if)",
|
||||
|
||||
0,
|
||||
"&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*"
|
||||
")[43}'(s20:improper application),'(y9:transform),@(y5:error)[32}@!(y10"
|
||||
":xform-call)",
|
||||
")[43}.1,.1c,'(s20:improper application),@(y7:x-error)[32}@!(y10:xform-"
|
||||
"call)",
|
||||
|
||||
0,
|
||||
"&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"
|
||||
")[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"
|
||||
"8L6,'(y6:lambda),l3]6}.!0.0^_1[23}.0,'(s20:improper lambda body),'(y9:"
|
||||
"transform),@(y5:error)[23}@!(y12:xform-lambda)",
|
||||
"8L6,'(y6:lambda),l3]6}.!0.0^_1[23}.0,'(y6:lambda)c,'(s20:improper lamb"
|
||||
"da body),@(y7:x-error)[22}@!(y12:xform-lambda)",
|
||||
|
||||
0,
|
||||
"&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"
|
||||
",.3da,f,@(y5:xform)[03},${.3a,@(y15:normalize-arity)[01},l2]1}'(s23:im"
|
||||
"proper lambda* clause),'(y9:transform),@(y5:error)[12},@(y5:%25map1)[0"
|
||||
"2},'(y7:lambda*)c]2}'(s21:improper lambda* form),'(y9:transform),@(y5:"
|
||||
"error)[22}@!(y13:xform-lambda*)",
|
||||
",.3da,f,@(y5:xform)[03},${.3a,@(y15:normalize-arity)[01},l2]1}.0,'(s23"
|
||||
":improper lambda* clause),@(y7:x-error)[12},@(y5:%25map1)[02},'(y7:lam"
|
||||
"bda*)c]2}.0,'(y7:lambda*)c,'(s21:improper lambda* form),@(y7:x-error)["
|
||||
"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{%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"
|
||||
":xform-body)[02},.1,'(y5:letcc),l3]4}'(s19:improper letcc form),'(y9:t"
|
||||
"ransform),@(y5:error)[22}@!(y11:xform-letcc)",
|
||||
":xform-body)[02},.1,'(y5:letcc),l3]4}.0,'(y5:letcc)c,'(s19:improper le"
|
||||
"tcc form),@(y7:x-error)[22}@!(y11:xform-letcc)",
|
||||
|
||||
0,
|
||||
"&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"
|
||||
"ansform),@(y5:error)[22}@!(y12:xform-withcc)",
|
||||
",@(y5:xform)[03},'(y6:withcc),l3]2}.0,'(y6:withcc)c,'(s20:improper wit"
|
||||
"hcc form),@(y7:x-error)[22}@!(y12:xform-withcc)",
|
||||
|
||||
0,
|
||||
"&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"
|
||||
"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"
|
||||
",.6a,@(y10:xform-set!)[03}c,.4d,.4d,.4d,:2^[55}${${:1,.6a,t,@(y5:xform"
|
||||
")[03},${.5a,:1[01},@(y16:binding-set-val!)[02}.4,.4,.4d,.4d,.4d,:2^[55"
|
||||
"}.!0.0^_1[55}@!(y12:xform-labels)",
|
||||
",.6a,l2,@(y10:xform-set!)[02}c,.4d,.4d,.4d,:2^[55}${${:1,.6a,t,@(y5:xf"
|
||||
"orm)[03},${.5a,:1[01},@(y16:binding-set-val!)[02}.4,.4,.4d,.4d,.4d,:2^"
|
||||
"[55}.!0.0^_1[55}@!(y12:xform-labels)",
|
||||
|
||||
0,
|
||||
"&0{%3${.2,@(y3:id?)[01}?{${.4,.4,f,@(y5:xform)[03},${.3,@(y7:id->sym)["
|
||||
"01},'(y6:define),l3]3}'(s29:define of non-identifier form),'(y9:transf"
|
||||
"orm),@(y5:error)[32}@!(y12:xform-define)",
|
||||
"&0{%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,f,@(y5:"
|
||||
"xform)[03},${.3a,@(y7:id->sym)[01},'(y6:define),l3]2}.0,'(y6:define)c,"
|
||||
"'(s20:improper define form),@(y7:x-error)[22}@!(y12:xform-define)",
|
||||
|
||||
0,
|
||||
"&0{%3${.2,@(y3:id?)[01}?{${.4,.4,t,@(y5:xform)[03},${.3,@(y7:id->sym)["
|
||||
"01},'(y13:define-syntax),l3]3}'(s36:define-syntax of non-identifier fo"
|
||||
"rm),'(y9:transform),@(y5:error)[32}@!(y19:xform-define-syntax)",
|
||||
"&0{%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,t,@(y5:"
|
||||
"xform)[03},${.3a,@(y7:id->sym)[01},'(y13:define-syntax),l3]2}.0,'(y13:"
|
||||
"define-syntax)c,'(s27:improper define-syntax form),@(y7:x-error)[22}@!"
|
||||
"(y19:xform-define-syntax)",
|
||||
|
||||
0,
|
||||
"${&0{%2.0,'(y3:...),@(y5:error)[22},'(y3:...),@(y12:make-binding)[02}@"
|
||||
"!(y30:denotation-of-default-ellipsis)",
|
||||
"${&0{%2.0,'(s19:improper use of ...),@(y7:x-error)[22},'(y3:...),@(y12"
|
||||
":make-binding)[02}@!(y30:denotation-of-default-ellipsis)",
|
||||
|
||||
0,
|
||||
"@(y30:denotation-of-default-ellipsis),${'(y4:body),'(y4:body),@(y12:ma"
|
||||
"ke-binding)[02},${'(y2:if),'(y2:if),@(y12:make-binding)[02},${'(y5:beg"
|
||||
"in),'(y5:begin),@(y12:make-binding)[02},${'(y6:withcc),'(y6:withcc),@("
|
||||
"y12:make-binding)[02},${'(y5:letcc),'(y5:letcc),@(y12:make-binding)[02"
|
||||
"},${'(y7:lambda*),'(y7:lambda*),@(y12:make-binding)[02},${'(y6:lambda)"
|
||||
",'(y6:lambda),@(y12:make-binding)[02},${'(y4:set&),'(y4:set&),@(y12:ma"
|
||||
"ke-binding)[02},${'(y4:set!),'(y4:set!),@(y12:make-binding)[02},${'(y5"
|
||||
":quote),'(y5:quote),@(y12:make-binding)[02},${'(y13:define-syntax),'(y"
|
||||
"13:define-syntax),@(y12:make-binding)[02},${'(y6:define),'(y6:define),"
|
||||
"@(y12:make-binding)[02},${'(y6:syntax),'(y6:syntax),@(y12:make-binding"
|
||||
")[02},l(i14)@!(y14:*transformers*)",
|
||||
"},${'(y13:syntax-lambda),'(y13:syntax-lambda),@(y12:make-binding)[02},"
|
||||
"${'(y7:lambda*),'(y7:lambda*),@(y12:make-binding)[02},${'(y6:lambda),'"
|
||||
"(y6:lambda),@(y12:make-binding)[02},${'(y4:set&),'(y4:set&),@(y12:make"
|
||||
"-binding)[02},${'(y4:set!),'(y4:set!),@(y12:make-binding)[02},${'(y5:q"
|
||||
"uote),'(y5:quote),@(y12:make-binding)[02},${'(y13:define-syntax),'(y13"
|
||||
":define-syntax),@(y12:make-binding)[02},${'(y6:define),'(y6:define),@("
|
||||
"y12:make-binding)[02},${'(y6:syntax),'(y6:syntax),@(y12:make-binding)["
|
||||
"02},l(i15)@!(y14:*transformers*)",
|
||||
|
||||
0,
|
||||
"&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),@"
|
||||
"(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"
|
||||
".0u?{${:3,'(s14:invalid syntax),'(y9:transform),@(y5:error)[03}}.0a,.0"
|
||||
"a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[2"
|
||||
"1}](i11)}@!(y13:syntax-rules*)",
|
||||
".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}](i11)}@!(y1"
|
||||
"3:syntax-rules*)",
|
||||
|
||||
0,
|
||||
"${&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}",
|
||||
|
||||
0,
|
||||
"${'(l2:l2:py1:_;pn;y5:forms;;;py4:body;y5:forms;;;l2:py1:_;ppl2:y3:key"
|
||||
";y5:trans;;y8:bindings;;y5:forms;;;l3:y13:letrec-syntax;l1:l2:y4:temp;"
|
||||
"y5:trans;;;l3:y10:let-syntax;y8:bindings;py13:letrec-syntax;pl1:l2:y3:"
|
||||
"key;y4:temp;;;y5:forms;;;;;;),n,f,'(y10:let-syntax),@(y26:install-tran"
|
||||
"sformer-rules!)[04}",
|
||||
"${'(l2:l2:py1:_;pn;y5:forms;;;py4:body;y5:forms;;;l2:py1:_;pl2:l2:y3:k"
|
||||
"ey;y5:trans;;y3:...;;y5:forms;;;l3:py13:syntax-lambda;pl2:y3:key;y3:.."
|
||||
".;;y5:forms;;;y5:trans;y3:...;;;),n,f,'(y10:let-syntax),@(y26:install-"
|
||||
"transformer-rules!)[04}",
|
||||
|
||||
0,
|
||||
"${'(l1:l2:py1:_;pl2:l2:y3:var;y4:init;;y3:...;;y5:forms;;;py4:body;pl3"
|
||||
|
|
|
|||
Loading…
Reference in a new issue