From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 19 Dec 1988 20:23:28 +0000 (+0000)
Subject: Do not require `object-immutable?' of arguments to constant folding
X-Git-Tag: 20090517-FFI~12328
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2bb2af050d30f209fe8636ed7fe70d702d764599;p=mit-scheme.git

Do not require `object-immutable?' of arguments to constant folding
operations.  Because of the rule which says that constants appearing
in program text must be immutable, we can freely constant fold
anything that we can get our hands on, provided that we never constant
fold anything to does a cons-like operation.
---

diff --git a/v7/src/compiler/fgopt/folcon.scm b/v7/src/compiler/fgopt/folcon.scm
index 8a3f54cbe..8dde2c878 100644
--- a/v7/src/compiler/fgopt/folcon.scm
+++ b/v7/src/compiler/fgopt/folcon.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/folcon.scm,v 4.6 1988/12/15 17:25:26 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/folcon.scm,v 4.7 1988/12/19 20:23:28 cph Rel $
 
 Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
@@ -36,9 +36,7 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 
-(package (fold-constants)
-
-(define-export (fold-constants lvalues applications)
+(define (fold-constants lvalues applications)
   #|
   ;; This is needed only if we use the version of eliminate-known-nodes
   ;; commented out below.
@@ -148,10 +146,7 @@ MIT in each case. |#
     (and (constant-foldable-operator? operator)
 	 ;; (rvalue-known? continuation)
 	 ;; (uni-continuation? (rvalue-known-value continuation))
-	 (for-all? operands
-		   (lambda (val)
-		     (and (rvalue-known-constant? val)
-			  (object-immutable? (rvalue-constant-value val)))))
+	 (for-all? operands rvalue-known-constant?)
 	 (let ((op (constant-foldable-operator-value operator)))
 	   (and (or (arity-correct? op (length operands))
 		    (begin
@@ -222,6 +217,4 @@ MIT in each case. |#
   (let ((arity (procedure-arity proc)))
     (and (>= n (car arity))
 	 (or (null? (cdr arity))
-	     (<= n (cdr arity))))))
-
-)
\ No newline at end of file
+	     (<= n (cdr arity))))))
\ No newline at end of file