suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Chez Scheme: cp0 repair for fx{+,*}/overflow with identity

Browse Source 
Using folding approach for `fx+` caused cp0 to convert `(fx+/overflow
x 0)` to `(fx+/overflow x)`, but two arguments are required.
This commit is contained in:
Matthew Flatt 2020-11-19 19:57:01 -07:00
parent f34ff31aef
commit 3b7378f071
2 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
racket/src/ChezScheme/mats/fx.ms
View File

@ -480,6 +480,8 @@
(eqv? (fx+/wraparound (most-negative-fixnum) -2) (sub1 (most-positive-fixnum)))
(eqv? (fx+/wraparound (most-positive-fixnum) (most-positive-fixnum)) -2)
(eqv? (fx+/wraparound (most-negative-fixnum) (most-negative-fixnum)) 0)
(eqv? (fx+/wraparound (collect-maximum-generation) 0) (collect-maximum-generation))
(eqv? (fx+/wraparound 0 (collect-maximum-generation)) (collect-maximum-generation))
)
(mat fx-
@ -565,6 +567,7 @@
(eqv? (fx-/wraparound (most-positive-fixnum) -2) (add1 (most-negative-fixnum)))
(eqv? (fx-/wraparound (most-positive-fixnum) (most-negative-fixnum)) -1)
(eqv? (fx-/wraparound (most-negative-fixnum) (most-positive-fixnum)) 1)
(eqv? (fx-/wraparound (collect-maximum-generation) 0) (collect-maximum-generation))
)
(mat fx*
@ -639,6 +642,8 @@
(eqv? (fx*/wraparound (most-positive-fixnum) -2) 2)
(eqv? (fx*/wraparound (most-positive-fixnum) (most-negative-fixnum)) (most-negative-fixnum))
(eqv? (fx*/wraparound (most-negative-fixnum) (most-positive-fixnum)) (most-negative-fixnum))
(eqv? (fx*/wraparound (collect-maximum-generation) 1) (collect-maximum-generation))
(eqv? (fx*/wraparound 1 (collect-maximum-generation)) (collect-maximum-generation))
)
(mat fxquotient

6
racket/src/ChezScheme/s/cp0.ss
View File

@ -2606,7 +2606,11 @@
[(eqv? a ident)
(if (and (fx= level 3) (null? (cdr val*)) (direct-result? (car val*)))
(car val*)
(build-primcall (app-preinfo ctxt) level prim val*))]
(if (and (null? (cdr val*))
;; `op` may require exactly 2 arguments
(eqv? (procedure-arity-mask op) 4))
(build-primcall (app-preinfo ctxt) level prim (cons `(quote ,ident) val*))
(build-primcall (app-preinfo ctxt) level prim val*)))]
[else
(build-primcall (app-preinfo ctxt) level prim (cons `(quote ,a) val*))])]))
(let* ([arg (car arg*)] [val (value-visit-operand! arg)])