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

cptypes: add special case for zero?

Browse Source
This commit is contained in:
Gustavo Massaccesi 2020-11-18 10:50:24 -03:00
parent cdfa80bde9
commit b9e1294b19
3 changed files with 48 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
racket/src/ChezScheme/mats/cptypes.ms
View File

@ -198,6 +198,18 @@
(cptypes-equivalent-expansion? (cptypes-equivalent-expansion?
'(lambda (x) (vector-set! x 0 0) (#2%odd? x) 1) '(lambda (x) (vector-set! x 0 0) (#2%odd? x) 1)
'(lambda (x) (vector-set! x 0 0) (#2%odd? x) 2)) '(lambda (x) (vector-set! x 0 0) (#2%odd? x) 2))
(cptypes-equivalent-expansion?
'(lambda (x) (when (or (fixnum? x) (bignum? x)) (zero? x)))
'(lambda (x) (when (or (fixnum? x) (bignum? x)) (#3%eq? x 0))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (and (or (fixnum? x) (bignum? x)) (zero? x)) x))
'(lambda (x) (when (and (or (fixnum? x) (bignum? x)) (zero? x)) 0)))
(cptypes-equivalent-expansion?
'(lambda (x) (when (fixnum? x) (zero? x)))
'(lambda (x) (when (fixnum? x) (#3%fxzero? x))))
(cptypes-equivalent-expansion?
'(lambda (x) (when (and (fixnum? x) (zero? x)) x))
'(lambda (x) (when (and (fixnum? x) (zero? x)) 0)))
) )
(mat cptypes-type-if (mat cptypes-type-if

34
racket/src/ChezScheme/s/cptypes.ss
View File

@ -1073,6 +1073,40 @@ Notes:
[else [else
(values `(call ,preinfo ,pr ,n) ret ntypes #f #f)]))]) (values `(call ,preinfo ,pr ,n) ret ntypes #f #f)]))])
(define-specialize 2 zero?
[(n) (let ([r (get-type n)])
(cond
[(predicate-implies? r 'bignum)
(values (make-seq ctxt n false-rec)
false-rec ntypes #f #f)]
[(predicate-implies? r 'fixnum)
(values `(call ,preinfo ,(lookup-primref 3 'fxzero?) ,n)
ret
ntypes
(pred-env-add/ref ntypes n `(quote 0) plxc)
#f)]
[(predicate-implies? r 'exact-integer)
(values `(call ,preinfo ,(lookup-primref 3 'eq?) ,n (quote 0))
ret
ntypes
(pred-env-add/ref ntypes n `(quote 0) plxc)
#f)]
[(predicate-implies? r 'flonum)
(values `(call ,preinfo ,(lookup-primref 3 'flzero?) ,n)
ret
ntypes
#f ; TODO: Add a type for flzero
#f)]
[else
(values `(call ,preinfo ,pr ,n) ret ntypes #f #f)]))])
(define-specialize 2 fxzero?
[(n) (values `(call ,preinfo ,pr ,n)
ret
ntypes
(pred-env-add/ref ntypes n `(quote 0) plxc)
#f)])
(define-specialize 2 atan (define-specialize 2 atan
[(n) (let ([r (get-type n)]) [(n) (let ([r (get-type n)])
(cond (cond

4
racket/src/ChezScheme/s/primdata.ss
View File

@ -45,7 +45,7 @@
(fx=? [sig [(fixnum fixnum fixnum ...) -> (boolean)]] [flags pure cp02 safeongoodargs]) ; restricted to 2+ arguments (fx=? [sig [(fixnum fixnum fixnum ...) -> (boolean)]] [flags pure cp02 safeongoodargs]) ; restricted to 2+ arguments
(fx>? [sig [(fixnum fixnum fixnum ...) -> (boolean)]] [flags pure cp02 safeongoodargs]) ; restricted to 2+ arguments (fx>? [sig [(fixnum fixnum fixnum ...) -> (boolean)]] [flags pure cp02 safeongoodargs]) ; restricted to 2+ arguments
(fx>=? [sig [(fixnum fixnum fixnum ...) -> (boolean)]] [flags pure cp02 safeongoodargs]) ; restricted to 2+ arguments (fx>=? [sig [(fixnum fixnum fixnum ...) -> (boolean)]] [flags pure cp02 safeongoodargs]) ; restricted to 2+ arguments
(fxzero? [sig [(fixnum) -> (boolean)]] [flags pure cp02 safeongoodargs]) (fxzero? [sig [(fixnum) -> (boolean)]] [flags pure cp02 safeongoodargs cptypes2])
(fxnegative? [sig [(fixnum) -> (boolean)]] [flags pure cp02 safeongoodargs]) (fxnegative? [sig [(fixnum) -> (boolean)]] [flags pure cp02 safeongoodargs])
(fxpositive? [sig [(fixnum) -> (boolean)]] [flags pure cp02 safeongoodargs]) (fxpositive? [sig [(fixnum) -> (boolean)]] [flags pure cp02 safeongoodargs])
(fxeven? [sig [(fixnum) -> (boolean)]] [flags pure cp02 safeongoodargs]) (fxeven? [sig [(fixnum) -> (boolean)]] [flags pure cp02 safeongoodargs])
@ -201,7 +201,7 @@
((r6rs: =) [sig [(number number number ...) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs]) ; restricted to 2+ arguments ((r6rs: =) [sig [(number number number ...) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs]) ; restricted to 2+ arguments
((r6rs: >) [sig [(real real real ...) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs]) ; restricted to 2+ arguments ((r6rs: >) [sig [(real real real ...) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs]) ; restricted to 2+ arguments
((r6rs: >=) [sig [(real real real ...) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs]) ; restricted to 2+ arguments ((r6rs: >=) [sig [(real real real ...) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs]) ; restricted to 2+ arguments
(zero? [sig [(number) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs]) (zero? [sig [(number) -> (boolean)]] [flags pure mifoldable discard safeongoodargs cptypes2 ieee r5rs])
(positive? [sig [(real) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs]) (positive? [sig [(real) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs])
(negative? [sig [(real) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs]) (negative? [sig [(real) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs])
(odd? [sig [(integer) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs]) (odd? [sig [(integer) -> (boolean)]] [flags pure mifoldable discard safeongoodargs ieee r5rs])