From: Joe Marshall <eval.apply@gmail.com>
Date: Sun, 22 Jan 2012 01:10:56 +0000 (-0800)
Subject: Relocate a top-level variable.
X-Git-Tag: release-9.2.0~334^2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d734e724684b3f0aaa4fa48f5e2a723b2a8f5944;p=mit-scheme.git

Relocate a top-level variable.
---

diff --git a/src/runtime/scomb.scm b/src/runtime/scomb.scm
index 7c730f087..10dbccea5 100644
--- a/src/runtime/scomb.scm
+++ b/src/runtime/scomb.scm
@@ -28,101 +28,7 @@ USA.
 ;;; package: (runtime scode-combinator)
 
 (declare (usual-integrations))
-
-(define (initialize-package!)
-  (set! combination/constant-folding-operators
-	(map (lambda (name)
-	       (make-primitive-procedure name #t))
-	     '(
-	       &*
-	       &+
-	       &-
-	       &/
-	       -1+
-	       1+
-	       ASCII->CHAR
-	       CELL?
-	       CHAR->ASCII
-	       CHAR->INTEGER
-	       CHAR-ASCII?
-	       CHAR-BITS
-	       CHAR-CODE
-	       CHAR-DOWNCASE
-	       CHAR-UPCASE
-	       COMPILED-CODE-ADDRESS->BLOCK
-	       COMPILED-CODE-ADDRESS->OFFSET
-	       DIVIDE-FIXNUM
-	       EQ?
-	       EQUAL-FIXNUM?
-	       FIXNUM-AND
-	       FIXNUM-ANDC
-	       FIXNUM-LSH
-	       FIXNUM-NOT
-	       FIXNUM-OR
-	       FIXNUM-QUOTIENT
-	       FIXNUM-REMAINDER
-	       FIXNUM-XOR
-	       FLONUM-ABS
-	       FLONUM-ACOS
-	       FLONUM-ADD
-	       FLONUM-ASIN
-	       FLONUM-ATAN
-	       FLONUM-ATAN2
-	       FLONUM-CEILING
-	       FLONUM-CEILING->EXACT
-	       FLONUM-COS
-	       FLONUM-DIVIDE
-	       FLONUM-EQUAL?
-	       FLONUM-EXP
-	       FLONUM-EXPT
-	       FLONUM-FLOOR
-	       FLONUM-FLOOR->EXACT
-	       FLONUM-GREATER?
-	       FLONUM-LESS?
-	       FLONUM-LOG
-	       FLONUM-MULTIPLY
-	       FLONUM-NEGATE
-	       FLONUM-NEGATIVE?
-	       FLONUM-POSITIVE?
-	       FLONUM-ROUND
-	       FLONUM-ROUND->EXACT
-	       FLONUM-SIN
-	       FLONUM-SQRT
-	       FLONUM-SUBTRACT
-	       FLONUM-TAN
-	       FLONUM-TRUNCATE
-	       FLONUM-TRUNCATE->EXACT
-	       FLONUM-ZERO?
-	       GCD-FIXNUM
-	       GREATER-THAN-FIXNUM?
-	       INDEX-FIXNUM?
-	       INTEGER->CHAR
-	       LESS-THAN-FIXNUM?
-	       MAKE-CHAR
-	       MAKE-NON-POINTER-OBJECT
-	       MINUS-FIXNUM
-	       MINUS-ONE-PLUS-FIXNUM
-	       MULTIPLY-FIXNUM
-	       NEGATIVE-FIXNUM?
-	       NEGATIVE?
-	       NOT
-	       NULL?
-	       OBJECT-TYPE
-	       OBJECT-TYPE?
-	       ONE-PLUS-FIXNUM
-	       PAIR?
-	       PLUS-FIXNUM
-	       POSITIVE-FIXNUM?
-	       POSITIVE?
-	       PRIMITIVE-PROCEDURE-ARITY
-	       ;; STRING->SYMBOL is a special case.  Strings can
-	       ;; be side-effected, but it is useful to be able to
-	       ;; constant fold this primitive anyway.
-	       STRING->SYMBOL
-	       STRING-LENGTH
-	       ZERO-FIXNUM?
-	       ZERO?
-	       ))))
+
 
 ;;;; Sequence
 
@@ -246,9 +152,6 @@ USA.
 
 (define-guarantee combination "SCode combination")
 
-;; TODO(jmarshall): Remove or relocate this.
-(define combination/constant-folding-operators)
-
 (define (make-combination operator operands)
 
   (define-integrable (%make-combination-0 operator)
diff --git a/src/sf/object.scm b/src/sf/object.scm
index 05c6be3dd..dc671e9be 100644
--- a/src/sf/object.scm
+++ b/src/sf/object.scm
@@ -350,6 +350,99 @@ USA.
 
 ;; Foldable operators primitives that are members of
 ;; combination/constant-folding-operators
+(define combination/constant-folding-operators
+  (map (lambda (name)
+	 (make-primitive-procedure name #t))
+       '(
+	 &*
+	 &+
+	 &-
+	 &/
+	 -1+
+	 1+
+	 ASCII->CHAR
+	 CELL?
+	 CHAR->ASCII
+	 CHAR->INTEGER
+	 CHAR-ASCII?
+	 CHAR-BITS
+	 CHAR-CODE
+	 CHAR-DOWNCASE
+	 CHAR-UPCASE
+	 COMPILED-CODE-ADDRESS->BLOCK
+	 COMPILED-CODE-ADDRESS->OFFSET
+	 DIVIDE-FIXNUM
+	 EQ?
+	 EQUAL-FIXNUM?
+	 FIXNUM-AND
+	 FIXNUM-ANDC
+	 FIXNUM-LSH
+	 FIXNUM-NOT
+	 FIXNUM-OR
+	 FIXNUM-QUOTIENT
+	 FIXNUM-REMAINDER
+	 FIXNUM-XOR
+	 FLONUM-ABS
+	 FLONUM-ACOS
+	 FLONUM-ADD
+	 FLONUM-ASIN
+	 FLONUM-ATAN
+	 FLONUM-ATAN2
+	 FLONUM-CEILING
+	 FLONUM-CEILING->EXACT
+	 FLONUM-COS
+	 FLONUM-DIVIDE
+	 FLONUM-EQUAL?
+	 FLONUM-EXP
+	 FLONUM-EXPT
+	 FLONUM-FLOOR
+	 FLONUM-FLOOR->EXACT
+	 FLONUM-GREATER?
+	 FLONUM-LESS?
+	 FLONUM-LOG
+	 FLONUM-MULTIPLY
+	 FLONUM-NEGATE
+	 FLONUM-NEGATIVE?
+	 FLONUM-POSITIVE?
+	 FLONUM-ROUND
+	 FLONUM-ROUND->EXACT
+	 FLONUM-SIN
+	 FLONUM-SQRT
+	 FLONUM-SUBTRACT
+	 FLONUM-TAN
+	 FLONUM-TRUNCATE
+	 FLONUM-TRUNCATE->EXACT
+	 FLONUM-ZERO?
+	 GCD-FIXNUM
+	 GREATER-THAN-FIXNUM?
+	 INDEX-FIXNUM?
+	 INTEGER->CHAR
+	 LESS-THAN-FIXNUM?
+	 MAKE-CHAR
+	 MAKE-NON-POINTER-OBJECT
+	 MINUS-FIXNUM
+	 MINUS-ONE-PLUS-FIXNUM
+	 MULTIPLY-FIXNUM
+	 NEGATIVE-FIXNUM?
+	 NEGATIVE?
+	 NOT
+	 NULL?
+	 OBJECT-TYPE
+	 OBJECT-TYPE?
+	 ONE-PLUS-FIXNUM
+	 PAIR?
+	 PLUS-FIXNUM
+	 POSITIVE-FIXNUM?
+	 POSITIVE?
+	 PRIMITIVE-PROCEDURE-ARITY
+	 ;; STRING->SYMBOL is a special case.  Strings can
+	 ;; be side-effected, but it is useful to be able to
+	 ;; constant fold this primitive anyway.
+	 STRING->SYMBOL
+	 STRING-LENGTH
+	 ZERO-FIXNUM?
+	 ZERO?
+	 )))
 
 (define (foldable-combination? operator operands)
   (and (constant? operator)
diff --git a/src/sf/sf.pkg b/src/sf/sf.pkg
index 2468fc75e..e2f4c7e16 100644
--- a/src/sf/sf.pkg
+++ b/src/sf/sf.pkg
@@ -36,8 +36,6 @@ USA.
          "usicon"
          "tables")
   (parent ())
-  (import (runtime scode-combinator)
-          combination/constant-folding-operators)
   (export ()
           sf:enable-argument-deletion?
           sf:enable-constant-folding?))