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