diff --git a/i.c b/i.c index 8cdf02b..18ac7db 100644 --- a/i.c +++ b/i.c @@ -3240,6 +3240,22 @@ define_instruction(fop) { gonexti(); } +define_instruction(pfc) { + ckr(ac); + /* port-fold-case NYI: return false for now */ + ac = bool_obj(0); + gonexti(); +} + +define_instruction(spfc) { + ckr(ac); + if (spop() != bool_obj(0)) { + /* set-port-fold-case! NYI: ignore for now */ + } + gonexti(); +} + + define_instruction(gos) { cxtype_oport_t *vt; ckw(ac); vt = ckoportvt(ac); diff --git a/i.h b/i.h index cf5ad88..9957fba 100644 --- a/i.h +++ b/i.h @@ -492,6 +492,8 @@ declare_instruction(oob, "P53", 0, "open-output-bytevector", declare_instruction(cip, "P60", 0, "close-input-port", '1', AUTOGL) declare_instruction(cop, "P61", 0, "close-output-port", '1', AUTOGL) declare_instruction(fop, "P71", 0, "flush-output-port", '1', AUTOGL) +declare_instruction(pfc, "P78", 0, "port-fold-case?", '1', AUTOGL) +declare_instruction(spfc, "P79", 0, "set-port-fold-case!", '2', AUTOGL) declare_instruction(gos, "P90", 0, "get-output-string", '1', AUTOGL) declare_instruction(gob, "P91", 0, "get-output-bytevector", '1', AUTOGL) declare_instruction(rdc, "R0\0Pi", 0, "read-char", 'u', AUTOGL) diff --git a/s.c b/s.c index e36885e..51165ba 100644 --- a/s.c +++ b/s.c @@ -846,123 +846,125 @@ char *s_code[] = { "tevector)[12}%x,&2{|10|21%%}@!(y15:read-bytevector)", "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)n.!0&0{%1.0,&1{%0:0z]0}]" - "1}.!1&0{%1.0K0]1}.!2.3,&1{%1.0K0?{${.2[00},:0^[11}.0]1}.!3.4,.4,&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}.!(i11)&" - "0{%1.0X8,'(i48),.1!}{f},.0?{.0]3}'(i65),.2" - "!}{f},.0?{.0]4}'(i97),.3!]4}f]4}.!(i12)&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}.!(i13).(i15),.(i11),&" - "2{%1${.2,:1^[01},.0R8?{.1,'(y5:port:),'(s22:unexpected end of file),@(" - "y10:read-error)[23}${.2,:0^[01}?{.1,'(y5:port:),.2d,'(s17:unexpected t" - "oken:),@(y10:read-error)[24}.0]2}.!(i14).8,.(i12),.(i20),.(i24),.(i19)" - ",.(i12),.(i22),.(i24),.(i27),.(i22),.(i12),.(i25),.(i13),.(i13),.(i37)" - ",&(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,:(i14)^,.3,.3,:8^[24}'(c]),.1C=" - "?{:(i14)^]2}'(c'),.1C=?{${.3,:3^[01},'(y5:quote),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-error)[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:e" - "nd 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,.1" - "c,: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:end of file after #),@(y10:read-error)[33}'(ct),.1Ci=," - ".0?{.0}{'(cf),.2Ci=}_1?{${.4,:3^[01},.0,'(l2: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),.6C" - "i=}_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:),'(s" - "25:invalid bytevector syntax),@(y10:read-error)[33}'(c%5c),.1C=?{.2R0." - "2R1,.0R8?{.3,'(y5:port:),'(s20:end of file after #%5c),@(y10:read-erro" - "r)[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:delet" - "e),.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:po" - "rt:),.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 notation),@(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= referen" - "ce:),'(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 tar" - "get),'(y5:port:),.5,@(y10:read-error)[63}.0,.2sz.0]6}:5,'(y5:port:),'(" - "s34:invalid terminator 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,'(s22:illegal character read),@(y10:read-error)[24}.!(i1" - "5).(i15),.(i11),.(i16),.(i12),&4{%4${.3,:3^[01},:0^,.1q?{.2,'(y5:port:" - "),'(s42:missing car -- ( immediately followed by .),@(y10:read-error)[" - "53}.0,,#0.0,.5,:3,:2,.(i10),:1,.(i11),:0,&8{%1.0R8?{:6,'(y5:port:),'(s" - "41:eof inside list -- 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:p" - "ort:),.2,'(s31:randomness after form after dot),@(y10:read-error)[34}:" - "6,'(y5:port:),'(s13:dot in #(...)),@(y10:read-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}.!(i16).(i15),.8,.(i12),&3{%1${" - ".2,:2^[01},,#0.0,.3,:2,:0,:1,&5{%1.0R8?{:3,'(y5:port:),'(s21:eof insid" - "e 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:read-error)[14}${${:3,:2^[01}" - ",:4^[01},.1c]1}.!0.0^_1[11}.!(i17).(i19),&1{%2.0R0,.0R8?{${.3,'(y5:por" - "t:),.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%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 newli" - "ne 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}.!" - "(i18).(i13),.(i13),&2{%2,#0.1,&1{%1.0u?{:0,'(y5:port:),'(s31:%5cx esca" - "pe sequence is too 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 within 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)[34}'2,.3>?{:4,'(y5:port:),'(s30:%5cx escape sequence i" - "s too long),@(y10:read-error)[33}:4R0'1,.3+,.2,.2c,:4R1,:5^[33}.!0.0^_" - "1[33}.!(i19)&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),.5Si=}_1?{f]4}'(c+),.2C=,.0?{" - ".0}{'(c-),.3C=}_1?{.2du?{t]4}'(c.),.3daC=?{.2ddp?{.2ddaC5~]4}f]4}.2daC" - "5~]4}'(c.),.2C=?{.2dp?{.2daC5~]4}f]4}f]4}.!(i20).(i13),.(i21),.(i11),." - "(i14),&4{%2'(c#),.1C=,.1,l1,.3R1,,#0.5,.1,:0,:1,:2,:3,&6{%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}?{.0X5]6}'(i10),.1E9,.0?{.0]7}:5,'(y5:port:),." - "3,'(s54:unsupported number syntax (implementation restriction)),@(y10:" - "read-error)[74}.0X5]6}'(c#),.1C=?{:5R0t,.2,.2c,:5R1,:4^[33}${.2,:3^[01" - "}?{:5R0.2,.2,.2c,:5R1,:4^[33}:5,'(y5:port:),.2,'(s29:unexpected number" - "/symbol char),@(y10:read-error)[34}.!0.0^_1[23}.!(i21)${.(i24),.(i18)^" - "[01},${.2,.(i14)^[01}~?{.1^u?{.0](i25)}.0,.7^[(i25)1}.(i23),'(y5:port:" - "),.2d,'(s17:unexpected token:),@(y10:read-error)[(i25)4", + "%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", "C", 0, "&0{%1f,.1,@(y5:%25read)[12}%x,&0{%0f,Pi,@(y5:%25read)[02}%x,&2{|00|11%" diff --git a/src/s.scm b/src/s.scm index 439b7e4..2aa3ca9 100644 --- a/src/s.scm +++ b/src/s.scm @@ -1534,7 +1534,7 @@ (define (%read port simple?) (define-syntax r-error (syntax-rules () [(_ p msg a ...) (read-error msg a ... 'port: p)])) - + (define fold-case? (port-fold-case? port)) (define shared '()) (define (make-shared-ref loc) (lambda () (unbox loc))) (define (shared-ref? form) (procedure? form)) @@ -1839,10 +1839,15 @@ (if (or hash? (char-numeric? c) (char=? c #\+) (char=? c #\-) (char=? c #\.)) (cond [(string=? s ".") dot] - [(suspect-number-or-symbol-peculiar? hash? c l s) (string->symbol s)] + [(suspect-number-or-symbol-peculiar? hash? c l s) + (if fold-case? + (string->symbol (string-foldcase s)) + (string->symbol s))] [(string->number s)] [else (r-error p "unsupported number syntax (implementation restriction)" s)]) - (string->symbol s)))] + (if fold-case? + (string->symbol (string-foldcase s)) + (string->symbol s))))] [(char=? c #\#) (read-char p) (loop (peek-char p) (cons c l) #t)] diff --git a/src/t.scm b/src/t.scm index b53ea1b..381a150 100644 --- a/src/t.scm +++ b/src/t.scm @@ -58,30 +58,46 @@ (apply (lambda ids exp ...) (cdr id)) (record-case id clause ...))])) -(define syntax-match? - (lambda (pat exp) - (or (eq? pat '*) - (equal? exp pat) - (and (pair? pat) - (cond - [(and (eq? (car pat) '$) - (pair? (cdr pat)) - (null? (cddr pat))) - (eq? exp (cadr pat))] - [(and (pair? (cdr pat)) - (eq? (cadr pat) '...) - (null? (cddr pat))) - (let ([pat (car pat)]) - (define (f lst) - (or (null? lst) - (and (pair? lst) - (syntax-match? pat (car lst)) - (f (cdr lst))))) - (f exp))] - [else - (and (pair? exp) - (syntax-match? (car pat) (car exp)) - (syntax-match? (cdr pat) (cdr exp)))]))))) +(define (sexp-match? pat x) + (or (eq? pat '*) + (and (eq? pat ') (symbol? x)) + (and (eq? pat ') (string? x)) + (eq? x pat) + (and (pair? pat) + (cond [(and (eq? (car pat) '...) + (pair? (cdr pat)) + (null? (cddr pat))) + (eq? x (cadr pat))] + [(and (pair? (cdr pat)) + (eq? (cadr pat) '...) + (null? (cddr pat))) + (let ([pat (car pat)]) + (if (eq? pat '*) + (list? x) + (let loop ([lst x]) + (or (null? lst) + (and (pair? lst) + (sexp-match? pat (car lst)) + (loop (cdr lst)))))))] + [else + (and (pair? x) + (sexp-match? (car pat) (car x)) + (sexp-match? (cdr pat) (cdr x)))])))) + +(define-syntax sexp-case + (syntax-rules (else) + [(_ (key ...) clauses ...) + (let ([atom-key (key ...)]) + (sexp-case atom-key clauses ...))] + [(_ key (else result1 result2 ...)) + (begin result1 result2 ...)] + [(_ key (pat result1 result2 ...)) + (if (sexp-match? 'pat key) + (begin result1 result2 ...))] + [(_ key (pat result1 result2 ...) clause clauses ...) + (if (sexp-match? 'pat key) + (begin result1 result2 ...) + (sexp-case key clause clauses ...))])) ; unique symbol generator (poor man's version) (define gensym @@ -115,6 +131,14 @@ (if (null? rest) x (cons x (loop (car rest) (cdr rest)))))) +(define (append* lst) + (cond [(null? lst) '()] + [(null? (cdr lst)) (car lst)] + [else (append (car lst) (append* (cdr lst)))])) + +(define (string-append* l) + (apply string-append l)) + (define (andmap p l) (if (pair? l) (and (p (car l)) (andmap p (cdr l))) #t)) @@ -123,9 +147,16 @@ (define (list2? x) (and (pair? x) (list1? (cdr x)))) (define (list2+? x) (and (pair? x) (list1+? (cdr x)))) +(define (read-code-sexp port) + ; for now, we will just use read with no support for circular structures + (read-simple port)) + (define (error* msg args) (raise (error-object #f msg args))) +(define (warning* msg args) + (print-error-message (string-append "Warning: " msg) args (current-error-port))) + ;--------------------------------------------------------------------------------------------- ; Syntax of the Scheme Core language @@ -738,6 +769,9 @@ (define (c-error msg . args) (error* (string-append "compiler: " msg) args)) +(define (c-warning msg . args) + (warning* (string-append "compiler: " msg) args)) + (define find-free* (lambda (x* b) (if (null? x*) @@ -1115,23 +1149,182 @@ ;--------------------------------------------------------------------------------------------- -; Code deserialization and execution +; Path and file name resolution ;--------------------------------------------------------------------------------------------- -;(define (execute-thunk-closure t) (t)) +(define (path-strip-directory filename) + (let loop ([l (reverse (string->list filename))] [r '()]) + (cond [(null? l) (list->string r)] + [(memv (car l) '(#\\ #\/ #\:)) (list->string r)] + [else (loop (cdr l) (cons (car l) r))]))) -; (define (make-closure code) ...) -- need builtin? +(define (path-directory filename) + (let loop ([l (reverse (string->list filename))]) + (cond [(null? l) ""] + [(memv (car l) '(#\\ #\/ #\:)) (list->string (reverse l))] + [else (loop (cdr l))]))) -;(define execute -; (lambda (code) -; (execute-thunk-closure (make-closure code)))) +(define (path-strip-extension filename) ;; improved + (let loop ([l (reverse (string->list filename))]) + (cond [(null? l) filename] + [(eqv? (car l) #\.) (list->string (reverse (cdr l)))] + [(memv (car l) '(#\\ #\/ #\:)) filename] + [else (loop (cdr l))]))) -;(define decode-sexp deserialize-sexp) +#;(define (path-extension filename) + (let loop ([l (reverse (string->list filename))] [r '()]) + (cond [(null? l) ""] + [(memv (car l) '(#\\ #\/ #\:)) ""] + [(eqv? (car l) #\.) (list->string (cons #\. r))] + [else (loop (cdr l) (cons (car l) r))]))) -;(define decode deserialize-code) +(define (base-path-separator basepath) + (let ([l (reverse (string->list basepath))]) + (cond [(null? l) #f] + [(memv (car l) '(#\\ #\/)) (car l)] + [else #f]))) -;(define (evaluate x) -; (execute (decode (compile-to-string (transform #f x))))) +(define (path-relative? filename) + (let ([l (string->list filename)]) + (cond [(null? l) #f] + [(memv (car l) '(#\\ #\/)) #f] + [(and (> (length l) 3) (char-alphabetic? (car l)) (eqv? (cadr l) #\:) (eqv? (caddr l) #\\)) #f] + [else #t]))) + +(define (file-resolve-relative-to-base-path filename basepath) + (if (and (path-relative? filename) (base-path-separator basepath)) + (string-append basepath filename) ; leading . and .. to be resolved by OS + filename)) + +; hacks for relative file name resolution + +(define *current-file-stack* '()) + +(define (current-file) ;=> filename of #f + (and (pair? *current-file-stack*) (car *current-file-stack*))) + +(define (with-current-file filename thunk) + (dynamic-wind + (lambda () (set! *current-file-stack* (cons filename *current-file-stack*))) + thunk + (lambda () (set! *current-file-stack* (cdr *current-file-stack*))))) + +(define (file-resolve-relative-to-current filename) ; => resolved or original filename + (if (path-relative? filename) + (let ([cf (current-file)]) + (if cf (file-resolve-relative-to-base-path filename (path-directory cf)) filename)) + filename)) + + +;--------------------------------------------------------------------------------------------- +; Library names and library file lookup +;--------------------------------------------------------------------------------------------- + +(define (listname-segment->string s) + (cond [(symbol? s) (symbol->string s)] + [(number? s) (number->string s)] + [(string? s) s] + [else (c-error "invalid symbolic file name element" s)])) + +(define modname-separator "_") + +(define (listname->modname listname) + (define sep modname-separator) + (let loop ([l listname] [r '()]) + (if (pair? l) + (loop (cdr l) + (if (null? r) + (cons (listname-segment->string (car l)) r) + (cons (listname-segment->string (car l)) (cons sep r)))) + (string-append* (reverse r))))) + +(define (listname->path listname basepath ext) + (define sep + (let ([sc (base-path-separator basepath)]) + (if sc (string sc) (c-error "library path does not end in separator" basepath)))) + (let loop ([l listname] [r '()]) + (if (pair? l) + (loop (cdr l) + (if (null? r) + (cons (listname-segment->string (car l)) r) + (cons (listname-segment->string (car l)) (cons sep r)))) + (file-resolve-relative-to-base-path (string-append* (reverse (cons ext r))) basepath)))) + + +; hacks for locating library files + +(define *library-path-list* '()) + +(define (add-library-path! path) + (if (base-path-separator path) + (set! *library-path-list* (append *library-path-list* (list path))) + (c-error "library path should end in directory separator" path))) + +(define (find-library-path libname) ;=> name of existing .sld file or #f + (let loop ([l *library-path-list*]) + (if (null? l) + #f + (let ([p (listname->path libname (car l) ".sld")]) + (if (and p (file-exists? p)) p (loop (cdr l))))))) + +(define (resolve-input-file/lib-name name) ;=> path (or error is signalled) + (define filepath + (if (string? name) + (file-resolve-relative-to-current name) + (find-library-path name))) + (if (not filepath) + (if (string? name) + (c-error "cannot resolve file name to a file:" name) + (c-error "cannot resolve library name to a file:" name 'in *library-path-list*))) + (if (not (file-exists? filepath)) + (c-error "cannot resolve file or library name to an existing file:" name '=> filepath)) + filepath) + +(define (call-with-input-file/lib name ci? proc) ;=> (proc filepath port), called while name is current-file + (let ([filepath (resolve-input-file/lib-name name)]) + (with-current-file filepath + (lambda () + (call-with-input-file filepath + (lambda (port) + (when ci? (set-port-fold-case! port #t)) + (proc filepath port))))))) + +(define (call-with-file/lib-sexps name ci? proc) ;=> (proc sexps), called while name is current-file + (call-with-input-file/lib name ci? ;=> + (lambda (filepath port) + (let loop ([sexps '()]) + (let ([s (read-code-sexp port)]) + (if (eof-object? s) + (proc (reverse! sexps)) + (loop (cons s sexps)))))))) + +(define (for-each-file/lib-sexp proc name ci?) ; proc called while name is current-file + (call-with-input-file/lib name ci? ;=> + (lambda (filepath port) + (let loop () + (let ([s (read-code-sexp port)]) + (unless (eof-object? s) (proc s) (loop))))))) + +(define (file/lib->modname name) + (cond [(and (pair? name) (list? name)) (listname->modname name)] + [(string? name) (path-strip-extension (path-strip-directory name))] + [else (c-error "illegal file or library name:" name)])) + +(define (file/lib/stdin->modname name) + (if (and (string? name) (string=? name "-")) + "stdin" + (file/lib->modname name))) + +; name prefixes + +(define (fully-qualified-prefix modname) + (string-append modname ".")) + +(define (fully-qualified-library-prefix lib) + (fully-qualified-prefix (file/lib->modname lib))) + +(define (fully-qualified-library-prefixed-name lib id) + (string-append (file/lib->modname lib) "." (symbol->string id))) ;--------------------------------------------------------------------------------------------- @@ -1197,7 +1390,7 @@ (env-lookup id *root-environment* at)) -; standard library environments +; standard library environments in sexp form (define *std-lib->env* '()) @@ -1205,29 +1398,18 @@ (lambda (r) (define (key->lib k) (case k - [(w) '(scheme write)] - [(t) '(scheme time)] - [(p) '(scheme repl)] - [(r) '(scheme read)] - [(v) '(scheme r5rs)] - [(u) '(scheme r5rs-null)] - [(s) '(scheme process-context)] - [(d) '(scheme load)] - [(z) '(scheme lazy)] - [(i) '(scheme inexact)] - [(f) '(scheme file)] - [(e) '(scheme eval)] - [(x) '(scheme cxr)] - [(o) '(scheme complex)] - [(h) '(scheme char)] - [(l) '(scheme case-lambda)] - [(b) '(scheme base)])) + [(w) '(scheme write)] [(t) '(scheme time)] [(p) '(scheme repl)] + [(r) '(scheme read)] [(v) '(scheme r5rs)] [(u) '(scheme r5rs-null)] + [(d) '(scheme load)] [(z) '(scheme lazy)] [(s) '(scheme process-context)] + [(i) '(scheme inexact)] [(f) '(scheme file)] [(e) '(scheme eval)] + [(o) '(scheme complex)] [(h) '(scheme char)] [(l) '(scheme case-lambda)] + [(x) '(scheme cxr)] [(b) '(scheme base)])) (define (put-loc! env k loc) (let* ([n (vector-length env)] [i (immediate-hash k n)] [al (vector-ref env i)] [p (assq k al)]) (cond [p (set-cdr! p loc)] [else (vector-set! env i (cons (cons k loc) al))]))) - (define (get-env-vec! lib) + (define (get-env! lib) (cond [(assoc lib *std-lib->env*) => cdr] [else (let* ([n (if (eq? lib '(skint repl)) 101 37)] ; use prime number @@ -1237,112 +1419,72 @@ (let loop ([name (car r)] [keys (cdr r)]) (cond [(null? keys) - (put-loc! (get-env-vec! '(skint repl)) name (root-environment name 'ref))] + (put-loc! (get-env! '(skint repl)) name (root-environment name 'ref))] [else - (put-loc! (get-env-vec! (key->lib (car keys))) name (root-environment name 'ref)) + (put-loc! (get-env! (key->lib (car keys))) name (root-environment name 'ref)) (loop name (cdr keys))]))) - '((* v b) (+ v b) (- v b) (... v u b) (/ v b) (< v b) - (<= v b) (= v b) (=> v u b) (> v b) (>= v b) (_ b) (abs v b) - (and v u b) (append v b) (apply v b) (assoc v b) (assq v b) - (assv v b) (begin v u b) (binary-port? b) (boolean=? b) - (boolean? v b) (bytevector b) (bytevector-append b) - (bytevector-copy b) (bytevector-copy! b) - (bytevector-length b) (bytevector-u8-ref b) - (bytevector-u8-set! b) (bytevector? b) (caar v b) (cadr v b) - (call-with-current-continuation v b) (call-with-port b) - (call-with-values v b) (call/cc b) (car v b) (case v u b) - (cdar v b) (cddr v b) (cdr v b) (ceiling v b) - (char->integer v b) (char-ready? v b) (char<=? v b) - (char=? v b) (char>? v b) - (char? b) (close-input-port v b) (close-output-port v b) - (close-port b) (complex? v b) (cond v u b) (cond-expand b) - (cons v b) (current-error-port b) (current-input-port v b) - (current-output-port v b) (define v u b) - (define-record-type b) (define-syntax v u b) - (define-values b) (denominator v b) (do v u b) - (dynamic-wind v b) (else v u b) (eof-object b) - (eof-object? v b) (eq? v b) (equal? v b) (eqv? v b) - (error b) (error-object-irritants b) - (error-object-message b) (error-object? b) (even? v b) - (exact b) (exact-integer-sqrt b) (exact-integer? b) - (exact? v b) (expt v b) (features b) (file-error? b) - (floor v b) (floor-quotient b) (floor-remainder b) - (floor/ b) (flush-output-port b) (for-each v b) (gcd v b) - (get-output-bytevector b) (get-output-string b) (guard b) - (if v u b) (include b) (include-ci b) (inexact b) - (inexact? v b) (input-port-open? b) (input-port? v b) - (integer->char v b) (integer? v b) (lambda v u b) (lcm v b) - (length v b) (let v u b) (let* v u b) (let*-values b) - (let-syntax v u b) (let-values b) (letrec v u b) (letrec* b) - (letrec-syntax v u b) (list v b) (list->string v b) - (list->vector v b) (list-copy b) (list-ref v b) - (list-set! b) (list-tail v b) (list? v b) - (make-bytevector b) (make-list b) (make-parameter b) - (make-string v b) (make-vector v b) (map v b) (max v b) - (member v b) (memq v b) (memv v b) (min v b) (modulo v b) - (negative? v b) (newline v b) (not v b) (null? v b) - (number->string v b) (number? v b) (numerator v b) - (odd? v b) (open-input-bytevector b) (open-input-string b) - (open-output-bytevector b) (open-output-string b) (or v u b) - (output-port-open? b) (output-port? v b) (pair? v b) - (parameterize b) (peek-char v b) (peek-u8 b) (port? b) - (positive? v b) (procedure? v b) (quasiquote v u b) - (quote v u b) (quotient v b) (raise b) (raise-continuable b) - (rational? v b) (rationalize v b) (read-bytevector b) - (read-bytevector! b) (read-char v b) (read-error? b) - (read-line b) (read-string b) (read-u8 b) (real? v b) - (remainder v b) (reverse v b) (round v b) (set! v b) - (set-car! v b) (set-cdr! v b) (square b) (string v b) - (string->list v b) (string->number v b) (string->symbol v b) - (string->utf8 b) (string->vector b) (string-append v b) - (string-copy v b) (string-copy! b) (string-fill! v b) - (string-for-each b) (string-length v b) (string-map b) - (string-ref v b) (string-set! v b) (string<=? v b) - (string=? v b) (string>? v b) - (string? v b) (substring v b) (symbol->string v b) - (symbol=? b) (symbol? v b) (syntax-error b) - (syntax-rules v u b) (textual-port? b) (truncate v b) - (truncate-quotient b) (truncate-remainder b) (truncate/ b) - (u8-ready? b) (unless b) (unquote v u b) - (unquote-splicing v u b) (utf8->string b) (values v b) - (vector v b) (vector->list v b) (vector->string b) - (vector-append b) (vector-copy b) (vector-copy! b) - (vector-fill! v b) (vector-for-each b) (vector-length v b) - (vector-map b) (vector-ref v b) (vector-set! v b) - (vector? v b) (when b) (with-exception-handler b) - (write-bytevector b) (write-char v b) (write-string b) - (write-u8 b) (zero? v b) (case-lambda l) - (char-alphabetic? v h) (char-ci<=? v h) (char-ci=? v h) (char-ci>? v h) - (char-downcase v h) (char-foldcase h) (char-lower-case? v h) - (char-numeric? v h) (char-upcase v h) (char-upper-case? v h) - (char-whitespace? v h) (digit-value h) (string-ci<=? v h) - (string-ci=? v h) - (string-ci>? v h) (string-downcase h) (string-foldcase h) - (string-upcase h) (angle v o) (imag-part v o) - (magnitude v o) (make-polar v o) (make-rectangular v o) - (real-part v o) (caaar v x) (caadr v x) (cadar v x) - (caddr v x) (cdaar v x) (cdadr v x) (cddar v x) (cdddr v x) - (caaaar v x) (caaadr v x) (caadar v x) (caaddr v x) - (cadaar v x) (cadadr v x) (caddar v x) (cadddr v x) - (cdaaar v x) (cdaadr v x) (cdadar v x) (cdaddr v x) - (cddaar v x) (cddadr v x) (cdddar v x) (cddddr v x) - (environment e) (eval v e) (call-with-input-file v f) - (call-with-output-file v f) (delete-file f) (file-exists? f) - (open-binary-input-file f) (open-binary-output-file f) - (open-input-file v f) (open-output-file v f) - (with-input-from-file v f) (with-output-to-file v f) - (acos v z i) (asin v z i) (atan v z i) (cos v z i) - (exp v z i) (finite? z i) (infinite? i) (log v i) (nan? i) - (sin v i) (sqrt v i) (tan v i) (delay v u z) (delay-force z) - (force v z) (make-promise z) (promise? z) (load v d) - (command-line s) (emergency-exit s) (exit s) - (get-environment-variable s) (get-environment-variables s) - (display w v) (exact->inexact v) (inexact->exact v) - (interaction-environment p v) (null-environment v) - (read r v) (scheme-report-environment v) (write w v) - (current-jiffy t) (current-second t) (jiffies-per-second t) - (write-shared w) (write-simple w))) + '((* v b) (+ v b) (- v b) (... v u b) (/ v b) (< v b) (<= v b) (= v b) (=> v u b) (> v b) (>= v b) + (_ b) (abs v b) (and v u b) (append v b) (apply v b) (assoc v b) (assq v b) (assv v b) (begin v u b) + (binary-port? b) (boolean=? b) (boolean? v b) (bytevector b) (bytevector-append b) + (bytevector-copy b) (bytevector-copy! b) (bytevector-length b) (bytevector-u8-ref b) + (bytevector-u8-set! b) (bytevector? b) (caar v b) (cadr v b) (call-with-current-continuation v b) + (call-with-port b) (call-with-values v b) (call/cc b) (car v b) (case v u b) (cdar v b) (cddr v b) + (cdr v b) (ceiling v b) (char->integer v b) (char-ready? v b) (char<=? v b) (char=? v b) (char>? v b) (char? b) (close-input-port v b) (close-output-port v b) + (close-port b) (complex? v b) (cond v u b) (cond-expand b) (cons v b) (current-error-port b) + (current-input-port v b) (current-output-port v b) (define v u b) (define-record-type b) + (define-syntax v u b) (define-values b) (denominator v b) (do v u b) (dynamic-wind v b) (else v u b) + (eof-object b) (eof-object? v b) (eq? v b) (equal? v b) (eqv? v b) (error b) + (error-object-irritants b) (error-object-message b) (error-object? b) (even? v b) (exact b) + (exact-integer-sqrt b) (exact-integer? b) (exact? v b) (expt v b) (features b) (file-error? b) + (floor v b) (floor-quotient b) (floor-remainder b) (floor/ b) (flush-output-port b) (for-each v b) + (gcd v b) (get-output-bytevector b) (get-output-string b) (guard b) (if v u b) (include b) + (include-ci b) (inexact b) (inexact? v b) (input-port-open? b) (input-port? v b) (integer->char v b) + (integer? v b) (lambda v u b) (lcm v b) (length v b) (let v u b) (let* v u b) (let*-values b) + (let-syntax v u b) (let-values b) (letrec v u b) (letrec* b) (letrec-syntax v u b) (list v b) + (list->string v b) (list->vector v b) (list-copy b) (list-ref v b) (list-set! b) (list-tail v b) + (list? v b) (make-bytevector b) (make-list b) (make-parameter b) (make-string v b) (make-vector v b) + (map v b) (max v b) (member v b) (memq v b) (memv v b) (min v b) (modulo v b) (negative? v b) + (newline v b) (not v b) (null? v b) (number->string v b) (number? v b) (numerator v b) (odd? v b) + (open-input-bytevector b) (open-input-string b) (open-output-bytevector b) (open-output-string b) + (or v u b) (output-port-open? b) (output-port? v b) (pair? v b) (parameterize b) (peek-char v b) + (peek-u8 b) (port? b) (positive? v b) (procedure? v b) (quasiquote v u b) (quote v u b) + (quotient v b) (raise b) (raise-continuable b) (rational? v b) (rationalize v b) (read-bytevector b) + (read-bytevector! b) (read-char v b) (read-error? b) (read-line b) (read-string b) (read-u8 b) + (real? v b) (remainder v b) (reverse v b) (round v b) (set! v b) (set-car! v b) (set-cdr! v b) + (square b) (string v b) (string->list v b) (string->number v b) (string->symbol v b) + (string->utf8 b) (string->vector b) (string-append v b) (string-copy v b) (string-copy! b) + (string-fill! v b) (string-for-each b) (string-length v b) (string-map b) (string-ref v b) + (string-set! v b) (string<=? v b) (string=? v b) (string>? v b) + (string? v b) (substring v b) (symbol->string v b) (symbol=? b) (symbol? v b) (syntax-error b) + (syntax-rules v u b) (textual-port? b) (truncate v b) (truncate-quotient b) (truncate-remainder b) + (truncate/ b) (u8-ready? b) (unless b) (unquote v u b) (unquote-splicing v u b) (utf8->string b) + (values v b) (vector v b) (vector->list v b) (vector->string b) (vector-append b) (vector-copy b) + (vector-copy! b) (vector-fill! v b) (vector-for-each b) (vector-length v b) (vector-map b) + (vector-ref v b) (vector-set! v b) (vector? v b) (when b) (with-exception-handler b) + (write-bytevector b) (write-char v b) (write-string b) (write-u8 b) (zero? v b) (case-lambda l) + (char-alphabetic? v h) (char-ci<=? v h) (char-ci=? v h) + (char-ci>? v h) (char-downcase v h) (char-foldcase h) (char-lower-case? v h) (char-numeric? v h) + (char-upcase v h) (char-upper-case? v h) (char-whitespace? v h) (digit-value h) (string-ci<=? v h) + (string-ci=? v h) (string-ci>? v h) (string-downcase h) + (string-foldcase h) (string-upcase h) (angle v o) (imag-part v o) (magnitude v o) (make-polar v o) + (make-rectangular v o) (real-part v o) (caaar v x) (caadr v x) (cadar v x) (caddr v x) (cdaar v x) + (cdadr v x) (cddar v x) (cdddr v x) (caaaar v x) (caaadr v x) (caadar v x) (caaddr v x) (cadaar v x) + (cadadr v x) (caddar v x) (cadddr v x) (cdaaar v x) (cdaadr v x) (cdadar v x) (cdaddr v x) + (cddaar v x) (cddadr v x) (cdddar v x) (cddddr v x) (environment e) (eval v e) + (call-with-input-file v f) (call-with-output-file v f) (delete-file f) (file-exists? f) + (open-binary-input-file f) (open-binary-output-file f) (open-input-file v f) (open-output-file v f) + (with-input-from-file v f) (with-output-to-file v f) (acos v z i) (asin v z i) (atan v z i) + (cos v z i) (exp v z i) (finite? z i) (infinite? i) (log v i) (nan? i) (sin v i) (sqrt v i) + (tan v i) (delay v u z) (delay-force z) (force v z) (make-promise z) (promise? z) (load v d) + (command-line s) (emergency-exit s) (exit s) (get-environment-variable s) + (get-environment-variables s) (display w v) (exact->inexact v) (inexact->exact v) + (interaction-environment p v) (null-environment v) (read r v) (scheme-report-environment v) + (write w v) (current-jiffy t) (current-second t) (jiffies-per-second t) (write-shared w) + (write-simple w) + ; skint extras go into (skint repl) environment only + (box?) (box) (unbox) (set-box!) + )) (define (std-lib->env lib) (cond [(assoc lib *std-lib->env*) => @@ -1383,7 +1525,7 @@ ; use new protocol for top-level envs (let* ([core (xform-define (cdr x) env)] [loc (xenv-lookup env (cadr core) 'define)]) - (if (and loc (syntax-match? '(ref *) (location-val loc))) + (if (and loc (sexp-match? '(ref *) (location-val loc))) #t (x-error "identifier cannot be (re)defined in env:" (cadr core) env)))] @@ -1424,7 +1566,7 @@ ; use new protocol for top-level envs (let* ([core (xform-define (cdr x) env)] [loc (xenv-lookup env (cadr core) 'define)]) - (if (and loc (syntax-match? '(ref *) (location-val loc))) + (if (and loc (sexp-match? '(ref *) (location-val loc))) (compile-and-run-core-expr (list 'set! (cadr (location-val loc)) (caddr core))) (x-error "identifier cannot be (re)defined in env:" @@ -1469,22 +1611,22 @@ (define (visit/v f) (define p (open-input-file f)) - (let loop ([x (read p)]) + (let loop ([x (read-code-sexp p)]) (unless (eof-object? x) (when *verbose* (write x) (newline)) (visit-top-form x root-environment) (when *verbose* (newline)) - (loop (read p)))) + (loop (read-code-sexp p)))) (close-input-port p)) (define (visit/x f) (define p (open-input-file f)) - (let loop ([x (read p)]) + (let loop ([x (read-code-sexp p)]) (unless (eof-object? x) (when *verbose* (write x) (newline)) (eval-top-form x root-environment) (when *verbose* (newline)) - (loop (read p)))) + (loop (read-code-sexp p)))) (close-input-port p)) @@ -1523,7 +1665,7 @@ ; use new protocol for top-level envs (let* ([core (xform-define (cdr x) env)] [loc (xenv-lookup env (cadr core) 'define)]) - (if (and loc (syntax-match? '(ref *) (location-val loc))) + (if (and loc (sexp-match? '(ref *) (location-val loc))) (repl-compile-and-run-core-expr (list 'set! (cadr (location-val loc)) (caddr core))) (x-error "identifier cannot be (re)defined in env:" @@ -1558,7 +1700,7 @@ (define (repl-read iport prompt) (when prompt (newline) (display prompt) (display " ")) - (read iport)) + (read-code-sexp iport)) (define (repl-from-port iport env prompt) (guard (err @@ -1585,7 +1727,7 @@ (define (benchmark-file fname) (define iport (open-input-file fname)) - (unless (syntax-match? '(load "libl.sf") (read iport)) + (unless (sexp-match? '(load "libl.sf") (read-code-sexp iport)) (error "unexpected benchmark file format" fname)) (repl-from-port iport repl-environment #f) (repl-eval-top-form '(main #f) repl-environment) diff --git a/t.c b/t.c index 67374a1..80225b1 100644 --- a/t.c +++ b/t.c @@ -30,12 +30,25 @@ char *t_code[] = { "y3:...;;l2:y3:cdr;y2:id;;;l4:y11:record-case;y2:id;y6:clause;y3:...;;;" ";", - "P", "syntax-match?", - "%2'(y1:*),.1q,.0?{.0]3}.1,.3e,.0?{.0]4}.2p?{'(y1:$),.3aq?{.2dp?{.2ddu}" - "{f}}{f}?{.2da,.4q]4}.2dp?{'(y3:...),.3daq?{.2ddu}{f}}{f}?{.2a,,#0.0,.2" - ",&2{%1.0u,.0?{.0]2}.1p?{${.3a,:0,@(y13:syntax-match?)[02}?{.1d,:1^[21}" - "f]2}f]2}.!0.5,.1^[61}.3p?{${.5a,.5a,@(y13:syntax-match?)[02}?{.3d,.3d," - "@(y13:syntax-match?)[42}f]4}f]4}f]4", + "P", "sexp-match?", + "%2'(y1:*),.1q,.0?{.0]3}'(y8:),.2q?{.2Y0}{f},.0?{.0]4}'(y8:),.3q?{.3S0}{f},.0?{.0]5}.3,.5q,.0?{.0]6}.4p?{'(y3:...),.5aq?{.4dp" + "?{.4ddu}{f}}{f}?{.4da,.6q]6}.4dp?{'(y3:...),.5daq?{.4ddu}{f}}{f}?{.4a," + "'(y1:*),.1q?{.6L0]7}.6,,#0.0,.3,&2{%1.0u,.0?{.0]2}.1p?{${.3a,:0,@(y11:" + "sexp-match?)[02}?{.1d,:1^[21}f]2}f]2}.!0.0^_1[71}.5p?{${.7a,.7a,@(y11:" + "sexp-match?)[02}?{.5d,.5d,@(y11:sexp-match?)[62}f]6}f]6}f]6", + + "S", "sexp-case", + "l6:y12:syntax-rules;l1:y4:else;;l2:l4:y1:_;l2:y3:key;y3:...;;y7:clause" + "s;y3:...;;l3:y3:let;l1:l2:y8:atom-key;l2:y3:key;y3:...;;;;l4:y9:sexp-c" + "ase;y8:atom-key;y7:clauses;y3:...;;;;l2:l3:y1:_;y3:key;l4:y4:else;y7:r" + "esult1;y7:result2;y3:...;;;l4:y5:begin;y7:result1;y7:result2;y3:...;;;" + "l2:l3:y1:_;y3:key;l4:y3:pat;y7:result1;y7:result2;y3:...;;;l3:y2:if;l3" + ":y11:sexp-match?;l2:y5:quote;y3:pat;;y3:key;;l4:y5:begin;y7:result1;y7" + ":result2;y3:...;;;;l2:l6:y1:_;y3:key;l4:y3:pat;y7:result1;y7:result2;y" + "3:...;;y6:clause;y7:clauses;y3:...;;l4:y2:if;l3:y11:sexp-match?;l2:y5:" + "quote;y3:pat;;y3:key;;l4:y5:begin;y7:result1;y7:result2;y3:...;;l5:y9:" + "sexp-case;y3:key;y6:clause;y7:clauses;y3:...;;;;", "C", 0, "'0,#0.0,&1{%!0'1,:0^I+:!0.0u?{'(i10),:0^X6,'(s1:#)S6X5]1}.0aY0?{'(i10)" @@ -51,6 +64,12 @@ char *t_code[] = { "P", "pair*", "%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[22", + "P", "append*", + "%1.0u?{n]1}.0du?{.0a]1}${.2d,@(y7:append*)[01},.1aL6]1", + + "P", "string-append*", + "%1.0,@(y14:%25string-append),@(y13:apply-to-list)[12", + "P", "andmap", "%2.1p?{${.3a,.3[01}?{.1d,.1,@(y6:andmap)[22}f]2}t]2", @@ -66,9 +85,15 @@ char *t_code[] = { "P", "list2+?", "%1.0p?{.0d,@(y7:list1+?)[11}f]1", + "P", "read-code-sexp", + "%1.0,@(y11:read-simple)[11", + "P", "error*", "%2${.3,.3,f,@(y12:error-object)[03},@(y5:raise)[21", + "P", "warning*", + "%2Pe,.2,.2,'(s9:Warning: )S6,@(y19:print-error-message)[23", + "P", "idslist?", "%1.0u?{t]1}.0p?{${.2a,@(y3:id?)[01}?{.0d,@(y8:idslist?)[11}f]1}.0,@(y3" ":id?)[11", @@ -373,6 +398,9 @@ char *t_code[] = { "P", "c-error", "%!1.0,.2,'(s10:compiler: )S6,@(y6:error*)[22", + "P", "c-warning", + "%!1.0,.2,'(s10:compiler: )S6,@(y8:warning*)[22", + "P", "find-free*", "%2.0u?{n]2}${.3,.3d,@(y10:find-free*)[02},${.4,.4a,@(y9:find-free)[02}" ",@(y9:set-union)[22", @@ -553,6 +581,118 @@ char *t_code[] = { "%1P51,${.2,'0,${n,.8,@(y9:find-free)[02},n,n,n,.9,@(y7:codegen)[07}.0P" "90]2", + "P", "path-strip-directory", + "%1n,.1X2A8,,#0.0,&1{%2.0u?{.1X3]2}'(l3:c%5c;c/;c:;),.1aA1?{.1X3]2}.1,." + "1ac,.1d,:0^[22}.!0.0^_1[12", + + "P", "path-directory", + "%1.0X2A8,,#0.0,&1{%1.0u?{'(s0:)]1}'(l3:c%5c;c/;c:;),.1aA1?{.0A8X3]1}.0" + "d,:0^[11}.!0.0^_1[11", + + "P", "path-strip-extension", + "%1.0X2A8,,#0.0,.3,&2{%1.0u?{:0]1}'(c.),.1av?{.0dA8X3]1}'(l3:c%5c;c/;c:" + ";),.1aA1?{:0]1}.0d,:1^[11}.!0.0^_1[11", + + "P", "base-path-separator", + "%1.0X2A8,.0u?{f]2}'(l2:c%5c;c/;),.1aA1?{.0a]2}f]2", + + "P", "path-relative?", + "%1.0X2,.0u?{f]2}'(l2:c%5c;c/;),.1aA1?{f]2}'3,.1g>?{.0aC4?{'(c:),.1dav?" + "{'(c%5c),.1ddav}{f}}{f}}{f}?{f]2}t]2", + + "P", "file-resolve-relative-to-base-path", + "%2${.2,@(y14:path-relative?)[01}?{${.3,@(y19:base-path-separator)[01}}" + "{f}?{.0,.2S6]2}.0]2", + + "C", 0, + "n@!(y20:*current-file-stack*)", + + "P", "current-file", + "%0@(y20:*current-file-stack*)p?{@(y20:*current-file-stack*)a]0}f]0", + + "P", "with-current-file", + "%2&0{%0@(y20:*current-file-stack*)d@!(y20:*current-file-stack*)]0},.2," + ".2,&1{%0@(y20:*current-file-stack*),:0c@!(y20:*current-file-stack*)]0}" + ",@(y12:dynamic-wind)[23", + + "P", "file-resolve-relative-to-current", + "%1${.2,@(y14:path-relative?)[01}?{${@(y12:current-file)[00},.0?{${.2,@" + "(y14:path-directory)[01},.2,@(y34:file-resolve-relative-to-base-path)[" + "22}.1]2}.0]1", + + "P", "listname-segment->string", + "%1.0Y0?{.0X4]1}.0N0?{'(i10),.1E8]1}.0S0?{.0]1}.0,'(s34:invalid symboli" + "c file name element),@(y7:c-error)[12", + + "C", 0, + "'(s1:_)@!(y17:modname-separator)", + + "P", "listname->modname", + "%1,#0@(y17:modname-separator).!0n,.2,,#0.0,.4,&2{%2.0p?{.1u?{.1,${.3a," + "@(y24:listname-segment->string)[01}c}{.1,:0^c,${.3a,@(y24:listname-seg" + "ment->string)[01}c},.1d,:1^[22}.1A8,@(y14:string-append*)[21}.!0.0^_1[" + "22", + + "P", "listname->path", + "%3,#0${.4,@(y19:base-path-separator)[01},.0?{.0,S11}{${.5,'(s38:librar" + "y path does not end in separator),@(y7:c-error)[02}}_1.!0n,.2,,#0.5,.7" + ",.2,.6,&4{%2.0p?{.1u?{.1,${.3a,@(y24:listname-segment->string)[01}c}{." + "1,:0^c,${.3a,@(y24:listname-segment->string)[01}c},.1d,:1^[22}:3,${.4," + ":2cA8,@(y14:string-append*)[01},@(y34:file-resolve-relative-to-base-pa" + "th)[22}.!0.0^_1[42", + + "C", 0, + "n@!(y19:*library-path-list*)", + + "P", "add-library-path!", + "%1${.2,@(y19:base-path-separator)[01}?{.0,l1,@(y19:*library-path-list*" + ")L6@!(y19:*library-path-list*)]1}.0,'(s46:library path should end in d" + "irectory separator),@(y7:c-error)[12", + + "P", "find-library-path", + "%1@(y19:*library-path-list*),,#0.2,.1,&2{%1.0u?{f]1}${'(s4:.sld),.3a,:" + "1,@(y14:listname->path)[03},.0?{.0F0}{f}?{.0]2}.1d,:0^[21}.!0.0^_1[11", + + "P", "resolve-input-file/lib-name", + "%1,#0.1S0?{${.3,@(y32:file-resolve-relative-to-current)[01}}{${.3,@(y1" + "7:find-library-path)[01}}.!0.0^~?{.1S0?{${.3,'(s35:cannot resolve file" + " name to a file:),@(y7:c-error)[02}}{${@(y19:*library-path-list*),'(y2" + ":in),.5,'(s38:cannot resolve library name to a file:),@(y7:c-error)[04" + "}}}.0^F0~?{${.2^,'(y2:=>),.5,'(s56:cannot resolve file or library name" + " to an existing file:),@(y7:c-error)[04}}.0^]2", + + "P", "call-with-input-file/lib", + "%3${.2,@(y27:resolve-input-file/lib-name)[01},.2,.1,.5,&3{%0:0,:1,:2,&" + "3{%1:0?{${t,.3,@(y19:set-port-fold-case!)[02}}.0,:1,:2[12},:1,@(y20:ca" + "ll-with-input-file)[02},.1,@(y17:with-current-file)[42", + + "P", "call-with-file/lib-sexps", + "%3.2,&1{%2n,,#0.3,:0,.2,&3{%1${:2,@(y14:read-code-sexp)[01},.0R8?{.1A9" + ",:1[21}.1,.1c,:0^[21}.!0.0^_1[21},.2,.2,@(y24:call-with-input-file/lib" + ")[33", + + "P", "for-each-file/lib-sexp", + "%3.0,&1{%2,#0.2,.1,:0,&3{%0${:2,@(y14:read-code-sexp)[01},.0R8~?{${.2," + ":0[01}:1^[10}]1}.!0.0^_1[20},.3,.3,@(y24:call-with-input-file/lib)[33", + + "P", "file/lib->modname", + "%1.0p?{.0L0}{f}?{.0,@(y17:listname->modname)[11}.0S0?{${.2,@(y20:path-" + "strip-directory)[01},@(y20:path-strip-extension)[11}.0,'(s29:illegal f" + "ile or library name:),@(y7:c-error)[12", + + "P", "file/lib/stdin->modname", + "%1.0S0?{'(s1:-),.1S=}{f}?{'(s5:stdin)]1}.0,@(y17:file/lib->modname)[11", + + "P", "fully-qualified-prefix", + "%1'(s1:.),.1S6]1", + + "P", "fully-qualified-library-prefix", + "%1${.2,@(y17:file/lib->modname)[01},@(y22:fully-qualified-prefix)[11", + + "P", "fully-qualified-library-prefixed-name", + "%2.1X4,'(s1:.),${.4,@(y17:file/lib->modname)[01},@(y14:%25string-appen" + "d)[23", + "P", "env-lookup", "%3.0K0?{.2,'(l2:y3:ref;y4:set!;),.1A1?{.1,@(y7:old-den)[41}f]4}.1,,#0." "4,.3,.2,&3{%1.0p?{:1,.1aaq?{:2,'(y3:ref),.1v?{.1ad]2}f]2}.0d,:0^[11}.0" @@ -577,7 +717,7 @@ char *t_code[] = { "n@!(y14:*std-lib->env*)", "C", 0, - "${'(l339:l3:y1:*;y1:v;y1:b;;l3:y1:+;y1:v;y1:b;;l3:y1:-;y1:v;y1:b;;l4:y" + "${'(l343:l3:y1:*;y1:v;y1:b;;l3:y1:+;y1:v;y1:b;;l3:y1:-;y1:v;y1:b;;l4:y" "3:...;y1:v;y1:u;y1:b;;l3:y1:/;y1:v;y1:b;;l3:y1:<;y1:v;y1:b;;l3:y2:<=;y" "1:v;y1:b;;l3:y1:=;y1:v;y1:b;;l4:y2:=>;y1:v;y1:u;y1:b;;l3:y1:>;y1:v;y1:" "b;;l3:y2:>=;y1:v;y1:b;;l2:y1:_;y1:b;;l3:y3:abs;y1:v;y1:b;;l4:y3:and;y1" @@ -706,24 +846,25 @@ char *t_code[] = { "1:v;;l3:y4:read;y1:r;y1:v;;l2:y25:scheme-report-environment;y1:v;;l3:y" "5:write;y1:w;y1:v;;l2:y13:current-jiffy;y1:t;;l2:y14:current-second;y1" ":t;;l2:y18:jiffies-per-second;y1:t;;l2:y12:write-shared;y1:w;;l2:y12:w" - "rite-simple;y1:w;;),&0{%1,,,#0#1#2&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;" - "y5:write;)]2}'(y1:t),.1v?{'(l2:y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2" - ":y6:scheme;y4:repl;)]2}'(y1:r),.1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v)" - ",.1v?{'(l2:y6:scheme;y4:r5rs;)]2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-n" - "ull;)]2}'(y1:s),.1v?{'(l2:y6:scheme;y15:process-context;)]2}'(y1:d),.1" + "rite-simple;y1:w;;l1:y4:box?;;l1:y3:box;;l1:y5:unbox;;l1:y8:set-box!;;" + "),&0{%1,,,#0#1#2&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;y5:write;)]2}'(y1:" + "t),.1v?{'(l2:y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2:y6:scheme;y4:repl" + ";)]2}'(y1:r),.1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v),.1v?{'(l2:y6:sche" + "me;y4:r5rs;)]2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-null;)]2}'(y1:d),.1" "v?{'(l2:y6:scheme;y4:load;)]2}'(y1:z),.1v?{'(l2:y6:scheme;y4:lazy;)]2}" - "'(y1:i),.1v?{'(l2:y6:scheme;y7:inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme" - ";y4:file;)]2}'(y1:e),.1v?{'(l2:y6:scheme;y4:eval;)]2}'(y1:x),.1v?{'(l2" - ":y6:scheme;y3:cxr;)]2}'(y1:o),.1v?{'(l2:y6:scheme;y7:complex;)]2}'(y1:" - "h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:l),.1v?{'(l2:y6:scheme;y11:cas" - "e-lambda;)]2}'(y1:b),.1v?{'(l2:y6:scheme;y4:base;)]2}]2}.!0&0{%3.0V3,." - "0,.3H2,.0,.3V4,.0,.5A3,.0?{.6,.1sd]7}.1,.7,.7cc,.3,.6V5]7}.!1&0{%1@(y1" - "4:*std-lib->env*),.1A5,.0?{.0d]2}'(l2:y5:skint;y4:repl;),.2q?{'(i101)}" - "{'(i37)},n,.1V2,@(y14:*std-lib->env*),.1,.5cc@!(y14:*std-lib->env*).0]" - "4}.!2.3d,.4a,,#0.0,.5,.5,.8,&4{%2.1u?{${'(y3:ref),.3,@(y16:root-enviro" - "nment)[02},.1,${'(l2:y5:skint;y4:repl;),:0^[01},:2^[23}${${'(y3:ref),." - "5,@(y16:root-environment)[02},.3,${${.9a,:1^[01},:0^[01},:2^[03}.1d,.1" - ",:3^[22}.!0.0^_1[42},@(y10:%25for-each1)[02}", + "'(y1:s),.1v?{'(l2:y6:scheme;y15:process-context;)]2}'(y1:i),.1v?{'(l2:" + "y6:scheme;y7:inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme;y4:file;)]2}'(y1:" + "e),.1v?{'(l2:y6:scheme;y4:eval;)]2}'(y1:o),.1v?{'(l2:y6:scheme;y7:comp" + "lex;)]2}'(y1:h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:l),.1v?{'(l2:y6:s" + "cheme;y11:case-lambda;)]2}'(y1:x),.1v?{'(l2:y6:scheme;y3:cxr;)]2}'(y1:" + "b),.1v?{'(l2:y6:scheme;y4:base;)]2}]2}.!0&0{%3.0V3,.0,.3H2,.0,.3V4,.0," + ".5A3,.0?{.6,.1sd]7}.1,.7,.7cc,.3,.6V5]7}.!1&0{%1@(y14:*std-lib->env*)," + ".1A5,.0?{.0d]2}'(l2:y5:skint;y4:repl;),.2q?{'(i101)}{'(i37)},n,.1V2,@(" + "y14:*std-lib->env*),.1,.5cc@!(y14:*std-lib->env*).0]4}.!2.3d,.4a,,#0.0" + ",.5,.5,.8,&4{%2.1u?{${'(y3:ref),.3,@(y16:root-environment)[02},.1,${'(" + "l2:y5:skint;y4:repl;),:0^[01},:2^[23}${${'(y3:ref),.5,@(y16:root-envir" + "onment)[02},.3,${${.9a,:1^[01},:0^[01},:2^[03}.1d,.1,:3^[22}.!0.0^_1[4" + "2},@(y10:%25for-each1)[02}", "P", "std-lib->env", "%1@(y14:*std-lib->env*),.1A5,.0?{.0,.0d,.0V3,'(l2:y5:skint;y4:repl;),." @@ -735,29 +876,29 @@ char *t_code[] = { "%2.0p?{${.3,.3a,t,@(y5:xform)[03},'(y5:begin),.1q?{.1d,,#0.4,.1,&2{%1." "0p?{${:1,.3a,@(y14:visit-top-form)[02}.0d,:0^[11}]1}.!0.0^_1[31}'(y6:d" "efine),.1q?{${.4,.4d,@(y12:xform-define)[02},${'(y6:define),.3da,.7,@(" - "y11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y13:syntax-match?)" - "[02}}{f}?{t]5}.4,.2da,'(s40:identifier cannot be (re)defined in env:)," - "@(y7:x-error)[53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define" - "-syntax)[02},${'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?" - "{.1dda,.1sz]5}.4,.2da,'(s50:identifier cannot be (re)defined as syntax" - " in env:),@(y7:x-error)[53}.0K0?{.2,${.5,.5,.5[02},@(y14:visit-top-for" - "m)[32}.0U0?{t]3}.0Y0?{t]3}t]3}t]2", + "y11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match?)[0" + "2}}{f}?{t]5}.4,.2da,'(s40:identifier cannot be (re)defined in env:),@(" + "y7:x-error)[53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-s" + "yntax)[02},${'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{." + "1dda,.1sz]5}.4,.2da,'(s50:identifier cannot be (re)defined as syntax i" + "n env:),@(y7:x-error)[53}.0K0?{.2,${.5,.5,.5[02},@(y14:visit-top-form)" + "[32}.0U0?{t]3}.0Y0?{t]3}t]3}t]2", "P", "eval-top-form", "%2.0p?{${.3,.3a,t,@(y5:xform)[03},'(y5:begin),.1q?{.1d,,#0.4,.1,&2{%1." "0p?{${:1,.3a,@(y13:eval-top-form)[02}.0d,:0^[11}]1}.!0.0^_1[31}'(y6:de" "fine),.1q?{${.4,.4d,@(y12:xform-define)[02},${'(y6:define),.3da,.7,@(y" - "11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y13:syntax-match?)[" - "02}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y25:compile-and-run-core-expr)[51" - "}.4,.2da,'(s40:identifier cannot be (re)defined in env:),@(y7:x-error)" - "[53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-syntax)[02}," - "${'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{.1dda,.1sz]5" - "}.4,.2da,'(s50:identifier cannot be (re)defined as syntax in env:),@(y" - "7:x-error)[53}.0K0?{.2,${.5,.5,.5[02},@(y13:eval-top-form)[32}.0U0?{${" - ".4,.4d,.4,@(y16:xform-integrable)[03},@(y25:compile-and-run-core-expr)" - "[31}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y25:compile-and-run-core-expr)[3" - "1}${.4,.4d,.4,@(y10:xform-call)[03},@(y25:compile-and-run-core-expr)[3" - "1}${.3,.3,f,@(y5:xform)[03},@(y25:compile-and-run-core-expr)[21", + "11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match?)[02" + "}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y25:compile-and-run-core-expr)[51}." + "4,.2da,'(s40:identifier cannot be (re)defined in env:),@(y7:x-error)[5" + "3}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-syntax)[02},${" + "'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{.1dda,.1sz]5}." + "4,.2da,'(s50:identifier cannot be (re)defined as syntax in env:),@(y7:" + "x-error)[53}.0K0?{.2,${.5,.5,.5[02},@(y13:eval-top-form)[32}.0U0?{${.4" + ",.4d,.4,@(y16:xform-integrable)[03},@(y25:compile-and-run-core-expr)[3" + "1}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y25:compile-and-run-core-expr)[31}" + "${.4,.4d,.4,@(y10:xform-call)[03},@(y25:compile-and-run-core-expr)[31}" + "${.3,.3,f,@(y5:xform)[03},@(y25:compile-and-run-core-expr)[21", "C", 0, "f@!(y9:*verbose*)", @@ -769,16 +910,16 @@ char *t_code[] = { ".2[00},@(y9:*verbose*)?{Po,.1W5PoW6]4}]4", "P", "visit/v", - "%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y4:read)[01},,#0.4,.1" - ",&2{%1.0R8~?{@(y9:*verbose*)?{Po,.1W5PoW6}${@(y16:root-environment),.3" - ",@(y14:visit-top-form)[02}@(y9:*verbose*)?{PoW6}${:1^,@(y4:read)[01},:" - "0^[11}]1}.!0.0^_1[01}.0^P60]2", + "%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y14:read-code-sexp)[0" + "1},,#0.4,.1,&2{%1.0R8~?{@(y9:*verbose*)?{Po,.1W5PoW6}${@(y16:root-envi" + "ronment),.3,@(y14:visit-top-form)[02}@(y9:*verbose*)?{PoW6}${:1^,@(y14" + ":read-code-sexp)[01},:0^[11}]1}.!0.0^_1[01}.0^P60]2", "P", "visit/x", - "%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y4:read)[01},,#0.4,.1" - ",&2{%1.0R8~?{@(y9:*verbose*)?{Po,.1W5PoW6}${@(y16:root-environment),.3" - ",@(y13:eval-top-form)[02}@(y9:*verbose*)?{PoW6}${:1^,@(y4:read)[01},:0" - "^[11}]1}.!0.0^_1[01}.0^P60]2", + "%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y14:read-code-sexp)[0" + "1},,#0.4,.1,&2{%1.0R8~?{@(y9:*verbose*)?{Po,.1W5PoW6}${@(y16:root-envi" + "ronment),.3,@(y13:eval-top-form)[02}@(y9:*verbose*)?{PoW6}${:1^,@(y14:" + "read-code-sexp)[01},:0^[11}]1}.!0.0^_1[01}.0^P60]2", "P", "repl-environment", "%2.1,@(y18:*root-environment*),.2,@(y10:env-lookup)[23", @@ -795,22 +936,22 @@ char *t_code[] = { "%2.0p?{${.3,.3a,t,@(y5:xform)[03},'(y5:begin),.1q?{.1d,,#0.4,.1,&2{%1." "0p?{${:1,.3a,@(y18:repl-eval-top-form)[02}.0d,:0^[11}]1}.!0.0^_1[31}'(" "y6:define),.1q?{${.4,.4d,@(y12:xform-define)[02},${'(y6:define),.3da,." - "7,@(y11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y13:syntax-mat" - "ch?)[02}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y30:repl-compile-and-run-cor" - "e-expr)[51}.4,.2da,'(s40:identifier cannot be (re)defined in env:),@(y" - "7:x-error)[53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-sy" - "ntax)[02},${'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{.1" - "dda,.1sz}{${.6,.4da,'(s50:identifier cannot be (re)defined as syntax i" - "n env:),@(y7:x-error)[03}}@(y9:*verbose*)?{Po,'(s18:SYNTAX INSTALLED: " - ")W4Po,.2daW5PoW6]5}]5}.0K0?{.2,${.5,.5,.5[02},@(y18:repl-eval-top-form" - ")[32}.0U0?{${.4,.4d,.4,@(y16:xform-integrable)[03},@(y30:repl-compile-" - "and-run-core-expr)[31}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y30:repl-compi" - "le-and-run-core-expr)[31}${.4,.4d,.4,@(y10:xform-call)[03},@(y30:repl-" - "compile-and-run-core-expr)[31}${.3,.3,f,@(y5:xform)[03},@(y30:repl-com" - "pile-and-run-core-expr)[21", + "7,@(y11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match" + "?)[02}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y30:repl-compile-and-run-core-" + "expr)[51}.4,.2da,'(s40:identifier cannot be (re)defined in env:),@(y7:" + "x-error)[53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-synt" + "ax)[02},${'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{.1dd" + "a,.1sz}{${.6,.4da,'(s50:identifier cannot be (re)defined as syntax in " + "env:),@(y7:x-error)[03}}@(y9:*verbose*)?{Po,'(s18:SYNTAX INSTALLED: )W" + "4Po,.2daW5PoW6]5}]5}.0K0?{.2,${.5,.5,.5[02},@(y18:repl-eval-top-form)[" + "32}.0U0?{${.4,.4d,.4,@(y16:xform-integrable)[03},@(y30:repl-compile-an" + "d-run-core-expr)[31}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y30:repl-compile" + "-and-run-core-expr)[31}${.4,.4d,.4,@(y10:xform-call)[03},@(y30:repl-co" + "mpile-and-run-core-expr)[31}${.3,.3,f,@(y5:xform)[03},@(y30:repl-compi" + "le-and-run-core-expr)[21", "P", "repl-read", - "%2.1?{PoW6Po,.2W4Po,'(s1: )W4}.0,@(y4:read)[21", + "%2.1?{PoW6Po,.2W4Po,'(s1: )W4}.0,@(y14:read-code-sexp)[21", "P", "repl-from-port", "%3${k0,.0,${.2,.8,.(i10),.9,&4{%0:3,&1{%!0.0,&1{%0:0,@(y6:values),@(y1" @@ -829,11 +970,11 @@ char *t_code[] = { ")[03}.0^P60]3", "P", "benchmark-file", - "%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y4:read)[01},'(l2:y4:" - "load;s7:libl.sf;),@(y13:syntax-match?)[02}~?{${.3,'(s32:unexpected ben" - "chmark file format),@(y5:error)[02}}${f,@(y16:repl-environment),.4^,@(" - "y14:repl-from-port)[03}${@(y16:repl-environment),'(l2:y4:main;f;),@(y1" - "8:repl-eval-top-form)[02}.0^P60]2", + "%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y14:read-code-sexp)[0" + "1},'(l2:y4:load;s7:libl.sf;),@(y11:sexp-match?)[02}~?{${.3,'(s32:unexp" + "ected benchmark file format),@(y5:error)[02}}${f,@(y16:repl-environmen" + "t),.4^,@(y14:repl-from-port)[03}${@(y16:repl-environment),'(l2:y4:main" + ";f;),@(y18:repl-eval-top-form)[02}.0^P60]2", "P", "run-repl", "%0'(s6:skint]),@(y16:repl-environment),Pi,@(y14:repl-from-port)[03",