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 dec975837aa74fb04803a6d4b69331c8c452eb9e..603a9581734bfd395f90bc011b6384aa63a2d61f 100644 (file)
--- 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 47ba32dfcc9164f5f89699e02d7b13275eea7c4b..5697af211d545b5ac7512692d616b0cffad74357 100644 (file)
--- 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 9c1e417deeda24fda5ee03c52e0047581a022537..f0c8b17e6a6d147585a7bdedaae6365448efe5ca 100644 (file)
--- 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))
+\f
+;;;; 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)))))
 \f
 ;;;; 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 d869c2406caa475352ce1ab1e0ca4fc0bf5c24de..e4fa5ba48e008a82ade4e1a1e2dc3e2213c99b25 100644 (file)
--- 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