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

fix lots of numeric types

Browse Source 
svn: r17520

original commit: 8b7fb016923da57df016ade78089468a902483d2
This commit is contained in:
Sam Tobin-Hochstadt 2010-01-06 23:21:31 +00:00
parent 1eeef8e717
commit a431e55952
1 changed files with 37 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
collects/typed-scheme/private/base-env-numeric.ss
View File

@ -3,7 +3,7 @@
(begin
(require
scheme/tcp
scheme
scheme scheme/flonum
scheme/unsafe/ops
(only-in rnrs/lists-6 fold-left)
'#%paramz
@ -26,14 +26,19 @@
;; numeric predicates
[zero? (make-pred-ty (list N) B -Zero)]
[number? (make-pred-ty N)]
[integer? (Univ . -> . B : (-LFS (list (-filter -Real)) (list (-not-filter -Integer))))]
[integer? (Univ . -> . B : (-LFS (list (-filter (Un -Integer -Flonum))) (list (-not-filter -Integer))))]
[exact-integer? (make-pred-ty -Integer)]
[real? (make-pred-ty -Real)]
[inexact-real? (make-pred-ty -Flonum)]
[complex? (make-pred-ty N)]
[rational? (make-pred-ty -Real)]
[exact? (N . -> . B : (-LFS (list) (list (-not-filter -ExactRational))))]
[inexact? (N . -> . B : (-LFS (list) (list (-not-filter -Flonum))))]
[fixnum? (Univ . -> . B : (-LFS (list (-filter -Integer)) null))]
[positive? (-> -Real B)]
[negative? (-> -Real B)]
[exact-positive-integer? (make-pred-ty -Pos)]
[exact-nonnegative-integer? (make-pred-ty -Nat)]
[odd? (-> -Integer B)]
[even? (-> -Integer B)]
@ -84,8 +89,6 @@
(make-Function (list (make-arr (list -Integer -Integer) (-values (list -Integer -Integer)))))]
;; exactness
[exact? (N . -> . B)]
[inexact? (N . -> . B)]
[exact->inexact (cl->*
(-Real . -> . -Flonum)
(N . -> . N))]
@ -93,18 +96,18 @@
(-Real . -> . -ExactRational)
(N . -> . N))]
[floor (-> N N)]
[ceiling (-> N N)]
[truncate (-> N N)]
[make-rectangular (N N . -> . N)]
[make-polar (N N . -> . N)]
[real-part (N . -> . N)]
[imag-part (N . -> . N)]
[magnitude (N . -> . N)]
[angle (N . -> . N)]
[numerator (N . -> . -Integer)]
[denominator (N . -> . -Integer)]
[rationalize (N N . -> . N)]
[floor (-> -Real -Real)]
[ceiling (-> -Real -Real)]
[truncate (-> -Real -Real)]
[make-rectangular (-Real -Real . -> . N)]
[make-polar (-Real -Real . -> . N)]
[real-part (N . -> . -Real)]
[imag-part (N . -> . -Real)]
[magnitude (N . -> . -Real)]
[angle (N . -> . -Real)]
[numerator (-Real . -> . -Integer)]
[denominator (-Real . -> . -Integer)]
[rationalize (-Real -Real . -> . N)]
[expt (cl->* (-Integer -Integer . -> . -Integer) (N N . -> . N))]
[sqrt (cl->*
(-Nat . -> . -Real)
@ -122,12 +125,12 @@
[gcd (null -Integer . ->* . -Integer)]
[lcm (null -Integer . ->* . -Integer)]
[round (N . -> . -Integer)]
[round (-Real . -> . -Real)]
;; scheme/math
[sgn (-Real . -> . -Real)]
[pi N]
[pi -Flonum]
[sqr (cl->* (-> -Pos -Pos)
(-> -Nat -Nat)
(-> -Integer -Integer)
@ -140,9 +143,10 @@
[sinh (N . -> . N)]
[cosh (N . -> . N)]
[tanh (N . -> . N)]
;; unsafe numeric ops
;; unsafe numeric ops
[unsafe-flabs fl-unop]
[unsafe-flsqrt fl-unop]
[unsafe-fl+ fl-op]
[unsafe-fl- fl-op]
@ -154,3 +158,16 @@
[unsafe-fl>= fl-comp]
[unsafe-fl> fl-comp]
[unsafe-fl< fl-comp]
;; safe flonum ops
[flabs fl-unop]
[flsqrt fl-unop]
[fl+ fl-op]
[fl- fl-op]
[fl* fl-op]
[fl/ fl-op]
[fl= fl-comp]
[fl<= fl-comp]
[fl>= fl-comp]
[fl> fl-comp]
[fl< fl-comp]