... fxmin & others; 'x' ig type

This commit is contained in:
ESL 2023-03-20 13:49:00 -04:00
parent 3730b714d4
commit 91b07297cf
5 changed files with 1277 additions and 1093 deletions

4
i.c
View file

@ -3590,6 +3590,10 @@ static obj *rds_intgtab(obj *r, obj *sp, obj *hp)
lcode = lbuf; assert(pe->enc);
sprintf(lbuf, "%%!0.0u,.0?{.0]2}.1d,.2a,,#0.0,&1{%%2.1u,.0?{.0]3}.2a,.0,.3%s?{.3d,.1,:0^[42}f]4}.!0.0^_1[22", pe->enc);
} break;
case 'x': {
lcode = lbuf; assert(pe->enc);
sprintf(lbuf, "%%!1.0,.2,,#0.0,&1{%%2.1u?{.0]2}.1d,.2a,.2%s,:0^[22}.!0.0^_1[22}", pe->enc);
} break;
default: assert(0);
}
if (!lcode || *lcode == 0) continue;

32
i.h
View file

@ -247,20 +247,20 @@ declare_instruction(iposp, "I>0", 0, "fxpositive?", '1', AUTOGL)
declare_instruction(inegp, "I<0", 0, "fxnegative?", '1', AUTOGL)
declare_instruction(ievnp, "Ie", 0, "fxeven?", '1', AUTOGL)
declare_instruction(ioddp, "Io", 0, "fxodd?", '1', AUTOGL)
declare_instruction(iadd, "I+", 0, "fx+", '2', AUTOGL)
declare_instruction(isub, "I-", 0, "fx-", '2', AUTOGL)
declare_instruction(imul, "I*", 0, "fx*", '2', AUTOGL)
declare_instruction(idiv, "I/", 0, "fx/", '2', AUTOGL)
declare_instruction(iadd, "I+\0'0", 0, "fx+", 'p', AUTOGL)
declare_instruction(isub, "I-\0I-!", 0, "fx-", 'm', AUTOGL)
declare_instruction(imul, "I*\0'1", 0, "fx*", 'p', AUTOGL)
declare_instruction(idiv, "I/\0,'1I/", 0, "fx/", 'm', AUTOGL)
declare_instruction(iquo, "Iq", 0, "fxquotient", '2', AUTOGL)
declare_instruction(irem, "Ir", 0, "fxremainder", '2', AUTOGL)
declare_instruction(ilt, "I<", 0, "fx<?", '2', AUTOGL)
declare_instruction(igt, "I>", 0, "fx>?", '2', AUTOGL)
declare_instruction(ile, "I>!", 0, "fx<=?", '2', AUTOGL)
declare_instruction(ige, "I<!", 0, "fx>=?", '2', AUTOGL)
declare_instruction(ieq, "I=", 0, "fx=?", '2', AUTOGL)
declare_instruction(ilt, "I<", 0, "fx<?", 'c', AUTOGL)
declare_instruction(igt, "I>", 0, "fx>?", 'c', AUTOGL)
declare_instruction(ile, "I>!", 0, "fx<=?", 'c', AUTOGL)
declare_instruction(ige, "I<!", 0, "fx>=?", 'c', AUTOGL)
declare_instruction(ieq, "I=", 0, "fx=?", 'c', AUTOGL)
declare_instruction(ine, "I=!", 0, "fx!=?", '2', AUTOGL)
declare_instruction(imin, "In", 0, "fxmin", '2', AUTOGL)
declare_instruction(imax, "Ix", 0, "fxmax", '2', AUTOGL)
declare_instruction(imin, "In", 0, "fxmin", 'x', AUTOGL)
declare_instruction(imax, "Ix", 0, "fxmax", 'x', AUTOGL)
declare_instruction(ineg, "I-!", 0, "fxneg", '1', AUTOGL)
declare_instruction(iabs, "Ia", 0, "fxabs", '1', AUTOGL)
declare_instruction(itoj, "Ij", 0, "fixnum->flonum", '1', AUTOGL)
@ -273,9 +273,9 @@ declare_instruction(igcd, "I7", 0, "fxgcd", '2', AUTOGL)
declare_instruction(ipow, "I8", 0, "fxexpt", '2', AUTOGL)
declare_instruction(isqrt, "I9", 0, "fxsqrt", '1', AUTOGL)
declare_instruction(inot, "D0", 0, "fxnot", '1', AUTOGL)
declare_instruction(iand, "D1", 0, "fxand", '2', AUTOGL)
declare_instruction(iior, "D2", 0, "fxior", '2', AUTOGL)
declare_instruction(ixor, "D3", 0, "fxxor", '2', AUTOGL)
declare_instruction(iand, "D1\0'(i-1)", 0, "fxand", 'p', AUTOGL)
declare_instruction(iior, "D2\0'0", 0, "fxior", 'p', AUTOGL)
declare_instruction(ixor, "D3\0'0", 0, "fxxor", 'p', AUTOGL)
declare_instruction(iasl, "D4", 0, "fxsll", '2', AUTOGL)
declare_instruction(iasr, "D5", 0, "fxsrl", '2', AUTOGL)
declare_instruction(jzerop, "J=0", 0, "flzero?", '1', AUTOGL)
@ -299,8 +299,8 @@ declare_instruction(jle, "J>!", 0, "fl<=?", 'c', AUTOGL)
declare_instruction(jge, "J<!", 0, "fl>=?", 'c', AUTOGL)
declare_instruction(jeq, "J=", 0, "fl=?", 'c', AUTOGL)
declare_instruction(jne, "J=!", 0, "fl!=?", '2', AUTOGL)
declare_instruction(jmin, "Jn", 0, "flmin", '2', AUTOGL)
declare_instruction(jmax, "Jx", 0, "flmax", '2', AUTOGL)
declare_instruction(jmin, "Jn", 0, "flmin", 'x', AUTOGL)
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(jtoi, "Ji", 0, "flonum->fixnum", '1', AUTOGL)

2283
k.c

File diff suppressed because it is too large Load diff

View file

@ -357,13 +357,13 @@
(define (integrable-argc-match? igt n)
(case igt
[(#\0) (= n 0)] [(#\1) (= n 1)] [(#\2) (= n 2)] [(#\3) (= n 3)]
[(#\p) (>= n 0)] [(#\m) (>= n 1)] [(#\c) (>= n 2)]
[(#\p) (>= n 0)] [(#\m) (>= n 1)] [(#\c) (>= n 2)] [(#\x) (>= n 1)]
[else #f]))
(define (xform-integrable ig tail env)
(if (integrable-argc-match? (integrable-type ig) (length tail))
(cons 'integrable (cons ig (map (lambda (sexp) (xform #f sexp env)) tail)))
(error 'transform "improper integrable application" (integrable-global ig))))
(xform-call (list 'ref (integrable-global ig)) tail env)))
(define (xform-lambda tail env)
(if (and (list1+? tail) (idslist? (car tail)))
@ -1135,6 +1135,14 @@
(do ([i 0 (fx+ i 1)]) [(fx>=? i opc)]
(unless (fxzero? i) (write-char #\; port))
(write-string igc0 port)))]
[(#\x) ; (length args) >= 1
(let ([opc (fx- (length args) 1)])
(do ([args (reverse args) (cdr args)] [l l (cons #f l)])
[(null? args)]
(codegen (car args) l f s g #f port)
(unless (null? (cdr args)) (write-char #\, port)))
(do ([i 0 (fx+ i 1)]) [(fx>=? i opc)]
(write-string igc0 port)))]
[else (error 'codegen "NYI: unsupported integrable type" igty)]))
(when k (write-char #\] port) (write-serialized-arg k port))]
[call (exp . args)

View file

@ -76,10 +76,10 @@
; (fxzero? x)
; (fxpositive? x)
; (fxnegative? x)
; (fx+ x y)
; (fx* x y)
; (fx- x y)
; (fx/ x y)
; (fx+ x ...)
; (fx* x ...)
; (fx- x y ...)
; (fx/ x y ...)
; (fxquotient x y)
; (fxremainder x y)
; (fxmodquo x y)
@ -88,11 +88,12 @@
; (fxeucrem x y) a.k.a. euclidean-remainder
; (fxneg x)
; (fxabs x)
; (fx<? x y)
; (fx<=? x y)
; (fx>? x y)
; (fx>=? x y)
; (fx=? x y)
; (fx<? x y z ...)
; (fx<=? x y z ...)
; (fx>? x y z ...)
; (fx>=? x y z ...)
; (fx=? x y z ...)
; (fx!=? x y)
; (fxmin x y)
; (fxmax x y)
; (fixnum->flonum x)
@ -114,17 +115,17 @@
; (flfinite? x)
; (fleven? x)
; (flodd? x)
; (fl+ x y)
; (fl- x y)
; (fl* x y)
; (fl/ x y)
; (fl+ x ...)
; (fl* x ...)
; (fl- x y ...)
; (fl/ x y ...)
; (flneg x)
; (flabs x)
; (fl<? x y)
; (fl<=? x y)
; (fl>? x y)
; (fl>=? x y)
; (fl=? x y)
; (fl<? x y z ...)
; (fl<=? x y z ...)
; (fl>? x y z ...)
; (fl>=? x y z ...)
; (fl=? x y z ...)
; (flmin x y)
; (flmax x y)
; (flonum->fixnum x)