From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Tue, 9 Mar 2010 21:38:57 +0000 (-0800)
Subject: Expander for NOT.
X-Git-Tag: 20100708-Gtk~111
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c1c3e6a17d586234b36877435b3721280bca77f7;p=mit-scheme.git

Expander for NOT.
---

diff --git a/src/sf/usiexp.scm b/src/sf/usiexp.scm
index 516203b3a..9bd4d1f03 100644
--- a/src/sf/usiexp.scm
+++ b/src/sf/usiexp.scm
@@ -469,12 +469,14 @@ USA.
       ;; Convert (eq? <expr> #f) and (eq? #f <expr>) to (not <expr>)
       ;; Conditional inversion will remove the call to not.
       (cond ((expression/always-false? (first operands))
+	     (warn "eq->not (1)" (first operands))
 	     (if (expression/effect-free? (first operands))
 		 (make-combination expr block (ucode-primitive not) (cdr operands))
 		 (sequence/make (and expr (object/scode expr))
 				(list (first operands)
 				      (make-combination #f block (ucode-primitive not) (cdr operands))))))
 	    ((expression/always-false? (second operands))
+	     (warn "eq->not (2)" (second operands))
 	     (if (expression/effect-free? (second operands))
 		 (make-combination expr block (ucode-primitive not) (list (car operands)))
 		 (sequence/make (and expr (object/scode expr))
@@ -491,6 +493,24 @@ USA.
 			operands)
       #f))
 
+(define (not-expansion expr operands block)
+  (if (and (pair? operands)
+	   (null? (cdr operands)))
+      (cond ((expression/always-false? (first operands))
+	     (warn "zapping not (1)" (first operands))
+	     (if (expression/effect-free? (first operands))
+		 (constant/make (and expr (object/scode expr)) #t)
+		 (sequence/make (and expr (object/scode expr))
+				(list (first operands) (constant/make #f #t)))))
+	    ((expression/never-false? (first operands))
+	     (warn "zapping not (2)" (first operands))
+	     (if (expression/effect-free? (first operands))
+		 (constant/make (and expr (object/scode expr)) #f)
+		 (sequence/make (and expr (object/scode expr))
+				(list (first operands) (constant/make #f #f)))))
+	    (else (make-combination expr block (ucode-primitive not) operands)))
+      #f))
+
 (define (type-test-expansion type)
   (lambda (expr operands block)
     (if (and (pair? operands)
@@ -673,6 +693,7 @@ USA.
 	    make-vector-8b
 	    ;; modulo	; Compiler does not currently open-code it.
 	    negative?
+	    not
 	    number?
 	    positive?
 	    quotient
@@ -755,6 +776,7 @@ USA.
 	   make-string-expansion
 	   ;; modulo-expansion
 	   negative?-expansion
+	   not-expansion
 	   complex?-expansion
 	   positive?-expansion
 	   quotient-expansion