From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 16 Oct 1990 21:07:11 +0000 (+0000)
Subject: Provide expansions for fixnum comparison operators:
X-Git-Tag: 20090517-FFI~11125
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=41b1bf494ec36840ef9778db909313cd0018f605;p=mit-scheme.git

Provide expansions for fixnum comparison operators:

    (FIX:= X Y)   --->   (EQ? X Y)
    (FIX:ZERO? X) --->   (EQ? X 0)
    (FIX:<= X Y)  --->   (NOT (FIX:> X Y))
    (FIX:>= X Y)  --->   (NOT (FIX:< X Y))
---

diff --git a/v7/src/sf/gconst.scm b/v7/src/sf/gconst.scm
index dec975837..603a95817 100644
--- a/v7/src/sf/gconst.scm
+++ b/v7/src/sf/gconst.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/gconst.scm,v 4.8 1990/07/15 22:57:43 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/gconst.scm,v 4.9 1990/10/16 21:06:53 cph Rel $
 
 Copyright (c) 1987, 1989, 1990 Massachusetts Institute of Technology
 
@@ -92,7 +92,7 @@ MIT in each case. |#
     FIX:-1+
     FIX:1+
     FIX:<
-    FIX:=
+    ;; FIX:= handled by expanding it to EQ?
     FIX:>
     FIX:AND
     FIX:ANDC
@@ -106,7 +106,7 @@ MIT in each case. |#
     FIX:QUOTIENT
     FIX:REMAINDER
     FIX:XOR
-    FIX:ZERO?
+    ;; FIX:ZERO? handled by expanding it to (EQ? x 0)
     FLO:*
     FLO:+
     FLO:-
diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm
index 47ba32dfc..5697af211 100644
--- a/v7/src/sf/make.scm
+++ b/v7/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.14 1990/06/25 18:54:16 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.15 1990/10/16 21:07:02 cph Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -39,4 +39,4 @@ MIT in each case. |#
 (package/system-loader "sf" '() 'QUERY)
 ((package/reference (find-package '(SCODE-OPTIMIZER))
 		    'USUAL-INTEGRATIONS/CACHE!))
-(add-system! (make-system "SF" 4 14 '()))
\ No newline at end of file
+(add-system! (make-system "SF" 4 15 '()))
\ No newline at end of file
diff --git a/v7/src/sf/usiexp.scm b/v7/src/sf/usiexp.scm
index 9c1e417de..f0c8b17e6 100644
--- a/v7/src/sf/usiexp.scm
+++ b/v7/src/sf/usiexp.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/usiexp.scm,v 4.4 1989/10/26 06:28:19 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/usiexp.scm,v 4.5 1990/10/16 21:07:11 cph Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -115,11 +115,48 @@ MIT in each case. |#
 		 (ucode-primitive negative?)
 		 (ucode-primitive positive?)))
 
-(define <=-expansion
-  (pairwise-test-inverse >-expansion))
+(define <=-expansion (pairwise-test-inverse >-expansion))
+(define >=-expansion (pairwise-test-inverse <-expansion))
+
+;;;; Fixnum Operations
 
-(define >=-expansion
-  (pairwise-test-inverse <-expansion))
+(define (fix:zero?-expansion operands if-expanded if-not-expanded block)
+  block if-not-expanded
+  (if (not (and (pair? operands) (null? (cdr operands))))
+      (error "wrong number of operands" operands))
+  (if-expanded
+   (make-combination (ucode-primitive eq?) (list (car operands) 0))))
+
+(define (fix:=-expansion operands if-expanded if-not-expanded block)
+  block if-not-expanded
+  (if (not (and (pair? operands)
+		(pair? (cdr operands))
+		(null? (cddr operands))))
+      (error "wrong number of operands" operands))
+  (if-expanded (make-combination (ucode-primitive eq?) operands)))
+
+(define (fix:<=-expansion operands if-expanded if-not-expanded block)
+  block if-not-expanded
+  (if (not (and (pair? operands)
+		(pair? (cdr operands))
+		(null? (cddr operands))))
+      (error "wrong number of operands" operands))
+  (if-expanded
+   (make-combination
+    (ucode-primitive not)
+    (list (make-combination (ucode-primitive greater-than-fixnum?)
+			    operands)))))
+
+(define (fix:>=-expansion operands if-expanded if-not-expanded block)
+  block if-not-expanded
+  (if (not (and (pair? operands)
+		(pair? (cdr operands))
+		(null? (cddr operands))))
+      (error "wrong number of operands" operands))
+  (if-expanded
+   (make-combination
+    (ucode-primitive not)
+    (list (make-combination (ucode-primitive less-than-fixnum?) operands)))))
 
 ;;;; N-ary Arithmetic Field Operations
 
@@ -404,7 +441,11 @@ MIT in each case. |#
     exact-integer?
     exact-rational?
     fifth
+    fix:<=
+    fix:=
+    fix:>=
     fix:fixnum?
+    fix:zero?
     flo:flonum?
     fourth
     int:integer?
@@ -471,7 +512,11 @@ MIT in each case. |#
    exact-integer?-expansion
    exact-rational?-expansion
    fifth-expansion
+   fix:<=-expansion
+   fix:=-expansion
+   fix:>=-expansion
    fix:fixnum?-expansion
+   fix:zero?-expansion
    flo:flonum?-expansion
    fourth-expansion
    exact-integer?-expansion
diff --git a/v8/src/sf/make.scm b/v8/src/sf/make.scm
index d869c2406..e4fa5ba48 100644
--- a/v8/src/sf/make.scm
+++ b/v8/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.14 1990/06/25 18:54:16 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.15 1990/10/16 21:07:02 cph Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -39,4 +39,4 @@ MIT in each case. |#
 (package/system-loader "sf" '() 'QUERY)
 ((package/reference (find-package '(SCODE-OPTIMIZER))
 		    'USUAL-INTEGRATIONS/CACHE!))
-(add-system! (make-system "SF" 4 14 '()))
\ No newline at end of file
+(add-system! (make-system "SF" 4 15 '()))
\ No newline at end of file