generic math instructions re-coded to N

This commit is contained in:
ESL 2023-03-25 12:03:28 -04:00
parent 7ef7b1857e
commit 295c62ca39
3 changed files with 75 additions and 41 deletions

54
i.h
View file

@ -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, "<!", 0, ">=", '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)

20
s.c
View file

@ -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"

View file

@ -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 ...)
; (fl<=? x y z ...)
; (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