From 41ec7aa9345f816cc4fa02007210bc49cba41af6 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 9 Jan 2018 20:06:58 -0800
Subject: [PATCH] Fix cold-load initialization so that predicate tag tables are
 built right.

---
 src/runtime/compound-predicate.scm | 12 +-----------
 src/runtime/predicate-lattice.scm  | 16 +++++++++++++---
 src/runtime/runtime.pkg            | 17 ++++++++---------
 3 files changed, 22 insertions(+), 23 deletions(-)

diff --git a/src/runtime/compound-predicate.scm b/src/runtime/compound-predicate.scm
index cf5169343..34daadb04 100644
--- 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 e616c1971..c74c9f978 100644
--- 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)
+
+(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 9617c33c8..da18d4764 100644
--- 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")
-- 
2.25.1