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

Various fixnum unsafe operations improvements.

Browse Source 
original commit: b7229487a59d3fa53f92bffb9f7374ab28bb8032
This commit is contained in:
Vincent St-Amour 2010-07-09 14:35:59 -04:00
parent c05f2797aa
commit a4cb468a71
2 changed files with 20 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/typed-scheme/private/base-env-numeric.rkt
View File

@ -46,7 +46,8 @@
(define-for-syntax fx-op (cl->* (-Pos -Pos . -> . -PositiveFixnum)
(-Nat -Nat . -> . -NonnegativeFixnum)
(-Integer -Integer . -> . -Fixnum)))
(define-for-syntax fx-intop (-Integer -Integer . -> . -Fixnum))
(define-for-syntax fx-natop (cl->* (-Nat -Nat . -> . -NonnegativeFixnum)
(-Integer -Integer . -> . -Fixnum)))
(define-for-syntax fx-unop (-Integer . -> . -Fixnum))
(define-for-syntax real-comp (->* (list R R) R B))
@ -57,6 +58,8 @@
(-Nat -Pos . -> . -PositiveFixnum)
(-Nat -Nat . -> . -NonnegativeFixnum)
(-Integer -Integer . -> . -Fixnum)))
(define-for-syntax fx--type
(-Integer -Integer . -> . -Fixnum))
(define-for-syntax fx=-type
(cl->*
(-> -Integer (-val 0) B : (-FS (-filter (-val 0) 0) -top))
@ -473,11 +476,11 @@
[unsafe-flimag-part (-InexactComplex . -> . -Flonum)]
[unsafe-fx+ fx+-type]
[unsafe-fx- fx-intop]
[unsafe-fx- fx--type]
[unsafe-fx* fx-op]
[unsafe-fxquotient fx-intop]
[unsafe-fxremainder fx-intop]
[unsafe-fxmodulo fx-intop]
[unsafe-fxquotient fx-natop]
[unsafe-fxremainder fx-natop]
[unsafe-fxmodulo fx-natop]
[unsafe-fxabs (-Integer . -> . (Un -PositiveFixnum (-val 0)))]
[unsafe-fxand fx-op]
@ -498,11 +501,11 @@
;; scheme/fixnum
[fx+ fx+-type]
[fx- fx-intop]
[fx- fx--type]
[fx* fx-op]
[fxquotient fx-intop]
[fxremainder fx-intop]
[fxmodulo fx-intop]
[fxquotient fx-natop]
[fxremainder fx-natop]
[fxmodulo fx-natop]
[fxabs (-Integer . -> . (Un -PositiveFixnum (-val 0)))]
[fxand fx-op]

9
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -22,7 +22,7 @@
(r:infer infer)
'#%paramz
(for-template
racket/unsafe/ops
racket/unsafe/ops racket/fixnum racket/flonum
(only-in '#%kernel [apply k:apply])
"internal-forms.rkt" scheme/base scheme/bool '#%paramz
(only-in racket/private/class-internal make-object do-make-object)))
@ -484,6 +484,13 @@
[(subtype t -NonnegativeFixnum) (ret -Fixnum)]
[(subtype t -ExactPositiveInteger) (ret -Nat)]
[else (tc/funapp #'op #'(v arg2) (single-value #'op) (list (ret t) (single-value #'arg2)) expected)]))]
;; idem for fx-
[(#%plain-app (~and op (~or (~literal fx-) (~literal unsafe-fx-))) v (~and arg2 ((~literal quote) 1)))
(add-typeof-expr #'arg2 (ret -PositiveFixnum))
(match-let ([(tc-result1: t) (single-value #'v)])
(cond
[(subtype t -ExactPositiveInteger) (ret -NonnegativeFixnum)]
[else (tc/funapp #'op #'(v arg2) (single-value #'op) (list (ret t) (single-value #'arg2)) expected)]))]
;; call-with-values
[(#%plain-app call-with-values prod con)
(match (tc/funapp #'prod #'() (single-value #'prod) null #f)