mirror of
https://github.com/false-schemers/skint.git
synced 2025-01-21 19:27:27 +01:00
port-fold-case hacks; library names & paths
This commit is contained in:
ESL
parent
9475e47871
commit
64be6ba43d
6 changed files with 663 additions and 355 deletions
16
i.c
16
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);
|
||||
|
|
|
|||
2
i.h
2
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)
|
||||
|
|
|
|||
236
s.c
236
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<?{.0,:3V4,.0K0?{${"
|
||||
".2,:2^[01},.2,:3V5}{${.2,:1^[01}}_1'1,.1I+,:0^[11}]1}.!0.0^_1[11}.0Y2?"
|
||||
"{.0zK0?{${.2z,:1^[01},.1sz]1}.0z,:1^[11}f]1}.!4.4,&1{%1${.2,:0^[01}.0]"
|
||||
"1}.!5f.!6f.!7f.!8f.!9'(y12:reader-token),l1,.0.!7'(s17:right parenthes"
|
||||
"is),.1c.!8'(s13:right bracket),.1c.!9'(s5:%22 . %22),.1c.!(i10)_1.6,&1"
|
||||
"{%1.0p?{:0^,.1aq]1}f]1}.!(i10)&0{%1'(s80:ABCDEFGHIJKLMNOPQRSTUVWXYZabc"
|
||||
"defghijklmnopqrstuvwxyz!$%25&*/:<=>?^_~0123456789+-.@),.1S8]1}.!(i11)&"
|
||||
"0{%1.0X8,'(i48),.1<!?{'(i57),.1>!}{f},.0?{.0]3}'(i65),.2<!?{'(i70),.2>"
|
||||
"!}{f},.0?{.0]4}'(i97),.3<!?{'(i102),.3>!]4}f]4}.!(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<?{.0,:3V4,.0K0?{${.2,:2^[01},.2,:3V5}{${.2,"
|
||||
":1^[01}}_1'1,.1I+,:0^[11}]1}.!0.0^_1[11}.0Y2?{.0zK0?{${.2z,:1^[01},.1s"
|
||||
"z]1}.0z,:1^[11}f]1}.!5.5,&1{%1${.2,:0^[01}.0]1}.!6f.!7f.!8f.!9f.!(i10)"
|
||||
"'(y12:reader-token),l1,.0.!8'(s17:right parenthesis),.1c.!9'(s13:right"
|
||||
" bracket),.1c.!(i10)'(s5:%22 . %22),.1c.!(i11)_1.7,&1{%1.0p?{:0^,.1aq]"
|
||||
"1}f]1}.!(i11)&0{%1'(s80:ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrst"
|
||||
"uvwxyz!$%25&*/:<=>?^_~0123456789+-.@),.1S8]1}.!(i12)&0{%1.0X8,'(i48),."
|
||||
"1<!?{'(i57),.1>!}{f},.0?{.0]3}'(i65),.2<!?{'(i70),.2>!}{f},.0?{.0]4}'("
|
||||
"i97),.3<!?{'(i102),.3>!]4}f]4}.!(i13)&0{%1.0C1,.0?{.0]2}'(c)),.2C=,.0?"
|
||||
"{.0]3}'(c(),.3C=,.0?{.0]4}'(c]),.4C=,.0?{.0]5}'(c[),.5C=,.0?{.0]6}'(c%"
|
||||
"22),.6C=,.0?{.0]7}'(c;),.7C=]7}.!(i14).(i16),.(i12),&2{%1${.2,:1^[01},"
|
||||
".0R8?{.1,'(y5:port:),'(s22:unexpected end of file),@(y10:read-error)[2"
|
||||
"3}${.2,:0^[01}?{.1,'(y5:port:),.2d,'(s17:unexpected token:),@(y10:read"
|
||||
"-error)[24}.0]2}.!(i15).9,.(i13),.(i21),.(i25),.(i20),.(i13),.(i23),.("
|
||||
"i25),.(i28),.(i23),.(i13),.(i26),.(i14),.(i14),.(i38),&(i15){%1.0R0,.0"
|
||||
"R8?{.0]2}.0C1?{.1,:(i10)^[21}'(c(),.1C=?{t,:9^,.3,.3,:8^[24}'(c)),.1C="
|
||||
"?{:9^]2}'(c[),.1C=?{t,:(i14)^,.3,.3,:8^[24}'(c]),.1C=?{:(i14)^]2}'(c')"
|
||||
",.1C=?{${.3,:3^[01},'(y5:quote),l2]2}'(c`),.1C=?{${.3,:3^[01},'(y10:qu"
|
||||
"asiquote),l2]2}${.2,:(i13)^[01}?{.1,.1,:(i11)^[22}'(c;),.1C=?{${.3R0,,"
|
||||
"#0.5,.1,&2{%1.0R8,.0?{.0]2}'(c%0a),.2C=,.0?{.0]3}:1R0,:0^[31}.!0.0^_1["
|
||||
"01}.1,:(i10)^[21}'(c,),.1C=?{.1R1,.0R8?{.2,'(y5:port:),'(s19:end of fi"
|
||||
"le after ,),@(y10:read-error)[33}'(c@),.1C=?{.2R0${.4,:3^[01},'(y16:un"
|
||||
"quote-splicing),l2]3}${.4,:3^[01},'(y7:unquote),l2]3}'(c%22),.1C=?{n,,"
|
||||
"#0.3,:(i12),.2,&3{%1:2R0,.0R8?{:2,'(y5:port:),'(s27:end of file within"
|
||||
" a string),@(y10:read-error)[23}'(c%5c),.1C=?{${'(y6:string),:2,:1^[02"
|
||||
"},.0?{.2,.1c}{.2},:0^[31}'(c%22),.1C=?{.1A9X3]2}.1,.1c,:0^[21}.!0.0^_1"
|
||||
"[21}'(c|),.1C=?{n,,#0.3,:(i12),.2,&3{%1:2R0,.0R8?{:2,'(y5:port:),'(s29"
|
||||
":end of file within a |symbol|),@(y10:read-error)[23}'(c%5c),.1C=?{${'"
|
||||
"(y6:symbol),:2,:1^[02},.0?{.2,.1c}{.2},:0^[31}'(c|),.1C=?{.1A9X3X5]2}."
|
||||
"1,.1c,:0^[21}.!0.0^_1[21}'(c#),.1C=?{.1R1,.0R8?{.2,'(y5:port:),'(s19:e"
|
||||
"nd of file after #),@(y10:read-error)[33}'(ct),.1Ci=,.0?{.0}{'(cf),.2C"
|
||||
"i=}_1?{${.4,:3^[01},.0,'(l2:y1:t;y4:true;),.1A1?{t]5}'(l2:y1:f;y5:fals"
|
||||
"e;),.1A1?{f]5}.4,'(y5:port:),.3,'(s23:unexpected name after #),@(y10:r"
|
||||
"ead-error)[54}'(cb),.1Ci=,.0?{.0}{'(co),.2Ci=,.0?{.0}{'(cd),.3Ci=,.0?{"
|
||||
".0}{'(cx),.4Ci=,.0?{.0}{'(ci),.5Ci=,.0?{.0}{'(ce),.6Ci=}_1}_1}_1}_1}_1"
|
||||
"?{.2,'(c#),:(i11)^[32}'(c&),.1C=?{.2R0${.4,:3^[01}b]3}'(c;),.1C=?{.2R0"
|
||||
"${.4,:3^[01}.2,:(i10)^[31}'(c|),.1C=?{.2R0${,#0.5,.1,&2{%0:1R0,.0R8?{:"
|
||||
"1,'(y5:port:),'(s25:end of file in #| comment),@(y10:read-error)[13}'("
|
||||
"c|),.1C=?{:1R1,.0R8?{:1,'(y5:port:),'(s25:end of file in #| comment),@"
|
||||
"(y10:read-error)[23}'(c#),.1C=?{:1R0]2}:0^[20}'(c#),.1C=?{:1R1,.0R8?{:"
|
||||
"1,'(y5:port:),'(s25:end of file in #| comment),@(y10:read-error)[23}'("
|
||||
"c|),.1C=?{:1R0${:0^[00}:0^[20}:0^[20}:0^[10}.!0.0^_1[00}.2,:(i10)^[31}"
|
||||
"'(c(),.1C=?{.2R0${f,:9^,.6,.5,:8^[04}X1]3}'(cu),.1C=?{.2R0'(c8),.3R0q?"
|
||||
"{'(c(),.3R0q}{f}?{${.4,:7^[01}E1]3}.2,'(y5:port:),'(s25:invalid byteve"
|
||||
"ctor syntax),@(y10:read-error)[33}'(c%5c),.1C=?{.2R0.2R1,.0R8?{.3,'(y5"
|
||||
":port:),'(s20:end of file after #%5c),@(y10:read-error)[43}.0,'(cx)C=?"
|
||||
"{.3R0${.5R1,:5^[01}?{.0]4}f,.4,:6^[42}.0C4?{${.5,:3^[01},'1,.1X4S3=?{."
|
||||
"1]5}.0,'(y4:null),.1v?{'0X9]6}'(y5:space),.1v?{'(c )]6}'(y5:alarm),.1v"
|
||||
"?{'(c%07)]6}'(y9:backspace),.1v?{'(c%08)]6}'(y6:delete),.1v?{'(i127)X9"
|
||||
"]6}'(y6:escape),.1v?{'(i27)X9]6}'(y3:tab),.1v?{'(c%09)]6}'(l2:y7:newli"
|
||||
"ne;y8:linefeed;),.1A1?{'(c%0a)]6}'(y4:vtab),.1v?{'(c%0b)]6}'(y4:page),"
|
||||
".1v?{'(c%0c)]6}'(y6:return),.1v?{'(c%0d)]6}.5,'(y5:port:),.3,'(s15:unk"
|
||||
"nown #%5c name),@(y10:read-error)[64}.3R0.0]4}.0C5?{:0?{${.4,'(y5:port"
|
||||
":),'(s44:#N=/#N# notation is not allowed in this mode),@(y10:read-erro"
|
||||
"r)[03}}n,,#0.4,.1,:4,:3,:2,:1,&6{%1:5R0,.0R8?{:5,'(y5:port:),'(s32:end"
|
||||
" of file within a #N notation),@(y10:read-error)[23}.0C5?{.1,.1c,:4^[2"
|
||||
"1}'(c#),.1C=?{.1A9X3,'(i10),.1E9,.0I0?{:0^,.1A3}{f},.0?{.0d]5}'(s22:un"
|
||||
"known #n# reference:),'(y5:port:),.4,@(y10:read-error)[53}'(c=),.1C=?{"
|
||||
".1A9X3,'(i10),.1E9,.0I0~?{${'(s22:invalid #n= reference:),'(y5:port:),"
|
||||
".5,@(y10:read-error)[03}}{:0^,.1A3?{${'(s18:duplicate #n= tag:),'(y5:p"
|
||||
"ort:),.4,@(y10:read-error)[03}}{f}}fb,:0^,${.3,:1^[01},.3cc:!0${:5,:2^"
|
||||
"[01},${.2,:3^[01}?{'(s31:#n= has another label as target),'(y5:port:),"
|
||||
".5,@(y10:read-error)[63}.0,.2sz.0]6}:5,'(y5:port:),'(s34:invalid termi"
|
||||
"nator for #N notation),@(y10:read-error)[23}.!0.0^_1[31}.2,'(y5:port:)"
|
||||
",.2,'(s16:unknown # syntax),@(y10:read-error)[34}.1,'(y5:port:),.2,'(s"
|
||||
"22:illegal character read),@(y10:read-error)[24}.!(i16).(i16),.(i12),."
|
||||
"(i17),.(i13),&4{%4${.3,:3^[01},:0^,.1q?{.2,'(y5:port:),'(s42:missing c"
|
||||
"ar -- ( immediately followed by .),@(y10:read-error)[53}.0,,#0.0,.5,:3"
|
||||
",:2,.(i10),:1,.(i11),:0,&8{%1.0R8?{:6,'(y5:port:),'(s41:eof inside lis"
|
||||
"t -- unbalanced parentheses),@(y10:read-error)[13}:1,.1q?{n]1}:0^,.1q?"
|
||||
"{:3?{${:6,:2^[01},${:6,:5^[01},:1,.1q?{.1]3}:6,'(y5:port:),.2,'(s31:ra"
|
||||
"ndomness after form after dot),@(y10:read-error)[34}:6,'(y5:port:),'(s"
|
||||
"13:dot in #(...)),@(y10:read-error)[13}${.2,:4^[01}?{:6,'(y5:port:),.2"
|
||||
"d,'(s20:error inside list --),@(y10:read-error)[14}${${:6,:5^[01},:7^["
|
||||
"01},.1c]1}.!0.0^_1[51}.!(i17).(i16),.9,.(i13),&3{%1${.2,:2^[01},,#0.0,"
|
||||
".3,:2,:0,:1,&5{%1.0R8?{:3,'(y5:port:),'(s21:eof inside bytevector),@(y"
|
||||
"10:read-error)[13}:0^,.1q?{n]1}${.2,:1^[01}?{:3,'(y5:port:),.2d,'(s26:"
|
||||
"error inside bytevector --),@(y10:read-error)[14}.0I0~,.0?{.0}{'0,.2I<"
|
||||
",.0?{.0}{'(i255),.3I>}_1}_1?{:3,'(y5:port:),.2,'(s33:invalid byte insi"
|
||||
"de bytevector --),@(y10:read-error)[14}${${:3,:2^[01},:4^[01},.1c]1}.!"
|
||||
"0.0^_1[11}.!(i18).(i20),&1{%2.0R0,.0R8?{${.3,'(y5:port:),.6,'(s20:end "
|
||||
"of file within a),@(y10:read-error)[04}}'(c%5c),.1C=,.0?{.0}{'(c%22),."
|
||||
"2C=,.0?{.0}{'(c|),.3C=}_1}_1?{.0]3}'(ca),.1C=?{'(c%07)]3}'(cb),.1C=?{'"
|
||||
"(c%08)]3}'(ct),.1C=?{'(c%09)]3}'(cn),.1C=?{'(c%0a)]3}'(cv),.1C=?{'(c%0"
|
||||
"b)]3}'(cf),.1C=?{'(c%0c)]3}'(cr),.1C=?{'(c%0d)]3}'(cx),.1C=?{t,.2,:0^["
|
||||
"32}'(y6:string),.3q?{.0C1}{f}?{.1R1,'(c%0a),.2C=,,#0.0,.5,&2{%2.1R8,.0"
|
||||
"?{.0}{.2C1~}_1?{.0?{f]2}:0,'(y5:port:),'(s32:no newline in line ending"
|
||||
" escape),@(y10:read-error)[23}.0?{'(c%0a),.2C=}{f}?{f]2}:0R0:0R1,.1,.0"
|
||||
"?{.0}{'(c%0a),.4C=}_1,:1^[22}.!0.0^_1[32}.1,'(y5:port:),.2,'(y1::),.6,"
|
||||
"'(s22:invalid char escape in),@(y10:read-error)[36}.!(i19).(i14),.(i14"
|
||||
"),&2{%2,#0.1,&1{%1.0u?{:0,'(y5:port:),'(s31:%5cx escape sequence is to"
|
||||
"o short),@(y10:read-error)[13}'(i16),.1A9X3X7X9]1}.!0'0,n,.3R1,,#0.0,."
|
||||
"6,:0,.7,.(i10),:1,&6{%3.0R8?{:1?{:4,'(y5:port:),'(s27:end of file with"
|
||||
"in a string),@(y10:read-error)[33}.1,:2^[31}:1?{'(c;),.1C=}{f}?{:4R0.1"
|
||||
",:2^[31}:1~?{${.2,:0^[01}}{f}?{.1,:2^[31}${.2,:3^[01}~?{:4,'(y5:port:)"
|
||||
",.2,'(s37:unexpected char in %5cx escape sequence),@(y10:read-error)[3"
|
||||
"4}'2,.3>?{:4,'(y5:port:),'(s30:%5cx escape sequence is too long),@(y10"
|
||||
":read-error)[33}:4R0'1,.3+,.2,.2c,:4R1,:5^[33}.!0.0^_1[33}.!(i20)&0{%4"
|
||||
".0,.0?{.0}{.2C5}_1?{f]4}'(s2:+i),.4Si=,.0?{.0}{'(s2:-i),.5Si=}_1?{f]4}"
|
||||
"'(s6:+nan.0),.4Si=,.0?{.0}{'(s6:-nan.0),.5Si=}_1?{f]4}'(s6:+inf.0),.4S"
|
||||
"i=,.0?{.0}{'(s6:-inf.0),.5Si=}_1?{f]4}'(c+),.2C=,.0?{.0}{'(c-),.3C=}_1"
|
||||
"?{.2du?{t]4}'(c.),.3daC=?{.2ddp?{.2ddaC5~]4}f]4}.2daC5~]4}'(c.),.2C=?{"
|
||||
".2dp?{.2daC5~]4}f]4}f]4}.!(i21).(i14),.(i22),.(i12),.3,.(i16),&5{%2'(c"
|
||||
"#),.1C=,.1,l1,.3R1,,#0.5,.1,:0,:1,:2,:3,:4,&7{%3.0R8,.0?{.0}{${.3,:0^["
|
||||
"01}}_1?{.1A9,.0a,.1X3,.5,.0?{.0}{.2C5,.0?{.0}{'(c+),.4C=,.0?{.0}{'(c-)"
|
||||
",.5C=,.0?{.0}{'(c.),.6C=}_1}_1}_1}_1?{'(s1:.),.1S=?{:2^]6}${.2,.5,.5,."
|
||||
"(i10),:1^[04}?{:3^?{.0SfX5]6}.0X5]6}'(i10),.1E9,.0?{.0]7}:6,'(y5:port:"
|
||||
"),.3,'(s54:unsupported number syntax (implementation restriction)),@(y"
|
||||
"10:read-error)[74}:3^?{.0SfX5]6}.0X5]6}'(c#),.1C=?{:6R0t,.2,.2c,:6R1,:"
|
||||
"5^[33}${.2,:4^[01}?{:6R0.2,.2,.2c,:6R1,:5^[33}:6,'(y5:port:),.2,'(s29:"
|
||||
"unexpected number/symbol char),@(y10:read-error)[34}.!0.0^_1[23}.!(i22"
|
||||
")${.(i25),.(i19)^[01},${.2,.(i15)^[01}~?{.2^u?{.0](i26)}.0,.8^[(i26)1}"
|
||||
".(i24),'(y5:port:),.2d,'(s17:unexpected token:),@(y10:read-error)[(i26"
|
||||
")4",
|
||||
|
||||
"C", 0,
|
||||
"&0{%1f,.1,@(y5:%25read)[12}%x,&0{%0f,Pi,@(y5:%25read)[02}%x,&2{|00|11%"
|
||||
|
|
|
|||
11
src/s.scm
11
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)]
|
||||
|
|
|
|||
474
src/t.scm
474
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>) (symbol? x))
|
||||
(and (eq? pat '<string>) (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>=? 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) (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-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-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>=? 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) (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-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-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)
|
||||
|
|
|
|||
279
t.c
279
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:<symbol>),.2q?{.2Y0}{f},.0?{.0]4}'(y8:<str"
|
||||
"ing>),.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",
|
||||
|
|
|
|||
Loading…
Reference in a new issue