diff --git a/s.c b/s.c index 51165ba..98c20aa 100644 --- a/s.c +++ b/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?^_~0123456789+-.@),.1S8]1}.!(i12)&0{%1.0X8,'(i48),." - "1!}{f},.0?{.0]3}'(i65),.2!}{f},.0?{.0]4}'(" - "i97),.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" + "?^_~0123" + "456789+-.@),.1S8]1}.!(i12)&0{%1.0X8,'(i48),.1!}{f},.0?{." + "0]3}'(i65),.2!}{f},.0?{.0]4}'(i97),.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 }; diff --git a/src/k.sf b/src/k.sf index eec3352..9981e1d 100644 --- a/src/k.sf +++ b/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)) diff --git a/src/s.scm b/src/s.scm index 2aa3ca9..85bc620 100644 --- a/src/s.scm +++ b/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 - - diff --git a/src/t.scm b/src/t.scm index bfefcbf..fec3cd7 100644 --- a/src/t.scm +++ b/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)) diff --git a/t.c b/t.c index d277105..f9ac7b4 100644 --- a/t.c +++ b/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:),.2q?{.2Y0}{f},.0?{.0]4}'(y8: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",