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.

diff --git a/src/runtime/record.scm b/src/runtime/record.scm
index 1ec9174947e76c59f7cfa89fe889da9494c03364..19d65980af34ad12632b4837e17833db1145e680 100644 (file)
--- 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))
 \f
 (define %record-metatag)
 (define record-type?)