[Guile-commits] GNU Guile branch, master, updated. v2.1.0-88-g7f5887e

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=7f5887e70b632d49b52679f383eff07d656e59a3

The branch, master has been updated
       via  7f5887e70b632d49b52679f383eff07d656e59a3 (commit)
      from  b9a5bac69082114a75278c0d0fceedab787dbf7c (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 7f5887e70b632d49b52679f383eff07d656e59a3
Author: Andy Wingo <address@hidden>
Date:   Sun Aug 24 17:07:49 2014 +0200

    Separate &boolean type into &true and &false
    
    * module/language/cps/types.scm (&all-types): Represent true and false
      as separate bits, so that #f can be removed from types on true
      branches.  Adapt all users.
    
    * module/language/cps/type-fold.scm (&scalar-types):
      (fold-and-reduce): Adapt to boolean type representation change.

-----------------------------------------------------------------------

Summary of changes:
 module/language/cps/type-fold.scm |    5 ++-
 module/language/cps/types.scm     |   58 ++++++++++++++++++++----------------
 2 files changed, 35 insertions(+), 28 deletions(-)

diff --git a/module/language/cps/type-fold.scm 
b/module/language/cps/type-fold.scm
index b7649df..21f242b 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -38,7 +38,7 @@
 ;; Branch folders.
 
 (define &scalar-types
-  (logior &exact-integer &flonum &char &unspecified &boolean &nil &null))
+  (logior &exact-integer &flonum &char &unspecified &false &true &nil &null))
 
 (define *branch-folders* (make-hash-table))
 
@@ -276,7 +276,8 @@
      ((eqv? type &flonum) (exact->inexact val))
      ((eqv? type &char) (integer->char val))
      ((eqv? type &unspecified) *unspecified*)
-     ((eqv? type &boolean) (not (zero? val)))
+     ((eqv? type &false) #f)
+     ((eqv? type &true) #t)
      ((eqv? type &nil) #nil)
      ((eqv? type &null) '())
      (else (error "unhandled type" type val))))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 2a21925..ca90f50 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -92,7 +92,8 @@
             &char
             &unspecified
             &unbound
-            &boolean
+            &false
+            &true
             &nil
             &null
             &symbol
@@ -143,7 +144,8 @@
   &char
   &unspecified
   &unbound
-  &boolean
+  &false
+  &true
   &nil
   &null
   &symbol
@@ -288,9 +290,10 @@ minimum, and maximum."
      (else (return &complex #f))))
    ((eq? val '()) (return &null #f))
    ((eq? val #nil) (return &nil #f))
+   ((eq? val #t) (return &true #f))
+   ((eq? val #f) (return &false #f))
    ((char? val) (return &char (char->integer val)))
    ((eqv? val *unspecified*) (return &unspecified #f))
-   ((boolean? val) (return &boolean (if val 1 0)))
    ((symbol? val) (return &symbol #f))
    ((keyword? val) (return &keyword #f))
    ((pair? val) (return &pair #f))
@@ -647,7 +650,7 @@ minimum, and maximum."
 
 (define-simple-type (number->string &number) (&string 0 +inf.0))
 (define-simple-type (string->number (&string 0 +inf.0))
-  ((logior &number &boolean) -inf.0 +inf.0))
+  ((logior &number &false) -inf.0 +inf.0))
 
 
 
@@ -891,11 +894,11 @@ minimum, and maximum."
   (define-type-inferrer (name val result)
     (cond
      ((zero? (logand (&type val) type))
-      (define! result &boolean 0 0))
+      (define! result &false 0 0))
      ((zero? (logand (&type val) (lognot type)))
-      (define! result &boolean 1 1))
+      (define! result &true 0 0))
      (else
-      (define! result &boolean 0 1)))))
+      (define! result (logior &true &false) 0 0)))))
 (define-number-kind-predicate-inferrer complex? &number)
 (define-number-kind-predicate-inferrer real? &real)
 (define-number-kind-predicate-inferrer rational?
@@ -910,23 +913,23 @@ minimum, and maximum."
   (restrict! val &number -inf.0 +inf.0)
   (cond
    ((zero? (logand (&type val) (logior &exact-integer &fraction)))
-    (define! result &boolean 0 0))
+    (define! result &false 0 0))
    ((zero? (logand (&type val) (lognot (logior &exact-integer &fraction))))
-    (define! result &boolean 1 1))
+    (define! result &true 0 0))
    (else
-    (define! result &boolean 0 1))))
+    (define! result (logior &true &false) 0 0))))
 
 (define-simple-type-checker (inexact? &number))
 (define-type-inferrer (inexact? val result)
   (restrict! val &number -inf.0 +inf.0)
   (cond
    ((zero? (logand (&type val) (logior &flonum &complex)))
-    (define! result &boolean 0 0))
+    (define! result &false 0 0))
    ((zero? (logand (&type val) (logand &number
                                        (lognot (logior &flonum &complex)))))
-    (define! result &boolean 1 1))
+    (define! result &true 0 0))
    (else
-    (define! result &boolean 0 1))))
+    (define! result (logior &true &false) 0 0))))
 
 (define-simple-type-checker (inf? &real))
 (define-type-inferrer (inf? val result)
@@ -934,13 +937,14 @@ minimum, and maximum."
   (cond
    ((or (zero? (logand (&type val) (logior &flonum &complex)))
         (and (not (inf? (&min val))) (not (inf? (&max val)))))
-    (define! result &boolean 0 0))
+    (define! result &false 0 0))
    (else
-    (define! result &boolean 0 1))))
+    (define! result (logior &true &false) 0 0))))
 
 (define-type-aliases inf? nan?)
 
-(define-simple-type (even? &exact-integer) (&boolean 0 1))
+(define-simple-type (even? &exact-integer)
+  ((logior &true &false) 0 0))
 (define-type-aliases even? odd?)
 
 ;; Bit operations.
@@ -1031,9 +1035,9 @@ minimum, and maximum."
         (b-max (&max b)))
     (if (and (eqv? a-min a-max) (>= a-min 0) (not (inf? a-min))
              (eqv? b-min b-max) (>= b-min 0) (not (inf? b-min)))
-        (let ((res (if (logbit? a-min b-min) 1 0)))
-          (define! result &boolean res res))
-        (define! result &boolean 0 1))))
+        (let ((type (if (logbit? a-min b-min) &true &false)))
+          (define! result type 0 0))
+        (define! result (logior &true &false) 0 0))))
 
 ;; Flonums.
 (define-simple-type-checker (sqrt &number))
@@ -1072,7 +1076,8 @@ minimum, and maximum."
 ;;; Characters.
 ;;;
 
-(define-simple-type (char<? &char &char) (&boolean 0 1))
+(define-simple-type (char<? &char &char)
+  ((logior &true &false) 0 0))
 (define-type-aliases char<? char<=? char>=? char>?)
 
 (define-simple-type-checker (integer->char (&exact-integer 0 #x10ffff)))
@@ -1220,15 +1225,16 @@ mapping symbols to types."
         (($ $branch kt ($ $values (arg)))
          ;; The "normal" continuation is the #f branch.
          (let ((types (restrict-var types arg
-                                    (make-type-entry (logior &boolean &nil)
+                                    (make-type-entry (logior &false &nil)
                                                      0
                                                      0))))
            (propagate! 0 k types))
-         ;; No additional information on the #t branch,
-         ;; as there's no way currently to remove #f
-         ;; from the typeset (because it would remove
-         ;; #t as well: they are both &boolean).
-         (propagate! 1 kt types))
+         (let ((types (restrict-var types arg
+                                    (make-type-entry
+                                     (logand &all-types 
+                                             (lognot (logior &false &nil)))
+                                     -inf.0 +inf.0))))
+           (propagate! 1 kt types)))
         (($ $branch kt ($ $primcall name args))
          ;; The "normal" continuation is the #f branch.
          (let ((types (infer-primcall types 0 name args #f)))


hooks/post-receive
-- 
GNU Guile