[movitz-cvs] CVS update: movitz/compiler-types.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv1074

Modified Files:
	compiler-types.lisp 
Log Message:
Fixed buggy encoded-emptyp.

Date: Sat Feb 14 17:47:25 2004
Author: ffjeld

Index: movitz/compiler-types.lisp
diff -u movitz/compiler-types.lisp:1.7 movitz/compiler-types.lisp:1.8
--- movitz/compiler-types.lisp:1.7	Sat Feb 14 17:11:36 2004
+++ movitz/compiler-types.lisp	Sat Feb 14 17:47:25 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Wed Sep 10 00:40:07 2003
 ;;;;                
-;;;; $Id: compiler-types.lisp,v 1.7 2004/02/14 22:11:36 ffjeld Exp $
+;;;; $Id: compiler-types.lisp,v 1.8 2004/02/14 22:47:25 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -472,7 +472,12 @@
 	 (assert (= 2 (length type-specifier)))
 	 (multiple-value-bind (code integer-range members include complement)
 	     (type-specifier-encode (second type-specifier))
-	   (values code integer-range members include (not complement))))
+	   (cond
+	    ((encoded-allp code integer-range members include complement)
+	     (type-specifier-encode nil))
+	    ((encoded-emptyp code integer-range members include complement)
+	     (type-specifier-encode t))
+	    (t (values code integer-range members include (not complement))))))
 	(integer
 	 (flet ((integer-limit (s n)
 		  (let ((x (if (nthcdr n s)
@@ -523,8 +528,14 @@
 If it isn't, also return wether we _know_ it isn't empty."
   (let ((x (and (= 0 code) (not integer-range) (null members) t)))
     (cond
-     ((null include)
-      (values (if complement (not x) x) t))
+     ((and x (null include) (not complement))
+      (values t t))
+     ((and (null include) complement)
+      (cond
+       ((encoded-allp code integer-range members include nil)
+	(warn "Seeing an encoded (not t), should be ()")
+	(values t t))
+       (t (values nil t))))
      ((not (null include))
       (values nil nil)))))