From 7fe537330b1bc0f009fb2810bb7a44f1b07f18c6 Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Fri, 18 Aug 1995 18:17:37 +0000
Subject: [PATCH] Made some operators (MEMQ, SQRT and EXPT) integrate as global
 operators. This will allow the new compiler to identify them and so something
 smart.

---
 v8/src/sf/usiexp.scm | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

diff --git a/v8/src/sf/usiexp.scm b/v8/src/sf/usiexp.scm
index 1946f08c7..de106f3b5 100644
--- 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))))))
+	    
 
   (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)
-- 
2.25.1