From 608753982f012d40a466fe08a86041e92a85f908 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 11 Nov 2015 10:14:51 +0100
Subject: [PATCH] Type inference distinguishes between untagged and tagged
 flonums

* module/language/cps/types.scm (&f64): New type, for untagged f64
  values.  Having a distinct type prevents type folding from replacing
  an untagged 3.0 with a tagged 3.0.
  (scm->f64, f64->scm): Support these new primcalls.
---
 module/language/cps/types.scm | 25 ++++++++++++++++++++++++-
 1 file changed, 24 insertions(+), 1 deletion(-)

diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 55cde2744..fc23e1691 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -117,6 +117,9 @@
             ;; Union types.
             &number &real
 
+            ;; Untagged types.
+            &f64
+
             infer-types
             lookup-pre-type
             lookup-post-type
@@ -164,7 +167,9 @@
   &bytevector
   &bitvector
   &array
-  &hash-table)
+  &hash-table
+
+  &f64)
 
 (define-syntax &no-type (identifier-syntax 0))
 
@@ -670,6 +675,24 @@ minimum, and maximum."
   ((logior &number &false) -inf.0 +inf.0))
 
 
+
+
+;;;
+;;; Unboxed double-precision floating-point numbers.
+;;;
+
+(define-type-checker (scm->f64 scm)
+  (check-type scm &real -inf.0 +inf.0))
+(define-type-inferrer (scm->f64 scm result)
+  (restrict! scm &real -inf.0 +inf.0)
+  (define! result &f64 (&min scm) (&max scm)))
+
+(define-type-checker (f64->scm f64)
+  #t)
+(define-type-inferrer (f64->scm f64 result)
+  (define! result &flonum (&min f64) (&max f64)))
+
+
 
 
 ;;;