diff options
-rw-r--r-- | module/language/cps/type-fold.scm | 5 | ||||
-rw-r--r-- | 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 b7649df33..21f242b20 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 2a2192540..ca90f50b8 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))) |