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@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)))