[Guile-commits] 02/16: Fix mismatch between CPS and Scheme "complex?" predicate

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit f75d0adc3f9dcb13838c9e13070fe78d9b1cf154
Author: Andy Wingo <address@hidden>
Date:   Tue Dec 26 21:38:46 2017 +0100

    Fix mismatch between CPS and Scheme "complex?" predicate
    
    * module/system/base/types/internal.scm (heap-tags): Rename complex and
      fraction predicates to "compnum?" and "fracnum?", as they aren't the
      same as the Scheme predicates "complex?" and "fraction?".
---
 module/language/cps/effects-analysis.scm |  5 ++++-
 module/language/cps/types.scm            | 13 +++----------
 module/system/base/types/internal.scm    |  4 ++--
 module/system/vm/assembler.scm           |  4 ++--
 4 files changed, 11 insertions(+), 15 deletions(-)

diff --git a/module/language/cps/effects-analysis.scm 
b/module/language/cps/effects-analysis.scm
index 3040451..b49ef15 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -315,7 +315,10 @@ the LABELS that are clobbered by the effects of LABEL."
   ((procedure? arg))
   ((thunk? arg))
   ((heap-number? arg))
-  ((bignum? arg)))
+  ((bignum? arg))
+  ((flonum? arg))
+  ((compnum? arg))
+  ((fracnum? arg)))
 
 ;; Fluids.
 (define-primitive-effects
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 9a1c6f2..278c4e1 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -675,6 +675,9 @@ minimum, and maximum."
 (define-simple-predicate-inferrer number? &number)
 (define-simple-predicate-inferrer char? &char)
 (define-simple-predicate-inferrer procedure? &procedure)
+(define-simple-predicate-inferrer flonum? &flonum)
+(define-simple-predicate-inferrer compnum? &complex)
+(define-simple-predicate-inferrer fracnum? &fraction)
 
 (define-predicate-inferrer (eq? a b true?)
   ;; We can only propagate information down the true leg.
@@ -1458,16 +1461,6 @@ minimum, and maximum."
     (define! result &special-immediate &true &true))
    (else
     (define! result &special-immediate &false &true))))
-;; Bah, needs rewrite to turn into actual control flow.
-(define-syntax-rule (define-simple-type-predicate-inferrer name type)
-  (define-type-inferrer (name val result)
-    (define-type-predicate-result val result type)))
-(define-simple-type-predicate-inferrer complex? &number)
-(define-simple-type-predicate-inferrer real? &real)
-(define-simple-type-predicate-inferrer rational? &exact-number)
-;; FIXME: If it's a flonum it may be an integer, but if it's not an
-;; integer it also may be still be a flonum.
-;; (define-simple-type-predicate-inferrer integer? (logior &exact-integer 
&flonum))
 
 (define-simple-type-checker (exact? &number))
 (define-type-inferrer (exact? val result)
diff --git a/module/system/base/types/internal.scm 
b/module/system/base/types/internal.scm
index 110465f..3dc847d 100644
--- a/module/system/base/types/internal.scm
+++ b/module/system/base/types/internal.scm
@@ -151,8 +151,8 @@
   ;(heap-number     heap-number?           #b1111111       #b0010111)
   (bignum           bignum?           #b111111111111  #b000100010111)
   (flonum           flonum?           #b111111111111  #b001000010111)
-  (complex          complex?          #b111111111111  #b001100010111)
-  (fraction         fraction?         #b111111111111  #b010000010111))
+  (complex          compnum?          #b111111111111  #b001100010111)
+  (fraction         fracnum?          #b111111111111  #b010000010111))
 
 (define-syntax define-tag
   (lambda (x)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 8b17ae2..7af7050 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -135,8 +135,8 @@
             emit-smob?
             emit-bignum?
             emit-flonum?
-            emit-complex?
-            emit-fraction?
+            emit-compnum?
+            emit-fracnum?
 
             emit-allocate-words
             emit-allocate-words/immediate