diff --git a/mats/cptypes.ms b/mats/cptypes.ms index f1ed11132..7f2f7f93d 100644 --- a/mats/cptypes.ms +++ b/mats/cptypes.ms @@ -893,6 +893,11 @@ (not (cptypes-equivalent-expansion? '(lambda (x) (#2%exact? x)) '(lambda (x) (#3%exact? x)))) + (cptypes-equivalent-expansion? + '(lambda (x) (when (fixnum? x) + (add1 x))) + '(lambda (x) (when (fixnum? x) + (#3%$fxx+ x 1)))) (not (cptypes-equivalent-expansion? '(lambda (x) (when (fixnum? x) (fixnum? (add1 x)))) @@ -908,11 +913,21 @@ (add1 x))) '(lambda (x) (when (flonum? x) (#3%fl+ x 1.0)))) + (cptypes-equivalent-expansion? + '(lambda (x) (when (fixnum? x) + (1+ x))) + '(lambda (x) (when (fixnum? x) + (#3%$fxx+ x 1)))) (cptypes-equivalent-expansion? '(lambda (x) (when (flonum? x) (1+ x))) '(lambda (x) (when (flonum? x) (#3%fl+ x 1.0)))) + (cptypes-equivalent-expansion? + '(lambda (x) (when (fixnum? x) + (sub1 x))) + '(lambda (x) (when (fixnum? x) + (#3%$fxx+ x -1)))) (not (cptypes-equivalent-expansion? '(lambda (x) (when (fixnum? x) (fixnum? (sub1 x)))) @@ -928,11 +943,21 @@ (sub1 x))) '(lambda (x) (when (flonum? x) (#3%fl- x 1.0)))) + (cptypes-equivalent-expansion? + '(lambda (x) (when (fixnum? x) + (1- x))) + '(lambda (x) (when (fixnum? x) + (#3%$fxx+ x -1)))) (cptypes-equivalent-expansion? '(lambda (x) (when (flonum? x) (1- x))) '(lambda (x) (when (flonum? x) (#3%fl- x 1.0)))) + (cptypes-equivalent-expansion? + '(lambda (x) (when (fixnum? x) + (-1+ x))) + '(lambda (x) (when (fixnum? x) + (#3%$fxx+ x -1)))) (cptypes-equivalent-expansion? '(lambda (x) (when (flonum? x) (-1+ x))) diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index 9c6b15297..3bbd3241e 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -118,7 +118,8 @@ Online versions of both books can be found at \subsection{Type recovery improvements (10.2.0)} -The type recovery pass has improved support for \scheme{abs} with a fixnum argument +The type recovery pass has improved support for \scheme{abs}, +\scheme{add1} and \scheme{sub1} with a fixnum argument and added support for \scheme{1+}, \scheme{1-}, and \scheme{-1+}. \subsection{Single-argument \scheme{fx-/wraparound} (10.2.0)} diff --git a/s/cpprim.ss b/s/cpprim.ss index 1a17a1253..953939245 100644 --- a/s/cpprim.ss +++ b/s/cpprim.ss @@ -1747,6 +1747,13 @@ (label ,Lfalse ,(%constant sfalse)) ,t)) (goto ,Lfalse))))]) + (define-inline 3 $fxx+ + [(e1 e2) + (bind #t (e1 e2) + (bind #f ([t (%inline +/ovfl ,e1 ,e2)]) + `(if (inline ,(make-info-condition-code 'overflow #f #t) ,%condition-code) + ,(build-libcall #t src sexpr + e1 e2) + ,t)))]) (let () (define (go src sexpr e1 e2) (let ([Llib (make-local-label 'Llib)]) diff --git a/s/cptypes.ss b/s/cptypes.ss index f91b6cedd..f847ec434 100644 --- a/s/cptypes.ss +++ b/s/cptypes.ss @@ -1150,6 +1150,10 @@ Notes: (define-specialize 2 (add1 sub1 1+ 1- -1+) [(n) (let ([r (get-type n)]) (cond + [(predicate-implies? r 'fixnum) + (let ([delta (if (memq prim-name '(add1 1+)) 1 -1)]) + (values `(call ,preinfo ,(lookup-primref 3 '$fxx+) ,n (quote ,delta)) + 'exact-integer ntypes #f #f))] [(predicate-implies? r 'exact-integer) (values `(call ,preinfo ,pr ,n) 'exact-integer ntypes #f #f)] diff --git a/s/mathprims.ss b/s/mathprims.ss index 0e1260895..2f86f2a8a 100644 --- a/s/mathprims.ss +++ b/s/mathprims.ss @@ -523,6 +523,12 @@ (unless (fixnum? y) (fxargerr '$fxu< y)) (#3%$fxu< x y))) + (set! $fxx+ + (lambda (x y) + (unless (fixnum? x) (fxargerr '$fxx+ x)) + (unless (fixnum? y) (fxargerr '$fxx+ y)) + (#3%$fxx+ x y))) + (define-addop fxlogand) (define-addop fxlogior) (define-addop fxlogor) diff --git a/s/primdata.ss b/s/primdata.ss index b9e4f91f4..a231cbb84 100644 --- a/s/primdata.ss +++ b/s/primdata.ss @@ -2017,13 +2017,13 @@ ($fixmediate [sig [(ptr) -> (ptr)]] [flags pure discard]) ($flvector-ref-check? [sig [(ptr ptr) -> (boolean)]] [flags unrestricted pure]) ($flvector-set!-check? [sig [(ptr ptr) -> (boolean)]] [flags unrestricted discard]) - ($<= [flags single-valued]) - ($< [flags single-valued]) - ($= [flags single-valued]) - ($- [flags single-valued]) - ($/ [flags single-valued]) - ($* [flags single-valued]) - ($+ [flags single-valued]) + ($<= [sig [(who number number) -> (boolean)]] [flags pure discard safeongoodargs]) + ($< [sig [(who number number) -> (boolean)]] [flags pure discard safeongoodargs]) + ($= [sig [(who number number) -> (boolean)]] [flags pure discard safeongoodargs]) + ($- [sig [(who number number) -> (number)]] [flags arith-op safeongoodargs]) + ($/ [sig [(who number number) -> (number)]] [flags arith-op]) + ($* [sig [(who number number) -> (number)]] [flags arith-op safeongoodargs]) + ($+ [sig [(who number number) -> (number)]] [flags arith-op safeongoodargs]) ($fleqv? [sig [(flonum flonum) -> (boolean)]] [flags pure mifoldable safeongoodargs]) ($flhash [flags single-valued]) ($flonum->digits [flags single-valued]) @@ -2212,6 +2212,7 @@ ($fxu< [flags single-valued pure cp02]) ($fxvector-ref-check? [sig [(ptr ptr) -> (boolean)]] [flags unrestricted pure]) ($fxvector-set!-check? [sig [(ptr ptr) -> (boolean)]] [flags unrestricted discard]) + ($fxx+ [sig [(fixnum fixnum) -> (sint)]] [flags arith-op safeongoodargs]) ($gc-cpu-time [flags true]) ($gc-real-time [flags true]) ($generation [flags single-valued]) diff --git a/s/prims.ss b/s/prims.ss index 89648023e..effbd8c5b 100644 --- a/s/prims.ss +++ b/s/prims.ss @@ -832,6 +832,10 @@ (lambda (x y) ($fx+? x y))) +(define $fxx+ + (lambda (x y) + ($fxx+ x y))) + (define $fx-? (lambda (x y) ($fx-? x y)))