mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-26 21:58:51 +01:00
t.scm uses macros from s.scm at xform time
This commit is contained in:
ESL
parent
7a95c9b784
commit
5d4078b173
2 changed files with 81 additions and 186 deletions
152
src/t.scm
152
src/t.scm
|
|
@ -675,103 +675,67 @@
|
|||
[else (loop (cdr rules))])))))
|
||||
|
||||
|
||||
; 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!
|
||||
; experimental lookup procedure for alist-like macro environments
|
||||
|
||||
(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)]))
|
||||
(define (lookup-in-transformer-env id env) ;=> binding | #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)
|
||||
(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
|
||||
#f]))))
|
||||
|
||||
(install-sr-transformer! 'letrec-syntax
|
||||
(syntax-rules ()
|
||||
[(_ ([key trans] ...) . forms) ; non-splicing!
|
||||
(body (define-syntax key trans) ... . forms)]))
|
||||
; make root env from a list of initial transformers
|
||||
|
||||
(install-sr-transformer! 'let-syntax
|
||||
(syntax-rules ()
|
||||
[(_ () . forms)
|
||||
(body . forms)]
|
||||
[(_ ([key trans] ...) . forms)
|
||||
((syntax-lambda (key ...) . forms) trans ...)]))
|
||||
(define *root-env*
|
||||
(let loop ([l (initial-transformers)] [env #t])
|
||||
(if (null? l) env
|
||||
(let ([p (car l)] [l (cdr l)])
|
||||
(let ([k (car p)] [v (cdr p)])
|
||||
(cond
|
||||
[(or (symbol? v) (number? v))
|
||||
(loop l (cons (cons k v) env))]
|
||||
[(and (pair? v) (eq? (car v) 'syntax-rules))
|
||||
(body
|
||||
(define (sr-env id)
|
||||
(lookup-in-transformer-env id *root-env*))
|
||||
(define sr-v
|
||||
(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))]))))))
|
||||
|
||||
(install-sr-transformer! 'letrec
|
||||
(syntax-rules ()
|
||||
[(_ ([var init] ...) . forms)
|
||||
(body (define var init) ... . forms)]))
|
||||
(define (root-env id)
|
||||
(lookup-in-transformer-env id *root-env*))
|
||||
|
||||
(install-sr-transformer! 'let
|
||||
(syntax-rules ()
|
||||
[(_ ([var init] ...) . forms)
|
||||
((lambda (var ...) . forms) init ...)]
|
||||
[(_ name ([var init] ...) . forms)
|
||||
((letrec ((name (lambda (var ...) . forms))) name) init ...)]))
|
||||
(define (error* msg args)
|
||||
(apply error (cons msg args)))
|
||||
|
||||
(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)] ...)]))
|
||||
(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)))))
|
||||
t))
|
||||
|
||||
(define (visit f)
|
||||
(define p (open-input-file f))
|
||||
(let loop ([x (read p)])
|
||||
(unless (eof-object? x)
|
||||
(let ([t (transform! x)])
|
||||
(write t)
|
||||
(newline))
|
||||
(loop (read p))))
|
||||
(close-input-port p))
|
||||
|
|
|
|||
115
t.c
115
t.c
|
|
@ -359,104 +359,35 @@ char *t_code[] = {
|
|||
"1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}]"
|
||||
"(i12)",
|
||||
|
||||
"S", "install-sr-transformer!",
|
||||
"l4:y12:syntax-rules;l2:y5:quote;y12:syntax-rules;;l2:l3:y1:_;l2:y5:quo"
|
||||
"te;y4:name;;py12:syntax-rules;pl2:y3:lit;y3:...;;y5:rules;;;;l5:y26:in"
|
||||
"stall-transformer-rules!;l2:y5:quote;y4:name;;f;l2:y5:quote;l2:y3:lit;"
|
||||
"y3:...;;;l2:y5:quote;y5:rules;;;;l2:l3:y1:_;l2:y5:quote;y4:name;;py12:"
|
||||
"syntax-rules;py8:ellipsis;pl2:y3:lit;y3:...;;y5:rules;;;;;l5:y26:insta"
|
||||
"ll-transformer-rules!;l2:y5:quote;y4:name;;l2:y5:quote;y8:ellipsis;;l2"
|
||||
":y5:quote;l2:y3:lit;y3:...;;;l2:y5:quote;y5:rules;;;;",
|
||||
"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",
|
||||
|
||||
"C", 0,
|
||||
"${'(l1:l2:py1:_;pl2:l2:y3:key;y5:trans;;y3:...;;y5:forms;;;py4:body;pl"
|
||||
"3:y13:define-syntax;y3:key;y5:trans;;py3:...;y5:forms;;;;;),n,f,'(y13:"
|
||||
"letrec-syntax),@(y26:install-transformer-rules!)[04}",
|
||||
"${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*)",
|
||||
|
||||
"C", 0,
|
||||
"${'(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}",
|
||||
"P", "root-env",
|
||||
"%1@(y10:*root-env*),.1,@(y25:lookup-in-transformer-env)[12",
|
||||
|
||||
"C", 0,
|
||||
"${'(l1:l2:py1:_;pl2:l2:y3:var;y4:init;;y3:...;;y5:forms;;;py4:body;pl3"
|
||||
":y6:define;y3:var;y4:init;;py3:...;y5:forms;;;;;),n,f,'(y6:letrec),@(y"
|
||||
"26:install-transformer-rules!)[04}",
|
||||
"P", "error*",
|
||||
"%2.1,.1c,@(y5:error),@(y13:apply-to-list)[22",
|
||||
|
||||
"C", 0,
|
||||
"${'(l2:l2:py1:_;pl2:l2:y3:var;y4:init;;y3:...;;y5:forms;;;l3:py6:lambd"
|
||||
"a;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:...;;;)"
|
||||
",n,f,'(y3:let),@(y26:install-transformer-rules!)[04}",
|
||||
"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}_"
|
||||
"1}.0]2",
|
||||
|
||||
"C", 0,
|
||||
"${'(l2:l2:py1:_;pn;y5:forms;;;py4:body;y5:forms;;;l2:py1:_;ppy5:first;"
|
||||
"y4:more;;y5:forms;;;l3:y3:let;l1:y5:first;;py4:let*;py4:more;y5:forms;"
|
||||
";;;;),n,f,'(y4:let*),@(y26:install-transformer-rules!)[04}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l3:l2:l1:y1:_;;t;;l2:l2:y1:_;y4:test;;y4:test;;l2:py1:_;py4:test;y"
|
||||
"5:tests;;;l4:y2:if;y4:test;py3:and;y5:tests;;f;;;),n,f,'(y3:and),@(y26"
|
||||
":install-transformer-rules!)[04}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l3:l2:l1:y1:_;;f;;l2:l2:y1:_;y4:test;;y4:test;;l2:py1:_;py4:test;y"
|
||||
"5:tests;;;l3:y3:let;l1:l2:y1:x;y4:test;;;l4:y2:if;y1:x;y1:x;py2:or;y5:"
|
||||
"tests;;;;;),n,f,'(y2:or),@(y26:install-transformer-rules!)[04}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l5:l2:l1:y1:_;;f;;l2:l2:y1:_;py4:else;y4:exps;;;py5:begin;y4:exps;"
|
||||
";;l2:py1:_;pl1:y1:x;;y4:rest;;;l3:y2:or;y1:x;py4:cond;y4:rest;;;;l2:py"
|
||||
"1:_;pl3:y1:x;y2:=>;y4:proc;;y4:rest;;;l3:y3:let;l1:l2:y3:tmp;y1:x;;;py"
|
||||
"4:cond;pl2:y3:tmp;l2:y4:proc;y3:tmp;;;y4:rest;;;;;l2:py1:_;ppy1:x;y4:e"
|
||||
"xps;;y4:rest;;;l4:y2:if;y1:x;py5:begin;y4:exps;;py4:cond;y4:rest;;;;),"
|
||||
"'(l2:y4:else;y2:=>;),f,'(y4:cond),@(y26:install-transformer-rules!)[04"
|
||||
"}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l2:l2:l3:y1:_;y1:k;y4:else;;t;;l2:l3:y1:_;y1:k;y5:atoms;;l3:y4:mem"
|
||||
"v;y1:k;l2:y5:quote;y5:atoms;;;;),'(l1:y4:else;),f,'(y9:case-test),@(y2"
|
||||
"6:install-transformer-rules!)[04}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l1:l2:l4:y1:_;y1:x;py4:test;y5:exprs;;y3:...;;l3:y3:let;l1:l2:y3:k"
|
||||
"ey;y1:x;;;l3:y4:cond;pl3:y9:case-test;y3:key;y4:test;;y5:exprs;;y3:..."
|
||||
";;;;),n,f,'(y4:case),@(y26:install-transformer-rules!)[04}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l1:l2:l5:y1:_;l2:py3:var;py4:init;y4:step;;;y3:...;;y6:ending;y4:e"
|
||||
"xpr;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:begin;py3:var;y4:s"
|
||||
"tep;;;y3:...;;;;;;),n,f,'(y2:do),@(y26:install-transformer-rules!)[04}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l8:l2:l2:y1:_;l2:y7:unquote;y1:x;;;y1:x;;l2:l2:y1:_;pl2:y16:unquot"
|
||||
"e-splicing;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:quas"
|
||||
"iquote;;l3:y10:quasiquote;l1:y1:x;;y1:d;;;;l2:l3:y1:_;l2:y7:unquote;y1"
|
||||
":x;;y1: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:quote;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"
|
||||
":quasiquote;py1:y;y1:d;;;;;l2:py1:_;pv2:y1:x;y3:...;;y1:d;;;l2:y12:lis"
|
||||
"t->vector;py10:quasiquote;pl2:y1:x;y3:...;;y1:d;;;;;l2:py1:_;py1:x;y1:"
|
||||
"d;;;l2:y5:quote;y1:x;;;),'(l3:y7:unquote;y16:unquote-splicing;y10:quas"
|
||||
"iquote;),f,'(y10:quasiquote),@(y26:install-transformer-rules!)[04}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l1:l2:py1:_;py4:test;y4:rest;;;l3:y2:if;y4:test;py5:begin;y4:rest;"
|
||||
";;;),n,f,'(y4:when),@(y26:install-transformer-rules!)[04}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l1:l2:py1:_;py4:test;y4:rest;;;l3:y2:if;l2:y3:not;y4:test;;py5:beg"
|
||||
"in;y4:rest;;;;),n,f,'(y6:unless),@(y26:install-transformer-rules!)[04}",
|
||||
|
||||
"C", 0,
|
||||
"${'(l1:l2:l3:y1:_;py4:args;y4:body;;y3:...;;l3:y7:lambda*;l2:y4:args;p"
|
||||
"y6:lambda;py4:args;y4:body;;;;y3:...;;;),n,f,'(y11:case-lambda),@(y26:"
|
||||
"install-transformer-rules!)[04}",
|
||||
"P", "visit",
|
||||
"%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y4:read)[01},,#0.4,.1"
|
||||
",&2{%1.0R8~?{${.2,@(y10:transform!)[01},Po,.1W5PoW6_1${:1^,@(y4:read)["
|
||||
"01},:0^[11}]1}.!0.0^_1[01}.0^P60]2",
|
||||
|
||||
0, 0, 0
|
||||
};
|
||||
|
|
|
|||
Loading…
Reference in a new issue