From 811678039b7c385d586d14acdaa70cc574b5782e Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 1 Oct 2018 23:13:38 -0700
Subject: [PATCH] Allow more general record predicates.

Rather than insisting on a linear inheritance of record types, the record
predicate now allows arbitrary sub-type relations.  This can of course cause
problems if misused, so use with care.
---
 src/runtime/record.scm | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/src/runtime/record.scm b/src/runtime/record.scm
index 1ec917494..19d65980a 100644
--- a/src/runtime/record.scm
+++ b/src/runtime/record.scm
@@ -138,7 +138,7 @@ USA.
 			(%record-ref object 0))
 		   (let ((type* (%record->type object)))
 		     (and type*
-			  (%record-type< type* type)))))))
+			  (%record-type<= type* type)))))))
        (type
 	(%%make-record-type type-name
 			    predicate
@@ -160,11 +160,17 @@ USA.
 	  ((%record-type-proxy? marker) (%proxy->record-type marker))
 	  (else #f))))
 
-(define (%record-type< t1 t2)
-  (let ((parent (%record-type-parent t1)))
-    (and parent
-	 (or (eq? parent t2)
-	     (%record-type< parent t2)))))
+;; Temporary definition for cold load.
+(define (%record-type<= t1 t2)
+  (or (eq? t1 t2)
+      (let ((parent (%record-type-parent t1)))
+	(and parent
+	     (%record-type<= parent t2)))))
+
+(defer-boot-action 'predicate-relations
+  (lambda ()
+    (set! %record-type<= dispatch-tag<=)
+    unspecific))
 
 (define %record-metatag)
 (define record-type?)
-- 
2.25.1