Made some operators (MEMQ, SQRT and EXPT) integrate as global operators.

This will allow the new compiler to identify them and so something smart.

diff --git a/v8/src/sf/usiexp.scm b/v8/src/sf/usiexp.scm
index 1946f08c79b3f27c00ccc013604c382c41ff2d90..de106f3b54ffd38ad1fa21c2a4cf8e5545827a98 100644 (file)
--- a/v8/src/sf/usiexp.scm
+++ b/v8/src/sf/usiexp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: usiexp.scm,v 1.4 1995/08/02 21:42:14 cph Exp $
+$Id: usiexp.scm,v 1.5 1995/08/18 18:17:37 adams Exp $
 
 Copyright (c) 1988-1995 Massachusetts Institute of Technology
 
@@ -580,6 +580,26 @@ MIT in each case. |#
                           (ucode-primitive integer->flonum 2)
                           (list (car operands) (constant/make #f #b10))))
        (if-not-expanded)))
+
+  (define (global-operator name #!optional min-arity max-arity)
+    (let ((min-arity (if (default-object? min-arity) 0 min-arity))
+         (max-arity (if (default-object? max-arity)
+                        (if (default-object? min-arity)
+                            #F
+                            min-arity)
+                        #F)))
+      (lambda (expr operands if-expanded if-not-expanded block)
+       (let ((operand-count (length operands)))
+         (if (and (<= min-arity operand-count)
+                  (or (not max-arity) (<= operand-count max-arity)))
+             (if-expanded
+              (combination/make
+               (and expr (object/scode expr))
+               block
+               (global-ref/make name)
+               operands))
+             (if-not-expanded))))))
+           
 \f
   (define usual-integrations/expansion-alist
     `((%record?           . ,%record?-expansion)
@@ -632,7 +652,7 @@ MIT in each case. |#
       (eighth             . ,eighth-expansion)
       (exact-integer?     . ,exact-integer?-expansion)
       (exact-rational?    . ,exact-rational?-expansion)
-      ;;(expt               . ,expt-expansion)
+      (expt               . ,(global-operator 'EXPT 2))
       (fifth              . ,fifth-expansion)
       (first              . ,first-expansion)
       (fix:<=             . ,fix:<=-expansion)
@@ -646,6 +666,7 @@ MIT in each case. |#
       (int:integer?       . ,exact-integer?-expansion)
       (list               . ,list-expansion)
       (make-string        . ,make-string-expansion)
+      (memq               . ,(global-operator 'MEMQ 2))
       ;;(modulo           . ,modulo-expansion)
       (negative?          . ,negative?-expansion)
       (complex?           . ,complex?-expansion)
@@ -655,6 +676,7 @@ MIT in each case. |#
       (second             . ,second-expansion)
       (seventh            . ,seventh-expansion)
       (sixth              . ,sixth-expansion)
+      (sqrt               . ,(global-operator 'SQRT 1))
       (string->symbol     . ,string->symbol-expansion)
       (symbol?            . ,symbol?-expansion)
       (third              . ,third-expansion)