From 0a94172bbde9762c4fb0baef0962701a2408b993 Mon Sep 17 00:00:00 2001 From: ESL Date: Mon, 20 Mar 2023 14:42:40 -0400 Subject: [PATCH] ... generic math ops are new integrables now --- i.h | 58 ++++++------- s.c | 240 +----------------------------------------------------- src/s.scm | 146 ++++++--------------------------- 3 files changed, 58 insertions(+), 386 deletions(-) diff --git a/i.h b/i.h index 7287319..a75e677 100644 --- a/i.h +++ b/i.h @@ -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", 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, "=", '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) diff --git a/s.c b/s.c index 0f9b1d8..0a4770d 100644 --- a/s.c +++ b/s.c @@ -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}@!(y11:%25residual<=)", - - 0, - "&0{%!0.0u,.0?{.0]2}.1d,.2a,,#0.0,&1{%2.1u,.0?{.0]3}.2a,.0,.3=)", - "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)", diff --git a/src/s.scm b/src/s.scm index ca9df1a..1e58486 100644 --- a/src/s.scm +++ b/src/s.scm @@ -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))