syntax-rules: support for boxes

This commit is contained in:
ESL 2024-07-24 19:28:00 -04:00
parent eb61384689
commit 5f3bd42a6b
2 changed files with 39 additions and 33 deletions

View file

@ -733,6 +733,7 @@
(let collect ([x x] [inc include-scalars] [l '()])
(cond [(id? x) (if (and inc (pred? x)) (cons x l) l)]
[(vector? x) (collect (vector->list x) inc l)]
[(box? x) (collect (unbox x) inc l)]
[(pair? x)
(if (ellipsis-pair? (cdr x))
(collect (car x) #t (collect (cddr x) inc l))
@ -762,9 +763,10 @@
(if (pat-literal? pat)
(continue-if (and (id? sexp) (free-id=? sexp use-env pat mac-env)))
(cons (cons pat sexp) bindings))]
[(vector? pat)
(or (vector? sexp) (fail))
[(vector? pat) (or (vector? sexp) (fail))
(match (vector->list pat) (vector->list sexp) bindings)]
[(box? pat) (or (box? sexp) (fail))
(match (unbox pat) (unbox sexp) bindings)]
[(not (pair? pat))
(continue-if (equal? pat sexp))]
[(ellipsis-pair? (cdr pat))
@ -812,6 +814,8 @@
(assq tmpl new-literals)))]
[(vector? tmpl)
(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))]
@ -891,6 +895,7 @@
(and (id? id) (free-id=? id env sym root-environment sym)))
(cons begin-id (preprocess-cond-expand lit=? sexp env))))
; library transformers
; code is a <core> scheme expression as produced by the expander

63
t.c
View file

@ -452,37 +452,38 @@ char *t_code[] = {
",@(y11:name-lookup)[03}.!5.(i11),.6,&2{%1${.2,@(y3:id?)[01}?{:0^,${'(y"
"4:peek),.4,:1[02}q]1}f]1}.!6.2,&1{%3n,.2,.2,,#0:0,.1,.8,&3{%3${.2,@(y3"
":id?)[01}?{.1?{${.2,:0[01}}{f}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2X0,:1^[33}"
".0p?{${.2d,:2^[01}?{${.4,.4,.4dd,:1^[03},t,.2a,:1^[33}${.4,.4,.4d,:1^["
"03},.2,.2a,:1^[33}.2]3}.!0.0^_1[33}.!7.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 syn"
"tax-case pattern),@(y7:x-error)[22}'1,.2I+,.1d,:3^[22}.!0.0^_1[22}.!8."
"7,.2,.(i10),.5,.4,.(i16),.(i12),&7{%3k3,.0,,#0.1,&1{%0f,:0[01}.!0n,.5,"
".5,,#0.4,.1,:6,:5,:4,:3,:2,:1,.(i17),:0,&(i10){%3,#0:9,.4,&2{%1.0?{:0]"
"1}:1^[10}.!0${.3,:0^[01}?{.3]4}${.3,@(y3:id?)[01}?{${.3,:3^[01}?{${.4,"
"@(y3:id?)[01}?{${:2,.4,:1,.7,@(y9:free-id=?)[04}}{f},.1^[41}.3,.3,.3cc"
"]4}.1V0?{.2V0,.0?{.0}{${:9^[00}}_1.3,.3X0,.3X0,:8^[43}.1p~?{.2,.2e,.1^"
"[41}${.3d,:4^[01}?{${t,.4dd,:5^[02},${f,.6,:5^[02},.1,.1I-,.0<0?{${:9^"
"[00}}{.0,.6A6},${.3,.9,@(y9:list-head)[02},${:6^,t,.(i10)a,:7^[03},,#0"
":8,.9,&2{%1${n,.3,:0a,:1^[03},@(y3:cdr),@(y5:%25map1)[12}.!0${.(i12),."
"6,.(i12)dd,:8^[03},${${.7,.6^,@(y5:%25map1)[02},.5c,@(y4:list)c,@(y4:%"
"25map),@(y13:apply-to-list)[02}L6](i11)}.2p?{${.5,.5d,.5d,:8^[03},.3a,"
".3a,:8^[43}:9^[40}.!0.0^_1[63}.!9.(i11),.2,.9,.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}.1~?{.0p?{${.2a,:2^[01}}{f}}{f}?{.0dp?{t"
",.1da,:7^[22}.0,'(s31:invalid escaped template syntax),@(y7:x-error)[2"
"2}.1~?{.0p?{${.2d,:3^[01}}{f}}{f}?{${.2a,:4^[01},,,#0#1:6,&1{%1:0,.1A3"
"d]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}.!(i10).(i14),.("
"i11),.(i11),&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syn"
"tax),@(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}](i15)",
".0Y2?{.2,.2,.2z,:1^[33}.0p?{${.2d,:2^[01}?{${.4,.4,.4dd,:1^[03},t,.2a,"
":1^[33}${.4,.4,.4d,:1^[03},.2,.2a,:1^[33}.2]3}.!0.0^_1[33}.!7.4,&1{%2'"
"0,.1,,#0.0,.4,.6,:0,&4{%2.0p~?{.1]2}:1?{${.2a,:0^[01}}{f}?{:2,'(s41:mi"
"splaced ellipsis in syntax-case pattern),@(y7:x-error)[22}'1,.2I+,.1d,"
":3^[22}.!0.0^_1[22}.!8.7,.2,.(i10),.5,.4,.(i16),.(i12),&7{%3k3,.0,,#0."
"1,&1{%0f,:0[01}.!0n,.5,.5,,#0.4,.1,:6,:5,:4,:3,:2,:1,.(i17),:0,&(i10){"
"%3,#0:9,.4,&2{%1.0?{:0]1}:1^[10}.!0${.3,:0^[01}?{.3]4}${.3,@(y3:id?)[0"
"1}?{${.3,:3^[01}?{${.4,@(y3:id?)[01}?{${:2,.4,:1,.7,@(y9:free-id=?)[04"
"}}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{${:9^[00}}_1.3,.3X0,.3X0,"
":8^[43}.1Y2?{.2Y2,.0?{.0}{${:9^[00}}_1.3,.3z,.3z,:8^[43}.1p~?{.2,.2e,."
"1^[41}${.3d,:4^[01}?{${t,.4dd,:5^[02},${f,.6,:5^[02},.1,.1I-,.0<0?{${:"
"9^[00}}{.0,.6A6},${.3,.9,@(y9:list-head)[02},${:6^,t,.(i10)a,:7^[03},,"
"#0:8,.9,&2{%1${n,.3,:0a,:1^[03},@(y3:cdr),@(y5:%25map1)[12}.!0${.(i12)"
",.6,.(i12)dd,:8^[03},${${.7,.6^,@(y5:%25map1)[02},.5c,@(y4:list)c,@(y4"
":%25map),@(y13:apply-to-list)[02}L6](i11)}.2p?{${.5,.5d,.5d,:8^[03},.3"
"a,.3a,:8^[43}:9^[40}.!0.0^_1[63}.!9.(i11),.2,.9,.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}_1"
"d]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 temp"
"late 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-lis"
"t)[02}L6]7}.0p?{${.3,.3d,:7^[02},${.4,.4a,:7^[02}c]2}.0]2}.!0.0^_1[32}"
".!0.0^_1[63}.!(i10).(i14),.(i11),.(i11),&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}](i15)",
"P", "make-include-transformer",
"%1,,,,#0#1#2#3&0{%2${.2,@(y6:list2?)[01}?{.0daS0}{f}~?{${.2,'(s14:inva"