From 62fed2125b1904eff8c7a459a3cfbd9dbe92c9d3 Mon Sep 17 00:00:00 2001 From: ESL Date: Thu, 25 Jul 2024 18:46:13 -0400 Subject: [PATCH] extra syntax-rules template escapes --- pre/s.scm | 2 +- pre/t.scm | 159 +++++++++++++++++++++++++++++++++--------------- t.c | 176 +++++++++++++++++++++++++++++++++--------------------- 3 files changed, 221 insertions(+), 116 deletions(-) diff --git a/pre/s.scm b/pre/s.scm index 973b5a2..50508c9 100644 --- a/pre/s.scm +++ b/pre/s.scm @@ -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 ...) diff --git a/pre/t.scm b/pre/t.scm index 0f3ea5e..3edc88d 100644 --- a/pre/t.scm +++ b/pre/t.scm @@ -64,7 +64,9 @@ (and (eq? pat ') (number? x)) (and (eq? pat ') (string? x)) (and (eq? pat ') (vector? x)) - (and (eq? pat ') (box? x)) + (and (eq? pat ') (bytevector? x)) + (and (eq? pat ') (char? x)) + (and (eq? pat ') (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! -(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))])) +; not for general use: used in scm2c.ssc simplistic transformer only! +(define (xform-define tail env) + (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 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])) +(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 '() "invalid number->string template args") + (number->string (car sexps)))] + [(id-escape=? x 'string->number) + (lambda (sexps) (check-syntax sexps '() "invalid string->number template args") + (string->number (car sexps)))] + [(id-escape=? x 'list->string) + (lambda (sexps) (check-syntax sexps '(( ...)) "invalid list->string template args") + (list->string (car sexps)))] + [(id-escape=? x 'string->list) + (lambda (sexps) (check-syntax sexps '() "invalid string->list template args") + (string->list (car sexps)))] + [(id-escape=? x 'list->bytevector) + (lambda (sexps) (check-syntax sexps '(( ...)) "invalid list->bytevector template args") + (list->bytevector (car sexps)))] + [(id-escape=? x 'bytevector->list) + (lambda (sexps) (check-syntax sexps '() "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 '( *) "invalid make-list template args") + (make-list (car sexps) (cadr sexps)))] + [(id-escape=? x 'string-append) + (lambda (sexps) (check-syntax sexps '( ...) "invalid string-append template args") + (apply string-append sexps))] + [(id-escape=? x 'char<=?) + (lambda (sexps) (check-syntax sexps '( ...) "invalid char<=? template args") + (apply < sexps))] + [(id-escape=? x '<=) + (lambda (sexps) (check-syntax sexps '( ...) "invalid <= template args") + (apply < sexps))] + [(id-escape=? x '+) + (lambda (sexps) (check-syntax sexps '( ...) "invalid + template args") + (apply + sexps))] + [(id-escape=? x '-) + (lambda (sexps) (check-syntax sexps '( ...) "invalid - template args") + (apply - sexps))] + [(id-escape=? x 'id->string) + (lambda (sexps) (check-syntax sexps '() "invalid id->string template args") + (symbol->string (id->sym (car sexps))))] + [(id-escape=? x 'string->id) + (lambda (sexps) + (sexp-case sexps + [() (id-rename-as x (string->symbol (car sexps)))] + [( ) (id-rename-as (cadr sexps) (string->symbol (car sexps)))] + [else (x-error "invalid string->id template args")]))] + [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))]))))) diff --git a/t.c b/t.c index 6ee3fc8..6c40a0f 100644 --- a/t.c +++ b/t.c @@ -37,15 +37,17 @@ char *t_code[] = { "%2'(y1:*),.1q,.0?{.0]3}'(y4:),.2q?{.2Y0,.0?{.0}{.3K0}_1}{f},.0?{.0" "]4}'(y8:),.3q?{.3Y0}{f},.0?{.0]5}'(y8:),.4q?{.4N0}{f}," ".0?{.0]6}'(y8:),.5q?{.5S0}{f},.0?{.0]7}'(y8:),.6q?{.6V" - "0}{f},.0?{.0]8}'(y5:),.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:),.7q?{.7B0}{f},.0?{.0]9}'(y6:)" + ",.8q?{.8C0}{f},.0?{.0](i10)}'(y6:),.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:;),.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:;),.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:;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:;),.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:;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:;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:;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:;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:;" + "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:" + ";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:;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:;),.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:;),@(y11:sexp-match?)[02}?{.0aX5,:0,@(y12:id-rena" + "me-as)[12}${.2,'(l2:y8:;y4:;),@(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"