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

extra syntax-rules template escapes

Browse source
This commit is contained in:
ESL 2024-07-25 18:46:13 -04:00
parent 8d5d967a97
commit 62fed2125b
3 changed files with 221 additions and 116 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
pre/s.scm
View file

@ -1027,7 +1027,7 @@
; (bytevector-length b)
; (bytevector-u8-ref b i)
; (bytevector-u8-set! b i u8)
; (list->bytevector l)
; (list->bytevector l) +
; (subbytevector b from to) +
; (bytevector=? b1 b2 b ...)

157
pre/t.scm
View file

@ -64,7 +64,9 @@
(and (eq? pat '<number>) (number? x))
(and (eq? pat '<string>) (string? x))
(and (eq? pat '<vector>) (vector? x))
(and (eq? pat '<box>) (box? x))
(and (eq? pat '<bytevector>) (bytevector? x))
(and (eq? pat '<char>) (char? x))
(and (eq? pat '<byte>) (and (exact-integer? x) (<= 0 x 255)))
(eqv? x pat)
(and (pair? pat)
(cond [(and (eq? (car pat) '...)
@ -372,9 +374,8 @@
(define syntax-quote-id (new-id 'syntax-quote (make-location 'syntax-quote) #f))
; standard way of comparing identifiers used as keywords and such; details below
(define (free-id=? id1 env1 id2 . ?env2)
(let* ([p1 (env1 id1 'peek)] [nr *root-name-registry*]
[p2 (if (pair? ?env2) ((car ?env2) id2 'peek) (or (name-lookup nr id2 #f) nr))])
(define (free-id=? id1 env1 id2 env2)
(let ([p1 (env1 id1 'peek)] [p2 (env2 id2 'peek)])
(and p1 p2 ; both envs should be supported by name registries
(if (and (name-registry? p1) (name-registry? p2))
(and (eq? p1 p2) (eq? id1 id2)) ; would end w/same loc if alloced
@ -411,8 +412,8 @@
[(withcc) (xform-withcc tail env)]
[(body) (xform-body tail env appos?)]
[(begin) (xform-begin tail env appos?)]
[(define) (xform-define tail env)]
[(define-syntax) (xform-define-syntax tail env)]
[(define) (xform-define tail env)] ; as expression: will fail later
[(define-syntax) (xform-define-syntax tail env)] ; as expression: will fail later
[(syntax-quote) (xform-syntax-quote tail env)]
[(syntax-lambda) (xform-syntax-lambda tail env appos?)]
[(syntax-rules) (xform-syntax-rules tail env)]
@ -639,23 +640,18 @@
(cons 'begin (map (lambda (sexp) (xform #f sexp env)) tail)))
(x-error "improper begin form" (cons 'begin tail))))
; used in simplistic transformer in scm2c.ssc only!
; not for general use: used in scm2c.ssc simplistic transformer only!
(define (xform-define tail env)
(cond [(and (list2? tail) (null? (car tail))) ; idless
(xform #f (cadr tail) env)]
[(and (list2? tail) (id? (car tail)))
(list 'define (id->sym (car tail))
(xform #f (cadr tail) env))]
[(and (list2+? tail) (pair? (car tail)) (id? (caar tail)) (idslist? (cdar tail)))
(list 'define (id->sym (caar tail))
(xform-lambda (cons (cdar tail) (cdr tail)) env))]
[else (x-error "improper define form" (cons 'define tail))]))
(let ([tail (preprocess-define 'define tail)])
(if (list1? tail) ; idless
(xform #f (cadr tail) env)
(list 'define (id->sym (car tail))
(xform #f (cadr tail) env)))))
; used in simplistic transformer in scm2c.ssc only!
(define (xform-define-syntax tail env) ; non-internal
(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))))
; not for general use: used in scm2c.ssc simplistic transformer only!
(define (xform-define-syntax tail env)
(let ([tail (preprocess-define-syntax 'define-syntax tail)])
(list 'define-syntax (id->sym (car tail)) (xform #t (cadr tail) env))))
(define (xform-syntax-quote tail env)
(if (list1? tail)
@ -697,17 +693,78 @@
(apply x-error args)
(x-error "improper syntax-error form" (cons 'syntax-error tail)))))
; named pattern/template escapes
; named pattern/template escapes (syntax-rules extension)
(define (pattern-escape->test x id-escape=?)
(cond
[(id-escape=? x 'number?)
number?]
[(id-escape=? x 'exact-integer?)
exact-integer?]
[(id-escape=? x 'boolean?)
boolean?]
[(id-escape=? x 'char?)
char? sexp]
[(id-escape=? x 'string?)
string?]
[(id-escape=? x 'bytevector?)
bytevector?]
[(id-escape=? x 'id?)
id?]
[else #f]))
(define (template-escape->conv x id-escape=?)
(cond
[(id-escape=? x 'number->string)
(lambda (sexps) (check-syntax sexps '(<number>) "invalid number->string template args")
(number->string (car sexps)))]
[(id-escape=? x 'string->number)
(lambda (sexps) (check-syntax sexps '(<string>) "invalid string->number template args")
(string->number (car sexps)))]
[(id-escape=? x 'list->string)
(lambda (sexps) (check-syntax sexps '((<char> ...)) "invalid list->string template args")
(list->string (car sexps)))]
[(id-escape=? x 'string->list)
(lambda (sexps) (check-syntax sexps '(<string>) "invalid string->list template args")
(string->list (car sexps)))]
[(id-escape=? x 'list->bytevector)
(lambda (sexps) (check-syntax sexps '((<byte> ...)) "invalid list->bytevector template args")
(list->bytevector (car sexps)))]
[(id-escape=? x 'bytevector->list)
(lambda (sexps) (check-syntax sexps '(<bytevector>) "invalid bytevector->list template args")
(bytevector->list (car sexps)))]
[(id-escape=? x 'length)
(lambda (sexps) (check-syntax sexps '((* ...)) "invalid length template args")
(length (car sexps)))]
[(id-escape=? x 'make-list)
(lambda (sexps) (check-syntax sexps '(<number> *) "invalid make-list template args")
(make-list (car sexps) (cadr sexps)))]
[(id-escape=? x 'string-append)
(lambda (sexps) (check-syntax sexps '(<string> ...) "invalid string-append template args")
(apply string-append sexps))]
[(id-escape=? x 'char<=?)
(lambda (sexps) (check-syntax sexps '(<char> ...) "invalid char<=? template args")
(apply < sexps))]
[(id-escape=? x '<=)
(lambda (sexps) (check-syntax sexps '(<number> ...) "invalid <= template args")
(apply < sexps))]
[(id-escape=? x '+)
(lambda (sexps) (check-syntax sexps '(<number> ...) "invalid + template args")
(apply + sexps))]
[(id-escape=? x '-)
(lambda (sexps) (check-syntax sexps '(<number> ...) "invalid - template args")
(apply - sexps))]
[(id-escape=? x 'id->string)
(lambda (sexps) (check-syntax sexps '(<id>) "invalid id->string template args")
(symbol->string (id->sym (car sexps))))]
[(id-escape=? x 'string->id)
(lambda (sexps)
(sexp-case sexps
[(<string>) (id-rename-as x (string->symbol (car sexps)))]
[(<string> <id>) (id-rename-as (cadr sexps) (string->symbol (car sexps)))]
[else (x-error "invalid string->id template args")]))]
[else #f]))
(define (pattern-escape->test x named-escape?)
(cond [(named-escape? x 'number?) (lambda (sexp env) (number? sexp))]
[(named-escape? x 'exact-integer?) (lambda (sexp env) (exact-integer? sexp))]
[(named-escape? x 'boolean?) (lambda (sexp env) (boolean? sexp))]
[(named-escape? x 'char?) (lambda (sexp env) (char? sexp))]
[(named-escape? x 'string?) (lambda (sexp env) (string? sexp))]
[(named-escape? x 'bytevector?) (lambda (sexp env) (bytevector? sexp))]
[(named-escape? x 'id?) (lambda (sexp env) (id? sexp))]
[else #f]))
; make transformer procedure from the rules
@ -736,9 +793,11 @@
(define (underscore? x)
(and (id? x) (eq? (mac-env x 'peek) underscore-den)))
; lazier variant for named escapes
(define (named-escape? x sym)
(and (id? x) (free-id=? x mac-env sym)))
; slow version of the above for escape keywords
(define (id-escape=? x s)
(and (id? x)
(eq? (mac-env x 'peek)
(name-lookup *root-name-registry* s (lambda (n) (list 'ref s))))))
; List-ids returns a list of the non-ellipsis ids in a pattern or template for which
; (pred? id) is true. If include-scalars is false, we only include ids that are
@ -787,9 +846,10 @@
(continue-if (equal? pat sexp))]
[(and (not esc?) (ellipsis? (car pat)) (list2? pat))
(match (cadr pat) sexp bindings #t)]
[(and (not esc?) (ellipsis? (car pat)) (list3? pat) (pattern-escape->test (cadr pat) named-escape?))
=> (lambda (test) (if (test sexp use-env) (match (caddr pat) sexp bindings esc?) (fail)))]
[(and (not esc?) (ellipsis? (car pat))) (fail)]
[(and (not esc?) (ellipsis? (car pat)) (list3? pat)
(pattern-escape->test (cadr pat) id-escape=?)) =>
(lambda (test) (if (test sexp) (match (caddr pat) sexp bindings esc?) (fail)))]
[(and (not esc?) (ellipsis? (car pat))) (x-error "unrecognized pattern escape" pat)]
[(and (not esc?) (ellipsis-pair? (cdr pat)))
(let* ([tail-len (proper-head-length (cddr pat) #t)]
[sexp-len (proper-head-length sexp #f)]
@ -807,7 +867,7 @@
(match (cdr pat) (cdr sexp) bindings esc?) esc?)]
[else (fail)])))))
(define (expand-template pat tmpl top-bindings)
(define (expand-template pat tmpl top-bindings use-env)
; New-literals is an alist mapping each literal id in the
; template to a fresh id for inserting into the output. It
; might have duplicate entries mapping an id to two different
@ -837,10 +897,16 @@
(list->vector (expand-part (vector->list tmpl) esc?))]
[(box? tmpl)
(box (expand-part (unbox tmpl) esc?))]
[(and (not esc?) (pair? tmpl) (ellipsis? (car tmpl))) ; r7rs
(if (pair? (cdr tmpl)) (expand-part (cadr tmpl) #t)
(x-error "invalid escaped template syntax" tmpl))]
[(and (not esc?) (pair? tmpl) (ellipsis-pair? (cdr tmpl)))
[(not (pair? tmpl))
tmpl]
[(and (not esc?) (ellipsis? (car tmpl)) (list3+? tmpl)
(template-escape->conv (cadr tmpl) id-escape=?)) =>
(lambda (conv) (conv (expand-part (cddr tmpl) esc?)))]
[(and (not esc?) (ellipsis? (car tmpl)) (list2? tmpl))
(expand-part (cadr tmpl) #t)]
[(and (not esc?) (ellipsis? (car tmpl)))
(x-error "unrecognized template escape" tmpl)]
[(and (not esc?) (ellipsis-pair? (cdr tmpl)))
(let ([vars-to-iterate (list-ellipsis-vars (car tmpl))])
(define (lookup var)
(cdr (assq var bindings)))
@ -854,16 +920,15 @@
(let ([val-lists (map lookup vars-to-iterate)]
[euv (lambda v* (apply expand-using-vals esc? v*))])
(append (apply map (cons euv val-lists)) (expand-part (cddr tmpl) esc?)))))]
[(pair? tmpl)
(cons (expand-part (car tmpl) esc?) (expand-part (cdr tmpl) esc?))]
[else tmpl]))))
[else ; regular pair
(cons (expand-part (car tmpl) esc?) (expand-part (cdr tmpl) esc?))]))))
(lambda (use use-env)
(let loop ([rules rules])
(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))]
(lambda (bindings) (expand-template pat tmpl bindings use-env))]
[else (loop (cdr rules))])))))

176
t.c
View file

@ -37,15 +37,17 @@ char *t_code[] = {
"%2'(y1:*),.1q,.0?{.0]3}'(y4:<id>),.2q?{.2Y0,.0?{.0}{.3K0}_1}{f},.0?{.0"
"]4}'(y8:<symbol>),.3q?{.3Y0}{f},.0?{.0]5}'(y8:<number>),.4q?{.4N0}{f},"
".0?{.0]6}'(y8:<string>),.5q?{.5S0}{f},.0?{.0]7}'(y8:<vector>),.6q?{.6V"
"0}{f},.0?{.0]8}'(y5:<box>),.7q?{.7Y2}{f},.0?{.0]9}.7,.9v,.0?{.0](i10)}"
".8p?{'(y3:...),.9aq?{.8dp?{.8ddu}{f}}{f}?{.8da,.(i10)v}{.8dp?{'(y3:..."
"),.9daq?{.8ddu}{f}}{f}?{.8a,'(y1:*),.1q?{.(i10)L0}{${.(i12),,#0.0,.5,&"
"2{%1.0u,.0?{.0]2}.1p?{${.3a,:0,@(y11:sexp-match?)[02}?{.1d,:1^[21}f]2}"
"f]2}.!0.0^_1[01}}_1}{.9p?{${.(i11)a,.(i11)a,@(y11:sexp-match?)[02}?{${"
".(i11)d,.(i11)d,@(y11:sexp-match?)[02}}{f}}{f}}}}{f},.0?{.0](i11)}.9V0"
"?{.(i10)V0?{${.(i12)X0,.(i12)X0,@(y11:sexp-match?)[02}}{f}}{f},.0?{.0]"
"(i12)}.(i10)Y2?{.(i11)Y2?{.(i11)z,.(i11)z,@(y11:sexp-match?)[(i12)2}f]"
"(i12)}f](i12)",
"0}{f},.0?{.0]8}'(y12:<bytevector>),.7q?{.7B0}{f},.0?{.0]9}'(y6:<char>)"
",.8q?{.8C0}{f},.0?{.0](i10)}'(y6:<byte>),.9q?{.9I0?{'(i255),.(i10),,'0"
">!;>!}{f}}{f},.0?{.0](i11)}.9,.(i11)v,.0?{.0](i12)}.(i10)p?{'(y3:...),"
".(i11)aq?{.(i10)dp?{.(i10)ddu}{f}}{f}?{.(i10)da,.(i12)v}{.(i10)dp?{'(y"
"3:...),.(i11)daq?{.(i10)ddu}{f}}{f}?{.(i10)a,'(y1:*),.1q?{.(i12)L0}{${"
".(i14),,#0.0,.5,&2{%1.0u,.0?{.0]2}.1p?{${.3a,:0,@(y11:sexp-match?)[02}"
"?{.1d,:1^[21}f]2}f]2}.!0.0^_1[01}}_1}{.(i11)p?{${.(i13)a,.(i13)a,@(y11"
":sexp-match?)[02}?{${.(i13)d,.(i13)d,@(y11:sexp-match?)[02}}{f}}{f}}}}"
"{f},.0?{.0](i13)}.(i11)V0?{.(i12)V0?{${.(i14)X0,.(i14)X0,@(y11:sexp-ma"
"tch?)[02}}{f}}{f},.0?{.0](i14)}.(i12)Y2?{.(i13)Y2?{.(i13)z,.(i13)z,@(y"
"11:sexp-match?)[(i14)2}f](i14)}f](i14)",
"S", "sexp-case",
"l6:y12:syntax-rules;l1:y4:else;;l2:l4:y1:_;l2:y3:key;y3:...;;y7:clause"
@ -242,10 +244,9 @@ char *t_code[] = {
"ntax-quote-id)",
"P", "free-id=?",
"%!3${'(y4:peek),.4,.6[02},@(y20:*root-name-registry*),.2p?{${'(y4:peek"
"),.8,.6a[02}}{${f,.8,.4,@(y11:name-lookup)[03},.0?{.0}{.1}_1},.2?{.0?{"
"${.4,@(y14:name-registry?)[01}?{${.2,@(y14:name-registry?)[01}}{f}?{.0"
",.3q?{.6,.5q]7}f]7}.0,.3q]7}f]7}f]7",
"%4${'(y4:peek),.5,.7[02},${'(y4:peek),.4,.6[02},.0?{.1?{${.2,@(y14:nam"
"e-registry?)[01}?{${.3,@(y14:name-registry?)[01}}{f}?{.1,.1q?{.4,.3q]6"
"}f]6}.1,.1q]6}f]6}f]6",
"P", "xform",
"%3${.3,@(y3:id?)[01}?{${.4,.4,@(y9:xform-ref)[02},.1?{.0]4}.0U0?{.0U7,"
@ -402,17 +403,14 @@ char *t_code[] = {
"c,'(s19:improper begin form),@(y7:x-error)[32",
"P", "xform-define",
"%2${.2,@(y6:list2?)[01}?{.0au}{f}?{.1,.1da,f,@(y5:xform)[23}${.2,@(y6:"
"list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,f,@(y5:xform)[03},${.3"
"a,@(y7:id->sym)[01},'(y6:define),l3]2}${.2,@(y7:list2+?)[01}?{.0ap?{${"
".2aa,@(y3:id?)[01}?{${.2ad,@(y8:idslist?)[01}}{f}}{f}}{f}?{${.3,.3d,.4"
"adc,@(y12:xform-lambda)[02},${.3aa,@(y7:id->sym)[01},'(y6:define),l3]2"
"}.0,'(y6:define)c,'(s20:improper define form),@(y7:x-error)[22",
"%2${.2,'(y6:define),@(y17:preprocess-define)[02},${.2,@(y6:list1?)[01}"
"?{.2,.1da,f,@(y5:xform)[33}${.4,.3da,f,@(y5:xform)[03},${.3a,@(y7:id->"
"sym)[01},'(y6:define),l3]3",
"P", "xform-define-syntax",
"%2${.2,@(y6:list2?)[01}?{${.2a,@(y3:id?)[01}}{f}?{${.3,.3da,t,@(y5:xfo"
"rm)[03},${.3a,@(y7:id->sym)[01},'(y13:define-syntax),l3]2}.0,'(y13:def"
"ine-syntax)c,'(s27:improper define-syntax form),@(y7:x-error)[22",
"%2${.2,'(y13:define-syntax),@(y24:preprocess-define-syntax)[02},${.4,."
"3da,t,@(y5:xform)[03},${.3a,@(y7:id->sym)[01},'(y13:define-syntax),l3]"
"3",
"P", "xform-syntax-quote",
"%2${.2,@(y6:list1?)[01}?{.0a]2}.0,'(y12:syntax-quote)c,'(s26:improper "
@ -444,11 +442,48 @@ char *t_code[] = {
"x-error)c,'(s26:improper syntax-error form),@(y7:x-error)[32",
"P", "pattern-escape->test",
"%2${'(y7:number?),.3,.5[02}?{&0{%2.0N0]2}]2}${'(y14:exact-integer?),.3"
",.5[02}?{&0{%2.0I0]2}]2}${'(y8:boolean?),.3,.5[02}?{&0{%2.0Y1]2}]2}${'"
"(y5:char?),.3,.5[02}?{&0{%2.0C0]2}]2}${'(y7:string?),.3,.5[02}?{&0{%2."
"0S0]2}]2}${'(y11:bytevector?),.3,.5[02}?{&0{%2.0B0]2}]2}${'(y3:id?),.3"
",.5[02}?{&0{%2.0,@(y3:id?)[21}]2}f]2",
"%2${'(y7:number?),.3,.5[02}?{@(y7:number?)]2}${'(y14:exact-integer?),."
"3,.5[02}?{@(y14:exact-integer?)]2}${'(y8:boolean?),.3,.5[02}?{@(y8:boo"
"lean?)]2}${'(y5:char?),.3,.5[02}?{@(y5:char?)@(y4:sexp)]2}${'(y7:strin"
"g?),.3,.5[02}?{@(y7:string?)]2}${'(y11:bytevector?),.3,.5[02}?{@(y11:b"
"ytevector?)]2}${'(y3:id?),.3,.5[02}?{@(y3:id?)]2}f]2",
"P", "template-escape->conv",
"%2${'(y14:number->string),.3,.5[02}?{&0{%1${'(s36:invalid number->stri"
"ng template args),'(l1:y8:<number>;),.4,@(y12:check-syntax)[03}'(i10),"
".1aE8]1}]2}${'(y14:string->number),.3,.5[02}?{&0{%1${'(s36:invalid str"
"ing->number template args),'(l1:y8:<string>;),.4,@(y12:check-syntax)[0"
"3}'(i10),.1aE9]1}]2}${'(y12:list->string),.3,.5[02}?{&0{%1${'(s34:inva"
"lid list->string template args),'(l1:l2:y6:<char>;y3:...;;),.4,@(y12:c"
"heck-syntax)[03}.0aX3]1}]2}${'(y12:string->list),.3,.5[02}?{&0{%1${'(s"
"34:invalid string->list template args),'(l1:y8:<string>;),.4,@(y12:che"
"ck-syntax)[03}.0aX2]1}]2}${'(y16:list->bytevector),.3,.5[02}?{&0{%1${'"
"(s38:invalid list->bytevector template args),'(l1:l2:y6:<byte>;y3:...;"
";),.4,@(y12:check-syntax)[03}.0aE1]1}]2}${'(y16:bytevector->list),.3,."
"5[02}?{&0{%1${'(s38:invalid bytevector->list template args),'(l1:y12:<"
"bytevector>;),.4,@(y12:check-syntax)[03}.0a,@(y16:bytevector->list)[11"
"}]2}${'(y6:length),.3,.5[02}?{&0{%1${'(s28:invalid length template arg"
"s),'(l1:l2:y1:*;y3:...;;),.4,@(y12:check-syntax)[03}.0ag]1}]2}${'(y9:m"
"ake-list),.3,.5[02}?{&0{%1${'(s31:invalid make-list template args),'(l"
"2:y8:<number>;y1:*;),.4,@(y12:check-syntax)[03}.0da,.1aL2]1}]2}${'(y13"
":string-append),.3,.5[02}?{&0{%1${'(s35:invalid string-append template"
" args),'(l2:y8:<string>;y3:...;),.4,@(y12:check-syntax)[03}.0,@(y14:%2"
"5string-append),@(y13:apply-to-list)[12}]2}${'(y7:char<=?),.3,.5[02}?{"
"&0{%1${'(s29:invalid char<=? template args),'(l2:y6:<char>;y3:...;),.4"
",@(y12:check-syntax)[03}.0,@(y1:<),@(y13:apply-to-list)[12}]2}${'(y2:<"
"=),.3,.5[02}?{&0{%1${'(s24:invalid <= template args),'(l2:y8:<number>;"
"y3:...;),.4,@(y12:check-syntax)[03}.0,@(y1:<),@(y13:apply-to-list)[12}"
"]2}${'(y1:+),.3,.5[02}?{&0{%1${'(s23:invalid + template args),'(l2:y8:"
"<number>;y3:...;),.4,@(y12:check-syntax)[03}.0,@(y1:+),@(y13:apply-to-"
"list)[12}]2}${'(y1:-),.3,.5[02}?{&0{%1${'(s23:invalid - template args)"
",'(l2:y8:<number>;y3:...;),.4,@(y12:check-syntax)[03}.0,@(y1:-),@(y13:"
"apply-to-list)[12}]2}${'(y10:id->string),.3,.5[02}?{&0{%1${'(s32:inval"
"id id->string template args),'(l1:y4:<id>;),.4,@(y12:check-syntax)[03}"
"${.2a,@(y7:id->sym)[01}X4]1}]2}${'(y10:string->id),.3,.5[02}?{.0,&1{%1"
"${.2,'(l1:y8:<string>;),@(y11:sexp-match?)[02}?{.0aX5,:0,@(y12:id-rena"
"me-as)[12}${.2,'(l2:y8:<string>;y4:<id>;),@(y11:sexp-match?)[02}?{.0aX"
"5,.1da,@(y12:id-rename-as)[12}'(s32:invalid string->id template args),"
"@(y7:x-error)[11}]2}f]2",
"P", "syntax-rules*",
"%4,,,,,,,,,,,,#0#1#2#3#4#5#6#7#8#9#(i10)#(i11).(i14),&1{%1:0,.1A0]1}.!"
@ -457,47 +492,52 @@ char *t_code[] = {
"!3.(i12),.4,.(i15),&3{%1:0?{:0,.1q]1}${.2,@(y3:id?)[01}?{:1^,${'(y4:pe"
"ek),.4,:2[02}q]1}f]1}.!4${&0{%1'(y1:_)]1},'(y1:_),@(y20:*root-name-reg"
"istry*),@(y11:name-lookup)[03}.!5.(i12),.6,&2{%1${.2,@(y3:id?)[01}?{:0"
"^,${'(y4:peek),.4,:1[02}q]1}f]1}.!6.(i12),&1{%2${.2,@(y3:id?)[01}?{.1,"
":0,.2,@(y9:free-id=?)[23}f]2}.!7.4,.3,&2{%3n,.2,.2,,#0:0,.1,:1,.9,&4{%"
"3${.2,@(y3:id?)[01}?{.1?{${.2,:0[01}}{f}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2"
"X0,:2^[33}.0Y2?{.2,.2,.2z,:2^[33}${.2,@(y7:list3+?)[01}?{${.2a,:1^[01}"
"}{f}?{.2,.2,.2dd,:2^[33}.0p?{${.2d,:3^[01}?{${.4,.4,.4dd,:2^[03},t,.2a"
",:2^[33}${.4,.4,.4d,:2^[03},.2,.2a,:2^[33}.2]3}.!0.0^_1[33}.!8.4,&1{%2"
"'0,.1,,#0.0,.4,.6,:0,&4{%2.0p~?{.1]2}:1?{${.2a,:0^[01}}{f}?{:2,'(s41:m"
"isplaced ellipsis in syntax-case pattern),@(y7:x-error)[22}'1,.2I+,.1d"
",:3^[22}.!0.0^_1[22}.!9.7,.5,.4,.(i12),.5,.(i13),.6,.(i19),.(i14),&9{%"
"3k3,.0,,#0.1,&1{%0f,:0[01}.!0f,n,.6,.6,,#0:8,:7,.(i12),:6,:5,:4,:3,.7,"
".(i13),:2,:1,:0,&(i12){%4,#0:3,.4,&2{%1.0?{:0]1}:1^[10}.!0.4~?{${.3,:0"
"^[01}}{f}?{.3]5}${.3,@(y3:id?)[01}?{${.3,:2^[01}?{${.4,@(y3:id?)[01}?{"
"${:1,.4,:9,.7,@(y9:free-id=?)[04}}{f},.1^[51}.3,.3,.3cc]5}.1V0?{.2V0,."
"0?{.0}{${:3^[00}}_1.4,.4,.4X0,.4X0,:4^[54}.1Y2?{.2Y2,.0?{.0}{${:3^[00}"
"}_1.4,.4,.4z,.4z,:4^[54}.1p~?{.2,.2e,.1^[51}.4~?{${.3a,:(i10)^[01}?{${"
".3,@(y6:list2?)[01}}{f}}{f}?{t,.4,.4,.4da,:4^[54}.4~?{${.3a,:(i10)^[01"
"}?{${.3,@(y6:list3?)[01}?{${:(i11)^,.4da,@(y20:pattern-escape->test)[0"
"2}}{f}}{f}}{f},.0?{.0,${:9,.7,.4[02}?{.6,.6,.6,.6dda,:4^[74}:3^[70}.5~"
"?{${.4a,:(i10)^[01}}{f}?{:3^[60}.5~?{${.4d,:8^[01}}{f}?{${t,.5dd,:7^[0"
"2},${f,.7,:7^[02},.1,.1I-,.0<0?{${:3^[00}}{.0,.7A6},${.3,.(i10),@(y9:l"
"ist-head)[02},${:6^,t,.(i11)a,:5^[03},,#0:4,.(i10),.(i14),&3{%1${:0,n,"
".4,:1a,:2^[04},@(y3:cdr),@(y5:%25map1)[12}.!0${.(i14),.(i14),.7,.(i14)"
"dd,:4^[04},${${.7,.6^,@(y5:%25map1)[02},.5c,@(y4:list)c,@(y4:%25map),@"
"(y13:apply-to-list)[02}L6](i13)}.3p?{.5,${.8,.8,.8d,.8d,:4^[04},.5a,.5"
"a,:4^[64}:3^[60}.!0.0^_1[64}.!(i10).(i12),.2,.(i10),.5,.8,&5{%3,,,#0#1"
"#2,#0${${.(i10),&1{%1:0,.1A3~]1},t,.(i11),:2^[03},:4,.4,&2{%1${:0,&1{%"
"0:0^]0},:1,.4,@(y14:new-literal-id)[03},.1c]1},@(y5:%25map1)[02}.!0.0^"
"_1.!0${:3^,f,.7,:2^[03}.!1.1,:2,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}."
"!2f,.6,.6,,#0.9,.5,:0,:1,.(i10),.5,&6{%3.2,.1,,#0.0,.5,:0,:1,:2,:3,:4,"
":5,&8{%2${.2,@(y3:id?)[01}?{:6,.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_"
"1}_1d]2}.0V0?{${.3,.3X0,:7^[02}X1]2}.0Y2?{${.3,.3z,:7^[02}b]2}.1~?{.0p"
"?{${.2a,:2^[01}}{f}}{f}?{.0dp?{t,.1da,:7^[22}.0,'(s31:invalid escaped "
"template syntax),@(y7:x-error)[22}.1~?{.0p?{${.2d,:3^[01}}{f}}{f}?{${."
"2a,:4^[01},,,#0#1:6,&1{%1:0,.1A3d]1}.!0.2,.4,:5,&3{%!1.1,${.3,:2,@(y4:"
"cons),@(y5:%25map2)[03},:1a,:0^[23}.!1.2u?{${.6,.6dd,:7^[02},${.7,.7a,"
":7^[02}c]5}.4,.2,&2{%!0.0,:1c,:0^,@(y13:apply-to-list)[12},${.5,.4^,@("
"y5:%25map1)[02},${.8,.8dd,:7^[02},${.3,.5c,@(y4:%25map),@(y13:apply-to"
"-list)[02}L6]7}.0p?{${.3,.3d,:7^[02},${.4,.4a,:7^[02}c]2}.0]2}.!0.0^_1"
"[32}.!0.0^_1[63}.!(i11).(i15),.(i12),.(i12),&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}](i16)",
"^,${'(y4:peek),.4,:1[02}q]1}f]1}.!6.(i12),&1{%2${.2,@(y3:id?)[01}?{${."
"3,&1{%1:0,'(y3:ref),l2]1},.4,@(y20:*root-name-registry*),@(y11:name-lo"
"okup)[03},${'(y4:peek),.4,:0[02}q]2}f]2}.!7.4,.3,&2{%3n,.2,.2,,#0:0,.1"
",:1,.9,&4{%3${.2,@(y3:id?)[01}?{.1?{${.2,:0[01}}{f}?{.2,.1c]3}.2]3}.0V"
"0?{.2,.2,.2X0,:2^[33}.0Y2?{.2,.2,.2z,:2^[33}${.2,@(y7:list3+?)[01}?{${"
".2a,:1^[01}}{f}?{.2,.2,.2dd,:2^[33}.0p?{${.2d,:3^[01}?{${.4,.4,.4dd,:2"
"^[03},t,.2a,:2^[33}${.4,.4,.4d,:2^[03},.2,.2a,:2^[33}.2]3}.!0.0^_1[33}"
".!8.4,&1{%2'0,.1,,#0.0,.4,.6,:0,&4{%2.0p~?{.1]2}:1?{${.2a,:0^[01}}{f}?"
"{:2,'(s41:misplaced ellipsis in syntax-case pattern),@(y7:x-error)[22}"
"'1,.2I+,.1d,:3^[22}.!0.0^_1[22}.!9.7,.5,.4,.(i12),.5,.(i13),.6,.(i19),"
".(i14),&9{%3k3,.0,,#0.1,&1{%0f,:0[01}.!0f,n,.6,.6,,#0:8,:7,:6,:5,:4,:3"
",.6,.(i12),:2,:1,.(i20),:0,&(i12){%4,#0:4,.4,&2{%1.0?{:0]1}:1^[10}.!0."
"4~?{${.3,:0^[01}}{f}?{.3]5}${.3,@(y3:id?)[01}?{${.3,:3^[01}?{${.4,@(y3"
":id?)[01}?{${:2,.4,:1,.7,@(y9:free-id=?)[04}}{f},.1^[51}.3,.3,.3cc]5}."
"1V0?{.2V0,.0?{.0}{${:4^[00}}_1.4,.4,.4X0,.4X0,:5^[54}.1Y2?{.2Y2,.0?{.0"
"}{${:4^[00}}_1.4,.4,.4z,.4z,:5^[54}.1p~?{.2,.2e,.1^[51}.4~?{${.3a,:(i1"
"0)^[01}?{${.3,@(y6:list2?)[01}}{f}}{f}?{t,.4,.4,.4da,:5^[54}.4~?{${.3a"
",:(i10)^[01}?{${.3,@(y6:list3?)[01}?{${:(i11)^,.4da,@(y20:pattern-esca"
"pe->test)[02}}{f}}{f}}{f},.0?{.0,${.6,.3[01}?{.6,.6,.6,.6dda,:5^[74}:4"
"^[70}.5~?{${.4a,:(i10)^[01}}{f}?{.2,'(s27:unrecognized pattern escape)"
",@(y7:x-error)[62}.5~?{${.4d,:9^[01}}{f}?{${t,.5dd,:8^[02},${f,.7,:8^["
"02},.1,.1I-,.0<0?{${:4^[00}}{.0,.7A6},${.3,.(i10),@(y9:list-head)[02},"
"${:7^,t,.(i11)a,:6^[03},,#0:5,.(i10),.(i14),&3{%1${:0,n,.4,:1a,:2^[04}"
",@(y3:cdr),@(y5:%25map1)[12}.!0${.(i14),.(i14),.7,.(i14)dd,:5^[04},${$"
"{.7,.6^,@(y5:%25map1)[02},.5c,@(y4:list)c,@(y4:%25map),@(y13:apply-to-"
"list)[02}L6](i13)}.3p?{.5,${.8,.8,.8d,.8d,:5^[04},.5a,.5a,:5^[64}:4^[6"
"0}.!0.0^_1[64}.!(i10).(i12),.2,.(i10),.(i10),.8,.7,&6{%4,,,#0#1#2,#0${"
"${.(i10),&1{%1:0,.1A3~]1},t,.(i11),:3^[03},:5,.4,&2{%1${:0,&1{%0:0^]0}"
",:1,.4,@(y14:new-literal-id)[03},.1c]1},@(y5:%25map1)[02}.!0.0^_1.!0${"
":4^,f,.7,:3^[03}.!1.1,:3,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2f,.6,"
".6,,#0.9,.5,.2,.9,:0,:1,:2,&7{%3.2,.1,,#0:0,:1,:2,:3,:4,.9,.6,:5,:6,&9"
"{%2${.2,@(y3:id?)[01}?{:3,.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d"
"]2}.0V0?{${.3,.3X0,:2^[02}X1]2}.0Y2?{${.3,.3z,:2^[02}b]2}.0p~?{.0]2}.1"
"~?{${.2a,:7^[01}?{${.2,@(y7:list3+?)[01}?{${:8^,.3da,@(y21:template-es"
"cape->conv)[02}}{f}}{f}}{f},.0?{.0,${.5,.5dd,:2^[02},.1[41}.2~?{${.3a,"
":7^[01}?{${.3,@(y6:list2?)[01}}{f}}{f}?{t,.2da,:2^[32}.2~?{${.3a,:7^[0"
"1}}{f}?{.1,'(s28:unrecognized template escape),@(y7:x-error)[32}.2~?{$"
"{.3d,:6^[01}}{f}?{${.3a,:5^[01},,,#0#1:3,&1{%1:0,.1A3d]1}.!0.2,.5,:4,&"
"3{%!1.1,${.3,:2,@(y4:cons),@(y5:%25map2)[03},:1a,:0^[23}.!1.2u?{${.7,."
"7dd,:2^[02},${.8,.8a,:2^[02}c]6}.5,.2,&2{%!0.0,:1c,:0^,@(y13:apply-to-"
"list)[12},${.5,.4^,@(y5:%25map1)[02},${.9,.9dd,:2^[02},${.3,.5c,@(y4:%"
"25map),@(y13:apply-to-list)[02}L6]8}${.4,.4d,:2^[02},${.5,.5a,:2^[02}c"
"]3}.!0.0^_1[32}.!0.0^_1[73}.!(i11).(i15),.(i12),.(i12),&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,:2,.1,.4,.6,:1^[64}.4d,:0^[51}.!0.0"
"^_1[21}](i16)",
"P", "make-include-transformer",
"%1,,,,#0#1#2#3&0{%2${.2,@(y6:list2?)[01}?{.0daS0}{f}~?{${.2,'(s14:inva"