Change tag representation so extra field is always a vector.

The original reason for using records in that field is no longer relevant now
that we have metatags to identify the tag type.

diff --git a/src/runtime/compound-predicate.scm b/src/runtime/compound-predicate.scm
index 6841f6e45888141281482cdc872e37f5ccec4dc7..f1d0d189d8e0dfb98582268f9789ef6a1d35cab7 100644 (file)
--- a/src/runtime/compound-predicate.scm
+++ b/src/runtime/compound-predicate.scm
@@ -43,19 +43,14 @@ USA.
 (define (make-compound-tag predicate operator operands)
   (%make-compound-tag (cons operator (map tag-name operands))
                      predicate
-                     (make-compound-tag-extra operator operands)))
+                     operator
+                     operands))
 
-(define (compound-tag-operator tag)
-  (compound-tag-extra-operator (tag-extra tag)))
+(define-integrable (compound-tag-operator tag)
+  (tag-extra tag 0))
 
-(define (compound-tag-operands tag)
-  (compound-tag-extra-operands (tag-extra tag)))
-
-(define-record-type <compound-tag-extra>
-    (make-compound-tag-extra operator operands)
-    compound-tag-extra?
-  (operator compound-tag-extra-operator)
-  (operands compound-tag-extra-operands))
+(define-integrable (compound-tag-operands tag)
+  (tag-extra tag 1))
 
 (define (tag-is-disjoin? object)
   (and (compound-tag? object)

diff --git a/src/runtime/parametric-predicate.scm b/src/runtime/parametric-predicate.scm
index 87ce1eeab8e310dba20e7a9098e0b7be70841ac0..00ba3ed404a9d696e0289b349b069c745d841be0 100644 (file)
--- a/src/runtime/parametric-predicate.scm
+++ b/src/runtime/parametric-predicate.scm
@@ -41,21 +41,13 @@ USA.
     unspecific))
 
 (define (make-parametric-tag name predicate template bindings)
-  (%make-parametric-tag name
-                       predicate
-                       (make-parametric-tag-extra template bindings)))
+  (%make-parametric-tag name predicate template bindings))
 
-(define (parametric-tag-template tag)
-  (parametric-tag-extra-template (tag-extra tag)))
+(define-integrable (parametric-tag-template tag)
+  (tag-extra tag 0))
 
-(define (parametric-tag-bindings tag)
-  (parametric-tag-extra-bindings (tag-extra tag)))
-
-(define-record-type <parametric-tag-extra>
-    (make-parametric-tag-extra template bindings)
-    parametric-tag-extra?
-  (template parametric-tag-extra-template)
-  (bindings parametric-tag-extra-bindings))
+(define-integrable (parametric-tag-bindings tag)
+  (tag-extra tag 1))
 
 (define (parametric-predicate? object)
   (and (predicate? object)

diff --git a/src/runtime/predicate-metadata.scm b/src/runtime/predicate-metadata.scm
index 862c8e6b1df6a14f9ba90fc7ad9f7bdb340e5894..409348c068fae3b2eecb8103ebd43de36029d271 100644 (file)
--- a/src/runtime/predicate-metadata.scm
+++ b/src/runtime/predicate-metadata.scm
@@ -55,18 +55,18 @@ USA.
        (lambda (object)
          (and (%record? object)
               (eq? metatag (%record-ref object 0)))))
-       (metatag (%make-tag metatag-tag name predicate #f)))
+       (metatag (%make-tag metatag-tag name predicate '#())))
     (set-tag<=! metatag metatag-tag)
     metatag))
 
 (define (metatag-constructor metatag #!optional caller)
   (guarantee metatag? metatag 'metatag-constructor)
-  (lambda (name predicate extra)
+  (lambda (name predicate . extra)
     (guarantee tag-name? name caller)
     (guarantee unary-procedure? predicate caller)
     (if (predicate? predicate)
        (error "Can't assign multiple tags to the same predicate:" predicate))
-    (%make-tag metatag name predicate extra)))
+    (%make-tag metatag name predicate (list->vector extra))))
 
 (define (metatag? object)
   (and (%record? object)
@@ -87,7 +87,7 @@ USA.
 (define %make-simple-tag)
 (add-boot-init!
  (lambda ()
-   (set! metatag-tag (%make-tag #f 'metatag metatag? #f))
+   (set! metatag-tag (%make-tag #f 'metatag metatag? '#()))
    (%record-set! metatag-tag 0 metatag-tag)
    (set! simple-tag-metatag
         (make-metatag 'simple-tag))
@@ -148,9 +148,9 @@ USA.
   (guarantee tag? tag 'tag->predicate)
   (%tag->predicate tag))
 
-(define (tag-extra tag)
+(define (tag-extra tag index)
   (guarantee tag? tag 'tag-extra)
-  (%tag-extra tag))
+  (vector-ref (%tag-extra tag) index))
 
 (define (any-tag-superset procedure tag)
   (guarantee tag? tag 'any-tag-superset)