From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 16 Jan 2018 06:48:18 +0000 (-0800)
Subject: Change tag representation so extra field is always a vector.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~355
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=02f69e756167554d763f4e629d0236f020254d79;p=mit-scheme.git

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 6841f6e45..f1d0d189d 100644
--- 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 87ce1eeab..00ba3ed40 100644
--- 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 862c8e6b1..409348c06 100644
--- 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)