mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-26 21:58:51 +01:00
s.scm library improvements
This commit is contained in:
ESL
parent
b564316cf8
commit
c32c9cfe49
5 changed files with 292 additions and 98 deletions
2
i.c
2
i.c
|
|
@ -931,7 +931,7 @@ define_instruction(vget) {
|
|||
define_instruction(vput) {
|
||||
obj x = spop(), y = spop(); int i;
|
||||
ckv(ac); ckk(x);
|
||||
i = fixnum_from_obj(spop());
|
||||
i = fixnum_from_obj(x);
|
||||
vectorref(ac, i) = y;
|
||||
gonexti();
|
||||
}
|
||||
|
|
|
|||
8
i.h
8
i.h
|
|
@ -316,10 +316,10 @@ declare_instruction(eq, "=", 0, "%eq", 2, INLINED)
|
|||
declare_instruction(ne, "=!", 0, "%ne", 2, INLINED)
|
||||
declare_instruction(neg, "-!", 0, "%neg", 1, INLINED)
|
||||
declare_instruction(abs, "G0", 0, "%abs", 1, INLINED)
|
||||
declare_instruction(mqu, "G3", 0, "%mqu", 1, INLINED)
|
||||
declare_instruction(mlo, "G4", 0, "%mlo", 1, INLINED)
|
||||
declare_instruction(quo, "G5", 0, "%quo", 1, INLINED)
|
||||
declare_instruction(rem, "G6", 0, "%rem", 1, INLINED)
|
||||
declare_instruction(mqu, "G3", 0, "%mqu", 2, INLINED)
|
||||
declare_instruction(mlo, "G4", 0, "%mlo", 2, INLINED)
|
||||
declare_instruction(quo, "G5", 0, "%quo", 2, INLINED)
|
||||
declare_instruction(rem, "G6", 0, "%rem", 2, INLINED)
|
||||
declare_instruction(nump, "N0", 0, "%nump", 1, INLINED)
|
||||
declare_instruction(intp, "N4", 0, "%intp", 1, INLINED)
|
||||
declare_instruction(nanp, "N5", 0, "%nanp", 1, INLINED)
|
||||
|
|
|
|||
175
s.c
175
s.c
|
|
@ -602,7 +602,7 @@ char *s_code[] = {
|
|||
";l2:y1:_;y18:%25residual-quotient;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1,@(y4:%25quo)[22}@!(y18:%25residual-quotient)",
|
||||
"&0{%2.1,.1G5]2}@!(y18:%25residual-quotient)",
|
||||
|
||||
"remainder",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25rem;y1:x;y1:y;;;l"
|
||||
|
|
@ -610,7 +610,7 @@ char *s_code[] = {
|
|||
";;l2:y1:_;y19:%25residual-remainder;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1,@(y4:%25rem)[22}@!(y19:%25residual-remainder)",
|
||||
"&0{%2.1,.1G6]2}@!(y19:%25residual-remainder)",
|
||||
|
||||
"truncate-quotient",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py8:quotient;y4:args;;;l2:y1:_"
|
||||
|
|
@ -626,7 +626,7 @@ char *s_code[] = {
|
|||
"2:y1:_;y16:%25residual-modquo;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1,@(y4:%25mqu)[22}@!(y16:%25residual-modquo)",
|
||||
"&0{%2.1,.1G3]2}@!(y16:%25residual-modquo)",
|
||||
|
||||
"modulo",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25mlo;y1:x;y1:y;;;l"
|
||||
|
|
@ -634,7 +634,7 @@ char *s_code[] = {
|
|||
"2:y1:_;y16:%25residual-modulo;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1,@(y4:%25mlo)[22}@!(y16:%25residual-modulo)",
|
||||
"&0{%2.1,.1G4]2}@!(y16:%25residual-modulo)",
|
||||
|
||||
"floor-quotient",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py6:modquo;y4:args;;;l2:y1:_;y"
|
||||
|
|
@ -644,6 +644,12 @@ char *s_code[] = {
|
|||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py6:modulo;y4:args;;;l2:y1:_;y"
|
||||
"6:modulo;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1G4,.2,.2G3,@(y5:%25sdmv)[22}@!(y6:floor/)",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1G6,.2,.2G5,@(y5:%25sdmv)[22}@!(y9:truncate/)",
|
||||
|
||||
"boolean?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25boolp;y1:x;;;l2:py1:_;"
|
||||
"y12:syntax-rules;;py18:%25residual-boolean?;y12:syntax-rules;;;l2:y1:_"
|
||||
|
|
@ -1348,14 +1354,6 @@ char *s_code[] = {
|
|||
"l5:y1:_;y1:x;y1:y;y1:z;y3:...;;l3:y13:vector-append;y1:x;l4:y13:vector"
|
||||
"-append;y1:y;y1:z;y3:...;;;;l2:y1:_;y23:%25residual-vector-append;;",
|
||||
|
||||
"vector->list",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25vtol;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py22:%25residual-vector->list;y12:syntax-rules;;;l2:y"
|
||||
"1:_;y22:%25residual-vector->list;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0X0]1}@!(y22:%25residual-vector->list)",
|
||||
|
||||
"list->vector",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25ltov;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py22:%25residual-list->vector;y12:syntax-rules;;;l2:y"
|
||||
|
|
@ -1364,6 +1362,58 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%1.0X1]1}@!(y22:%25residual-list->vector)",
|
||||
|
||||
0,
|
||||
"&0{%3n,'1,.4I-,,#0.3,.1,.6,&3{%2:0,.1I<?{.1]2}.1,.1,:2V4c,'1,.2I-,:1^["
|
||||
"22}.!0.0^_1[32}@!(y15:subvector->list)",
|
||||
|
||||
0,
|
||||
"&0{%3.2,.2,.2,@(y15:subvector->list)[33}%x,&0{%2.0V3,.2,.2,@(y15:subve"
|
||||
"ctor->list)[23}%x,&0{%1.0X0]1}%x,&3{|10|21|32%%}@!(y12:vector->list)",
|
||||
|
||||
0,
|
||||
"&0{%5.1,.1V3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.3,.7,.6,.3,&4{%2:3,.2I<!,"
|
||||
".0?{.0]3}.2,:2V4,.2,:1V5.2'1,.3I+,.2'1,.3I+,:0^[32}.!0.0^_1[62}'1,.1I-"
|
||||
",${'1,.8,.(i10),@(y13:%25residual-fx-)[03},.4I+,,#0.7,.7,.6,.3,&4{%2:3"
|
||||
",.2I<,.0?{.0]3}.2,:2V4,.2,:1V5.2'1,.3I-,.2'1,.3I-,:0^[32}.!0.0^_1[62}@"
|
||||
"!(y15:subvector-copy!)",
|
||||
|
||||
0,
|
||||
"&0{%5.4,.4,.4,.4,.4,@(y15:subvector-copy!)[55}%x,&0{%4.2V3,.4,.4,.4,.4"
|
||||
",@(y15:subvector-copy!)[45}%x,&0{%3.2V3,'0,.4,.4,.4,@(y15:subvector-co"
|
||||
"py!)[35}%x,&3{|30|41|52%%}@!(y12:vector-copy!)",
|
||||
|
||||
0,
|
||||
"&0{%3f,.2,.4I-V2,${.5,.5,.5,'0,.6,@(y15:subvector-copy!)[05}.0]4}@!(y9"
|
||||
":subvector)",
|
||||
|
||||
0,
|
||||
"&0{%3.2,.2,.2,@(y9:subvector)[33}%x,&0{%2.0V3,.2,.2,@(y9:subvector)[23"
|
||||
"}%x,&0{%1.0V3,'0,.2,@(y9:subvector)[13}%x,&3{|10|21|32%%}@!(y11:vector"
|
||||
"-copy)",
|
||||
|
||||
0,
|
||||
"&0{%4.2,,#0.5,.4,.4,.3,&4{%1:3,.1I<!,.0?{.0]2}:2,.2,:1V5.1'1,.2I+,:0^["
|
||||
"21}.!0.0^_1[41}@!(y15:subvector-fill!)",
|
||||
|
||||
0,
|
||||
"&0{%4.3,.3,.3,.3,@(y15:subvector-fill!)[44}%x,&0{%3.0V3,.3,.3,.3,@(y15"
|
||||
":subvector-fill!)[34}%x,&0{%2.0V3,'0,.3,.3,@(y15:subvector-fill!)[24}%"
|
||||
"x,&3{|20|31|42%%}@!(y12:vector-fill!)",
|
||||
|
||||
0,
|
||||
"&0{%5.1,.1S3I-,.4I+,.5In,.4,.3,,#0.0,.5,.8,.6,&4{%2:0,.2I<!?{:2]2}.1,:"
|
||||
"1V4,.1,:2S5.1'1,.2I+,.1'1,.2I+,:3^[22}.!0.0^_1[62}@!(y22:subvector-str"
|
||||
"ing-copy!)",
|
||||
|
||||
0,
|
||||
"&0{%3.2,.2,.2,'0,'(c ),.6,.8I-S2,@(y22:subvector-string-copy!)[35}@!(y"
|
||||
"17:subvector->string)",
|
||||
|
||||
0,
|
||||
"&0{%3.2,.2,.2,@(y17:subvector->string)[33}%x,&0{%2.0V3,.2,.2,@(y17:sub"
|
||||
"vector->string)[23}%x,&0{%1.0V3,'0,.2,@(y17:subvector->string)[13}%x,&"
|
||||
"3{|10|21|32%%}@!(y14:vector->string)",
|
||||
|
||||
"string?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25strp;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py17:%25residual-string?;y12:syntax-rules;;;l2:y1:_;y"
|
||||
|
|
@ -1411,6 +1461,34 @@ char *s_code[] = {
|
|||
"y1:y;y1:z;y3:...;;l3:y13:string-append;y1:x;l4:y13:string-append;y1:y;"
|
||||
"y1:z;y3:...;;;;l2:y1:_;y23:%25residual-string-append;;",
|
||||
|
||||
"list->string",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25ltos;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py22:%25residual-list->string;y12:syntax-rules;;;l2:y"
|
||||
"1:_;y22:%25residual-list->string;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0X3]1}@!(y22:%25residual-list->string)",
|
||||
|
||||
0,
|
||||
"&0{%3n,'1,.4I-,,#0.3,.1,.6,&3{%2:0,.1I<?{.1]2}.1,.1,:2S4c,'1,.2I-,:1^["
|
||||
"22}.!0.0^_1[32}@!(y15:substring->list)",
|
||||
|
||||
0,
|
||||
"&0{%3.2,.2,.2,@(y15:substring->list)[33}%x,&0{%2.0S3,.2,.2,@(y15:subst"
|
||||
"ring->list)[23}%x,&0{%1.0X2]1}%x,&3{|10|21|32%%}@!(y12:string->list)",
|
||||
|
||||
0,
|
||||
"&0{%5.1,.1S3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.3,.7,.6,.3,&4{%2:3,.2I<!,"
|
||||
".0?{.0]3}.2,:2S4,.2,:1S5.2'1,.3I+,.2'1,.3I+,:0^[32}.!0.0^_1[62}'1,.1I-"
|
||||
",${'1,.8,.(i10),@(y13:%25residual-fx-)[03},.4I+,,#0.7,.7,.6,.3,&4{%2:3"
|
||||
",.2I<,.0?{.0]3}.2,:2S4,.2,:1S5.2'1,.3I-,.2'1,.3I-,:0^[32}.!0.0^_1[62}@"
|
||||
"!(y15:substring-copy!)",
|
||||
|
||||
0,
|
||||
"&0{%5.4,.4,.4,.4,.4,@(y15:substring-copy!)[55}%x,&0{%4.2S3,.4,.4,.4,.4"
|
||||
",@(y15:substring-copy!)[45}%x,&0{%3.2S3,'0,.4,.4,.4,@(y15:substring-co"
|
||||
"py!)[35}%x,&3{|30|41|52%%}@!(y12:string-copy!)",
|
||||
|
||||
"substring",
|
||||
"l5:y12:syntax-rules;n;l2:l4:y1:_;y1:x;y1:s;y1:e;;l4:y5:%25ssub;y1:x;y1"
|
||||
":s;y1:e;;;l2:py1:_;y12:syntax-rules;;py19:%25residual-substring;y12:sy"
|
||||
|
|
@ -1419,6 +1497,33 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%3.2,.2,.2S7]3}@!(y19:%25residual-substring)",
|
||||
|
||||
0,
|
||||
"&0{%3.2,.2,.2S7]3}%x,&0{%2.0S3,.2,.2S7]2}%x,&0{%1.0S3,'0,.2S7]1}%x,&3{"
|
||||
"|10|21|32%%}@!(y11:string-copy)",
|
||||
|
||||
0,
|
||||
"&0{%4.2,,#0.5,.4,.4,.3,&4{%1:3,.1I<!,.0?{.0]2}:2,.2,:1S5.1'1,.2I+,:0^["
|
||||
"21}.!0.0^_1[41}@!(y15:substring-fill!)",
|
||||
|
||||
0,
|
||||
"&0{%4.3,.3,.3,.3,@(y15:substring-fill!)[44}%x,&0{%3.0S3,.3,.3,.3,@(y15"
|
||||
":substring-fill!)[34}%x,&0{%2.0S3,'0,.3,.3,@(y15:substring-fill!)[24}%"
|
||||
"x,&3{|20|31|42%%}@!(y12:string-fill!)",
|
||||
|
||||
0,
|
||||
"&0{%5.1,.1V3I-,.4I+,.5In,.4,.3,,#0.0,.5,.8,.6,&4{%2:0,.2I<!?{:2]2}.1,:"
|
||||
"1S4,.1,:2V5.1'1,.2I+,.1'1,.2I+,:3^[22}.!0.0^_1[62}@!(y22:substring-vec"
|
||||
"tor-copy!)",
|
||||
|
||||
0,
|
||||
"&0{%3.2,.2,.2,'0,f,.6,.8I-V2,@(y22:substring-vector-copy!)[35}@!(y17:s"
|
||||
"ubstring->vector)",
|
||||
|
||||
0,
|
||||
"&0{%3.2,.2,.2,@(y17:substring->vector)[33}%x,&0{%2.0S3,.2,.2,@(y17:sub"
|
||||
"string->vector)[23}%x,&0{%1.0S3,'0,.2,@(y17:substring->vector)[13}%x,&"
|
||||
"3{|10|21|32%%}@!(y14:string->vector)",
|
||||
|
||||
"string-cmp",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25scmp;y1:x;y1:y;;;"
|
||||
"l2:py1:_;y12:syntax-rules;;py20:%25residual-string-cmp;y12:syntax-rule"
|
||||
|
|
@ -1515,22 +1620,6 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%2.1,.1Si<!]2}@!(y19:%25residual-string>=?)",
|
||||
|
||||
"string->list",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25stol;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py22:%25residual-string->list;y12:syntax-rules;;;l2:y"
|
||||
"1:_;y22:%25residual-string->list;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0X2]1}@!(y22:%25residual-string->list)",
|
||||
|
||||
"list->string",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25ltos;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py22:%25residual-list->string;y12:syntax-rules;;;l2:y"
|
||||
"1:_;y22:%25residual-list->string;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0X3]1}@!(y22:%25residual-list->string)",
|
||||
|
||||
"fixnum->string",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:r;;l3:y5:%25itos;y1:x;y1:r;;;"
|
||||
"l2:py1:_;y12:syntax-rules;;py24:%25residual-fixnum->string;y12:syntax-"
|
||||
|
|
@ -1621,31 +1710,29 @@ char *s_code[] = {
|
|||
|
||||
0,
|
||||
"&0{%!2.0u?{.2S3,'(c ),.1S2,'0,,#0.0,.3,.8,.8,.7,&5{%1:0,.1I<!?{:3]1}${"
|
||||
".2,:2S4,:1[01},.1,:3S5.0'1,.1I+,:4^[11}.!0.0^_1[51}${@(y22:%25residual"
|
||||
"-string->list),${.5,.8c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c"
|
||||
"]1}n]1}.!0.0^_1[01}_1,.4c,@(y13:%25residual-map),@(y5:%25appl)[02}X3]3"
|
||||
"}@!(y10:string-map)",
|
||||
".2,:2S4,:1[01},.1,:3S5.0'1,.1I+,:4^[11}.!0.0^_1[51}${@(y12:string->lis"
|
||||
"t),${.5,.8c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0"
|
||||
"^_1[01}_1,.4c,@(y13:%25residual-map),@(y5:%25appl)[02}X3]3}@!(y10:stri"
|
||||
"ng-map)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2V3,f,.1V2,'0,,#0.0,.3,.8,.8,.7,&5{%1:0,.1I<!?{:3]1}${.2,:"
|
||||
"2V4,:1[01},.1,:3V5.0'1,.1I+,:4^[11}.!0.0^_1[51}${@(y22:%25residual-vec"
|
||||
"tor->list),${.5,.8c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n"
|
||||
"]1}.!0.0^_1[01}_1,.4c,@(y13:%25residual-map),@(y5:%25appl)[02}X1]3}@!("
|
||||
"y10:vector-map)",
|
||||
"2V4,:1[01},.1,:3V5.0'1,.1I+,:4^[11}.!0.0^_1[51}${@(y12:vector->list),$"
|
||||
"{.5,.8c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1["
|
||||
"01}_1,.4c,@(y13:%25residual-map),@(y5:%25appl)[02}X1]3}@!(y10:vector-m"
|
||||
"ap)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2S3,'0,,#0.2,.6,.6,.3,&4{%1:3,.1I<!,.0?{.0]2}${.3,:2S4,:1["
|
||||
"01}.1'1,.2I+,:0^[21}.!0.0^_1[41}@(y22:%25residual-string->list),${.3,."
|
||||
"6c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1"
|
||||
",.2c,@(y18:%25residual-for-each),@(y5:%25appl)[32}@!(y15:string-for-ea"
|
||||
"ch)",
|
||||
"01}.1'1,.2I+,:0^[21}.!0.0^_1[41}@(y12:string->list),${.3,.6c,,#0.4,.1,"
|
||||
"&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.2c,@(y18:%"
|
||||
"25residual-for-each),@(y5:%25appl)[32}@!(y15:string-for-each)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2V3,'0,,#0.2,.6,.6,.3,&4{%1:3,.1I<!,.0?{.0]2}${.3,:2V4,:1["
|
||||
"01}.1'1,.2I+,:0^[21}.!0.0^_1[41}@(y22:%25residual-vector->list),${.3,."
|
||||
"6c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1"
|
||||
",.2c,@(y18:%25residual-for-each),@(y5:%25appl)[32}@!(y15:vector-for-ea"
|
||||
"ch)",
|
||||
"01}.1'1,.2I+,:0^[21}.!0.0^_1[41}@(y12:vector->list),${.3,.6c,,#0.4,.1,"
|
||||
"&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.2c,@(y18:%"
|
||||
"25residual-for-each),@(y5:%25appl)[32}@!(y15:vector-for-each)",
|
||||
|
||||
"input-port?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25ipp;y1:x;;;l2:py1:_;y1"
|
||||
|
|
|
|||
141
src/s.scm
141
src/s.scm
|
|
@ -265,8 +265,11 @@
|
|||
(define-syntax floor-quotient modquo)
|
||||
(define-syntax floor-remainder modulo)
|
||||
|
||||
;floor/
|
||||
;truncate/
|
||||
(define (floor/ x y)
|
||||
(%sdmv (floor-quotient x y) (floor-remainder x y)))
|
||||
|
||||
(define (truncate/ x y)
|
||||
(%sdmv (truncate-quotient x y) (truncate-remainder x y)))
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -492,16 +495,68 @@
|
|||
[(_ x y z ...) (vector-append x (vector-append y z ...))]
|
||||
[_ %residual-vector-append]))
|
||||
|
||||
(define-inline (vector->list x) %residual-vector->list (%vtol x))
|
||||
|
||||
(define-inline (list->vector x) %residual-list->vector (%ltov x))
|
||||
|
||||
;vector->list/1/2/3
|
||||
;vector-copy/1/2/3=subvector
|
||||
;vector-copy!/2/3/4/5 (to at from start end)
|
||||
;vector-fill!/2/3/4 (vector val start end)
|
||||
;vector->string/1/2/3
|
||||
;string->vector/1/2/3
|
||||
(define (subvector->list vec start end)
|
||||
(let loop ([i (fx- end 1)] [l '()])
|
||||
(if (fx<? i start) l (loop (fx- i 1) (cons (vector-ref vec i) l)))))
|
||||
|
||||
(define vector->list
|
||||
(case-lambda
|
||||
[(vec) (%vtol vec)]
|
||||
[(vec start) (subvector->list vec start (vector-length vec))]
|
||||
[(vec start end) (subvector->list vec start end)]))
|
||||
|
||||
(define (subvector-copy! to at from start end)
|
||||
(let ([limit (fxmin end (fx+ start (fx- (vector-length to) at)))])
|
||||
(if (fx<=? at start)
|
||||
(do ([i at (fx+ i 1)] [j start (fx+ j 1)])
|
||||
[(fx>=? j limit)]
|
||||
(vector-set! to i (vector-ref from j)))
|
||||
(do ([i (fx+ at (fx- (fx- end start) 1)) (fx- i 1)] [j (fx- limit 1) (fx- j 1)])
|
||||
[(fx<? j start)]
|
||||
(vector-set! to i (vector-ref from j))))))
|
||||
|
||||
(define vector-copy!
|
||||
(case-lambda
|
||||
[(to at from) (subvector-copy! to at from 0 (vector-length from))]
|
||||
[(to at from start) (subvector-copy! to at from start (vector-length from))]
|
||||
[(to at from start end) (subvector-copy! to at from start end)]))
|
||||
|
||||
(define (subvector vec start end) ; TODO: %vsub?
|
||||
(let ([v (make-vector (fx- end start))])
|
||||
(subvector-copy! v 0 vec start end)
|
||||
v))
|
||||
|
||||
(define vector-copy
|
||||
(case-lambda
|
||||
[(vec) (subvector vec 0 (vector-length vec))] ; TODO: %vcpy ?
|
||||
[(vec start) (subvector vec start (vector-length vec))]
|
||||
[(vec start end) (subvector vec start end)]))
|
||||
|
||||
(define (subvector-fill! vec x start end)
|
||||
(do ([i start (fx+ i 1)]) [(fx>=? i end)] (vector-set! vec i x)))
|
||||
|
||||
(define vector-fill!
|
||||
(case-lambda
|
||||
[(vec x) (subvector-fill! vec x 0 (vector-length vec))]
|
||||
[(vec x start) (subvector-fill! vec x start (vector-length vec))]
|
||||
[(vec x start end) (subvector-fill! vec x start end)]))
|
||||
|
||||
(define (subvector-string-copy! to at from start end)
|
||||
(let ([limit (fxmin end (fx+ start (fx- (string-length to) at)))])
|
||||
(do ([i at (fx+ i 1)] [j start (fx+ j 1)])
|
||||
[(fx>=? j limit) to]
|
||||
(string-set! to i (vector-ref from j)))))
|
||||
|
||||
(define (subvector->string vec start end)
|
||||
(subvector-string-copy! (make-string (fx- end start)) 0 vec start end))
|
||||
|
||||
(define vector->string
|
||||
(case-lambda
|
||||
[(vec) (subvector->string vec 0 (vector-length vec))]
|
||||
[(vec start) (subvector->string vec start (vector-length vec))]
|
||||
[(vec start end) (subvector->string vec start end)]))
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -535,8 +590,66 @@
|
|||
[(_ x y z ...) (string-append x (string-append y z ...))]
|
||||
[_ %residual-string-append]))
|
||||
|
||||
(define-inline (list->string x) %residual-list->string (%ltos x))
|
||||
|
||||
(define (substring->list str start end)
|
||||
(let loop ([i (fx- end 1)] [l '()])
|
||||
(if (fx<? i start) l (loop (fx- i 1) (cons (string-ref str i) l)))))
|
||||
|
||||
(define string->list
|
||||
(case-lambda
|
||||
[(str) (%stol str)]
|
||||
[(str start) (substring->list str start (string-length str))]
|
||||
[(str start end) (substring->list str start end)]))
|
||||
|
||||
(define (substring-copy! to at from start end)
|
||||
(let ([limit (fxmin end (fx+ start (fx- (string-length to) at)))])
|
||||
(if (fx<=? at start)
|
||||
(do ([i at (fx+ i 1)] [j start (fx+ j 1)])
|
||||
[(fx>=? j limit)]
|
||||
(string-set! to i (string-ref from j)))
|
||||
(do ([i (fx+ at (fx- (fx- end start) 1)) (fx- i 1)] [j (fx- limit 1) (fx- j 1)])
|
||||
[(fx<? j start)]
|
||||
(string-set! to i (string-ref from j))))))
|
||||
|
||||
(define string-copy!
|
||||
(case-lambda
|
||||
[(to at from) (substring-copy! to at from 0 (string-length from))]
|
||||
[(to at from start) (substring-copy! to at from start (string-length from))]
|
||||
[(to at from start end) (substring-copy! to at from start end)]))
|
||||
|
||||
(define-inline (substring x s e) %residual-substring (%ssub x s e))
|
||||
|
||||
(define string-copy
|
||||
(case-lambda
|
||||
[(str) (substring str 0 (string-length str))] ; TODO: %scpy ?
|
||||
[(str start) (substring str start (string-length str))]
|
||||
[(str start end) (substring str start end)]))
|
||||
|
||||
(define (substring-fill! str c start end)
|
||||
(do ([i start (fx+ i 1)]) [(fx>=? i end)] (string-set! str i c)))
|
||||
|
||||
(define string-fill!
|
||||
(case-lambda
|
||||
[(str c) (substring-fill! str c 0 (string-length str))]
|
||||
[(str c start) (substring-fill! str c start (string-length str))]
|
||||
[(str c start end) (substring-fill! str c start end)]))
|
||||
|
||||
(define (substring-vector-copy! to at from start end)
|
||||
(let ([limit (fxmin end (fx+ start (fx- (vector-length to) at)))])
|
||||
(do ([i at (fx+ i 1)] [j start (fx+ j 1)])
|
||||
[(fx>=? j limit) to]
|
||||
(vector-set! to i (string-ref from j)))))
|
||||
|
||||
(define (substring->vector str start end)
|
||||
(substring-vector-copy! (make-vector (fx- end start)) 0 str start end))
|
||||
|
||||
(define string->vector
|
||||
(case-lambda
|
||||
[(str) (substring->vector str 0 (string-length str))]
|
||||
[(str start) (substring->vector str start (string-length str))]
|
||||
[(str start end) (substring->vector str start end)]))
|
||||
|
||||
(define-inline (string-cmp x y) %residual-string-cmp (%scmp x y))
|
||||
(define-inline (string=? x y) %residual-string<? (%seq x y))
|
||||
(define-inline (string<? x y) %residual-string<? (%slt x y))
|
||||
|
|
@ -550,17 +663,9 @@
|
|||
(define-inline (string-ci>? x y) %residual-string>? (%sigt x y))
|
||||
(define-inline (string-ci>=? x y) %residual-string>=? (%sige x y))
|
||||
|
||||
(define-inline (string->list x) %residual-string->list (%stol x))
|
||||
|
||||
(define-inline (list->string x) %residual-list->string (%ltos x))
|
||||
|
||||
;string-upcase
|
||||
;string-downcase
|
||||
;string-foldcase
|
||||
;string->list/1/2/3
|
||||
;string-copy/1/2/3=substring
|
||||
;string-copy!/2/3/4/5 (to at from start end)
|
||||
;string-fill!/2/3/4 (string v start end)
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
|
|||
64
t.c
64
t.c
|
|
@ -153,9 +153,9 @@ char *t_code[] = {
|
|||
|
||||
0,
|
||||
"&0{%2${.2,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@(y7:id->sym)[11}.0p?{${.2"
|
||||
"d,:0^[01},${.3a,:0^[01}c]1}.0V0?{:0^,${.3X0,,#0.4,.1,&2{%1.0p?{${.2d,:"
|
||||
"0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1X1]1}.0]1}.!0.0^_1[01},'(y5:q"
|
||||
"uote),l2]2}@!(y11:xform-quote)",
|
||||
"d,:0^[01},${.3a,:0^[01}c]1}.0V0?{:0^,${${.5,@(y12:vector->list)[01},,#"
|
||||
"0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1X1]1}"
|
||||
".0]1}.!0.0^_1[01},'(y5:quote),l2]2}@!(y11:xform-quote)",
|
||||
|
||||
0,
|
||||
"&0{%2${.2,.4[01},.0Y0?{.0,'(y3:ref),l2]3}.0,@(y11:binding-val)[31}@!(y"
|
||||
|
|
@ -274,34 +274,36 @@ char *t_code[] = {
|
|||
"}.!1.3,&1{%1.0p?{.0a,:0^[11}f]1}.!2.7,.9,&2{%1:0?{:0,.1q]1}${.2,@(y3:i"
|
||||
"d?)[01}?{@(y30:denotation-of-default-ellipsis),${.3,:1[01}q]1}f]1}.!3."
|
||||
"2,&1{%3n,.2,.2,,#0:0,.1,.8,&3{%3${.2,@(y3:id?)[01}?{.1?{${.2,:0[01}}{f"
|
||||
"}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2X0,:1^[33}.0p?{${.2d,:2^[01}?{${.4,.4,."
|
||||
"4dd,:1^[03},t,.2a,:1^[33}${.4,.4,.4d,:1^[03},.2,.2a,:1^[33}.2]3}.!0.0^"
|
||||
"_1[33}.!4.4,.2,.4,.3,.(i11),&5{%3.1,.1,.4,:0,:1,:2,:3,:4,&8{%1,#0.1,&1"
|
||||
"{%0f,:0[01}.!0n,:7,:6,,#0.4,.1,:0,:1,:2,:3,:4,:5,&8{%3,#0:7,.4,&2{%1.0"
|
||||
"?{:0]1}:1^[10}.!0${.3,@(y3:id?)[01}?{${.3,:2^[01}?{${.4,@(y3:id?)[01}?"
|
||||
"{${.3,:1[01},${.5,:0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{$"
|
||||
"{:7^[00}}_1.3,.3X0,.3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1dd"
|
||||
"g,.3L0?{.3g}{${:7^[00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${"
|
||||
":4^,t,.(i10)a,:5^[03},,#0.8,:6,&2{%1@(y13:%25residual-cdr),${n,.4,:1a,"
|
||||
":0^[03},,#0.2,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1["
|
||||
"21}.!0${.(i12),.6,.(i12)dd,:6^[03},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${.2d"
|
||||
",:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.5c,@(y14:%25residual-list"
|
||||
")c,@(y13:%25residual-map),@(y5:%25appl)[02}L6](i11)}.2p?{${.5,.5d,.5d,"
|
||||
":6^[03},.3a,.3a,:6^[43}:7^[40}.!0.0^_1[23},@(y4:%25ccc)[31}.!5.7,.2,.6"
|
||||
",.5,&4{%3,,,#0#1#2:3,&1{%1${${.4,:0[01},@(y6:new-id)[01},.1c]1},${${.("
|
||||
"i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[03},,#0.4,.1,&2{%1.0p?{${.2d,:0^[01"
|
||||
"},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1.!0${:2^,f,.7,:1^[03}.!1.1,:1,&2{%"
|
||||
"1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,.2,.8,:0,&5{%2.0,,#"
|
||||
"0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:3,.1A3,.0?{.0}{:0,.2A3"
|
||||
",.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:2^[01}X1]1}.0p?{${.2d,:6^[01}"
|
||||
"?{${.2a,:5^[01},,,#0#1:3,&1{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y"
|
||||
"14:%25residual-cons),@(y13:%25residual-map)[03},:1a,:0^[12}.!1.0^,${.5"
|
||||
",,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,$"
|
||||
"{.6dd,:2^[01},${.3,.6^c,@(y13:%25residual-map),@(y5:%25appl)[02}L6]5}$"
|
||||
"{.2d,:2^[01},${.3a,:2^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!6.(i10),."
|
||||
"7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syntax),'("
|
||||
"y9:transform),@(y5:error)[03}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,."
|
||||
"0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}](i11)}@!(y13:syntax-rules*)",
|
||||
"}?{.2,.1c]3}.2]3}.0V0?{.2,.2,${.4,@(y12:vector->list)[01},:1^[33}.0p?{"
|
||||
"${.2d,:2^[01}?{${.4,.4,.4dd,:1^[03},t,.2a,:1^[33}${.4,.4,.4d,:1^[03},."
|
||||
"2,.2a,:1^[33}.2]3}.!0.0^_1[33}.!4.4,.2,.4,.3,.(i11),&5{%3.1,.1,.4,:0,:"
|
||||
"1,:2,:3,:4,&8{%1,#0.1,&1{%0f,:0[01}.!0n,:7,:6,,#0.4,.1,:0,:1,:2,:3,:4,"
|
||||
":5,&8{%3,#0:7,.4,&2{%1.0?{:0]1}:1^[10}.!0${.3,@(y3:id?)[01}?{${.3,:2^["
|
||||
"01}?{${.4,@(y3:id?)[01}?{${.3,:1[01},${.5,:0[01}q}{f},.1^[41}.3,.3,.3c"
|
||||
"c]4}.1V0?{.2V0,.0?{.0}{${:7^[00}}_1.3,${.5,@(y12:vector->list)[01},${."
|
||||
"5,@(y12:vector->list)[01},:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1"
|
||||
"ddg,.3L0?{.3g}{${:7^[00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,"
|
||||
"${:4^,t,.(i10)a,:5^[03},,#0.8,:6,&2{%1@(y13:%25residual-cdr),${n,.4,:1"
|
||||
"a,:0^[03},,#0.2,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_"
|
||||
"1[21}.!0${.(i12),.6,.(i12)dd,:6^[03},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${."
|
||||
"2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.5c,@(y14:%25residual-li"
|
||||
"st)c,@(y13:%25residual-map),@(y5:%25appl)[02}L6](i11)}.2p?{${.5,.5d,.5"
|
||||
"d,:6^[03},.3a,.3a,:6^[43}:7^[40}.!0.0^_1[23},@(y4:%25ccc)[31}.!5.7,.2,"
|
||||
".6,.5,&4{%3,,,#0#1#2:3,&1{%1${${.4,:0[01},@(y6:new-id)[01},.1c]1},${${"
|
||||
".(i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[03},,#0.4,.1,&2{%1.0p?{${.2d,:0^["
|
||||
"01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1.!0${:2^,f,.7,:1^[03}.!1.1,:1,&2"
|
||||
"{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,.2,.8,:0,&5{%2.0,"
|
||||
",#0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:3,.1A3,.0?{.0}{:0,.2"
|
||||
"A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${${.4,@(y12:vector->list)[01},:2^["
|
||||
"01}X1]1}.0p?{${.2d,:6^[01}?{${.2a,:5^[01},,,#0#1:3,&1{%1:0,.1A3d]1}.!0"
|
||||
".2,.4,:4,&3{%!0${.2,:2,@(y14:%25residual-cons),@(y13:%25residual-map)["
|
||||
"03},:1a,:0^[12}.!1.0^,${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[0"
|
||||
"1}c]1}n]1}.!0.0^_1[01}_1,${.6dd,:2^[01},${.3,.6^c,@(y13:%25residual-ma"
|
||||
"p),@(y5:%25appl)[02}L6]5}${.2d,:2^[01},${.3a,:2^[01}c]1}.0]1}.!0.0^_1["
|
||||
"21}.!0.0^_1[62}.!6.(i10),.7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:"
|
||||
"3,'(s14:invalid syntax),'(y9:transform),@(y5:error)[03}}.0a,.0a,.1da,$"
|
||||
"{:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}](i11)"
|
||||
"}@!(y13:syntax-rules*)",
|
||||
|
||||
0,
|
||||
"${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n"
|
||||
|
|
|
|||
Loading…
Reference in a new issue