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

... generic math ops are new integrables now

Browse source
This commit is contained in:
ESL 2023-03-20 14:42:40 -04:00
parent 91b07297cf
commit 0a94172bbd
3 changed files with 58 additions and 386 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

58
i.h
View file

@ -287,7 +287,7 @@ declare_instruction(jintp, "Jw", 0, "flinteger?", '1', AUTOGL)
declare_instruction(jnanp, "Ju", 0, "flnan?", '1', AUTOGL)
declare_instruction(jfinp, "Jf", 0, "flfinite?", '1', AUTOGL)
declare_instruction(jinfp, "Jh", 0, "flinfinite?", '1', AUTOGL)
declare_instruction(jadd, "J+\0'(j0)", 0, "fl+", 'p', AUTOGL)
declare_instruction(jadd, "J+\0'(j0)", 0, "fl+", 'p', AUTOGL)
declare_instruction(jsub, "J-\0J-!", 0, "fl-", 'm', AUTOGL)
declare_instruction(jmul, "J*\0'(j1)", 0, "fl*", 'p', AUTOGL)
declare_instruction(jdiv, "J/\0,'(j1)J/", 0, "fl/", 'm', AUTOGL)
@ -311,36 +311,36 @@ declare_instruction(jfloor, "H0", 0, "flfloor", '1', AUTOGL)
declare_instruction(jceil, "H1", 0, "flceiling", '1', AUTOGL)
declare_instruction(jtrunc, "H2", 0, "fltruncate", '1', AUTOGL)
declare_instruction(jround, "H3", 0, "flround", '1', AUTOGL)
declare_instruction(zerop, "=0", 0, "%zerop", 1, INLINED)
declare_instruction(posp, ">0", 0, "%posp", 1, INLINED)
declare_instruction(negp, "<0", 0, "%negp", 1, INLINED)
declare_instruction(add, "+", 0, "%add", 2, INLINED)
declare_instruction(sub, "-", 0, "%sub", 2, INLINED)
declare_instruction(mul, "*", 0, "%mul", 2, INLINED)
declare_instruction(div, "/", 0, "%div", 2, INLINED)
declare_instruction(lt, "<", 0, "%lt", 2, INLINED)
declare_instruction(gt, ">", 0, "%gt", 2, INLINED)
declare_instruction(le, ">!", 0, "%le", 2, INLINED)
declare_instruction(ge, "<!", 0, "%ge", 2, INLINED)
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", 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)
declare_instruction(finp, "N6", 0, "%finp", 1, INLINED)
declare_instruction(infp, "N7", 0, "%infp", 1, INLINED)
declare_instruction(evnp, "N8", 0, "%evnp", 1, INLINED)
declare_instruction(oddp, "N9", 0, "%oddp", 1, INLINED)
declare_instruction(zerop, "=0", 0, "zero?", '1', AUTOGL)
declare_instruction(posp, ">0", 0, "positive?", '1', AUTOGL)
declare_instruction(negp, "<0", 0, "negative?", '1', AUTOGL)
declare_instruction(add, "+\0'0", 0, "+", 'p', AUTOGL)
declare_instruction(sub, "-\0-!", 0, "-", 'm', AUTOGL)
declare_instruction(mul, "*\0'1", 0, "*", 'p', AUTOGL)
declare_instruction(div, "/\0,'1/", 0, "/", 'm', AUTOGL)
declare_instruction(lt, "<", 0, "<", 'c', AUTOGL)
declare_instruction(gt, ">", 0, ">", 'c', AUTOGL)
declare_instruction(le, ">!", 0, "<=", 'c', AUTOGL)
declare_instruction(ge, "<!", 0, ">=", 'c', AUTOGL)
declare_instruction(eq, "=", 0, "=", 'c', AUTOGL)
declare_instruction(ne, "=!", 0, "!=", '2', AUTOGL)
declare_instruction(neg, "-!", 0, "neg", '1', AUTOGL)
declare_instruction(abs, "G0", 0, "abs", '1', AUTOGL)
declare_instruction(mqu, "G3", 0, "modquo", '2', AUTOGL)
declare_instruction(mlo, "G4", 0, "modulo", '2', AUTOGL)
declare_instruction(quo, "G5", 0, "quotient", '2', AUTOGL)
declare_instruction(rem, "G6", 0, "remainder", '2', AUTOGL)
declare_instruction(nump, "N0", 0, "number?", '1', AUTOGL)
declare_instruction(intp, "N4", 0, "integer?", '1', AUTOGL)
declare_instruction(nanp, "N5", 0, "nan?", '1', AUTOGL)
declare_instruction(finp, "N6", 0, "finite?", '1', AUTOGL)
declare_instruction(infp, "N7", 0, "infinite?", '1', AUTOGL)
declare_instruction(evnp, "N8", 0, "even?", '1', AUTOGL)
declare_instruction(oddp, "N9", 0, "odd?", '1', AUTOGL)
declare_instruction(ntoi, "M0", 0, "%ntoi", 1, INLINED)
declare_instruction(ntoj, "M1", 0, "%ntoj", 1, INLINED)
declare_instruction(min, "M2", 0, "%min", 2, INLINED)
declare_instruction(max, "M3", 0, "%max", 2, INLINED)
declare_instruction(min, "M2", 0, "min", 'x', AUTOGL)
declare_instruction(max, "M3", 0, "max", 'x', AUTOGL)
declare_instruction(listp, "L0", 0, "%listp", 1, INLINED)
declare_instruction(list, "l", 1, "%list", -1, "%!0_!]0")
declare_instrshadow(list, "L1", 1, NULL, 0, INLINED)

240
s.c
View file

@ -2,22 +2,6 @@
char *s_code[] = {
"number?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25nump;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py17:%25residual-number?;y12:syntax-rules;;;l2:y1:_;y"
"17:%25residual-number?;;",
0,
"&0{%1.0N0]1}@!(y17:%25residual-number?)",
"integer?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25intp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py18:%25residual-integer?;y12:syntax-rules;;;l2:y1:_;"
"y18:%25residual-integer?;;",
0,
"&0{%1.0N4]1}@!(y18:%25residual-integer?)",
"complex?",
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py7:number?;y4:args;;;l2:y1:_;"
"y7:number?;;",
@ -50,160 +34,6 @@ char *s_code[] = {
0,
"&0{%1.0%nJ0]1}@!(y18:%25residual-inexact?)",
"finite?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25finp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py17:%25residual-finite?;y12:syntax-rules;;;l2:y1:_;y"
"17:%25residual-finite?;;",
0,
"&0{%1.0N6]1}@!(y17:%25residual-finite?)",
"infinite?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25infp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py19:%25residual-infinite?;y12:syntax-rules;;;l2:y1:_"
";y19:%25residual-infinite?;;",
0,
"&0{%1.0N7]1}@!(y19:%25residual-infinite?)",
"nan?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25nanp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py14:%25residual-nan?;y12:syntax-rules;;;l2:y1:_;y14:"
"%25residual-nan?;;",
0,
"&0{%1.0N5]1}@!(y14:%25residual-nan?)",
"zero?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25zerop;y1:x;;;l2:py1:_;"
"y12:syntax-rules;;py15:%25residual-zero?;y12:syntax-rules;;;l2:y1:_;y1"
"5:%25residual-zero?;;",
0,
"&0{%1.0=0]1}@!(y15:%25residual-zero?)",
"positive?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25posp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py19:%25residual-positive?;y12:syntax-rules;;;l2:y1:_"
";y19:%25residual-positive?;;",
0,
"&0{%1.0>0]1}@!(y19:%25residual-positive?)",
"negative?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25negp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py19:%25residual-negative?;y12:syntax-rules;;;l2:y1:_"
";y19:%25residual-negative?;;",
0,
"&0{%1.0<0]1}@!(y19:%25residual-negative?)",
"even?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25evnp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py15:%25residual-even?;y12:syntax-rules;;;l2:y1:_;y15"
":%25residual-even?;;",
0,
"&0{%1.0N8]1}@!(y15:%25residual-even?)",
"odd?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25oddp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py14:%25residual-odd?;y12:syntax-rules;;;l2:y1:_;y14:"
"%25residual-odd?;;",
0,
"&0{%1.0N9]1}@!(y14:%25residual-odd?)",
"min",
"l7:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;y1:x;;l2:l3:y1:_;y1:x;y1:y;;l3:"
"y4:%25min;y1:x;y1:y;;;l2:l5:y1:_;y1:x;y1:y;y1:z;y3:...;;l4:y3:min;l3:y"
"3:min;y1:x;y1:y;;y1:z;y3:...;;;l2:py1:_;y4:args;;py13:%25residual-min;"
"y4:args;;;l2:y1:_;y13:%25residual-min;;",
"max",
"l7:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;y1:x;;l2:l3:y1:_;y1:x;y1:y;;l3:"
"y4:%25max;y1:x;y1:y;;;l2:l5:y1:_;y1:x;y1:y;y1:z;y3:...;;l4:y3:max;l3:y"
"3:max;y1:x;y1:y;;y1:z;y3:...;;;l2:py1:_;y4:args;;py13:%25residual-max;"
"y4:args;;;l2:y1:_;y13:%25residual-max;;",
"+",
"l7:y12:syntax-rules;n;l2:l1:y1:_;;i0;;l2:l2:y1:_;y1:x;;l2:y4:%25ckn;y1"
":x;;;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25add;y1:x;y1:y;;;l2:l5:y1:_;y1:x;y1"
":y;y1:z;y3:...;;l4:y1:+;l3:y1:+;y1:x;y1:y;;y1:z;y3:...;;;l2:y1:_;y10:%"
"25residual+;;",
"*",
"l7:y12:syntax-rules;n;l2:l1:y1:_;;i1;;l2:l2:y1:_;y1:x;;l2:y4:%25ckn;y1"
":x;;;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25mul;y1:x;y1:y;;;l2:l5:y1:_;y1:x;y1"
":y;y1:z;y3:...;;l4:y1:*;l3:y1:*;y1:x;y1:y;;y1:z;y3:...;;;l2:y1:_;y10:%"
"25residual*;;",
"-",
"l7:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25neg;y1:x;;;l2:l3:y1:_;"
"y1:x;y1:y;;l3:y4:%25sub;y1:x;y1:y;;;l2:l5:y1:_;y1:x;y1:y;y1:z;y3:...;;"
"l4:y1:-;l3:y1:-;y1:x;y1:y;;y1:z;y3:...;;;l2:py1:_;y4:args;;py10:%25res"
"idual-;y4:args;;;l2:y1:_;y10:%25residual-;;",
"/",
"l7:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y4:%25div;i1;y1:x;;;l2:l3:y1"
":_;y1:x;y1:y;;l3:y4:%25div;y1:x;y1:y;;;l2:l5:y1:_;y1:x;y1:y;y1:z;y3:.."
".;;l4:y1:/;l3:y1:/;y1:x;y1:y;;y1:z;y3:...;;;l2:py1:_;y4:args;;py10:%25"
"residual/;y4:args;;;l2:y1:_;y10:%25residual/;;",
"=",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y3:%25eq;y1:x;y1:y;;;l2"
":l5:y1:_;y1:x;y1:y;y1:z;y3:...;;l3:y3:let;l1:l2:y1:t;y1:y;;;l3:y3:and;"
"l3:y1:=;y1:x;y1:t;;l4:y1:=;y1:t;y1:z;y3:...;;;;;l2:py1:_;y4:args;;py10"
":%25residual=;y4:args;;;l2:y1:_;y10:%25residual=;;",
"<",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y3:%25lt;y1:x;y1:y;;;l2"
":l5:y1:_;y1:x;y1:y;y1:z;y3:...;;l3:y3:let;l1:l2:y1:t;y1:y;;;l3:y3:and;"
"l3:y1:<;y1:x;y1:t;;l4:y1:<;y1:t;y1:z;y3:...;;;;;l2:py1:_;y4:args;;py10"
":%25residual<;y4:args;;;l2:y1:_;y10:%25residual<;;",
">",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y3:%25gt;y1:x;y1:y;;;l2"
":l5:y1:_;y1:x;y1:y;y1:z;y3:...;;l3:y3:let;l1:l2:y1:t;y1:y;;;l3:y3:and;"
"l3:y1:>;y1:x;y1:t;;l4:y1:>;y1:t;y1:z;y3:...;;;;;l2:py1:_;y4:args;;py10"
":%25residual>;y4:args;;;l2:y1:_;y10:%25residual>;;",
"<=",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y3:%25le;y1:x;y1:y;;;l2"
":l5:y1:_;y1:x;y1:y;y1:z;y3:...;;l3:y3:let;l1:l2:y1:t;y1:y;;;l3:y3:and;"
"l3:y2:<=;y1:x;y1:t;;l4:y2:<=;y1:t;y1:z;y3:...;;;;;l2:py1:_;y4:args;;py"
"11:%25residual<=;y4:args;;;l2:y1:_;y11:%25residual<=;;",
">=",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y3:%25ge;y1:x;y1:y;;;l2"
":l5:y1:_;y1:x;y1:y;y1:z;y3:...;;l3:y3:let;l1:l2:y1:t;y1:y;;;l3:y3:and;"
"l3:y2:>=;y1:x;y1:t;;l4:y2:>=;y1:t;y1:z;y3:...;;;;;l2:py1:_;y4:args;;py"
"11:%25residual>=;y4:args;;;l2:y1:_;y11:%25residual>=;;",
"abs",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25abs;y1:x;;;l2:py1:_;y1"
"2:syntax-rules;;py13:%25residual-abs;y12:syntax-rules;;;l2:y1:_;y13:%2"
"5residual-abs;;",
0,
"&0{%1.0G0]1}@!(y13:%25residual-abs)",
"quotient",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25quo;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py18:%25residual-quotient;y12:syntax-rules;;"
";l2:y1:_;y18:%25residual-quotient;;",
0,
"&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"
"2:py1:_;y12:syntax-rules;;py19:%25residual-remainder;y12:syntax-rules;"
";;l2:y1:_;y19:%25residual-remainder;;",
0,
"&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:_"
";y8:quotient;;",
@ -212,22 +42,6 @@ char *s_code[] = {
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py9:remainder;y4:args;;;l2:y1:"
"_;y9:remainder;;",
"modquo",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25mqu;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py16:%25residual-modquo;y12:syntax-rules;;;l"
"2:y1:_;y16:%25residual-modquo;;",
0,
"&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"
"2:py1:_;y12:syntax-rules;;py16:%25residual-modulo;y12:syntax-rules;;;l"
"2:y1:_;y16:%25residual-modulo;;",
0,
"&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"
"6:modquo;;",
@ -442,12 +256,6 @@ char *s_code[] = {
0,
"&0{%1.0X5]1}@!(y24:%25residual-string->symbol)",
"c?r",
"l5:y12:syntax-rules;l2:y1:a;y1:d;;l2:l2:y3:c?r;y1:x;;y1:x;;l2:l5:y3:c?"
"r;y1:a;y1:?;y3:...;y1:x;;l2:y3:car;l4:y3:c?r;y1:?;y3:...;y1:x;;;;l2:l5"
":y3:c?r;y1:d;y1:?;y3:...;y1:x;;l2:y3:cdr;l4:y3:c?r;y1:?;y3:...;y1:x;;;"
";",
"list?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25listp;y1:x;;;l2:py1:_;"
"y12:syntax-rules;;py15:%25residual-list?;y12:syntax-rules;;;l2:y1:_;y1"
@ -518,8 +326,8 @@ char *s_code[] = {
"&0{%2.1%l,.1A1]2}@!(y14:%25residual-memv)",
0,
"&0{%3.1p?{${${.5,@(y4:%25car)[01},.3,.6[02}?{.1]3}.2,${.4,@(y4:%25cdr)"
"[01},.2,@(y7:%25member)[33}f]3}@!(y7:%25member)",
"&0{%3.1p?{${.3a,.3,.6[02}?{.1]3}.2,.2d,.2,@(y7:%25member)[33}f]3}@!(y7"
":%25member)",
"member",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y1:y;;l3:y5:%25meme;y1:v;l2:y4:%"
@ -1298,56 +1106,12 @@ char *s_code[] = {
0,
"&0{%!1.0u?{'(c ),.2S2]2}.0a,.2S2]2}@!(y21:%25residual-make-string)",
0,
"&0{%!0.0u,.0?{.0]2}.1d,.2a,,#0.0,&1{%2.1u,.0?{.0]3}.2a,.0,.3=?{.3d,.1,"
":0^[42}f]4}.!0.0^_1[22}@!(y10:%25residual=)",
0,
"&0{%!0.0u,.0?{.0]2}.1d,.2a,,#0.0,&1{%2.1u,.0?{.0]3}.2a,.0,.3<?{.3d,.1,"
":0^[42}f]4}.!0.0^_1[22}@!(y10:%25residual<)",
0,
"&0{%!0.0u,.0?{.0]2}.1d,.2a,,#0.0,&1{%2.1u,.0?{.0]3}.2a,.0,.3>?{.3d,.1,"
":0^[42}f]4}.!0.0^_1[22}@!(y10:%25residual>)",
0,
"&0{%!0.0u,.0?{.0]2}.1d,.2a,,#0.0,&1{%2.1u,.0?{.0]3}.2a,.0,.3>!?{.3d,.1"
",:0^[42}f]4}.!0.0^_1[22}@!(y11:%25residual<=)",
0,
"&0{%!0.0u,.0?{.0]2}.1d,.2a,,#0.0,&1{%2.1u,.0?{.0]3}.2a,.0,.3<!?{.3d,.1"
",:0^[42}f]4}.!0.0^_1[22}@!(y11:%25residual>=)",
"minmax-reducer",
"l3:y12:syntax-rules;n;l2:l2:y1:_;y1:f;;l3:y6:lambda;py1:x;y4:args;;l4:"
"y3:let;y4:loop;l2:l2:y1:x;y1:x;;l2:y4:args;y4:args;;;l4:y2:if;l2:y5:nu"
"ll?;y4:args;;y1:x;l3:y4:loop;l3:y1:f;y1:x;l2:y3:car;y4:args;;;l2:y3:cd"
"r;y4:args;;;;;;;",
0,
"&0{%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}.1d,.2a,.2M2,:0^[22}.!0.0^_1[22}@!(y1"
"3:%25residual-min)",
0,
"&0{%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}.1d,.2a,.2M3,:0^[22}.!0.0^_1[22}@!(y1"
"3:%25residual-max)",
0,
"&0{%!0.0u?{'0]1}.0d,.1a,,#0.0,&1{%2.1u?{.0]2}.1d,.2a,.2+,:0^[22}.!0.0^"
"_1[12}@!(y10:%25residual+)",
0,
"&0{%!0.0u?{'1]1}.0d,.1a,,#0.0,&1{%2.1u?{.0]2}.1d,.2a,.2*,:0^[22}.!0.0^"
"_1[12}@!(y10:%25residual*)",
0,
"&0{%!1.0u?{.1-!]2}.0,.2,,#0.0,&1{%2.1u?{.0]2}.1d,.2a,.2-,:0^[22}.!0.0^"
"_1[22}@!(y10:%25residual-)",
0,
"&0{%!1.0u?{.1,'1/]2}.0,.2,,#0.0,&1{%2.1u?{.0]2}.1d,.2a,.2/,:0^[22}.!0."
"0^_1[22}@!(y10:%25residual/)",
0,
"&0{%!2.0u?{.2%l,.2A2]3}.0a,.3,.3,@(y7:%25member)[33}@!(y16:%25residual"
"-member)",

146
src/s.scm
View file

@ -126,6 +126,7 @@
; (fl>? x y z ...)
; (fl>=? x y z ...)
; (fl=? x y z ...)
; (fl!=? x y)
; (flmin x y)
; (flmax x y)
; (flonum->fixnum x)
@ -135,9 +136,10 @@
; Numbers (fixnums or flonums)
;---------------------------------------------------------------------------------------------
(define-inline (number? x) %residual-number? (%nump x))
(define-inline (integer? x) %residual-integer? (%intp x))
; integrables:
;
; (number? x)
; (integer? x)
(define-syntax complex? number?)
@ -151,115 +153,36 @@
(define-inline (inexact? x) %residual-inexact? (flonum? (%ckn x)))
(define-inline (finite? x) %residual-finite? (%finp x))
; (finite? x)
; (infinite? x)
; (nan? x)
; (zero? x)
; (positive? x)
; (negative? x)
; (even? x)
; (odd? x)
(define-inline (infinite? x) %residual-infinite? (%infp x))
; (+ x ...)
; (* x ...)
; (- x y ...)
; (/ x y ...)
(define-inline (nan? x) %residual-nan? (%nanp x))
; (< x y z ...)
; (<= x y z ...)
; (> x y z ...)
; (>= x y z ...)
; (= x y z ...)
(define-inline (zero? x) %residual-zero? (%zerop x))
; (abs x)
(define-inline (positive? x) %residual-positive? (%posp x))
(define-inline (negative? x) %residual-negative? (%negp x))
(define-inline (even? x) %residual-even? (%evnp x))
(define-inline (odd? x) %residual-odd? (%oddp x))
(define-syntax min
(syntax-rules ()
[(_ x) x]
[(_ x y) (%min x y)]
[(_ x y z ...) (min (min x y) z ...)]
[(_ . args) (%residual-min . args)]
[_ %residual-min]))
(define-syntax max
(syntax-rules ()
[(_ x) x]
[(_ x y) (%max x y)]
[(_ x y z ...) (max (max x y) z ...)]
[(_ . args) (%residual-max . args)]
[_ %residual-max]))
(define-syntax +
(syntax-rules ()
[(_) 0]
[(_ x) (%ckn x)]
[(_ x y) (%add x y)]
[(_ x y z ...) (+ (+ x y) z ...)]
[_ %residual+]))
(define-syntax *
(syntax-rules ()
[(_) 1]
[(_ x) (%ckn x)]
[(_ x y) (%mul x y)]
[(_ x y z ...) (* (* x y) z ...)]
[_ %residual*]))
(define-syntax -
(syntax-rules ()
[(_ x) (%neg x)]
[(_ x y) (%sub x y)]
[(_ x y z ...) (- (- x y) z ...)]
[(_ . args) (%residual- . args)]
[_ %residual-]))
(define-syntax /
(syntax-rules ()
[(_ x) (%div 1 x)]
[(_ x y) (%div x y)]
[(_ x y z ...) (/ (/ x y) z ...)]
[(_ . args) (%residual/ . args)]
[_ %residual/]))
(define-syntax =
(syntax-rules ()
[(_ x y) (%eq x y)]
[(_ x y z ...) (let ([t y]) (and (= x t) (= t z ...)))]
[(_ . args) (%residual= . args)]
[_ %residual=]))
(define-syntax <
(syntax-rules ()
[(_ x y) (%lt x y)]
[(_ x y z ...) (let ([t y]) (and (< x t) (< t z ...)))]
[(_ . args) (%residual< . args)]
[_ %residual<]))
(define-syntax >
(syntax-rules ()
[(_ x y) (%gt x y)]
[(_ x y z ...) (let ([t y]) (and (> x t) (> t z ...)))]
[(_ . args) (%residual> . args)]
[_ %residual>]))
(define-syntax <=
(syntax-rules ()
[(_ x y) (%le x y)]
[(_ x y z ...) (let ([t y]) (and (<= x t) (<= t z ...)))]
[(_ . args) (%residual<= . args)]
[_ %residual<=]))
(define-syntax >=
(syntax-rules ()
[(_ x y) (%ge x y)]
[(_ x y z ...) (let ([t y]) (and (>= x t) (>= t z ...)))]
[(_ . args) (%residual>= . args)]
[_ %residual>=]))
(define-inline (abs x) %residual-abs (%abs x))
(define-inline (quotient x y) %residual-quotient (%quo x y))
(define-inline (remainder x y) %residual-remainder (%rem x y))
; (quotient x y)
; (remainder x y)
(define-syntax truncate-quotient quotient)
(define-syntax truncate-remainder remainder)
(define-inline (modquo x y) %residual-modquo (%mqu x y))
(define-inline (modulo x y) %residual-modulo (%mlo x y))
; (modquo x y) %residual-modquo (%mqu x y))
; (modulo x y) %residual-modulo (%mlo x y))
(define-syntax floor-quotient modquo)
(define-syntax floor-remainder modulo)
@ -1015,12 +938,6 @@
(define %residual-make-vector (unary-binary-adaptor make-vector))
(define %residual-make-string (unary-binary-adaptor make-string))
(define %residual= (cmp-reducer =))
(define %residual< (cmp-reducer <))
(define %residual> (cmp-reducer >))
(define %residual<= (cmp-reducer <=))
(define %residual>= (cmp-reducer >=))
(define-syntax minmax-reducer
(syntax-rules ()
[(_ f)
@ -1030,9 +947,6 @@
x
(loop (f x (car args)) (cdr args)))))]))
(define %residual-min (minmax-reducer min))
(define %residual-max (minmax-reducer max))
(define-syntax addmul-reducer
(syntax-rules ()
[(_ f s)
@ -1044,9 +958,6 @@
x
(loop (f x (car args)) (cdr args))))))]))
(define %residual+ (addmul-reducer + 0))
(define %residual* (addmul-reducer * 1))
(define-syntax subdiv-reducer
(syntax-rules ()
[(_ f)
@ -1058,9 +969,6 @@
x
(loop (f x (car args)) (cdr args))))))]))
(define %residual- (subdiv-reducer -))
(define %residual/ (subdiv-reducer /))
(define %residual-member (binary-ternary-adaptor member))
(define %residual-assoc (binary-ternary-adaptor assoc))