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

Add the fx to fl conversion functions to Typed Scheme

Browse Source 
Add tests for flonum operations to Typed Scheme test suite

Fix the compiler bug tests above uncovered

svn: r18609

original commit: af84b331a13c53709eaba9f0faf7af0c64a000a1
This commit is contained in:
Noel Welsh 2010-03-24 13:18:37 +00:00
parent f18f8b8bf1
commit e1072ebb22
2 changed files with 59 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
collects/tests/typed-scheme/succeed/flonum.ss Normal file
View File

@ -0,0 +1,57 @@
#lang typed/scheme
(require
scheme/flonum
scheme/unsafe/ops)
(: check (All (a) ((a a -> Boolean) a a -> Boolean)))
;; Simple check function as SchemeUnit doesn't work in Typed Scheme (yet)
(define (check f a b)
(if (f a b)
#t
(error (format "Check (~a ~a ~a) failed" f a b))))
(: check-pred (All (a) ((a -> Boolean) a -> Boolean)))
(define (check-pred pred v)
(if (pred v)
#t
(error (format "Check predicate (~a ~a) failed" pred v))))
(: true? (Any -> Boolean))
(define (true? x)
(if x #t #f))
;; Check that flonum (safe and unsafe) functions work as expected
(check = (flabs 1.45) (unsafe-flabs 1.45))
(check = (fl+ 1.45 2.36) (unsafe-fl+ 1.45 2.36))
(check = (fl- 1.45 2.36) (unsafe-fl- 1.45 2.36))
(check = (fl* 1.45 2.36) (unsafe-fl* 1.45 2.36))
(check = (fl/ 1.45 2.36) (unsafe-fl/ 1.45 2.36))
(check-pred true? (fl= 1.45 1.45))
(check-pred true? (fl<= 1.45 1.45))
(check-pred true? (fl>= 1.45 1.45))
(check-pred true? (fl> 1.45 1.36))
(check-pred true? (fl< 1.36 1.45))
(check-pred true? (unsafe-fl= 1.45 1.45))
(check-pred true? (unsafe-fl<= 1.45 1.45))
(check-pred true? (unsafe-fl>= 1.45 1.45))
(check-pred true? (unsafe-fl> 1.45 1.36))
(check-pred true? (unsafe-fl< 1.36 1.45))
(check = (flmin 1.45 2.36) (unsafe-flmin 1.45 2.36))
(check = (flmax 1.45 2.36) (unsafe-flmax 1.45 2.36))
(check = (flround 1.45) (unsafe-flround 1.45))
(check = (flfloor 1.45) (unsafe-flfloor 1.45))
(check = (flceiling 1.45) (unsafe-flceiling 1.45))
(check = (fltruncate 1.45) (unsafe-fltruncate 1.45))
(check = (flsin 1.45) (unsafe-flsin 1.45))
(check = (flcos 1.45) (unsafe-flcos 1.45))
(check = (fltan 1.45) (unsafe-fltan 1.45))
(check = (flatan 1.45) (unsafe-flatan 1.45))
(check = (flasin .45) (unsafe-flasin .45))
(check = (flacos .45) (unsafe-flacos .45))
(check = (fllog 1.45) (unsafe-fllog 1.45))
(check = (flexp 1.45) (unsafe-flexp 1.45))
(check = (flsqrt 1.45) (unsafe-flsqrt 1.45))
(check = (->fl 1) 1.0)
(check = (unsafe-fx->fl 1) 1.0)

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

@ -185,6 +185,7 @@
[unsafe-fllog fl-unop]
[unsafe-flexp fl-unop]
[unsafe-flsqrt fl-unop]
[unsafe-fx->fl (-Integer . -> . -Flonum)]
[unsafe-fx+ fx-op]
[unsafe-fx- fx-intop]
@ -261,6 +262,7 @@
[fllog fl-unop]
[flexp fl-unop]
[flsqrt fl-unop]
[->fl (-Integer . -> . -Flonum)]
;; safe flvector ops