From 76b19d414ab7fd96061c9c4c4a923289d633a773 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 16 Jun 1988 06:38:35 +0000
Subject: [PATCH] Increase the number of primitives that are constant folded.

---
 v7/src/runtime/scomb.scm | 52 +++++++++++++++++++++++++++++++++++-----
 1 file changed, 46 insertions(+), 6 deletions(-)

diff --git a/v7/src/runtime/scomb.scm b/v7/src/runtime/scomb.scm
index 672bbfa76..ac0f40dde 100644
--- a/v7/src/runtime/scomb.scm
+++ b/v7/src/runtime/scomb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scomb.scm,v 14.1 1988/06/13 11:51:13 cph Exp $
+$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 $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -40,11 +40,51 @@ MIT in each case. |#
 (define (initialize-package!)
   (set! combination/constant-folding-operators
 	(map make-primitive-procedure
-	     '(PRIMITIVE-TYPE
-	       &+ &- &* &/ INTEGER-DIVIDE 1+ -1+
-	       TRUNCATE ROUND FLOOR CEILING
-	       SQRT EXP LOG SIN COS &ATAN))))
-
+	     '(
+	       &*
+	       &+
+	       &-
+	       &/
+	       &ATAN
+	       -1+
+	       1+
+	       ASCII->CHAR
+	       CEILING
+	       CELL?
+	       CHAR->ASCII
+	       CHAR->INTEGER
+	       CHAR-ASCII?
+	       CHAR-BITS
+	       CHAR-CODE
+	       CHAR-DOWNCASE
+	       CHAR-UPCASE
+	       COMPILED-CODE-ADDRESS->BLOCK
+	       COMPILED-CODE-ADDRESS->OFFSET
+	       COS
+	       EQ?
+	       EXP
+	       FLOOR
+	       INTEGER->CHAR
+	       LOG
+	       MAKE-CHAR
+	       MAKE-NON-POINTER-OBJECT
+	       NEGATIVE?
+	       NOT
+	       OBJECT-TYPE
+	       OBJECT-TYPE?
+	       PAIR?
+	       POSITIVE?
+	       PRIMITIVE-PROCEDURE-ARITY
+	       ROUND
+	       SIN
+	       SQRT
+	       ;; STRING->SYMBOL is a special case.  Strings have can
+	       ;; be side-effected, but it is useful to be able to
+	       ;; constant fold this primitive anyway.
+	       STRING->SYMBOL
+	       TRUNCATE	       ZERO?
+	       ))))
+
 ;;;; Sequence
 
 (define (make-sequence actions)
-- 
2.25.1