mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-25 21:58:54 +01:00
handcoded expanders for includes and cond-expand
This commit is contained in:
dermagen
parent
db8b0591d8
commit
df2628a4a2
5 changed files with 327 additions and 171 deletions
264
s.c
264
s.c
|
|
@ -150,6 +150,29 @@ char *s_code[] = {
|
|||
"l3:y12:syntax-rules;n;l2:l3:y1:_;py4:args;y5:forms;;y3:...;;l3:y7:lamb"
|
||||
"da*;l2:y4:args;py6:lambda;py4:args;y5:forms;;;;y3:...;;;",
|
||||
|
||||
"S", "%if-expand",
|
||||
"l12:y12:syntax-rules;l4:y3:and;y2:or;y3:not;y7:library;;l2:l4:y1:_;l1:"
|
||||
"y3:and;;y3:con;y3:alt;;y3:con;;l2:l4:y1:_;l2:y3:and;y1:r;;y3:con;y3:al"
|
||||
"t;;l4:y10:%25if-expand;y1:r;y3:con;y3:alt;;;l2:l4:y1:_;py3:and;py1:r;y"
|
||||
"2:r*;;;y3:con;y3:alt;;l4:y10:%25if-expand;y1:r;l4:y10:%25if-expand;py3"
|
||||
":and;y2:r*;;y3:con;y3:alt;;y3:alt;;;l2:l4:y1:_;l1:y2:or;;y3:con;y3:alt"
|
||||
";;y3:alt;;l2:l4:y1:_;l2:y2:or;y1:r;;y3:con;y3:alt;;l4:y10:%25if-expand"
|
||||
";y1:r;y3:con;y3:alt;;;l2:l4:y1:_;py2:or;py1:r;y2:r*;;;y3:con;y3:alt;;l"
|
||||
"4:y10:%25if-expand;y1:r;y3:con;l4:y10:%25if-expand;py2:or;y2:r*;;y3:co"
|
||||
"n;y3:alt;;;;l2:l4:y1:_;l2:y3:not;y1:r;;y3:con;y3:alt;;l4:y10:%25if-exp"
|
||||
"and;y1:r;y3:alt;y3:con;;;l2:l4:y1:_;l2:y7:library;y1:l;;y3:con;y3:alt;"
|
||||
";l4:y20:if-library-available;y1:l;y3:con;y3:alt;;;l2:l4:y1:_;py1:x;y1:"
|
||||
"y;;y3:con;y3:alt;;l3:y12:syntax-error;s45:unrecognized cond-expand fea"
|
||||
"ture requirement:;py1:x;y1:y;;;;l2:l4:y1:_;y1:f;y3:con;y3:alt;;l4:y20:"
|
||||
"if-feature-available;y1:f;y3:con;y3:alt;;;",
|
||||
|
||||
"S", "cond-expand",
|
||||
"l6:y12:syntax-rules;l1:y4:else;;l2:l1:y1:_;;l1:y4:void;;;l2:l2:y1:_;py"
|
||||
"4:else;y4:exps;;;py5:begin;y4:exps;;;l2:py1:_;pl1:y1:x;;y4:rest;;;l4:y"
|
||||
"10:%25if-expand;y1:x;l1:y5:begin;;py11:cond-expand;y4:rest;;;;l2:py1:_"
|
||||
";ppy1:x;y4:exps;;y4:rest;;;l4:y10:%25if-expand;y1:x;py5:begin;y4:exps;"
|
||||
";py11:cond-expand;y4:rest;;;;",
|
||||
|
||||
"C", 0,
|
||||
"@(y4:box?)@!(y8:promise?)",
|
||||
|
||||
|
|
@ -847,124 +870,123 @@ char *s_code[] = {
|
|||
|
||||
"P", "%read",
|
||||
"%2,,,,,,,,,,,,,,,,,,,,,,,#0#1#2#3#4#5#6#7#8#9#(i10)#(i11)#(i12)#(i13)#"
|
||||
"(i14)#(i15)#(i16)#(i17)#(i18)#(i19)#(i20)#(i21)#(i22)${.(i25),@(y15:po"
|
||||
"rt-fold-case?)[01}.!0n.!1&0{%1.0,&1{%0:0z]0}]1}.!2&0{%1.0K0]1}.!3.4,&1"
|
||||
"{%1.0K0?{${.2[00},:0^[11}.0]1}.!4.5,.5,&2{%1.0p?{.0aK0?{${.2a,:0^[01},"
|
||||
".1sa}{${.2a,:1^[01}}.0dK0?{${.2d,:0^[01},.1sd]1}.0d,:1^[11}.0V0?{'0,,#"
|
||||
"0.2,:0,:1,.3,&4{%1:3V3,.1I<?{.0,:3V4,.0K0?{${.2,:2^[01},.2,:3V5}{${.2,"
|
||||
":1^[01}}_1'1,.1I+,:0^[11}]1}.!0.0^_1[11}.0Y2?{.0zK0?{${.2z,:1^[01},.1s"
|
||||
"z]1}.0z,:1^[11}f]1}.!5.5,&1{%1${.2,:0^[01}.0]1}.!6f.!7f.!8f.!9f.!(i10)"
|
||||
"'(y12:reader-token),l1,.0.!8'(s17:right parenthesis),.1c.!9'(s13:right"
|
||||
" bracket),.1c.!(i10)'(s5:%22 . %22),.1c.!(i11)_1.7,&1{%1.0p?{:0^,.1aq]"
|
||||
"1}f]1}.!(i11)&0{%1'(s80:ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrst"
|
||||
"uvwxyz!$%25&*/:<=>?^_~0123456789+-.@),.1S8]1}.!(i12)&0{%1.0X8,'(i48),."
|
||||
"1<!?{'(i57),.1>!}{f},.0?{.0]3}'(i65),.2<!?{'(i70),.2>!}{f},.0?{.0]4}'("
|
||||
"i97),.3<!?{'(i102),.3>!]4}f]4}.!(i13)&0{%1.0C1,.0?{.0]2}'(c)),.2C=,.0?"
|
||||
"{.0]3}'(c(),.3C=,.0?{.0]4}'(c]),.4C=,.0?{.0]5}'(c[),.5C=,.0?{.0]6}'(c%"
|
||||
"22),.6C=,.0?{.0]7}'(c;),.7C=]7}.!(i14).(i16),.(i12),&2{%1${.2,:1^[01},"
|
||||
".0R8?{.1,'(y5:port:),'(s22:unexpected end of file),@(y10:read-error)[2"
|
||||
"3}${.2,:0^[01}?{.1,'(y5:port:),.2d,'(s17:unexpected token:),@(y10:read"
|
||||
"-error)[24}.0]2}.!(i15).9,.(i13),.(i21),.(i25),.(i20),.(i13),.(i23),.("
|
||||
"i25),.(i28),.(i23),.(i13),.(i26),.(i14),.(i14),.(i38),&(i15){%1.0R0,.0"
|
||||
"R8?{.0]2}.0C1?{.1,:(i10)^[21}'(c(),.1C=?{t,:9^,.3,.3,:8^[24}'(c)),.1C="
|
||||
"?{:9^]2}'(c[),.1C=?{t,:(i14)^,.3,.3,:8^[24}'(c]),.1C=?{:(i14)^]2}'(c')"
|
||||
",.1C=?{${.3,:3^[01},'(y5:quote),l2]2}'(c`),.1C=?{${.3,:3^[01},'(y10:qu"
|
||||
"asiquote),l2]2}${.2,:(i13)^[01}?{.1,.1,:(i11)^[22}'(c;),.1C=?{${.3R0,,"
|
||||
"#0.5,.1,&2{%1.0R8,.0?{.0]2}'(c%0a),.2C=,.0?{.0]3}:1R0,:0^[31}.!0.0^_1["
|
||||
"01}.1,:(i10)^[21}'(c,),.1C=?{.1R1,.0R8?{.2,'(y5:port:),'(s19:end of fi"
|
||||
"le after ,),@(y10:read-error)[33}'(c@),.1C=?{.2R0${.4,:3^[01},'(y16:un"
|
||||
"quote-splicing),l2]3}${.4,:3^[01},'(y7:unquote),l2]3}'(c%22),.1C=?{n,,"
|
||||
"#0.3,:(i12),.2,&3{%1:2R0,.0R8?{:2,'(y5:port:),'(s27:end of file within"
|
||||
" a string),@(y10:read-error)[23}'(c%5c),.1C=?{${'(y6:string),:2,:1^[02"
|
||||
"},.0?{.2,.1c}{.2},:0^[31}'(c%22),.1C=?{.1A9X3]2}.1,.1c,:0^[21}.!0.0^_1"
|
||||
"[21}'(c|),.1C=?{n,,#0.3,:(i12),.2,&3{%1:2R0,.0R8?{:2,'(y5:port:),'(s29"
|
||||
":end of file within a |symbol|),@(y10:read-error)[23}'(c%5c),.1C=?{${'"
|
||||
"(y6:symbol),:2,:1^[02},.0?{.2,.1c}{.2},:0^[31}'(c|),.1C=?{.1A9X3X5]2}."
|
||||
"1,.1c,:0^[21}.!0.0^_1[21}'(c#),.1C=?{.1R1,.0R8?{.2,'(y5:port:),'(s19:e"
|
||||
"nd of file after #),@(y10:read-error)[33}'(ct),.1Ci=,.0?{.0}{'(cf),.2C"
|
||||
"i=}_1?{${.4,:3^[01},.0,'(l2:y1:t;y4:true;),.1A1?{t]5}'(l2:y1:f;y5:fals"
|
||||
"e;),.1A1?{f]5}.4,'(y5:port:),.3,'(s23:unexpected name after #),@(y10:r"
|
||||
"ead-error)[54}'(cb),.1Ci=,.0?{.0}{'(co),.2Ci=,.0?{.0}{'(cd),.3Ci=,.0?{"
|
||||
".0}{'(cx),.4Ci=,.0?{.0}{'(ci),.5Ci=,.0?{.0}{'(ce),.6Ci=}_1}_1}_1}_1}_1"
|
||||
"?{.2,'(c#),:(i11)^[32}'(c&),.1C=?{.2R0${.4,:3^[01}b]3}'(c;),.1C=?{.2R0"
|
||||
"${.4,:3^[01}.2,:(i10)^[31}'(c|),.1C=?{.2R0${,#0.5,.1,&2{%0:1R0,.0R8?{:"
|
||||
"1,'(y5:port:),'(s25:end of file in #| comment),@(y10:read-error)[13}'("
|
||||
"c|),.1C=?{:1R1,.0R8?{:1,'(y5:port:),'(s25:end of file in #| comment),@"
|
||||
"(y10:read-error)[23}'(c#),.1C=?{:1R0]2}:0^[20}'(c#),.1C=?{:1R1,.0R8?{:"
|
||||
"1,'(y5:port:),'(s25:end of file in #| comment),@(y10:read-error)[23}'("
|
||||
"c|),.1C=?{:1R0${:0^[00}:0^[20}:0^[20}:0^[10}.!0.0^_1[00}.2,:(i10)^[31}"
|
||||
"'(c(),.1C=?{.2R0${f,:9^,.6,.5,:8^[04}X1]3}'(cu),.1C=?{.2R0'(c8),.3R0q?"
|
||||
"{'(c(),.3R0q}{f}?{${.4,:7^[01}E1]3}.2,'(y5:port:),'(s25:invalid byteve"
|
||||
"ctor syntax),@(y10:read-error)[33}'(c%5c),.1C=?{.2R0.2R1,.0R8?{.3,'(y5"
|
||||
":port:),'(s20:end of file after #%5c),@(y10:read-error)[43}.0,'(cx)C=?"
|
||||
"{.3R0${.5R1,:5^[01}?{.0]4}f,.4,:6^[42}.0C4?{${.5,:3^[01},'1,.1X4S3=?{."
|
||||
"1]5}.0,'(y4:null),.1v?{'0X9]6}'(y5:space),.1v?{'(c )]6}'(y5:alarm),.1v"
|
||||
"?{'(c%07)]6}'(y9:backspace),.1v?{'(c%08)]6}'(y6:delete),.1v?{'(i127)X9"
|
||||
"]6}'(y6:escape),.1v?{'(i27)X9]6}'(y3:tab),.1v?{'(c%09)]6}'(l2:y7:newli"
|
||||
"ne;y8:linefeed;),.1A1?{'(c%0a)]6}'(y4:vtab),.1v?{'(c%0b)]6}'(y4:page),"
|
||||
".1v?{'(c%0c)]6}'(y6:return),.1v?{'(c%0d)]6}.5,'(y5:port:),.3,'(s15:unk"
|
||||
"nown #%5c name),@(y10:read-error)[64}.3R0.0]4}.0C5?{:0?{${.4,'(y5:port"
|
||||
":),'(s44:#N=/#N# notation is not allowed in this mode),@(y10:read-erro"
|
||||
"r)[03}}n,,#0.4,.1,:4,:3,:2,:1,&6{%1:5R0,.0R8?{:5,'(y5:port:),'(s32:end"
|
||||
" of file within a #N notation),@(y10:read-error)[23}.0C5?{.1,.1c,:4^[2"
|
||||
"1}'(c#),.1C=?{.1A9X3,'(i10),.1E9,.0I0?{:0^,.1A3}{f},.0?{.0d]5}'(s22:un"
|
||||
"known #n# reference:),'(y5:port:),.4,@(y10:read-error)[53}'(c=),.1C=?{"
|
||||
".1A9X3,'(i10),.1E9,.0I0~?{${'(s22:invalid #n= reference:),'(y5:port:),"
|
||||
".5,@(y10:read-error)[03}}{:0^,.1A3?{${'(s18:duplicate #n= tag:),'(y5:p"
|
||||
"ort:),.4,@(y10:read-error)[03}}{f}}fb,:0^,${.3,:1^[01},.3cc:!0${:5,:2^"
|
||||
"[01},${.2,:3^[01}?{'(s31:#n= has another label as target),'(y5:port:),"
|
||||
".5,@(y10:read-error)[63}.0,.2sz.0]6}:5,'(y5:port:),'(s34:invalid termi"
|
||||
"nator for #N notation),@(y10:read-error)[23}.!0.0^_1[31}.2,'(y5:port:)"
|
||||
",.2,'(s16:unknown # syntax),@(y10:read-error)[34}.1,'(y5:port:),.2,'(s"
|
||||
"22:illegal character read),@(y10:read-error)[24}.!(i16).(i16),.(i12),."
|
||||
"(i17),.(i13),&4{%4${.3,:3^[01},:0^,.1q?{.2,'(y5:port:),'(s42:missing c"
|
||||
"ar -- ( immediately followed by .),@(y10:read-error)[53}.0,,#0.0,.5,:3"
|
||||
",:2,.(i10),:1,.(i11),:0,&8{%1.0R8?{:6,'(y5:port:),'(s41:eof inside lis"
|
||||
"t -- unbalanced parentheses),@(y10:read-error)[13}:1,.1q?{n]1}:0^,.1q?"
|
||||
"{:3?{${:6,:2^[01},${:6,:5^[01},:1,.1q?{.1]3}:6,'(y5:port:),.2,'(s31:ra"
|
||||
"ndomness after form after dot),@(y10:read-error)[34}:6,'(y5:port:),'(s"
|
||||
"13:dot in #(...)),@(y10:read-error)[13}${.2,:4^[01}?{:6,'(y5:port:),.2"
|
||||
"d,'(s20:error inside list --),@(y10:read-error)[14}${${:6,:5^[01},:7^["
|
||||
"01},.1c]1}.!0.0^_1[51}.!(i17).(i16),.9,.(i13),&3{%1${.2,:2^[01},,#0.0,"
|
||||
".3,:2,:0,:1,&5{%1.0R8?{:3,'(y5:port:),'(s21:eof inside bytevector),@(y"
|
||||
"10:read-error)[13}:0^,.1q?{n]1}${.2,:1^[01}?{:3,'(y5:port:),.2d,'(s26:"
|
||||
"error inside bytevector --),@(y10:read-error)[14}.0I0~,.0?{.0}{'0,.2I<"
|
||||
",.0?{.0}{'(i255),.3I>}_1}_1?{:3,'(y5:port:),.2,'(s33:invalid byte insi"
|
||||
"de bytevector --),@(y10:read-error)[14}${${:3,:2^[01},:4^[01},.1c]1}.!"
|
||||
"0.0^_1[11}.!(i18).(i20),&1{%2.0R0,.0R8?{${.3,'(y5:port:),.6,'(s20:end "
|
||||
"of file within a),@(y10:read-error)[04}}'(c%5c),.1C=,.0?{.0}{'(c%22),."
|
||||
"2C=,.0?{.0}{'(c|),.3C=}_1}_1?{.0]3}'(ca),.1C=?{'(c%07)]3}'(cb),.1C=?{'"
|
||||
"(c%08)]3}'(ct),.1C=?{'(c%09)]3}'(cn),.1C=?{'(c%0a)]3}'(cv),.1C=?{'(c%0"
|
||||
"b)]3}'(cf),.1C=?{'(c%0c)]3}'(cr),.1C=?{'(c%0d)]3}'(cx),.1C=?{t,.2,:0^["
|
||||
"32}'(y6:string),.3q?{.0C1}{f}?{.1R1,'(c%0a),.2C=,,#0.0,.5,&2{%2.1R8,.0"
|
||||
"?{.0}{.2C1~}_1?{.0?{f]2}:0,'(y5:port:),'(s32:no newline in line ending"
|
||||
" escape),@(y10:read-error)[23}.0?{'(c%0a),.2C=}{f}?{f]2}:0R0:0R1,.1,.0"
|
||||
"?{.0}{'(c%0a),.4C=}_1,:1^[22}.!0.0^_1[32}.1,'(y5:port:),.2,'(y1::),.6,"
|
||||
"'(s22:invalid char escape in),@(y10:read-error)[36}.!(i19).(i14),.(i14"
|
||||
"),&2{%2,#0.1,&1{%1.0u?{:0,'(y5:port:),'(s31:%5cx escape sequence is to"
|
||||
"o short),@(y10:read-error)[13}'(i16),.1A9X3X7X9]1}.!0'0,n,.3R1,,#0.0,."
|
||||
"6,:0,.7,.(i10),:1,&6{%3.0R8?{:1?{:4,'(y5:port:),'(s27:end of file with"
|
||||
"in a string),@(y10:read-error)[33}.1,:2^[31}:1?{'(c;),.1C=}{f}?{:4R0.1"
|
||||
",:2^[31}:1~?{${.2,:0^[01}}{f}?{.1,:2^[31}${.2,:3^[01}~?{:4,'(y5:port:)"
|
||||
",.2,'(s37:unexpected char in %5cx escape sequence),@(y10:read-error)[3"
|
||||
"4}'2,.3>?{:4,'(y5:port:),'(s30:%5cx escape sequence is too long),@(y10"
|
||||
":read-error)[33}:4R0'1,.3+,.2,.2c,:4R1,:5^[33}.!0.0^_1[33}.!(i20)&0{%4"
|
||||
".0,.0?{.0}{.2C5}_1?{f]4}'(s2:+i),.4Si=,.0?{.0}{'(s2:-i),.5Si=}_1?{f]4}"
|
||||
"'(s6:+nan.0),.4Si=,.0?{.0}{'(s6:-nan.0),.5Si=}_1?{f]4}'(s6:+inf.0),.4S"
|
||||
"i=,.0?{.0}{'(s6:-inf.0),.5Si=}_1?{f]4}'(c+),.2C=,.0?{.0}{'(c-),.3C=}_1"
|
||||
"?{.2du?{t]4}'(c.),.3daC=?{.2ddp?{.2ddaC5~]4}f]4}.2daC5~]4}'(c.),.2C=?{"
|
||||
".2dp?{.2daC5~]4}f]4}f]4}.!(i21).(i14),.(i22),.(i12),.3,.(i16),&5{%2'(c"
|
||||
"#),.1C=,.1,l1,.3R1,,#0.5,.1,:0,:1,:2,:3,:4,&7{%3.0R8,.0?{.0}{${.3,:0^["
|
||||
"01}}_1?{.1A9,.0a,.1X3,.5,.0?{.0}{.2C5,.0?{.0}{'(c+),.4C=,.0?{.0}{'(c-)"
|
||||
",.5C=,.0?{.0}{'(c.),.6C=}_1}_1}_1}_1?{'(s1:.),.1S=?{:2^]6}${.2,.5,.5,."
|
||||
"(i10),:1^[04}?{:3^?{.0SfX5]6}.0X5]6}'(i10),.1E9,.0?{.0]7}:6,'(y5:port:"
|
||||
"),.3,'(s54:unsupported number syntax (implementation restriction)),@(y"
|
||||
"10:read-error)[74}:3^?{.0SfX5]6}.0X5]6}'(c#),.1C=?{:6R0t,.2,.2c,:6R1,:"
|
||||
"5^[33}${.2,:4^[01}?{:6R0.2,.2,.2c,:6R1,:5^[33}:6,'(y5:port:),.2,'(s29:"
|
||||
"unexpected number/symbol char),@(y10:read-error)[34}.!0.0^_1[23}.!(i22"
|
||||
")${.(i25),.(i19)^[01},${.2,.(i15)^[01}~?{.2^u?{.0](i26)}.0,.8^[(i26)1}"
|
||||
".(i24),'(y5:port:),.2d,'(s17:unexpected token:),@(y10:read-error)[(i26"
|
||||
")4",
|
||||
"(i14)#(i15)#(i16)#(i17)#(i18)#(i19)#(i20)#(i21)#(i22).(i23)P78.!0n.!1&"
|
||||
"0{%1.0,&1{%0:0z]0}]1}.!2&0{%1.0K0]1}.!3.4,&1{%1.0K0?{${.2[00},:0^[11}."
|
||||
"0]1}.!4.5,.5,&2{%1.0p?{.0aK0?{${.2a,:0^[01},.1sa}{${.2a,:1^[01}}.0dK0?"
|
||||
"{${.2d,:0^[01},.1sd]1}.0d,:1^[11}.0V0?{'0,,#0.2,:0,:1,.3,&4{%1:3V3,.1I"
|
||||
"<?{.0,:3V4,.0K0?{${.2,:2^[01},.2,:3V5}{${.2,:1^[01}}_1'1,.1I+,:0^[11}]"
|
||||
"1}.!0.0^_1[11}.0Y2?{.0zK0?{${.2z,:1^[01},.1sz]1}.0z,:1^[11}f]1}.!5.5,&"
|
||||
"1{%1${.2,:0^[01}.0]1}.!6f.!7f.!8f.!9f.!(i10)'(y12:reader-token),l1,.0."
|
||||
"!8'(s17:right parenthesis),.1c.!9'(s13:right bracket),.1c.!(i10)'(s5:%"
|
||||
"22 . %22),.1c.!(i11)_1.7,&1{%1.0p?{:0^,.1aq]1}f]1}.!(i11)&0{%1'(s80:AB"
|
||||
"CDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!$%25&*/:<=>?^_~0123"
|
||||
"456789+-.@),.1S8]1}.!(i12)&0{%1.0X8,'(i48),.1<!?{'(i57),.1>!}{f},.0?{."
|
||||
"0]3}'(i65),.2<!?{'(i70),.2>!}{f},.0?{.0]4}'(i97),.3<!?{'(i102),.3>!]4}"
|
||||
"f]4}.!(i13)&0{%1.0C1,.0?{.0]2}'(c)),.2C=,.0?{.0]3}'(c(),.3C=,.0?{.0]4}"
|
||||
"'(c]),.4C=,.0?{.0]5}'(c[),.5C=,.0?{.0]6}'(c%22),.6C=,.0?{.0]7}'(c;),.7"
|
||||
"C=]7}.!(i14).(i16),.(i12),&2{%1${.2,:1^[01},.0R8?{.1,'(y5:port:),'(s22"
|
||||
":unexpected end of file),@(y10:read-error)[23}${.2,:0^[01}?{.1,'(y5:po"
|
||||
"rt:),.2d,'(s17:unexpected token:),@(y10:read-error)[24}.0]2}.!(i15).9,"
|
||||
".(i13),.(i21),.(i25),.(i20),.(i13),.(i23),.(i25),.(i28),.(i23),.(i13),"
|
||||
".(i26),.(i14),.(i14),.(i38),&(i15){%1.0R0,.0R8?{.0]2}.0C1?{.1,:(i10)^["
|
||||
"21}'(c(),.1C=?{t,:9^,.3,.3,:8^[24}'(c)),.1C=?{:9^]2}'(c[),.1C=?{t,:(i1"
|
||||
"4)^,.3,.3,:8^[24}'(c]),.1C=?{:(i14)^]2}'(c'),.1C=?{${.3,:3^[01},'(y5:q"
|
||||
"uote),l2]2}'(c`),.1C=?{${.3,:3^[01},'(y10:quasiquote),l2]2}${.2,:(i13)"
|
||||
"^[01}?{.1,.1,:(i11)^[22}'(c;),.1C=?{${.3R0,,#0.5,.1,&2{%1.0R8,.0?{.0]2"
|
||||
"}'(c%0a),.2C=,.0?{.0]3}:1R0,:0^[31}.!0.0^_1[01}.1,:(i10)^[21}'(c,),.1C"
|
||||
"=?{.1R1,.0R8?{.2,'(y5:port:),'(s19:end of file after ,),@(y10:read-err"
|
||||
"or)[33}'(c@),.1C=?{.2R0${.4,:3^[01},'(y16:unquote-splicing),l2]3}${.4,"
|
||||
":3^[01},'(y7:unquote),l2]3}'(c%22),.1C=?{n,,#0.3,:(i12),.2,&3{%1:2R0,."
|
||||
"0R8?{:2,'(y5:port:),'(s27:end of file within a string),@(y10:read-erro"
|
||||
"r)[23}'(c%5c),.1C=?{${'(y6:string),:2,:1^[02},.0?{.2,.1c}{.2},:0^[31}'"
|
||||
"(c%22),.1C=?{.1A9X3]2}.1,.1c,:0^[21}.!0.0^_1[21}'(c|),.1C=?{n,,#0.3,:("
|
||||
"i12),.2,&3{%1:2R0,.0R8?{:2,'(y5:port:),'(s29:end of file within a |sym"
|
||||
"bol|),@(y10:read-error)[23}'(c%5c),.1C=?{${'(y6:symbol),:2,:1^[02},.0?"
|
||||
"{.2,.1c}{.2},:0^[31}'(c|),.1C=?{.1A9X3X5]2}.1,.1c,:0^[21}.!0.0^_1[21}'"
|
||||
"(c#),.1C=?{.1R1,.0R8?{.2,'(y5:port:),'(s19:end of file after #),@(y10:"
|
||||
"read-error)[33}'(ct),.1Ci=,.0?{.0}{'(cf),.2Ci=}_1?{${.4,:3^[01},.0,'(l"
|
||||
"2:y1:t;y4:true;),.1A1?{t]5}'(l2:y1:f;y5:false;),.1A1?{f]5}.4,'(y5:port"
|
||||
":),.3,'(s23:unexpected name after #),@(y10:read-error)[54}'(cb),.1Ci=,"
|
||||
".0?{.0}{'(co),.2Ci=,.0?{.0}{'(cd),.3Ci=,.0?{.0}{'(cx),.4Ci=,.0?{.0}{'("
|
||||
"ci),.5Ci=,.0?{.0}{'(ce),.6Ci=}_1}_1}_1}_1}_1?{.2,'(c#),:(i11)^[32}'(c&"
|
||||
"),.1C=?{.2R0${.4,:3^[01}b]3}'(c;),.1C=?{.2R0${.4,:3^[01}.2,:(i10)^[31}"
|
||||
"'(c|),.1C=?{.2R0${,#0.5,.1,&2{%0:1R0,.0R8?{:1,'(y5:port:),'(s25:end of"
|
||||
" file in #| comment),@(y10:read-error)[13}'(c|),.1C=?{:1R1,.0R8?{:1,'("
|
||||
"y5:port:),'(s25:end of file in #| comment),@(y10:read-error)[23}'(c#),"
|
||||
".1C=?{:1R0]2}:0^[20}'(c#),.1C=?{:1R1,.0R8?{:1,'(y5:port:),'(s25:end of"
|
||||
" file in #| comment),@(y10:read-error)[23}'(c|),.1C=?{:1R0${:0^[00}:0^"
|
||||
"[20}:0^[20}:0^[10}.!0.0^_1[00}.2,:(i10)^[31}'(c(),.1C=?{.2R0${f,:9^,.6"
|
||||
",.5,:8^[04}X1]3}'(cu),.1C=?{.2R0'(c8),.3R0q?{'(c(),.3R0q}{f}?{${.4,:7^"
|
||||
"[01}E1]3}.2,'(y5:port:),'(s25:invalid bytevector syntax),@(y10:read-er"
|
||||
"ror)[33}'(c%5c),.1C=?{.2R0.2R1,.0R8?{.3,'(y5:port:),'(s20:end of file "
|
||||
"after #%5c),@(y10:read-error)[43}.0,'(cx)C=?{.3R0${.5R1,:5^[01}?{.0]4}"
|
||||
"f,.4,:6^[42}.0C4?{${.5,:3^[01},'1,.1X4S3=?{.1]5}.0,'(y4:null),.1v?{'0X"
|
||||
"9]6}'(y5:space),.1v?{'(c )]6}'(y5:alarm),.1v?{'(c%07)]6}'(y9:backspace"
|
||||
"),.1v?{'(c%08)]6}'(y6:delete),.1v?{'(i127)X9]6}'(y6:escape),.1v?{'(i27"
|
||||
")X9]6}'(y3:tab),.1v?{'(c%09)]6}'(l2:y7:newline;y8:linefeed;),.1A1?{'(c"
|
||||
"%0a)]6}'(y4:vtab),.1v?{'(c%0b)]6}'(y4:page),.1v?{'(c%0c)]6}'(y6:return"
|
||||
"),.1v?{'(c%0d)]6}.5,'(y5:port:),.3,'(s15:unknown #%5c name),@(y10:read"
|
||||
"-error)[64}.3R0.0]4}.0C5?{:0?{${.4,'(y5:port:),'(s44:#N=/#N# notation "
|
||||
"is not allowed in this mode),@(y10:read-error)[03}}n,,#0.4,.1,:4,:3,:2"
|
||||
",:1,&6{%1:5R0,.0R8?{:5,'(y5:port:),'(s32:end of file within a #N notat"
|
||||
"ion),@(y10:read-error)[23}.0C5?{.1,.1c,:4^[21}'(c#),.1C=?{.1A9X3,'(i10"
|
||||
"),.1E9,.0I0?{:0^,.1A3}{f},.0?{.0d]5}'(s22:unknown #n# reference:),'(y5"
|
||||
":port:),.4,@(y10:read-error)[53}'(c=),.1C=?{.1A9X3,'(i10),.1E9,.0I0~?{"
|
||||
"${'(s22:invalid #n= reference:),'(y5:port:),.5,@(y10:read-error)[03}}{"
|
||||
":0^,.1A3?{${'(s18:duplicate #n= tag:),'(y5:port:),.4,@(y10:read-error)"
|
||||
"[03}}{f}}fb,:0^,${.3,:1^[01},.3cc:!0${:5,:2^[01},${.2,:3^[01}?{'(s31:#"
|
||||
"n= has another label as target),'(y5:port:),.5,@(y10:read-error)[63}.0"
|
||||
",.2sz.0]6}:5,'(y5:port:),'(s34:invalid terminator for #N notation),@(y"
|
||||
"10:read-error)[23}.!0.0^_1[31}.2,'(y5:port:),.2,'(s16:unknown # syntax"
|
||||
"),@(y10:read-error)[34}.1,'(y5:port:),.2,'(s22:illegal character read)"
|
||||
",@(y10:read-error)[24}.!(i16).(i16),.(i12),.(i17),.(i13),&4{%4${.3,:3^"
|
||||
"[01},:0^,.1q?{.2,'(y5:port:),'(s42:missing car -- ( immediately follow"
|
||||
"ed by .),@(y10:read-error)[53}.0,,#0.0,.5,:3,:2,.(i10),:1,.(i11),:0,&8"
|
||||
"{%1.0R8?{:6,'(y5:port:),'(s41:eof inside list -- unbalanced parenthese"
|
||||
"s),@(y10:read-error)[13}:1,.1q?{n]1}:0^,.1q?{:3?{${:6,:2^[01},${:6,:5^"
|
||||
"[01},:1,.1q?{.1]3}:6,'(y5:port:),.2,'(s31:randomness after form after "
|
||||
"dot),@(y10:read-error)[34}:6,'(y5:port:),'(s13:dot in #(...)),@(y10:re"
|
||||
"ad-error)[13}${.2,:4^[01}?{:6,'(y5:port:),.2d,'(s20:error inside list "
|
||||
"--),@(y10:read-error)[14}${${:6,:5^[01},:7^[01},.1c]1}.!0.0^_1[51}.!(i"
|
||||
"17).(i16),.9,.(i13),&3{%1${.2,:2^[01},,#0.0,.3,:2,:0,:1,&5{%1.0R8?{:3,"
|
||||
"'(y5:port:),'(s21:eof inside bytevector),@(y10:read-error)[13}:0^,.1q?"
|
||||
"{n]1}${.2,:1^[01}?{:3,'(y5:port:),.2d,'(s26:error inside bytevector --"
|
||||
"),@(y10:read-error)[14}.0I0~,.0?{.0}{'0,.2I<,.0?{.0}{'(i255),.3I>}_1}_"
|
||||
"1?{:3,'(y5:port:),.2,'(s33:invalid byte inside bytevector --),@(y10:re"
|
||||
"ad-error)[14}${${:3,:2^[01},:4^[01},.1c]1}.!0.0^_1[11}.!(i18).(i20),&1"
|
||||
"{%2.0R0,.0R8?{${.3,'(y5:port:),.6,'(s20:end of file within a),@(y10:re"
|
||||
"ad-error)[04}}'(c%5c),.1C=,.0?{.0}{'(c%22),.2C=,.0?{.0}{'(c|),.3C=}_1}"
|
||||
"_1?{.0]3}'(ca),.1C=?{'(c%07)]3}'(cb),.1C=?{'(c%08)]3}'(ct),.1C=?{'(c%0"
|
||||
"9)]3}'(cn),.1C=?{'(c%0a)]3}'(cv),.1C=?{'(c%0b)]3}'(cf),.1C=?{'(c%0c)]3"
|
||||
"}'(cr),.1C=?{'(c%0d)]3}'(cx),.1C=?{t,.2,:0^[32}'(y6:string),.3q?{.0C1}"
|
||||
"{f}?{.1R1,'(c%0a),.2C=,,#0.0,.5,&2{%2.1R8,.0?{.0}{.2C1~}_1?{.0?{f]2}:0"
|
||||
",'(y5:port:),'(s32:no newline in line ending escape),@(y10:read-error)"
|
||||
"[23}.0?{'(c%0a),.2C=}{f}?{f]2}:0R0:0R1,.1,.0?{.0}{'(c%0a),.4C=}_1,:1^["
|
||||
"22}.!0.0^_1[32}.1,'(y5:port:),.2,'(y1::),.6,'(s22:invalid char escape "
|
||||
"in),@(y10:read-error)[36}.!(i19).(i14),.(i14),&2{%2,#0.1,&1{%1.0u?{:0,"
|
||||
"'(y5:port:),'(s31:%5cx escape sequence is too short),@(y10:read-error)"
|
||||
"[13}'(i16),.1A9X3X7X9]1}.!0'0,n,.3R1,,#0.0,.6,:0,.7,.(i10),:1,&6{%3.0R"
|
||||
"8?{:1?{:4,'(y5:port:),'(s27:end of file within a string),@(y10:read-er"
|
||||
"ror)[33}.1,:2^[31}:1?{'(c;),.1C=}{f}?{:4R0.1,:2^[31}:1~?{${.2,:0^[01}}"
|
||||
"{f}?{.1,:2^[31}${.2,:3^[01}~?{:4,'(y5:port:),.2,'(s37:unexpected char "
|
||||
"in %5cx escape sequence),@(y10:read-error)[34}'2,.3>?{:4,'(y5:port:),'"
|
||||
"(s30:%5cx escape sequence is too long),@(y10:read-error)[33}:4R0'1,.3+"
|
||||
",.2,.2c,:4R1,:5^[33}.!0.0^_1[33}.!(i20)&0{%4.0,.0?{.0}{.2C5}_1?{f]4}'("
|
||||
"s2:+i),.4Si=,.0?{.0}{'(s2:-i),.5Si=}_1?{f]4}'(s6:+nan.0),.4Si=,.0?{.0}"
|
||||
"{'(s6:-nan.0),.5Si=}_1?{f]4}'(s6:+inf.0),.4Si=,.0?{.0}{'(s6:-inf.0),.5"
|
||||
"Si=}_1?{f]4}'(c+),.2C=,.0?{.0}{'(c-),.3C=}_1?{.2du?{t]4}'(c.),.3daC=?{"
|
||||
".2ddp?{.2ddaC5~]4}f]4}.2daC5~]4}'(c.),.2C=?{.2dp?{.2daC5~]4}f]4}f]4}.!"
|
||||
"(i21).(i14),.(i22),.(i12),.3,.(i16),&5{%2'(c#),.1C=,.1,l1,.3R1,,#0.5,."
|
||||
"1,:0,:1,:2,:3,:4,&7{%3.0R8,.0?{.0}{${.3,:0^[01}}_1?{.1A9,.0a,.1X3,.5,."
|
||||
"0?{.0}{.2C5,.0?{.0}{'(c+),.4C=,.0?{.0}{'(c-),.5C=,.0?{.0}{'(c.),.6C=}_"
|
||||
"1}_1}_1}_1?{'(s1:.),.1S=?{:2^]6}${.2,.5,.5,.(i10),:1^[04}?{:3^?{.0SfX5"
|
||||
"]6}.0X5]6}'(i10),.1E9,.0?{.0]7}:6,'(y5:port:),.3,'(s54:unsupported num"
|
||||
"ber syntax (implementation restriction)),@(y10:read-error)[74}:3^?{.0S"
|
||||
"fX5]6}.0X5]6}'(c#),.1C=?{:6R0t,.2,.2c,:6R1,:5^[33}${.2,:4^[01}?{:6R0.2"
|
||||
",.2,.2c,:6R1,:5^[33}:6,'(y5:port:),.2,'(s29:unexpected number/symbol c"
|
||||
"har),@(y10:read-error)[34}.!0.0^_1[23}.!(i22)${.(i25),.(i19)^[01},${.2"
|
||||
",.(i15)^[01}~?{.2^u?{.0](i26)}.0,.8^[(i26)1}.(i24),'(y5:port:),.2d,'(s"
|
||||
"17:unexpected token:),@(y10:read-error)[(i26)4",
|
||||
|
||||
"C", 0,
|
||||
"&0{%1f,.1,@(y5:%25read)[12}%x,&0{%0f,Pi,@(y5:%25read)[02}%x,&2{|00|11%"
|
||||
|
|
@ -995,5 +1017,11 @@ char *s_code[] = {
|
|||
"P", "command-line",
|
||||
"%0'0,n,,#0.0,&1{%2.1Z0,.0?{'1,.3I+,.2,.2c,:0^[32}.1A9]3}.!0.0^_1[02",
|
||||
|
||||
"P", "features",
|
||||
"%0'(l4:y4:r7rs;y12:exact-closed;y5:skint;y11:skint-1.0.0;)]0",
|
||||
|
||||
"P", "feature-available?",
|
||||
"%1.0Y0?{${@(y8:features)[00},.1A0]1}f]1",
|
||||
|
||||
0, 0, 0
|
||||
};
|
||||
|
|
|
|||
4
src/k.sf
4
src/k.sf
|
|
@ -63,6 +63,10 @@
|
|||
'record-case-miss]
|
||||
[(record-case id [else exp ...])
|
||||
(begin exp ...)]
|
||||
[(record-case id [(key ...) ids exp ...] clause ...)
|
||||
(if (memq (car id) '(key ...))
|
||||
(apply (lambda ids exp ...) (cdr id))
|
||||
(record-case id clause ...))]
|
||||
[(record-case id [key ids exp ...] clause ...)
|
||||
(if (eq? (car id) 'key)
|
||||
(apply (lambda ids exp ...) (cdr id))
|
||||
|
|
|
|||
55
src/s.scm
55
src/s.scm
|
|
@ -192,7 +192,31 @@
|
|||
(syntax-rules ()
|
||||
[(_ [args . forms] ...) (lambda* [args (lambda args . forms)] ...)]))
|
||||
|
||||
;cond-expand
|
||||
(define-syntax %if-expand
|
||||
(syntax-rules (and or not library)
|
||||
[(_ (and) con alt) con]
|
||||
[(_ (and r) con alt) (%if-expand r con alt)]
|
||||
[(_ (and r . r*) con alt) (%if-expand r (%if-expand (and . r*) con alt) alt)]
|
||||
[(_ (or) con alt) alt]
|
||||
[(_ (or r) con alt) (%if-expand r con alt)]
|
||||
[(_ (or r . r*) con alt) (%if-expand r con (%if-expand (or . r*) con alt))]
|
||||
[(_ (not r) con alt) (%if-expand r alt con)]
|
||||
[(_ (library l) con alt)
|
||||
(if-library-available l con alt)] ; macro defined later in t.scm
|
||||
[(_ (x . y) con alt)
|
||||
(syntax-error "unrecognized cond-expand feature requirement:" (x . y))]
|
||||
[(_ f con alt)
|
||||
(if-feature-available f con alt)])) ; macro defined later in t.scm
|
||||
|
||||
(define-syntax cond-expand
|
||||
(syntax-rules (else)
|
||||
[(_) (void)]
|
||||
[(_ [else . exps])
|
||||
(begin . exps)]
|
||||
[(_ [x] . rest)
|
||||
(%if-expand x (begin) (cond-expand . rest))]
|
||||
[(_ [x . exps] . rest)
|
||||
(%if-expand x (begin . exps) (cond-expand . rest))]))
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -401,6 +425,8 @@
|
|||
; (fixnum->string x (radix 10))
|
||||
; (string->fixnum s (radix 10))
|
||||
|
||||
;TBD:
|
||||
;
|
||||
;fx-width
|
||||
;fx-greatest
|
||||
;fx-least
|
||||
|
|
@ -960,6 +986,8 @@
|
|||
; Bytevectors
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
; integrables:
|
||||
;
|
||||
; (bytevector? x)
|
||||
; (make-bytevector n (u8 0))
|
||||
; (bytevector u8 ...)
|
||||
|
|
@ -1915,11 +1943,16 @@
|
|||
; System interface
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
;load
|
||||
; integrables:
|
||||
;
|
||||
; (file-exists? s)
|
||||
; (delete-file s)
|
||||
; (rename-file sold snew) +
|
||||
; (%argv-ref i) +
|
||||
; (get-environment-variable s)
|
||||
; (current-second)
|
||||
; (current-jiffy)
|
||||
; (jiffies-per-second)
|
||||
|
||||
(define (command-line)
|
||||
(let loop ([r '()] [i 0])
|
||||
|
|
@ -1928,16 +1961,14 @@
|
|||
(loop (cons arg r) (fx+ i 1))
|
||||
(reverse! r)))))
|
||||
|
||||
(define (features) '(r7rs exact-closed skint skint-1.0.0))
|
||||
|
||||
(define (feature-available? f)
|
||||
(and (symbol? f) (memq f (features))))
|
||||
|
||||
;TBD:
|
||||
;
|
||||
;load
|
||||
;exit
|
||||
;emergency-exit
|
||||
|
||||
;(get-environment-variable s)
|
||||
;get-environment-variables
|
||||
|
||||
; (current-second)
|
||||
; (current-jiffy)
|
||||
; (jiffies-per-second)
|
||||
|
||||
;features
|
||||
|
||||
|
||||
|
|
|
|||
103
src/t.scm
103
src/t.scm
|
|
@ -53,6 +53,10 @@
|
|||
'record-case-miss]
|
||||
[(record-case id [else exp ...])
|
||||
(begin exp ...)]
|
||||
[(record-case id [(key ...) ids exp ...] clause ...)
|
||||
(if (memq (car id) '(key ...))
|
||||
(apply (lambda ids exp ...) (cdr id))
|
||||
(record-case id clause ...))]
|
||||
[(record-case id [key ids exp ...] clause ...)
|
||||
(if (eq? (car id) 'key)
|
||||
(apply (lambda ids exp ...) (cdr id))
|
||||
|
|
@ -504,7 +508,7 @@
|
|||
(if (and (pair? xexps) (null? (cdr xexps)))
|
||||
(car xexps) ; (begin x) => x
|
||||
(cons 'begin xexps)))
|
||||
(x-error "improper begin form" (cons 'begin! tail))))
|
||||
(x-error "improper begin form" (cons 'begin tail))))
|
||||
|
||||
(define (xform-define tail env) ; non-internal
|
||||
(cond [(and (list2? tail) (null? (car tail))) ; idless
|
||||
|
|
@ -680,6 +684,32 @@
|
|||
(lambda (bindings) (expand-template pat tmpl bindings))]
|
||||
[else (loop (cdr rules))])))))
|
||||
|
||||
; hand-made transformers (use functionality defined below)
|
||||
|
||||
(define (make-include-transformer ci?)
|
||||
(define begin-id (new-id 'begin (make-location 'begin)))
|
||||
(lambda (sexp env)
|
||||
(if (list1+? sexp)
|
||||
(let loop ([files (cdr sexp)] [exp-lists '()])
|
||||
(if (null? files)
|
||||
(cons begin-id (apply append (reverse! exp-lists)))
|
||||
(call-with-file/lib-sexps (car files) ci? ;=>
|
||||
(lambda (exp-list)
|
||||
(loop (cdr files) (cons exp-list exp-lists))))))
|
||||
(x-error "invalid syntax" sexp))))
|
||||
|
||||
(define (if-feature-available-transformer sexp env)
|
||||
(if (and (list? sexp) (= (length sexp) 4))
|
||||
(let ([r (cadr sexp)] [con (caddr sexp)] [alt (cadddr sexp)])
|
||||
(if (feature-available? (xform-sexp->datum r)) con alt))
|
||||
(x-error "invalid syntax" sexp)))
|
||||
|
||||
(define (if-library-available-transformer sexp env)
|
||||
(if (and (list? sexp) (= (length sexp) 4))
|
||||
(let ([r (cadr sexp)] [con (caddr sexp)] [alt (cadddr sexp)])
|
||||
(if (library-available? (xform-sexp->datum r)) con alt))
|
||||
(x-error "invalid syntax" sexp)))
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; String representation of S-expressions and code arguments
|
||||
|
|
@ -1363,33 +1393,54 @@
|
|||
#f]))))
|
||||
|
||||
|
||||
; make explicit root environment (a vector) from the list of initial transformers
|
||||
; make explicit root environment (a vector) and fill it
|
||||
|
||||
(define *root-environment*
|
||||
(let* ([n 101] ; use prime number
|
||||
[env (make-vector n '())])
|
||||
(define (put! k loc)
|
||||
(let* ([i (immediate-hash k n)] [al (vector-ref env i)] [p (assq k al)])
|
||||
(cond [p (set-car! (cdr p) loc)]
|
||||
[else (vector-set! env i (cons (list k loc #t) al))])))
|
||||
(let loop ([l (initial-transformers)])
|
||||
(if (null? l) env
|
||||
(let ([p (car l)] [l (cdr l)])
|
||||
(let ([k (car p)] [v (cdr p)])
|
||||
(cond
|
||||
[(or (symbol? v) (number? v))
|
||||
(put! k (make-location v))
|
||||
(loop l)]
|
||||
[(and (pair? v) (eq? (car v) 'syntax-rules))
|
||||
(body
|
||||
(define (sr-env id at)
|
||||
(env-lookup id *root-environment* at))
|
||||
(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))))
|
||||
(put! k (make-location sr-v))
|
||||
(loop l))])))))))
|
||||
(make-vector 101 '())) ; use prime number
|
||||
|
||||
(define (define-in-root-environment! name loc imported?)
|
||||
(let* ([env *root-environment*] [n (vector-length env)]
|
||||
[i (immediate-hash name n)] [al (vector-ref env i)]
|
||||
[p (assq name al)])
|
||||
(if p
|
||||
(begin (set-car! (cdr p) loc) (set-car! (cddr p) imported?))
|
||||
(vector-set! env i (cons (list name loc imported?) al)))))
|
||||
|
||||
; put handmade ones first!
|
||||
|
||||
(define-in-root-environment! 'include
|
||||
(make-location (make-include-transformer #f)) #t)
|
||||
|
||||
(define-in-root-environment! 'include-ci
|
||||
(make-location (make-include-transformer #t)) #t)
|
||||
|
||||
(define-in-root-environment! 'if-feature-available
|
||||
(make-location if-feature-available-transformer) #t)
|
||||
|
||||
(define-in-root-environment! 'if-library-available
|
||||
(make-location if-library-available-transformer) #t)
|
||||
|
||||
; now put the builtins (lazily) and others
|
||||
|
||||
(let ([put! (lambda (k loc) (define-in-root-environment! k loc #t))])
|
||||
(let loop ([l (initial-transformers)])
|
||||
(if (null? l) 'ok
|
||||
(let ([p (car l)] [l (cdr l)])
|
||||
(let ([k (car p)] [v (cdr p)])
|
||||
(cond
|
||||
[(or (symbol? v) (number? v))
|
||||
(put! k (make-location v))
|
||||
(loop l)]
|
||||
[(and (pair? v) (eq? (car v) 'syntax-rules))
|
||||
(body
|
||||
(define (sr-env id at)
|
||||
(env-lookup id *root-environment* at))
|
||||
(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))))
|
||||
(put! k (make-location sr-v))
|
||||
(loop l))]))))))
|
||||
|
||||
(define (root-environment id at)
|
||||
(env-lookup id *root-environment* at))
|
||||
|
|
|
|||
72
t.c
72
t.c
|
|
@ -20,15 +20,18 @@ char *t_code[] = {
|
|||
"ct)[02},.1ac]2}.1,.1d,@(y13:set-intersect)[22",
|
||||
|
||||
"S", "record-case",
|
||||
"l6:y12:syntax-rules;l1:y4:else;;l2:l4:y11:record-case;py2:pa;y2:ir;;y6"
|
||||
"l7:y12:syntax-rules;l1:y4:else;;l2:l4:y11:record-case;py2:pa;y2:ir;;y6"
|
||||
":clause;y3:...;;l3:y3:let;l1:l2:y2:id;py2:pa;y2:ir;;;;l4:y11:record-ca"
|
||||
"se;y2:id;y6:clause;y3:...;;;;l2:l2:y11:record-case;y2:id;;l2:y5:quote;"
|
||||
"y16:record-case-miss;;;l2:l3:y11:record-case;y2:id;l3:y4:else;y3:exp;y"
|
||||
"3:...;;;l3:y5:begin;y3:exp;y3:...;;;l2:l5:y11:record-case;y2:id;l4:y3:"
|
||||
"key;y3:ids;y3:exp;y3:...;;y6:clause;y3:...;;l4:y2:if;l3:y3:eq?;l2:y3:c"
|
||||
"ar;y2:id;;l2:y5:quote;y3:key;;;l3:y5:apply;l4:y6:lambda;y3:ids;y3:exp;"
|
||||
"y3:...;;l2:y3:cdr;y2:id;;;l4:y11:record-case;y2:id;y6:clause;y3:...;;;"
|
||||
";",
|
||||
"3:...;;;l3:y5:begin;y3:exp;y3:...;;;l2:l5:y11:record-case;y2:id;l4:l2:"
|
||||
"y3:key;y3:...;;y3:ids;y3:exp;y3:...;;y6:clause;y3:...;;l4:y2:if;l3:y4:"
|
||||
"memq;l2:y3:car;y2:id;;l2:y5:quote;l2:y3:key;y3:...;;;;l3:y5:apply;l4:y"
|
||||
"6:lambda;y3:ids;y3:exp;y3:...;;l2:y3:cdr;y2:id;;;l4:y11:record-case;y2"
|
||||
":id;y6:clause;y3:...;;;;l2:l5:y11:record-case;y2:id;l4:y3:key;y3:ids;y"
|
||||
"3:exp;y3:...;;y6:clause;y3:...;;l4:y2:if;l3:y3:eq?;l2:y3:car;y2:id;;l2"
|
||||
":y5:quote;y3:key;;;l3:y5:apply;l4:y6:lambda;y3:ids;y3:exp;y3:...;;l2:y"
|
||||
"3:cdr;y2:id;;;l4:y11:record-case;y2:id;y6:clause;y3:...;;;;",
|
||||
|
||||
"P", "sexp-match?",
|
||||
"%2'(y1:*),.1q,.0?{.0]3}'(y8:<symbol>),.2q?{.2Y0}{f},.0?{.0]4}'(y8:<str"
|
||||
|
|
@ -284,8 +287,8 @@ char *t_code[] = {
|
|||
|
||||
"P", "xform-begin",
|
||||
"%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0p?{.0"
|
||||
"du}{f}?{.0a]3}.0,'(y5:begin)c]3}.0,'(y6:begin!)c,'(s19:improper begin "
|
||||
"form),@(y7:x-error)[22",
|
||||
"du}{f}?{.0a]3}.0,'(y5:begin)c]3}.0,'(y5:begin)c,'(s19:improper begin f"
|
||||
"orm),@(y7:x-error)[22",
|
||||
|
||||
"P", "xform-define",
|
||||
"%2${.2,@(y6:list2?)[01}?{.0au}{f}?{.1,.1da,f,@(y5:xform)[23}${.2,@(y6:"
|
||||
|
|
@ -357,6 +360,23 @@ char *t_code[] = {
|
|||
"0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1["
|
||||
"21}](i12)",
|
||||
|
||||
"P", "make-include-transformer",
|
||||
"%1,#0${'(y5:begin)b,'(y5:begin),@(y6:new-id)[02}.!0.1,.1,&2{%2${.2,@(y"
|
||||
"7:list1+?)[01}?{n,.1d,,#0.0,:1,:0,&3{%2.0u?{${.3A9,@(y7:%25append),@(y"
|
||||
"13:apply-to-list)[02},:0^c]2}.1,.1,:2,&3{%1:2,.1c,:1d,:0^[12},:1,.2a,@"
|
||||
"(y24:call-with-file/lib-sexps)[23}.!0.0^_1[22}.0,'(s14:invalid syntax)"
|
||||
",@(y7:x-error)[22}]2",
|
||||
|
||||
"P", "if-feature-available-transformer",
|
||||
"%2.0L0?{'4,.1g=}{f}?{.0ddda,.1dda,.2da,${${.4,@(y17:xform-sexp->datum)"
|
||||
"[01},@(y18:feature-available?)[01}?{.1]5}.2]5}.0,'(s14:invalid syntax)"
|
||||
",@(y7:x-error)[22",
|
||||
|
||||
"P", "if-library-available-transformer",
|
||||
"%2.0L0?{'4,.1g=}{f}?{.0ddda,.1dda,.2da,${${.4,@(y17:xform-sexp->datum)"
|
||||
"[01},@(y18:library-available?)[01}?{.1]5}.2]5}.0,'(s14:invalid syntax)"
|
||||
",@(y7:x-error)[22",
|
||||
|
||||
"P", "write-serialized-char",
|
||||
"%2'(c%25),.1C=,.0?{.0}{'(c%22),.2C=,.0?{.0}{'(c%5c),.3C=,.0?{.0}{'(c )"
|
||||
",.4C<,.0?{.0}{'(c~),.5C>}_1}_1}_1}_1?{.1,'(c%25)W0'(i16),.1X8X6,'1,.1S"
|
||||
|
|
@ -703,13 +723,35 @@ char *t_code[] = {
|
|||
"K0?{:1,:2,.2[12}f]1}.!0.0^_1[31",
|
||||
|
||||
"C", 0,
|
||||
"'(i101),n,.1V2,,#0.2,.2,&2{%2:1,.1H2,.0,:0V4,.0,.3A3,.0?{.4,.1dsa]5}.1"
|
||||
",t,.6,.6,l3c,.3,:0V5]5}.!0${U1,,#0.0,.5,.7,&3{%1.0u?{:0]1}.0d,.1a,.0d,"
|
||||
".1a,.1Y0,.0?{.0}{.2N0}_1?{${.3b,.3,:1^[02}.3,:2^[51}.1p?{'(y12:syntax-"
|
||||
"rules),.2aq}{f}?{,,#0#1&0{%2.1,@(y18:*root-environment*),.2,@(y10:env-"
|
||||
"lookup)[23}.!0${.5da,@(y3:id?)[01}?{${.5ddd,.6dda,.7da,.5^,@(y13:synta"
|
||||
"x-rules*)[04}}{${.5dd,.6da,f,.5^,@(y13:syntax-rules*)[04}}.!1${.3^b,.5"
|
||||
",:1^[02}.5,:2^[71}f]5}.!0.0^_1[01}_1_1_1@!(y18:*root-environment*)",
|
||||
"n,'(i101)V2@!(y18:*root-environment*)",
|
||||
|
||||
"P", "define-in-root-environment!",
|
||||
"%3@(y18:*root-environment*),.0V3,.0,.3H2,.0,.3V4,.0,.5A3,.0?{.6,.1dsa."
|
||||
"7,.1ddsa]8}.1,.8,.8,.8,l3c,.3,.6V5]8",
|
||||
|
||||
"C", 0,
|
||||
"${t,${f,@(y24:make-include-transformer)[01}b,'(y7:include),@(y27:defin"
|
||||
"e-in-root-environment!)[03}",
|
||||
|
||||
"C", 0,
|
||||
"${t,${t,@(y24:make-include-transformer)[01}b,'(y10:include-ci),@(y27:d"
|
||||
"efine-in-root-environment!)[03}",
|
||||
|
||||
"C", 0,
|
||||
"${t,@(y32:if-feature-available-transformer)b,'(y20:if-feature-availabl"
|
||||
"e),@(y27:define-in-root-environment!)[03}",
|
||||
|
||||
"C", 0,
|
||||
"${t,@(y32:if-library-available-transformer)b,'(y20:if-library-availabl"
|
||||
"e),@(y27:define-in-root-environment!)[03}",
|
||||
|
||||
"C", 0,
|
||||
"&0{%2t,.2,.2,@(y27:define-in-root-environment!)[23},${U1,,#0.0,.5,&2{%"
|
||||
"1.0u?{'(y2:ok)]1}.0d,.1a,.0d,.1a,.1Y0,.0?{.0}{.2N0}_1?{${.3b,.3,:0[02}"
|
||||
".3,:1^[51}.1p?{'(y12:syntax-rules),.2aq}{f}?{,,#0#1&0{%2.1,@(y18:*root"
|
||||
"-environment*),.2,@(y10:env-lookup)[23}.!0${.5da,@(y3:id?)[01}?{${.5dd"
|
||||
"d,.6dda,.7da,.5^,@(y13:syntax-rules*)[04}}{${.5dd,.6da,f,.5^,@(y13:syn"
|
||||
"tax-rules*)[04}}.!1${.3^b,.5,:0[02}.5,:1^[71}f]5}.!0.0^_1[01}_1",
|
||||
|
||||
"P", "root-environment",
|
||||
"%2.1,@(y18:*root-environment*),.2,@(y10:env-lookup)[23",
|
||||
|
|
|
|||
Loading…
Reference in a new issue