mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-26 21:58:51 +01:00
library improvements 1
This commit is contained in:
ESL
parent
c5fb756ea6
commit
01561c7243
2 changed files with 346 additions and 248 deletions
203
s.c
203
s.c
|
|
@ -94,19 +94,35 @@ char *s_code[] = {
|
|||
"y4:exps;;py4:cond;y4:rest;;;;",
|
||||
|
||||
"S", "%case-test",
|
||||
"l4:y12:syntax-rules;l1:y4:else;;l2:l3:y1:_;y1:k;y4:else;;t;;l2:l3:y1:_"
|
||||
";y1:k;y5:atoms;;l3:y4:memv;y1:k;l2:y5:quote;y5:atoms;;;;",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:k;n;;f;;l2:l3:y1:_;y1:k;l1:y5:datu"
|
||||
"m;;;l3:y4:eqv?;y1:k;l2:y5:quote;y5:datum;;;;l2:l3:y1:_;y1:k;y4:data;;l"
|
||||
"3:y4:memv;y1:k;l2:y5:quote;y4:data;;;;",
|
||||
|
||||
"S", "%case",
|
||||
"l7:y12:syntax-rules;l2:y4:else;y2:=>;;l2:l2:y1:_;y3:key;;l1:y5:begin;;"
|
||||
";l2:l3:y1:_;y3:key;l3:y4:else;y2:=>;y7:resproc;;;l2:y7:resproc;y3:key;"
|
||||
";;l2:l3:y1:_;y3:key;l3:y4:else;y4:expr;y3:...;;;l3:y5:begin;y4:expr;y3"
|
||||
":...;;;l2:py1:_;py3:key;pl3:l2:y5:datum;y3:...;;y2:=>;y7:resproc;;y7:c"
|
||||
"lauses;;;;l4:y2:if;l3:y10:%25case-test;y3:key;l2:y5:datum;y3:...;;;l2:"
|
||||
"y7:resproc;y3:key;;py5:%25case;py3:key;y7:clauses;;;;;l2:py1:_;py3:key"
|
||||
";pl3:l2:y5:datum;y3:...;;y4:expr;y3:...;;y7:clauses;;;;l4:y2:if;l3:y10"
|
||||
":%25case-test;y3:key;l2:y5:datum;y3:...;;;l3:y5:begin;y4:expr;y3:...;;"
|
||||
"py5:%25case;py3:key;y7:clauses;;;;;",
|
||||
|
||||
"S", "case",
|
||||
"l3:y12:syntax-rules;n;l2:l4:y1:_;y1:x;py4:test;y5:exprs;;y3:...;;l3:y3"
|
||||
":let;l1:l2:y3:key;y1:x;;;l3:y4:cond;pl3:y10:%25case-test;y3:key;y4:tes"
|
||||
"t;;y5:exprs;;y3:...;;;;",
|
||||
"l3:y12:syntax-rules;n;l2:py1:_;py1:x;y7:clauses;;;l3:y3:let;l1:l2:y3:k"
|
||||
"ey;y1:x;;;py5:%25case;py3:key;y7:clauses;;;;;",
|
||||
|
||||
"S", "%do-step",
|
||||
"l4:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;y1:x;;l2:l3:y1:_;y1:x;y1:y;;y1:"
|
||||
"y;;",
|
||||
|
||||
"S", "do",
|
||||
"l3:y12:syntax-rules;n;l2:l5:y1:_;l2:py3:var;py4:init;y4:step;;;y3:...;"
|
||||
";y6:ending;y4:expr;y3:...;;l4:y3:let;y4:loop;l2:l2:y3:var;y4:init;;y3:"
|
||||
"...;;l3:y4:cond;y6:ending;l4:y4:else;y4:expr;y3:...;l3:y4:loop;py5:beg"
|
||||
"in;py3:var;y4:step;;;y3:...;;;;;;",
|
||||
"l3:y12:syntax-rules;n;l2:l5:y1:_;l2:l4:y3:var;y4:init;y4:step;y3:...;;"
|
||||
"y3:...;;l3:y4:test;y4:expr;y3:...;;y7:command;y3:...;;l4:y3:let;y4:loo"
|
||||
"p;l2:l2:y3:var;y4:init;;y3:...;;l4:y2:if;y4:test;l3:y5:begin;y4:expr;y"
|
||||
"3:...;;l5:y3:let;n;y7:command;y3:...;l3:y4:loop;l4:y8:%25do-step;y3:va"
|
||||
"r;y4:step;y3:...;;y3:...;;;;;;",
|
||||
|
||||
"S", "quasiquote",
|
||||
"l10:y12:syntax-rules;l3:y7:unquote;y16:unquote-splicing;y10:quasiquote"
|
||||
|
|
@ -180,6 +196,72 @@ char *s_code[] = {
|
|||
|
||||
"A", "cons*", "list*",
|
||||
|
||||
"P", "substring->list",
|
||||
"%3n,'1,.4I-,,#0.3,.1,.6,&3{%2:0,.1I<?{.1]2}.1,.1,:2S4c,'1,.2I-,:1^[22}"
|
||||
".!0.0^_1[32",
|
||||
|
||||
"C", 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%%}@!(y13:%25string->list"
|
||||
")",
|
||||
|
||||
"S", "string->list",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y14:%25string->list1;y1:x;;;"
|
||||
"l2:py1:_;y1:r;;py13:%25string->list;y1:r;;;l2:y1:_;y13:%25string->list"
|
||||
";;",
|
||||
|
||||
"P", "substring-copy!",
|
||||
"%5.1,.1S3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.0,.5,.8,.6,&4{%2:0,.2I<!?{]2"
|
||||
"}.1,:1S4,.1,:2S5'1,.2I+,'1,.2I+,:3^[22}.!0.0^_1[62}'1,.1I-,'1,.6,.8I-I"
|
||||
"-,.4I+,,#0.0,.5,.8,.(i10),&4{%2:0,.2I<?{]2}.1,:1S4,.1,:2S5'1,.2I-,'1,."
|
||||
"2I-,:3^[22}.!0.0^_1[62",
|
||||
|
||||
"C", 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!)",
|
||||
|
||||
"C", 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)",
|
||||
|
||||
"P", "substring-fill!",
|
||||
"%4.2,,#0.0,.3,.5,.8,&4{%1:0,.1I<!?{]1}:1,.1,:2S5'1,.1I+,:3^[11}.!0.0^_"
|
||||
"1[41",
|
||||
|
||||
"C", 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!)",
|
||||
|
||||
"P", "substring-vector-copy!",
|
||||
"%5.1,.1V3I-,.4I+,.5In,.4,.3,,#0.0,.5,.8,.6,&4{%2:0,.2I<!?{:2]2}.1,:1S4"
|
||||
",.1,:2V5'1,.2I+,'1,.2I+,:3^[22}.!0.0^_1[62",
|
||||
|
||||
"P", "substring->vector",
|
||||
"%3.2,.2,.2,'0,f,.6,.8I-V2,@(y22:substring-vector-copy!)[35",
|
||||
|
||||
"C", 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)",
|
||||
|
||||
"P", "strings-sum-length",
|
||||
"%1'0,.1,,#0.0,&1{%2.0u?{.1]2}.0aS3,.2I+,.1d,:0^[22}.!0.0^_1[12",
|
||||
|
||||
"P", "strings-copy-into!",
|
||||
"%2'0,.2,,#0.0,.4,&2{%2.0u?{:0]2}.0d,.1a,.0S3,${.2,'0,.5,.9,:0,@(y15:su"
|
||||
"bstring-copy!)[05}.0,.5I+,.3,:1^[52}.!0.0^_1[22",
|
||||
|
||||
"P", "%string-append",
|
||||
"%!0.0,'(c ),${.4,@(y18:strings-sum-length)[01}S2,@(y18:strings-copy-in"
|
||||
"to!)[12",
|
||||
|
||||
"S", "string-append",
|
||||
"l7:y12:syntax-rules;n;l2:l1:y1:_;;s0:;;l2:l2:y1:_;y1:x;;l2:y4:%25cks;y"
|
||||
"1:x;;;l2:l3:y1:_;y1:x;y1:y;;l3:y10:string-cat;y1:x;y1:y;;;l2:py1:_;y1:"
|
||||
"r;;py14:%25string-append;y1:r;;;l2:y1:_;y14:%25string-append;;",
|
||||
|
||||
"P", "subvector->list",
|
||||
"%3n,'1,.4I-,,#0.3,.1,.6,&3{%2:0,.1I<?{.1]2}.1,.1,:2V4c,'1,.2I-,:1^[22}"
|
||||
".!0.0^_1[32",
|
||||
|
|
@ -195,10 +277,10 @@ char *s_code[] = {
|
|||
";;",
|
||||
|
||||
"P", "subvector-copy!",
|
||||
"%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"
|
||||
",.6,.8I-I-,.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",
|
||||
"%5.1,.1V3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.0,.5,.8,.6,&4{%2:0,.2I<!?{]2"
|
||||
"}.1,:1V4,.1,:2V5'1,.2I+,'1,.2I+,:3^[22}.!0.0^_1[62}'1,.1I-,'1,.6,.8I-I"
|
||||
"-,.4I+,,#0.0,.5,.8,.(i10),&4{%2:0,.2I<?{]2}.1,:1V4,.1,:2V5'1,.2I-,'1,."
|
||||
"2I-,:3^[22}.!0.0^_1[62",
|
||||
|
||||
"C", 0,
|
||||
"&0{%5.4,.4,.4,.4,.4,@(y15:subvector-copy!)[55}%x,&0{%4.2V3,.4,.4,.4,.4"
|
||||
|
|
@ -214,8 +296,8 @@ char *s_code[] = {
|
|||
"-copy)",
|
||||
|
||||
"P", "subvector-fill!",
|
||||
"%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",
|
||||
"%4.2,,#0.0,.3,.5,.8,&4{%1:0,.1I<!?{]1}:1,.1,:2V5'1,.1I+,:3^[11}.!0.0^_"
|
||||
"1[41",
|
||||
|
||||
"C", 0,
|
||||
"&0{%4.3,.3,.3,.3,@(y15:subvector-fill!)[44}%x,&0{%3.0V3,.3,.3,.3,@(y15"
|
||||
|
|
@ -224,7 +306,7 @@ char *s_code[] = {
|
|||
|
||||
"P", "subvector-string-copy!",
|
||||
"%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",
|
||||
",.1,:2S5'1,.2I+,'1,.2I+,:3^[22}.!0.0^_1[62",
|
||||
|
||||
"P", "subvector->string",
|
||||
"%3.2,.2,.2,'0,'(c ),.6,.8I-S2,@(y22:subvector-string-copy!)[35",
|
||||
|
|
@ -251,72 +333,6 @@ char *s_code[] = {
|
|||
";l2:py1:_;y1:r;;py14:%25vector-append;y1:r;;;l2:y1:_;y14:%25vector-app"
|
||||
"end;;",
|
||||
|
||||
"P", "substring->list",
|
||||
"%3n,'1,.4I-,,#0.3,.1,.6,&3{%2:0,.1I<?{.1]2}.1,.1,:2S4c,'1,.2I-,:1^[22}"
|
||||
".!0.0^_1[32",
|
||||
|
||||
"C", 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%%}@!(y13:%25string->list"
|
||||
")",
|
||||
|
||||
"S", "string->list",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y14:%25string->list1;y1:x;;;"
|
||||
"l2:py1:_;y1:r;;py13:%25string->list;y1:r;;;l2:y1:_;y13:%25string->list"
|
||||
";;",
|
||||
|
||||
"P", "substring-copy!",
|
||||
"%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"
|
||||
",.6,.8I-I-,.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",
|
||||
|
||||
"C", 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!)",
|
||||
|
||||
"C", 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)",
|
||||
|
||||
"P", "substring-fill!",
|
||||
"%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",
|
||||
|
||||
"C", 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!)",
|
||||
|
||||
"P", "substring-vector-copy!",
|
||||
"%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",
|
||||
|
||||
"P", "substring->vector",
|
||||
"%3.2,.2,.2,'0,f,.6,.8I-V2,@(y22:substring-vector-copy!)[35",
|
||||
|
||||
"C", 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)",
|
||||
|
||||
"P", "strings-sum-length",
|
||||
"%1'0,.1,,#0.0,&1{%2.0u?{.1]2}.0aS3,.2I+,.1d,:0^[22}.!0.0^_1[12",
|
||||
|
||||
"P", "strings-copy-into!",
|
||||
"%2'0,.2,,#0.0,.4,&2{%2.0u?{:0]2}.0d,.1a,.0S3,${.2,'0,.5,.9,:0,@(y15:su"
|
||||
"bstring-copy!)[05}.0,.5I+,.3,:1^[52}.!0.0^_1[22",
|
||||
|
||||
"P", "%string-append",
|
||||
"%!0.0,'(c ),${.4,@(y18:strings-sum-length)[01}S2,@(y18:strings-copy-in"
|
||||
"to!)[12",
|
||||
|
||||
"S", "string-append",
|
||||
"l7:y12:syntax-rules;n;l2:l1:y1:_;;s0:;;l2:l2:y1:_;y1:x;;l2:y4:%25cks;y"
|
||||
"1:x;;;l2:l3:y1:_;y1:x;y1:y;;l3:y10:string-cat;y1:x;y1:y;;;l2:py1:_;y1:"
|
||||
"r;;py14:%25string-append;y1:r;;;l2:y1:_;y14:%25string-append;;",
|
||||
|
||||
"P", "%apply",
|
||||
"%!2${.2,.5,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[02},."
|
||||
"2,@(y13:apply-to-list)[32",
|
||||
|
|
@ -376,25 +392,24 @@ char *s_code[] = {
|
|||
|
||||
"P", "string-map",
|
||||
"%!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}${${.4,.7c,@(y13:%25st"
|
||||
"ring->list),@(y5:%25map1)[02},.4c,@(y4:%25map),@(y13:apply-to-list)[02"
|
||||
"}X3]3",
|
||||
":2S4,:1[01},.1,:3S5'1,.1I+,:4^[11}.!0.0^_1[51}${${.4,.7c,@(y13:%25stri"
|
||||
"ng->list),@(y5:%25map1)[02},.4c,@(y4:%25map),@(y13:apply-to-list)[02}X"
|
||||
"3]3",
|
||||
|
||||
"P", "vector-map",
|
||||
"%!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}${${.4,.7c,@(y13:%25vector"
|
||||
"->list),@(y5:%25map1)[02},.4c,@(y4:%25map),@(y13:apply-to-list)[02}X1]"
|
||||
"3",
|
||||
",:1[01},.1,:3V5'1,.1I+,:4^[11}.!0.0^_1[51}${${.4,.7c,@(y13:%25vector->"
|
||||
"list),@(y5:%25map1)[02},.4c,@(y4:%25map),@(y13:apply-to-list)[02}X1]3",
|
||||
|
||||
"P", "string-for-each",
|
||||
"%!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}${.2,.5c,@(y13:%25string->list),@(y5:%25m"
|
||||
"ap1)[02},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32",
|
||||
"%!2.0u?{.2S3,'0,,#0.0,.5,.7,.5,&4{%1:0,.1I<!?{]1}${.2,:1S4,:2[01}'1,.1"
|
||||
"I+,:3^[11}.!0.0^_1[41}${.2,.5c,@(y13:%25string->list),@(y5:%25map1)[02"
|
||||
"},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32",
|
||||
|
||||
"P", "vector-for-each",
|
||||
"%!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}${.2,.5c,@(y13:%25vector->list),@(y5:%25m"
|
||||
"ap1)[02},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32",
|
||||
"%!2.0u?{.2V3,'0,,#0.0,.5,.7,.5,&4{%1:0,.1I<!?{]1}${.2,:1V4,:2[01}'1,.1"
|
||||
"I+,:3^[11}.!0.0^_1[41}${.2,.5c,@(y13:%25vector->list),@(y5:%25map1)[02"
|
||||
"},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32",
|
||||
|
||||
"P", "port?",
|
||||
"%1.0P00,.0?{.0]2}.1P01]2",
|
||||
|
|
|
|||
391
src/s.scm
391
src/s.scm
|
|
@ -128,20 +128,46 @@
|
|||
[(_ (x . exps) . rest) (if x (begin . exps) (cond . rest))]))
|
||||
|
||||
(define-syntax %case-test
|
||||
(syntax-rules (else)
|
||||
[(_ k else) #t]
|
||||
[(_ k atoms) (memv k 'atoms)]))
|
||||
(syntax-rules ()
|
||||
[(_ k ()) #f]
|
||||
[(_ k (datum)) (eqv? k 'datum)]
|
||||
[(_ k data) (memv k 'data)]))
|
||||
|
||||
(define-syntax %case
|
||||
(syntax-rules (else =>)
|
||||
[(_ key) (begin)]
|
||||
[(_ key (else => resproc))
|
||||
(resproc key)]
|
||||
[(_ key (else expr ...))
|
||||
(begin expr ...)]
|
||||
[(_ key ((datum ...) => resproc) . clauses)
|
||||
(if (%case-test key (datum ...))
|
||||
(resproc key)
|
||||
(%case key . clauses))]
|
||||
[(_ key ((datum ...) expr ...) . clauses)
|
||||
(if (%case-test key (datum ...))
|
||||
(begin expr ...)
|
||||
(%case key . clauses))]))
|
||||
|
||||
(define-syntax case
|
||||
(syntax-rules ()
|
||||
[(_ x (test . exprs) ...)
|
||||
(let ([key x]) (cond ((%case-test key test) . exprs) ...))]))
|
||||
[(_ x . clauses) (let ([key x]) (%case key . clauses))]))
|
||||
|
||||
(define-syntax %do-step
|
||||
(syntax-rules ()
|
||||
[(_ x) x] [(_ x y) y]))
|
||||
|
||||
(define-syntax do
|
||||
(syntax-rules ()
|
||||
[(_ ((var init . step) ...) ending expr ...)
|
||||
[(_ ([var init step ...] ...)
|
||||
[test expr ...]
|
||||
command ...)
|
||||
(let loop ([var init] ...)
|
||||
(cond ending [else expr ... (loop (begin var . step) ...)]))]))
|
||||
(if test
|
||||
(begin expr ...)
|
||||
(let () command ...
|
||||
(loop (%do-step var step ...) ...))))]))
|
||||
|
||||
|
||||
(define-syntax quasiquote
|
||||
(syntax-rules (unquote unquote-splicing quasiquote)
|
||||
|
|
@ -168,10 +194,6 @@
|
|||
|
||||
;cond-expand
|
||||
|
||||
;letrec*
|
||||
;let-values
|
||||
;let*-values
|
||||
|
||||
;delay
|
||||
;delay-force
|
||||
|
||||
|
|
@ -205,10 +227,12 @@
|
|||
|
||||
; integrables:
|
||||
;
|
||||
; (fixnum? x)
|
||||
; (fixnum? o)
|
||||
; (fxzero? x)
|
||||
; (fxpositive? x)
|
||||
; (fxnegative? x)
|
||||
; (fxeven? x)
|
||||
; (fxodd? x)
|
||||
; (fx+ x ...)
|
||||
; (fx* x ...)
|
||||
; (fx- x y ...)
|
||||
|
|
@ -229,8 +253,30 @@
|
|||
; (fx!=? x y)
|
||||
; (fxmin x y)
|
||||
; (fxmax x y)
|
||||
; (fxneg x)
|
||||
; (fxabs x)
|
||||
; (fxgcd x y)
|
||||
; (fxexpt x y)
|
||||
; (fxsqrt x)
|
||||
; (fxnot x)
|
||||
; (fxand x ...)
|
||||
; (fxior x ...)
|
||||
; (fxxor x ...)
|
||||
; (fxsll x y)
|
||||
; (fxsrl x y)
|
||||
; (fixnum->flonum x)
|
||||
|
||||
;fx-width
|
||||
;fx-greatest
|
||||
;fx-least
|
||||
;fxarithmetic-shift-right
|
||||
;fxarithmetic-shift-left
|
||||
;fxlength cf. integer-length (+ 1 (integer-length i))
|
||||
; is the number of bits needed to represent i in a signed twos-complement representation
|
||||
; 0 => 0, 1 => 1, -1 => 0, 7 => 3, -7 => 3, 8 => 4, -8 => 3
|
||||
;fxbit-count cf. bit-count
|
||||
; Returns the population count of 1's (i >= 0) or 0's (i < 0)
|
||||
; 0 => 0, -1 => 0, 7 => 3, 13 => 3, -13 => 2
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Inexact floating-point numbers (flonums)
|
||||
|
|
@ -238,7 +284,7 @@
|
|||
|
||||
; integrables:
|
||||
;
|
||||
; (flonum? x)
|
||||
; (flonum? o)
|
||||
; (flzero? x)
|
||||
; (flpositive? x)
|
||||
; (flnegative? x)
|
||||
|
|
@ -264,6 +310,7 @@
|
|||
; (flmax x y)
|
||||
; (flonum->fixnum x)
|
||||
|
||||
;....
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Numbers (fixnums or flonums)
|
||||
|
|
@ -272,13 +319,13 @@
|
|||
; integrables:
|
||||
;
|
||||
; (number? x)
|
||||
; (integer? x)
|
||||
; (complex? x) == number? what about inf and nan?
|
||||
; (real? x) == number? what about inf and nan?
|
||||
; (rational? x) == number? what about inf and nan?
|
||||
; (exact-integer? x) == fixnum?
|
||||
; (integer? x)
|
||||
; (exact? x)
|
||||
; (inexact? x)
|
||||
; (exact-integer? x) == fixnum?
|
||||
; (finite? x)
|
||||
; (infinite? x)
|
||||
; (nan? x)
|
||||
|
|
@ -287,6 +334,8 @@
|
|||
; (negative? x)
|
||||
; (even? x)
|
||||
; (odd? x)
|
||||
; (min x y ...)
|
||||
; (max x y ...)
|
||||
; (+ x ...)
|
||||
; (* x ...)
|
||||
; (- x y ...)
|
||||
|
|
@ -304,6 +353,10 @@
|
|||
; (floor-quotient x y)
|
||||
; (floor-remainder x y)
|
||||
; (modulo x y) = floor-remainder
|
||||
; (inexact x)
|
||||
; (exact x)
|
||||
; (number->string x (radix 10))
|
||||
; (string->number x (radix 10))
|
||||
|
||||
(define (floor/ x y)
|
||||
(values (floor-quotient x y) (floor-remainder x y)))
|
||||
|
|
@ -311,6 +364,34 @@
|
|||
(define (truncate/ x y)
|
||||
(values (truncate-quotient x y) (truncate-remainder x y)))
|
||||
|
||||
;gcd
|
||||
;lcm
|
||||
;numerator
|
||||
;denominator
|
||||
;floor
|
||||
;ceiling
|
||||
;truncate
|
||||
;round
|
||||
;rationalize
|
||||
;exp
|
||||
;log 1-and-2-arg
|
||||
;sin
|
||||
;cos
|
||||
;tan
|
||||
;asin
|
||||
;acos
|
||||
;atan 1-and-2-arg
|
||||
;square
|
||||
;sqrt
|
||||
;exact-integer-sqrt
|
||||
;expt
|
||||
;make-rectangular
|
||||
;make-polar
|
||||
;real-part
|
||||
;imag-part
|
||||
;magnitude
|
||||
;angle
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Booleans
|
||||
|
|
@ -322,50 +403,6 @@
|
|||
; (not x)
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Characters
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
; integrables:
|
||||
;
|
||||
; (char? x)
|
||||
; (char-cmp c1 c2)
|
||||
; (char=? c1 c2 c ...)
|
||||
; (char<? c1 c2 c ...)
|
||||
; (char>? c1 c2 c ...)
|
||||
; (char<=? c1 c2 c ...)
|
||||
; (char>=? c1 c2 c ...)
|
||||
; (char-ci-cmp c1 c2)
|
||||
; (char-ci=? c1 c2 c ...)
|
||||
; (char-ci<? c1 c2 c ...)
|
||||
; (char-ci>? c1 c2 c ...)
|
||||
; (char-ci<=? c1 c2 c ...)
|
||||
; (char-ci>=? c1 c2 c ...)
|
||||
; (char-alphabetic? c)
|
||||
; (char-numeric? x)
|
||||
; (char-whitespace? c)
|
||||
; (char-upper-case? c)
|
||||
; (char-lower-case? c)
|
||||
; (char-upcase c)
|
||||
; (char-downcase c)
|
||||
; (char->integer c)
|
||||
; (integer->char n)
|
||||
|
||||
;char-foldcase
|
||||
;digit-value
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Symbols
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
; integrables:
|
||||
;
|
||||
; (symbol? x)
|
||||
; (symbol->string y)
|
||||
; (string->symbol s)
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Null and Pairs
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -471,109 +508,47 @@
|
|||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Vectors
|
||||
; Symbols
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
; integrables:
|
||||
;
|
||||
; (vector? x)
|
||||
; (vector x ...)
|
||||
; (make-vector n (i #f))
|
||||
; (vector-length v)
|
||||
; (vector-ref v i)
|
||||
; (vector-set! v i x)
|
||||
; (list->vector x)
|
||||
; (vector-cat v1 v2)
|
||||
; (symbol? x)
|
||||
; (symbol->string y)
|
||||
; (string->symbol s)
|
||||
|
||||
(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) (%vector->list1 vec)]
|
||||
[(vec start) (subvector->list vec start (vector-length vec))]
|
||||
[(vec start end) (subvector->list vec start end)]))
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Characters
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
(define-syntax vector->list
|
||||
(syntax-rules ()
|
||||
[(_ x) (%vector->list1 x)]
|
||||
[(_ . r) (%vector->list . r)]
|
||||
[_ %vector->list]))
|
||||
; integrables:
|
||||
;
|
||||
; (char? x)
|
||||
; (char-cmp c1 c2)
|
||||
; (char=? c1 c2 c ...)
|
||||
; (char<? c1 c2 c ...)
|
||||
; (char>? c1 c2 c ...)
|
||||
; (char<=? c1 c2 c ...)
|
||||
; (char>=? c1 c2 c ...)
|
||||
; (char-ci-cmp c1 c2)
|
||||
; (char-ci=? c1 c2 c ...)
|
||||
; (char-ci<? c1 c2 c ...)
|
||||
; (char-ci>? c1 c2 c ...)
|
||||
; (char-ci<=? c1 c2 c ...)
|
||||
; (char-ci>=? c1 c2 c ...)
|
||||
; (char-alphabetic? c)
|
||||
; (char-numeric? x)
|
||||
; (char-whitespace? c)
|
||||
; (char-upper-case? c)
|
||||
; (char-lower-case? c)
|
||||
; (char-upcase c)
|
||||
; (char-downcase c)
|
||||
; (char->integer c)
|
||||
; (integer->char n)
|
||||
|
||||
(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)]))
|
||||
|
||||
(define (vectors-sum-length vecs)
|
||||
(let loop ([vecs vecs] [l 0])
|
||||
(if (null? vecs) l (loop (cdr vecs) (fx+ l (vector-length (car vecs)))))))
|
||||
|
||||
(define (vectors-copy-into! to vecs)
|
||||
(let loop ([vecs vecs] [i 0])
|
||||
(if (null? vecs)
|
||||
to
|
||||
(let ([vec (car vecs)] [vecs (cdr vecs)])
|
||||
(let ([len (vector-length vec)])
|
||||
(subvector-copy! to i vec 0 len)
|
||||
(loop vecs (fx+ i len)))))))
|
||||
|
||||
(define (%vector-append . vecs)
|
||||
(vectors-copy-into! (make-vector (vectors-sum-length vecs)) vecs))
|
||||
|
||||
(define-syntax vector-append
|
||||
(syntax-rules ()
|
||||
[(_) '#()] [(_ x) (%ckv x)]
|
||||
[(_ x y) (vector-cat x y)]
|
||||
[(_ . r) (%vector-append . r)]
|
||||
[_ %vector-append]))
|
||||
;char-foldcase
|
||||
;digit-value
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -589,6 +564,7 @@
|
|||
; (string-ref x i)
|
||||
; (string-set! x i v)
|
||||
; (list->string l)
|
||||
; (%string->list1 s)
|
||||
; (string-cat s1 s2)
|
||||
; (substring s from to)
|
||||
; (string-cmp s1 s2)
|
||||
|
|
@ -695,6 +671,113 @@
|
|||
;string-foldcase
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Vectors
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
; integrables:
|
||||
;
|
||||
; (vector? x)
|
||||
; (vector x ...)
|
||||
; (make-vector n (i #f))
|
||||
; (vector-length v)
|
||||
; (vector-ref v i)
|
||||
; (vector-set! v i x)
|
||||
; (%vector->list1 v)
|
||||
; (list->vector l)
|
||||
; (vector-cat v1 v2)
|
||||
|
||||
(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) (%vector->list1 vec)]
|
||||
[(vec start) (subvector->list vec start (vector-length vec))]
|
||||
[(vec start end) (subvector->list vec start end)]))
|
||||
|
||||
(define-syntax vector->list
|
||||
(syntax-rules ()
|
||||
[(_ x) (%vector->list1 x)]
|
||||
[(_ . r) (%vector->list . r)]
|
||||
[_ %vector->list]))
|
||||
|
||||
(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)]))
|
||||
|
||||
(define (vectors-sum-length vecs)
|
||||
(let loop ([vecs vecs] [l 0])
|
||||
(if (null? vecs) l (loop (cdr vecs) (fx+ l (vector-length (car vecs)))))))
|
||||
|
||||
(define (vectors-copy-into! to vecs)
|
||||
(let loop ([vecs vecs] [i 0])
|
||||
(if (null? vecs)
|
||||
to
|
||||
(let ([vec (car vecs)] [vecs (cdr vecs)])
|
||||
(let ([len (vector-length vec)])
|
||||
(subvector-copy! to i vec 0 len)
|
||||
(loop vecs (fx+ i len)))))))
|
||||
|
||||
(define (%vector-append . vecs)
|
||||
(vectors-copy-into! (make-vector (vectors-sum-length vecs)) vecs))
|
||||
|
||||
(define-syntax vector-append
|
||||
(syntax-rules ()
|
||||
[(_) '#()] [(_ x) (%ckv x)]
|
||||
[(_ x y) (vector-cat x y)]
|
||||
[(_ . r) (%vector-append . r)]
|
||||
[_ %vector-append]))
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Conversions
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
|
|||
Loading…
Reference in a new issue