Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2024-12-27 21:58:53 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

library improvements 1

Browse source
This commit is contained in:
ESL 2023-03-25 00:35:23 -04:00
parent c5fb756ea6
commit 01561c7243
2 changed files with 346 additions and 248 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

203
s.c
View file

@ -94,19 +94,35 @@ char *s_code[] = {
"y4:exps;;py4:cond;y4:rest;;;;", "y4:exps;;py4:cond;y4:rest;;;;",
"S", "%case-test", "S", "%case-test",
"l4:y12:syntax-rules;l1:y4:else;;l2:l3:y1:_;y1:k;y4:else;;t;;l2:l3:y1:_" "l5:y12:syntax-rules;n;l2:l3:y1:_;y1:k;n;;f;;l2:l3:y1:_;y1:k;l1:y5:datu"
";y1:k;y5:atoms;;l3:y4:memv;y1:k;l2:y5:quote;y5:atoms;;;;", "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", "S", "case",
"l3:y12:syntax-rules;n;l2:l4:y1:_;y1:x;py4:test;y5:exprs;;y3:...;;l3:y3" "l3:y12:syntax-rules;n;l2:py1:_;py1:x;y7:clauses;;;l3:y3:let;l1:l2:y3:k"
":let;l1:l2:y3:key;y1:x;;;l3:y4:cond;pl3:y10:%25case-test;y3:key;y4:tes" "ey;y1:x;;;py5:%25case;py3:key;y7:clauses;;;;;",
"t;;y5:exprs;;y3:...;;;;",
"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", "S", "do",
"l3:y12:syntax-rules;n;l2:l5:y1:_;l2:py3:var;py4:init;y4:step;;;y3:...;" "l3:y12:syntax-rules;n;l2:l5:y1:_;l2:l4:y3:var;y4:init;y4:step;y3:...;;"
";y6:ending;y4:expr;y3:...;;l4:y3:let;y4:loop;l2:l2:y3:var;y4:init;;y3:" "y3:...;;l3:y4:test;y4:expr;y3:...;;y7:command;y3:...;;l4:y3:let;y4:loo"
"...;;l3:y4:cond;y6:ending;l4:y4:else;y4:expr;y3:...;l3:y4:loop;py5:beg" "p;l2:l2:y3:var;y4:init;;y3:...;;l4:y2:if;y4:test;l3:y5:begin;y4:expr;y"
"in;py3:var;y4:step;;;y3:...;;;;;;", "3:...;;l5:y3:let;n;y7:command;y3:...;l3:y4:loop;l4:y8:%25do-step;y3:va"
"r;y4:step;y3:...;;y3:...;;;;;;",
"S", "quasiquote", "S", "quasiquote",
"l10:y12:syntax-rules;l3:y7:unquote;y16:unquote-splicing;y10:quasiquote" "l10:y12:syntax-rules;l3:y7:unquote;y16:unquote-splicing;y10:quasiquote"
@ -180,6 +196,72 @@ char *s_code[] = {
"A", "cons*", "list*", "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", "P", "subvector->list",
"%3n,'1,.4I-,,#0.3,.1,.6,&3{%2:0,.1I<?{.1]2}.1,.1,:2V4c,'1,.2I-,:1^[22}" "%3n,'1,.4I-,,#0.3,.1,.6,&3{%2:0,.1I<?{.1]2}.1,.1,:2V4c,'1,.2I-,:1^[22}"
".!0.0^_1[32", ".!0.0^_1[32",
@ -195,10 +277,10 @@ char *s_code[] = {
";;", ";;",
"P", "subvector-copy!", "P", "subvector-copy!",
"%5.1,.1V3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.3,.7,.6,.3,&4{%2:3,.2I<!,.0?" "%5.1,.1V3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.0,.5,.8,.6,&4{%2:0,.2I<!?{]2"
"{.0]3}.2,:2V4,.2,:1V5.2'1,.3I+,.2'1,.3I+,:0^[32}.!0.0^_1[62}'1,.1I-,'1" "}.1,:1V4,.1,:2V5'1,.2I+,'1,.2I+,:3^[22}.!0.0^_1[62}'1,.1I-,'1,.6,.8I-I"
",.6,.8I-I-,.4I+,,#0.7,.7,.6,.3,&4{%2:3,.2I<,.0?{.0]3}.2,:2V4,.2,:1V5.2" "-,.4I+,,#0.0,.5,.8,.(i10),&4{%2:0,.2I<?{]2}.1,:1V4,.1,:2V5'1,.2I-,'1,."
"'1,.3I-,.2'1,.3I-,:0^[32}.!0.0^_1[62", "2I-,:3^[22}.!0.0^_1[62",
"C", 0, "C", 0,
"&0{%5.4,.4,.4,.4,.4,@(y15:subvector-copy!)[55}%x,&0{%4.2V3,.4,.4,.4,.4" "&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)", "-copy)",
"P", "subvector-fill!", "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}" "%4.2,,#0.0,.3,.5,.8,&4{%1:0,.1I<!?{]1}:1,.1,:2V5'1,.1I+,:3^[11}.!0.0^_"
".!0.0^_1[41", "1[41",
"C", 0, "C", 0,
"&0{%4.3,.3,.3,.3,@(y15:subvector-fill!)[44}%x,&0{%3.0V3,.3,.3,.3,@(y15" "&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!", "P", "subvector-string-copy!",
"%5.1,.1S3I-,.4I+,.5In,.4,.3,,#0.0,.5,.8,.6,&4{%2:0,.2I<!?{:2]2}.1,:1V4" "%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", "P", "subvector->string",
"%3.2,.2,.2,'0,'(c ),.6,.8I-S2,@(y22:subvector-string-copy!)[35", "%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" ";l2:py1:_;y1:r;;py14:%25vector-append;y1:r;;;l2:y1:_;y14:%25vector-app"
"end;;", "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", "P", "%apply",
"%!2${.2,.5,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[02},." "%!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", "2,@(y13:apply-to-list)[32",
@ -376,25 +392,24 @@ char *s_code[] = {
"P", "string-map", "P", "string-map",
"%!2.0u?{.2S3,'(c ),.1S2,'0,,#0.0,.3,.8,.8,.7,&5{%1:0,.1I<!?{:3]1}${.2," "%!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" ":2S4,:1[01},.1,:3S5'1,.1I+,:4^[11}.!0.0^_1[51}${${.4,.7c,@(y13:%25stri"
"ring->list),@(y5:%25map1)[02},.4c,@(y4:%25map),@(y13:apply-to-list)[02" "ng->list),@(y5:%25map1)[02},.4c,@(y4:%25map),@(y13:apply-to-list)[02}X"
"}X3]3", "3]3",
"P", "vector-map", "P", "vector-map",
"%!2.0u?{.2V3,f,.1V2,'0,,#0.0,.3,.8,.8,.7,&5{%1:0,.1I<!?{:3]1}${.2,:2V4" "%!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" ",: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]" "list),@(y5:%25map1)[02},.4c,@(y4:%25map),@(y13:apply-to-list)[02}X1]3",
"3",
"P", "string-for-each", "P", "string-for-each",
"%!2.0u?{.2S3,'0,,#0.2,.6,.6,.3,&4{%1:3,.1I<!,.0?{.0]2}${.3,:2S4,:1[01}" "%!2.0u?{.2S3,'0,,#0.0,.5,.7,.5,&4{%1:0,.1I<!?{]1}${.2,:1S4,:2[01}'1,.1"
".1'1,.2I+,:0^[21}.!0.0^_1[41}${.2,.5c,@(y13:%25string->list),@(y5:%25m" "I+,:3^[11}.!0.0^_1[41}${.2,.5c,@(y13:%25string->list),@(y5:%25map1)[02"
"ap1)[02},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32", "},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32",
"P", "vector-for-each", "P", "vector-for-each",
"%!2.0u?{.2V3,'0,,#0.2,.6,.6,.3,&4{%1:3,.1I<!,.0?{.0]2}${.3,:2V4,:1[01}" "%!2.0u?{.2V3,'0,,#0.0,.5,.7,.5,&4{%1:0,.1I<!?{]1}${.2,:1V4,:2[01}'1,.1"
".1'1,.2I+,:0^[21}.!0.0^_1[41}${.2,.5c,@(y13:%25vector->list),@(y5:%25m" "I+,:3^[11}.!0.0^_1[41}${.2,.5c,@(y13:%25vector->list),@(y5:%25map1)[02"
"ap1)[02},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32", "},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32",
"P", "port?", "P", "port?",
"%1.0P00,.0?{.0]2}.1P01]2", "%1.0P00,.0?{.0]2}.1P01]2",

391
src/s.scm
View file

@ -128,20 +128,46 @@
[(_ (x . exps) . rest) (if x (begin . exps) (cond . rest))])) [(_ (x . exps) . rest) (if x (begin . exps) (cond . rest))]))
(define-syntax %case-test (define-syntax %case-test
(syntax-rules (else) (syntax-rules ()
[(_ k else) #t] [(_ k ()) #f]
[(_ k atoms) (memv k 'atoms)])) [(_ 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 (define-syntax case
(syntax-rules () (syntax-rules ()
[(_ x (test . exprs) ...) [(_ x . clauses) (let ([key x]) (%case key . clauses))]))
(let ([key x]) (cond ((%case-test key test) . exprs) ...))]))
(define-syntax %do-step
(syntax-rules ()
[(_ x) x] [(_ x y) y]))
(define-syntax do (define-syntax do
(syntax-rules () (syntax-rules ()
[(_ ((var init . step) ...) ending expr ...) [(_ ([var init step ...] ...)
[test expr ...]
command ...)
(let loop ([var init] ...) (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 (define-syntax quasiquote
(syntax-rules (unquote unquote-splicing quasiquote) (syntax-rules (unquote unquote-splicing quasiquote)
@ -168,10 +194,6 @@
;cond-expand ;cond-expand
;letrec*
;let-values
;let*-values
;delay ;delay
;delay-force ;delay-force
@ -205,10 +227,12 @@
; integrables: ; integrables:
; ;
; (fixnum? x) ; (fixnum? o)
; (fxzero? x) ; (fxzero? x)
; (fxpositive? x) ; (fxpositive? x)
; (fxnegative? x) ; (fxnegative? x)
; (fxeven? x)
; (fxodd? x)
; (fx+ x ...) ; (fx+ x ...)
; (fx* x ...) ; (fx* x ...)
; (fx- x y ...) ; (fx- x y ...)
@ -229,8 +253,30 @@
; (fx!=? x y) ; (fx!=? x y)
; (fxmin x y) ; (fxmin x y)
; (fxmax 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) ; (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) ; Inexact floating-point numbers (flonums)
@ -238,7 +284,7 @@
; integrables: ; integrables:
; ;
; (flonum? x) ; (flonum? o)
; (flzero? x) ; (flzero? x)
; (flpositive? x) ; (flpositive? x)
; (flnegative? x) ; (flnegative? x)
@ -264,6 +310,7 @@
; (flmax x y) ; (flmax x y)
; (flonum->fixnum x) ; (flonum->fixnum x)
;....
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; Numbers (fixnums or flonums) ; Numbers (fixnums or flonums)
@ -272,13 +319,13 @@
; integrables: ; integrables:
; ;
; (number? x) ; (number? x)
; (integer? x)
; (complex? x) == number? what about inf and nan? ; (complex? x) == number? what about inf and nan?
; (real? x) == number? what about inf and nan? ; (real? x) == number? what about inf and nan?
; (rational? x) == number? what about inf and nan? ; (rational? x) == number? what about inf and nan?
; (exact-integer? x) == fixnum? ; (integer? x)
; (exact? x) ; (exact? x)
; (inexact? x) ; (inexact? x)
; (exact-integer? x) == fixnum?
; (finite? x) ; (finite? x)
; (infinite? x) ; (infinite? x)
; (nan? x) ; (nan? x)
@ -287,6 +334,8 @@
; (negative? x) ; (negative? x)
; (even? x) ; (even? x)
; (odd? x) ; (odd? x)
; (min x y ...)
; (max x y ...)
; (+ x ...) ; (+ x ...)
; (* x ...) ; (* x ...)
; (- x y ...) ; (- x y ...)
@ -304,6 +353,10 @@
; (floor-quotient x y) ; (floor-quotient x y)
; (floor-remainder x y) ; (floor-remainder x y)
; (modulo x y) = floor-remainder ; (modulo x y) = floor-remainder
; (inexact x)
; (exact x)
; (number->string x (radix 10))
; (string->number x (radix 10))
(define (floor/ x y) (define (floor/ x y)
(values (floor-quotient x y) (floor-remainder x y))) (values (floor-quotient x y) (floor-remainder x y)))
@ -311,6 +364,34 @@
(define (truncate/ x y) (define (truncate/ x y)
(values (truncate-quotient x y) (truncate-remainder 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 ; Booleans
@ -322,50 +403,6 @@
; (not x) ; (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 ; Null and Pairs
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
@ -471,109 +508,47 @@
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; Vectors ; Symbols
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; integrables: ; integrables:
; ;
; (vector? x) ; (symbol? x)
; (vector x ...) ; (symbol->string y)
; (make-vector n (i #f)) ; (string->symbol s)
; (vector-length v)
; (vector-ref v i)
; (vector-set! v i x)
; (list->vector x)
; (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 ; Characters
[(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 ; integrables:
(syntax-rules () ;
[(_ x) (%vector->list1 x)] ; (char? x)
[(_ . r) (%vector->list . r)] ; (char-cmp c1 c2)
[_ %vector->list])) ; (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) ;char-foldcase
(let ([limit (fxmin end (fx+ start (fx- (vector-length to) at)))]) ;digit-value
(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]))
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
@ -589,6 +564,7 @@
; (string-ref x i) ; (string-ref x i)
; (string-set! x i v) ; (string-set! x i v)
; (list->string l) ; (list->string l)
; (%string->list1 s)
; (string-cat s1 s2) ; (string-cat s1 s2)
; (substring s from to) ; (substring s from to)
; (string-cmp s1 s2) ; (string-cmp s1 s2)
@ -695,6 +671,113 @@
;string-foldcase ;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 ; Conversions
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------