From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Sun, 5 Nov 1995 14:26:18 +0000 (+0000)
Subject: Added %=, %< and %>
X-Git-Tag: 20090517-FFI~5760
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=0db704aa4101db93f91981bfdb1e67a7eeaf656a;p=mit-scheme.git

Added %=, %< and %>
---

diff --git a/v8/src/compiler/midend/typerew.scm b/v8/src/compiler/midend/typerew.scm
index 3ab848f36..6db52c3b4 100644
--- a/v8/src/compiler/midend/typerew.scm
+++ b/v8/src/compiler/midend/typerew.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: typerew.scm,v 1.9 1995/11/04 16:57:43 adams Exp $
+$Id: typerew.scm,v 1.10 1995/11/05 14:26:18 adams Exp $
 
 Copyright (c) 1994-1995 Massachusetts Institute of Technology
 
@@ -1181,7 +1181,7 @@ MIT in each case. |#
 	       (lambda (t q env form receiver)
 		 form			; ignored
 		 (result receiver range q
-			 (q-env:restrict (q-env:glb/1 env q1 t1)
+			 (q-env:restrict (q-env:glb/1 env q t)
 					 effect)))))
 	(let* ((arg-type     (first spec))
 	       (result-type  (second spec)))
@@ -1560,6 +1560,7 @@ MIT in each case. |#
 
   (define-typerew-replacement-method 'EXPT 2
     (lambda (form base exponent)
+      form				; ignored
       (let* ((t-exponent (typerew/type exponent)))
 	(cond ((and (type:subset? t-exponent type:fixnum)
 		    (or (equal? base '(QUOTE -1))
@@ -1582,10 +1583,18 @@ MIT in each case. |#
 	effect:none)
 
       (define-typerew-binary-variants-replacement-method primitive
-	type:fixnum             type:fixnum             type:any       fix:op
-	type:flonum             type:flonum             type:any       flo:op
-	(type:not type:fixnum)  type:any                type:any       %op
-	type:any                (type:not type:fixnum)  type:any       %op)))
+	type:fixnum             type:fixnum             type:any      fix:op
+	type:flonum             type:flonum             type:any      flo:op
+	(type:not type:fixnum)  type:any                type:any      %op
+	type:any                (type:not type:fixnum)  type:any      %op)
+
+      (define-typerew-binary-variants-type-method  %op
+	type:number             type:number             type:boolean
+	effect:none)
+
+      (define-typerew-binary-variants-replacement-method %op
+	type:fixnum             type:fixnum             type:any      fix:op
+	type:flonum             type:flonum             type:any      flo:op)))
 
   (define-relational-method  '&<  fix:<  flo:<  %<)
   (define-relational-method  '&>  fix:>  flo:>  %>))
@@ -1596,6 +1605,9 @@ MIT in each case. |#
   (define-typerew-binary-variants-type-method  &=
     type:number                 type:number             type:boolean
     effect:none)
+  (define-typerew-binary-variants-type-method  %=
+    type:number                 type:number             type:boolean
+    effect:none)
   (define-typerew-binary-variants-type-method  INT=
     type:exact-integer          type:exact-integer      type:boolean
     effect:none)
@@ -1607,7 +1619,11 @@ MIT in each case. |#
     type:exact-number       type:fixnum             type:any    EQ?
     type:flonum             type:flonum             type:any    flo:=
     (type:not type:fixnum)  type:any                type:any    %=
-    type:any                (type:not type:fixnum)  type:any    %=)  
+    type:any                (type:not type:fixnum)  type:any    %=)
+  (define-typerew-binary-variants-replacement-method  %=
+    type:fixnum             type:exact-number       type:any    EQ?
+    type:exact-number       type:fixnum             type:any    EQ?
+    type:flonum             type:flonum             type:any    flo:=)
   (define-typerew-binary-variants-replacement-method  INT=
     type:fixnum             type:exact-integer      type:any    EQ?
     type:exact-integer      type:fixnum             type:any    EQ?))    
@@ -1826,5 +1842,4 @@ MIT in each case. |#
 				  suggested-operator-replacement: ,new)))))
 	      (form-map/put! cache e annotation)
 	      annotation))))
-    (pp/ann program annotate)))
-
+    (pp/ann program annotate)))
\ No newline at end of file