Create procedure `%make-combination' that does not attempt to constant
authorChris Hanson <org/chris-hanson/cph>
Sat, 15 Apr 1989 01:22:51 +0000 (01:22 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 15 Apr 1989 01:22:51 +0000 (01:22 +0000)
fold the combination before constructing it.

v7/src/runtime/scomb.scm

index ac0f40ddeb8f22fb74042b79510d9ccec237bff7..b259227b7e63555a9b59d61e598aa0dc40b857ed 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scomb.scm,v 14.2 1988/06/16 06:38:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scomb.scm,v 14.3 1989/04/15 01:22:51 cph Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -193,13 +193,18 @@ MIT in each case. |#
       (object-type? (ucode-type primitive-combination-3) object)))
 
 (define (make-combination operator operands)
-  (cond ((and (memq operator combination/constant-folding-operators)
-             (let loop ((operands operands))
-               (or (null? operands)
-                   (and (scode-constant? (car operands))
-                        (loop (cdr operands))))))
-        (apply operator operands))
-       ((null? operands)
+  (if (and (memq operator combination/constant-folding-operators)
+          (let loop ((operands operands))
+            (or (null? operands)
+                (and (scode-constant? (car operands))
+                     (loop (cdr operands))))))
+      (apply operator operands)
+      (%make-combination operator operands)))
+
+(define combination/constant-folding-operators)
+
+(define (%make-combination operator operands)
+  (cond ((null? operands)
         (if (and (primitive-procedure? operator)
                  (= (primitive-procedure-arity operator) 0))
             (object-new-type (ucode-type primitive-combination-0) operator)
@@ -230,8 +235,6 @@ MIT in each case. |#
              (ucode-type primitive-combination-3)
              (ucode-type combination))
          (cons operator operands)))))
-
-(define combination/constant-folding-operators)
 \f
 (let-syntax
     ((combination-dispatch