Fix cold-load initialization so that predicate tag tables are built right.

diff --git a/src/runtime/compound-predicate.scm b/src/runtime/compound-predicate.scm
index cf5169343a7669ac27472a6186606483dcb07b6f..34daadb0403fc611c3b1d0c36235bff72f7e5072 100644 (file)
--- a/src/runtime/compound-predicate.scm
+++ b/src/runtime/compound-predicate.scm
@@ -163,14 +163,4 @@ USA.
      (make-joinish-memoizer tag-is-top?))
 
    (define-compound-operator 'conjoin
-     (make-joinish-memoizer tag-is-bottom?))))
-
-(define any-object?)
-(define no-object?)
-(add-boot-init!
- (lambda ()
-   (set! any-object? (conjoin))
-   (set! no-object? (disjoin))
-   (set! the-top-tag (predicate->tag any-object?))
-   (set! the-bottom-tag (predicate->tag no-object?))
-   unspecific))
\ No newline at end of file
+     (make-joinish-memoizer tag-is-bottom?))))
\ No newline at end of file

diff --git a/src/runtime/predicate-lattice.scm b/src/runtime/predicate-lattice.scm
index e616c1971ffbbd4faeecf9ee51cea8163d1a7ea5..c74c9f978de245abab5b3435f448646dda8bf60d 100644 (file)
--- a/src/runtime/predicate-lattice.scm
+++ b/src/runtime/predicate-lattice.scm
@@ -76,6 +76,14 @@ USA.
        (cons (vector test1 test2 handler)
              tag<=-overrides))
   unspecific)
+\f
+(define (any-object? object)
+  (declare (ignore object))
+  #t)
+
+(define (no-object? object)
+  (declare (ignore object))
+  #f)
 
 (define (top-tag) the-top-tag)
 (define (bottom-tag) the-bottom-tag)
@@ -83,9 +91,11 @@ USA.
 (define-integrable (tag-is-top? tag) (eq? the-top-tag tag))
 (define-integrable (tag-is-bottom? tag) (eq? the-bottom-tag tag))
 
-;; These definitions will be overwritten when the tags are created:
-(define the-top-tag #f)
-(define the-bottom-tag #f)
+(define-deferred the-top-tag
+  (make-compound-tag any-object? 'conjoin '()))
+
+(define-deferred the-bottom-tag
+  (make-compound-tag no-object? 'disjoin '()))
 
 (define tag<=-cache)
 (define tag<=-overrides)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 9617c33c8861bf2aafe5fa911b324cdf004c7593..da18d4764f3aa572af902c586ccda2432aec2599 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1846,8 +1846,10 @@ USA.
   (files "predicate-lattice")
   (parent (runtime))
   (export ()
+         any-object?
          predicate<=
-         predicate>=)
+         predicate>=
+         no-object?)
   (export (runtime)
          bottom-tag
          define-tag<=
@@ -1856,28 +1858,25 @@ USA.
          tag<=
          tag=
          tag>=
-         top-tag)
-  (export (runtime compound-predicate)
-         the-bottom-tag
-         the-top-tag))
+         top-tag))
 
 (define-package (runtime compound-predicate)
   (files "compound-predicate")
   (parent (runtime))
   (export ()
-         any-object?
          compound-predicate-operands
          compound-predicate-operator
          compound-predicate?
          conjoin
          conjoin*
          disjoin
-         disjoin*
-         no-object?)
+         disjoin*)
   (export (runtime)
          compound-tag-operands
          compound-tag-operator
-         tag-is-compound?))
+         tag-is-compound?)
+  (export (runtime predicate-lattice)
+         make-compound-tag))
 
 (define-package (runtime parametric-predicate)
   (files "parametric-predicate")