From e1072ebb2237bedeb1e0c78d854fc6768f250a59 Mon Sep 17 00:00:00 2001
From: Noel Welsh <noel@racket-lang.org>
Date: Wed, 24 Mar 2010 13:18:37 +0000
Subject: [PATCH] Add the fx to fl conversion functions to Typed Scheme

Add tests for flonum operations to Typed Scheme test suite

Fix the compiler bug tests above uncovered

svn: r18609

original commit: af84b331a13c53709eaba9f0faf7af0c64a000a1
---
 collects/tests/typed-scheme/succeed/flonum.ss | 57 +++++++++++++++++++
 .../typed-scheme/private/base-env-numeric.ss  |  2 +
 2 files changed, 59 insertions(+)
 create mode 100644 collects/tests/typed-scheme/succeed/flonum.ss

diff --git a/collects/tests/typed-scheme/succeed/flonum.ss b/collects/tests/typed-scheme/succeed/flonum.ss
new file mode 100644
index 00000000..d6c70ff3
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/flonum.ss
@@ -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)
diff --git a/collects/typed-scheme/private/base-env-numeric.ss b/collects/typed-scheme/private/base-env-numeric.ss
index 5d2b05ed..a7eb9b63 100644
--- a/collects/typed-scheme/private/base-env-numeric.ss
+++ b/collects/typed-scheme/private/base-env-numeric.ss
@@ -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