From 295c62ca39abe7fd57f6b5fc9cff3e4c84a17ee0 Mon Sep 17 00:00:00 2001 From: ESL Date: Sat, 25 Mar 2023 12:03:28 -0400 Subject: [PATCH] generic math instructions re-coded to N --- i.h | 54 +++++++++++++++++++++++++++--------------------------- s.c | 20 ++++++++++++++++++-- src/s.scm | 42 ++++++++++++++++++++++++++++++------------ 3 files changed, 75 insertions(+), 41 deletions(-) diff --git a/i.h b/i.h index 86199be..48344b7 100644 --- a/i.h +++ b/i.h @@ -260,7 +260,7 @@ declare_instruction(imqu, "Il", 0, "fxmodquo", '2', declare_instruction(imlo, "Im", 0, "fxmodulo", '2', AUTOGL) declare_instruction(ieuq, "I5", 0, "fxeucquo", '2', AUTOGL) declare_instruction(ieur, "I6", 0, "fxeucrem", '2', AUTOGL) -declare_instruction(igcd, "Ig", 0, "fxgcd", '2', AUTOGL) +declare_instruction(igcd, "Ig\0'0", 0, "fxgcd", 'p', AUTOGL) declare_instruction(ipow, "Ip", 0, "fxexpt", '2', AUTOGL) declare_instruction(isqrt, "It", 0, "fxsqrt", '1', AUTOGL) declare_instruction(inot, "D0", 0, "fxnot", '1', AUTOGL) @@ -294,7 +294,7 @@ declare_instruction(jmin, "Jn", 0, "flmin", 'x', declare_instruction(jmax, "Jx", 0, "flmax", 'x', AUTOGL) declare_instruction(jneg, "J-!", 0, "flneg", '1', AUTOGL) declare_instruction(jabs, "Ja", 0, "flabs", '1', AUTOGL) -declare_instruction(jgcd, "Jg", 0, "flgcd", '2', AUTOGL) +declare_instruction(jgcd, "Jg\0'(j0)", 0, "flgcd", 'p', AUTOGL) declare_instruction(jpow, "Jp", 0, "flexpt", '2', AUTOGL) declare_instruction(jsqrt, "Jt", 0, "flsqrt", '1', AUTOGL) declare_instruction(jtoi, "Ji", 0, "flonum->fixnum", '1', AUTOGL) @@ -318,30 +318,30 @@ declare_instruction(le, ">!", 0, "<=", 'c', declare_instruction(ge, "=", 'c', AUTOGL) declare_instruction(eq, "=", 0, "=", 'c', AUTOGL) declare_instruction(ne, "=!", 0, "!=", '2', AUTOGL) -declare_instruction(min, "Gn", 0, "min", 'x', AUTOGL) -declare_instruction(max, "Gx", 0, "max", 'x', AUTOGL) +declare_instruction(min, "Nn", 0, "min", 'x', AUTOGL) +declare_instruction(max, "Nx", 0, "max", 'x', AUTOGL) declare_instruction(neg, "-!", 0, "neg", '1', AUTOGL) -declare_instruction(abs, "Ga", 0, "abs", '1', AUTOGL) -declare_instruction(gcd, "Gg", 0, "gcd", '2', AUTOGL) -declare_instruction(pow, "Gp", 0, "expt", '2', AUTOGL) -declare_instruction(sqrt, "Gt", 0, "sqrt", '1', AUTOGL) -declare_instruction(mqu, "Gl", 0, "floor-quotient", '2', AUTOGL) -declare_instruction(mlo, "Gm", 0, "floor-remainder", '2', AUTOGL) -declare_instruction(quo, "Gq", 0, "truncate-quotient", '2', AUTOGL) -declare_instruction(rem, "Gr", 0, "truncate-remainder", '2', AUTOGL) +declare_instruction(abs, "Na", 0, "abs", '1', AUTOGL) +declare_instruction(gcd, "Ng\0'0", 0, "gcd", 'p', AUTOGL) +declare_instruction(pow, "Np", 0, "expt", '2', AUTOGL) +declare_instruction(sqrt, "Nt", 0, "sqrt", '1', AUTOGL) +declare_instruction(mqu, "Nl", 0, "floor-quotient", '2', AUTOGL) +declare_instruction(mlo, "Nm", 0, "floor-remainder", '2', AUTOGL) +declare_instruction(quo, "Nq", 0, "truncate-quotient", '2', AUTOGL) +declare_instruction(rem, "Nr", 0, "truncate-remainder", '2', AUTOGL) declare_instruction(nump, "N0", 0, "number?", '1', AUTOGL) -declare_instruction(intp, "Gw", 0, "integer?", '1', AUTOGL) -declare_instruction(nanp, "Gu", 0, "nan?", '1', AUTOGL) -declare_instruction(finp, "Gf", 0, "finite?", '1', AUTOGL) -declare_instruction(infp, "Gh", 0, "infinite?", '1', AUTOGL) -declare_instruction(evnp, "Ge", 0, "even?", '1', AUTOGL) -declare_instruction(oddp, "Go", 0, "odd?", '1', AUTOGL) -declare_instruction(ntoi, "Gi", 0, "exact", '1', AUTOGL) -declare_instruction(ntoj, "Gj", 0, "inexact", '1', AUTOGL) -declare_instruction(floor, "Gb", 0, "floor", '1', AUTOGL) -declare_instruction(ceil, "Gc", 0, "ceiling", '1', AUTOGL) -declare_instruction(trunc, "Gk", 0, "truncate", '1', AUTOGL) -declare_instruction(round, "Gd", 0, "round", '1', AUTOGL) +declare_instruction(intp, "Nw", 0, "integer?", '1', AUTOGL) +declare_instruction(nanp, "Nu", 0, "nan?", '1', AUTOGL) +declare_instruction(finp, "Nf", 0, "finite?", '1', AUTOGL) +declare_instruction(infp, "Nh", 0, "infinite?", '1', AUTOGL) +declare_instruction(evnp, "Ne", 0, "even?", '1', AUTOGL) +declare_instruction(oddp, "No", 0, "odd?", '1', AUTOGL) +declare_instruction(ntoi, "Ni", 0, "exact", '1', AUTOGL) +declare_instruction(ntoj, "Nj", 0, "inexact", '1', AUTOGL) +declare_instruction(floor, "Nb", 0, "floor", '1', AUTOGL) +declare_instruction(ceil, "Nc", 0, "ceiling", '1', AUTOGL) +declare_instruction(trunc, "Nk", 0, "truncate", '1', AUTOGL) +declare_instruction(round, "Nd", 0, "round", '1', AUTOGL) declare_instruction(listp, "L0", 0, "list?", '1', AUTOGL) declare_instruction(list, "l", 1, "list", '#', "%!0_!]0") declare_instruction(lmk, "L2\0f", 0, "make-list", 'b', AUTOGL) @@ -467,9 +467,9 @@ declare_integrable(NULL, "N0", 0, "rational?", '1', declare_integrable(NULL, "I0", 0, "exact-integer?", '1', AUTOGL) declare_integrable(NULL, "%nI0", 0, "exact?", '1', AUTOGL) declare_integrable(NULL, "%nJ0", 0, "inexact?", '1', AUTOGL) -declare_integrable(NULL, "Gm", 0, "modulo", '2', AUTOGL) -declare_integrable(NULL, "Gq", 0, "quotient", '2', AUTOGL) -declare_integrable(NULL, "Gr", 0, "remainder", '2', AUTOGL) +declare_integrable(NULL, "Nm", 0, "modulo", '2', AUTOGL) +declare_integrable(NULL, "Nq", 0, "quotient", '2', AUTOGL) +declare_integrable(NULL, "Nr", 0, "remainder", '2', AUTOGL) declare_integrable(NULL, "Ij", 0, "exact->inexact", '1', AUTOGL) declare_integrable(NULL, "Ji", 0, "inexact->exact", '1', AUTOGL) declare_integrable(NULL, "aaa", 0, "caaar", '1', AUTOGL) diff --git a/s.c b/s.c index 5d951fc..08de738 100644 --- a/s.c +++ b/s.c @@ -151,10 +151,26 @@ char *s_code[] = { "da*;l2:y4:args;py6:lambda;py4:args;y5:forms;;;;y3:...;;;", "P", "floor/", - "%2.1,.1Gm,.2,.2Gl,@(y6:values)[22", + "%2.1,.1Nm,.2,.2Nl,@(y6:values)[22", "P", "truncate/", - "%2.1,.1Gr,.2,.2Gq,@(y6:values)[22", + "%2.1,.1Nr,.2,.2Nq,@(y6:values)[22", + + "P", "lcm", + "%!0.0u?{'1]1}.0d,.1a,,#0.0,&1{%2.1u?{.0]2}.1a,.0,.2Ng,.3d,.1=0?{.1}{.2" + "Na,.2,.5NaNq*},:0^[42}.!0.0^_1[12", + + "P", "numerator", + "%1.0]1", + + "P", "denominator", + "%1'1]1", + + "P", "rationalize", + "%2.0]2", + + "P", "square", + "%1.0,.1*]1", "P", "%append", "%!0.0,,#0.0,&1{%1.0u?{n]1}.0du?{.0a]1}${.2d,:0^[01},.1aL6]1}.!0.0^_1[1" diff --git a/src/s.scm b/src/s.scm index 2523953..15fbad6 100644 --- a/src/s.scm +++ b/src/s.scm @@ -300,6 +300,13 @@ ; (fl/ x y ...) ; (flneg x) ; (flabs x) +; (flgcd x y) +; (flexpt x y) +; (flsqrt x) +; (flfloor x) +; (flceiling x) +; (fltruncate x) +; (flround x) ; (fl? x y z ...) @@ -353,6 +360,13 @@ ; (floor-quotient x y) ; (floor-remainder x y) ; (modulo x y) = floor-remainder +; (gcd x y) +; (floor x) +; (ceiling x) +; (truncate x) +; (round x) +; (sqrt x) +; (expt x y) ; (inexact x) ; (exact x) ; (number->string x (radix 10)) @@ -364,15 +378,19 @@ (define (truncate/ x y) (values (truncate-quotient x y) (truncate-remainder x y))) -;gcd -;lcm -;numerator -;denominator -;floor -;ceiling -;truncate -;round -;rationalize +(define (lcm . args) + (if (null? args) 1 + (let loop ([x (car args)] [args (cdr args)]) + (if (null? args) x + (let* ([y (car args)] [g (gcd x y)]) + (loop (if (zero? g) g (* (quotient (abs x) g) (abs y))) (cdr args))))))) + +(define (numerator n) n) + +(define (denominator n) 1) + +(define (rationalize n d) n) + ;exp ;log 1-and-2-arg ;sin @@ -381,10 +399,10 @@ ;asin ;acos ;atan 1-and-2-arg -;square -;sqrt + +(define (square x) (* x x)) + ;exact-integer-sqrt -;expt ;make-rectangular ;make-polar ;real-part