[movitz-cvs] CVS update: movitz/special-operators.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	special-operators.lisp 
Log Message:
Ensure inlined-not returns correct type: either boolean, null, or (eql t).

Date: Sat Feb 14 18:46:56 2004
Author: ffjeld

Index: movitz/special-operators.lisp
diff -u movitz/special-operators.lisp:1.12 movitz/special-operators.lisp:1.13
--- movitz/special-operators.lisp:1.12	Sat Feb 14 10:18:54 2004
+++ movitz/special-operators.lisp	Sat Feb 14 18:46:56 2004
@@ -8,7 +8,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Nov 24 16:22:59 2000
 ;;;;                
-;;;; $Id: special-operators.lisp,v 1.12 2004/02/14 15:18:54 ffjeld Exp $
+;;;; $Id: special-operators.lisp,v 1.13 2004/02/14 23:46:56 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -622,12 +622,21 @@
 	   ((member (operator result-mode) '(:push))
 	    (values :eax nil))
 	   (t (values result-mode nil)))
-	(compiler-values-bind (&all not-values &returns not-returns &code not-code)
+	(compiler-values-bind (&all not-values &returns not-returns &code not-code &type not-type)
 	    (compiler-call #'compile-form-unprotected
 	      :defaults forward
 	      :form x
 	      :result-mode not-result-mode)
-	  (setf (not-values :producer) (list :not (not-values :producer)))
+	  (setf (not-values :producer)
+	    (list :not (not-values :producer)))
+	  (let ((not-type (type-specifier-primary not-type)))
+	   (setf (not-values :type)
+	    (cond
+	     ((movitz-subtypep not-type 'null)
+	      '(eql t))
+	     ((movitz-subtypep not-type '(not null))
+	      'null)
+	     (t 'boolean))))
 	  ;; (warn "res: ~S" result-mode-inverted-p)
 	  (cond
 	   ((and result-mode-inverted-p
@@ -644,7 +653,7 @@
 		:code code)))
 	   ((not result-mode-inverted-p)
 	    ;; We must invert returns-mode
-	      (case (operator not-returns)
+	    (case (operator not-returns)
 	      (#.(append +boolean-modes+ '(:boolean-branch-on-true :boolean-branch-on-false))
 		 (compiler-values (not-values)
 		   :returns (complement-boolean-result-mode not-returns)))