From 8b9a15e5048e276a7344cfd05082b7e28725f4c1 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 17 Jan 2018 18:02:58 -0800
Subject: [PATCH] Rename "tag" to "dispatch-tag" and move bindings to global
 env.

This name is at least somewhat specific, so it should be OK in global.
---
 src/runtime/bundle.scm                      |  7 +-
 src/runtime/compound-predicate.scm          | 35 ++++----
 src/runtime/gentag.scm                      | 82 +++++++++----------
 src/runtime/parametric-predicate.scm        | 41 +++++-----
 src/runtime/predicate-dispatch.scm          |  6 +-
 src/runtime/predicate-lattice.scm           | 89 +++++++++++----------
 src/runtime/predicate-metadata.scm          | 14 ++--
 src/runtime/predicate-tagging.scm           | 36 ++++-----
 src/runtime/record.scm                      | 12 +--
 src/runtime/runtime.pkg                     | 52 ++++++------
 src/runtime/unpars.scm                      |  4 +-
 src/sos/class.scm                           | 12 +--
 src/sos/generic.scm                         | 30 +++----
 src/sos/tvector.scm                         |  8 +-
 tests/Clean.sh                              |  2 +-
 tests/runtime/test-parametric-predicate.scm |  8 +-
 tests/runtime/test-predicate-metadata.scm   | 10 +--
 tests/sos/test-genmult.scm                  |  4 +-
 18 files changed, 230 insertions(+), 222 deletions(-)

diff --git a/src/runtime/bundle.scm b/src/runtime/bundle.scm
index eee490b91..a78024dea 100644
--- a/src/runtime/bundle.scm
+++ b/src/runtime/bundle.scm
@@ -57,11 +57,12 @@ USA.
       ((predicate
 	(lambda (datum)
 	  (and (bundle? datum)
-	       (tag<= (bundle-interface-tag (bundle-interface datum)) tag))))
+	       (dispatch-tag<= (bundle-interface-tag (bundle-interface datum))
+			       tag))))
        (tag
 	(begin
 	  (register-predicate! predicate name '<= bundle?)
-	  (predicate->tag predicate))))
+	  (predicate->dispatch-tag predicate))))
     tag))
 
 (define (elements? object)
@@ -88,7 +89,7 @@ USA.
   (element-properties %bundle-interface-element-properties))
 
 (define (bundle-interface-predicate interface)
-  (tag->predicate (bundle-interface-tag interface)))
+  (dispatch-tag->predicate (bundle-interface-tag interface)))
 
 (define (bundle-interface-element-names interface)
   (vector->list (%bundle-interface-element-names interface)))
diff --git a/src/runtime/compound-predicate.scm b/src/runtime/compound-predicate.scm
index 13cdd7240..9cc5b72d5 100644
--- a/src/runtime/compound-predicate.scm
+++ b/src/runtime/compound-predicate.scm
@@ -29,23 +29,23 @@ USA.
 
 (declare (usual-integrations))
 
-(define compound-tag-metatag (make-metatag 'compound-tag))
-(define compound-tag? (tag->predicate compound-tag-metatag))
+(define compound-tag-metatag (make-dispatch-metatag 'compound-tag))
+(define compound-tag? (dispatch-tag->predicate compound-tag-metatag))
 
 (define %make-compound-tag
-  (metatag-constructor compound-tag-metatag 'make-compound-tag))
+  (dispatch-metatag-constructor compound-tag-metatag 'make-compound-tag))
 
 (define (make-compound-tag predicate operator operands)
-  (%make-compound-tag (cons operator (map tag-name operands))
+  (%make-compound-tag (cons operator (map dispatch-tag-name operands))
 		      predicate
 		      operator
 		      operands))
 
 (define-integrable (compound-tag-operator tag)
-  (tag-extra tag 0))
+  (dispatch-tag-extra tag 0))
 
 (define-integrable (compound-tag-operands tag)
-  (tag-extra tag 1))
+  (dispatch-tag-extra tag 1))
 
 (define (tag-is-disjoin? object)
   (and (compound-tag? object)
@@ -58,21 +58,21 @@ USA.
 (add-boot-init!
  (lambda ()
 
-   (define-tag<= tag? tag-is-disjoin?
+   (define-dispatch-tag<= dispatch-tag? tag-is-disjoin?
      (lambda (tag1 tag2)
        (any (lambda (component2)
-	      (tag<= tag1 component2))
+	      (dispatch-tag<= tag1 component2))
 	    (compound-tag-operands tag2))))
 
-   (define-tag<= tag-is-conjoin? tag?
+   (define-dispatch-tag<= tag-is-conjoin? dispatch-tag?
      (lambda (tag1 tag2)
        (any (lambda (component1)
-	      (tag<= component1 tag2))
+	      (dispatch-tag<= component1 tag2))
 	    (compound-tag-operands tag1))))))
 
 (define (compound-predicate? object)
   (and (predicate? object)
-       (compound-tag? (predicate->tag object))))
+       (compound-tag? (predicate->dispatch-tag object))))
 
 (add-boot-init!
  (lambda ()
@@ -80,10 +80,11 @@ USA.
 			'<= predicate?)))
 
 (define (compound-predicate-operator predicate)
-  (compound-tag-operator (predicate->tag predicate)))
+  (compound-tag-operator (predicate->dispatch-tag predicate)))
 
 (define (compound-predicate-operands predicate)
-  (map tag->predicate (compound-tag-operands (predicate->tag predicate))))
+  (map dispatch-tag->predicate
+       (compound-tag-operands (predicate->dispatch-tag predicate))))
 
 (define (disjoin . predicates)
   (disjoin* predicates))
@@ -109,11 +110,11 @@ USA.
 
 (define (make-predicate datum-test operator operands)
   (if (every predicate? operands)
-      (tag->predicate
+      (dispatch-tag->predicate
        ((compound-operator-builder operator)
 	datum-test
 	operator
-	(map predicate->tag operands)))
+	(map predicate->dispatch-tag operands)))
       datum-test))
 
 (define compound-operator-builder)
@@ -153,7 +154,7 @@ USA.
 		   (memoizer datum-test operator tags)))))))
 
    (define-compound-operator 'disjoin
-     (make-joinish-memoizer tag-is-top?))
+     (make-joinish-memoizer dispatch-tag-is-top?))
 
    (define-compound-operator 'conjoin
-     (make-joinish-memoizer tag-is-bottom?))))
\ No newline at end of file
+     (make-joinish-memoizer dispatch-tag-is-bottom?))))
\ No newline at end of file
diff --git a/src/runtime/gentag.scm b/src/runtime/gentag.scm
index 149c23a39..46d41b7d5 100644
--- a/src/runtime/gentag.scm
+++ b/src/runtime/gentag.scm
@@ -60,25 +60,25 @@ USA.
 		    (or (object-non-pointer? elt)
 			(tag-name? elt)))
 		  (cdr object)))))
-(register-predicate! tag-name? 'tag-name)
+(register-predicate! tag-name? 'dispatch-tag-name)
 
 (define (set-predicate-tag! predicate tag)
   (defer-boot-action 'set-predicate-tag!
     (lambda ()
       (set-predicate-tag! predicate tag))))
 
-(define (tag? object)
+(define (dispatch-tag? object)
   (and (%record? object)
-       (metatag? (%record-ref object 0))))
-(register-predicate! tag? 'tag '<= %record?)
+       (dispatch-metatag? (%record-ref object 0))))
+(register-predicate! dispatch-tag? 'tag '<= %record?)
 
-(define-integrable (%tag-name tag)
+(define-integrable (%dispatch-tag-name tag)
   (%record-ref tag 9))
 
-(define-integrable (%tag->predicate tag)
+(define-integrable (%dispatch-tag->predicate tag)
   (%record-ref tag 10))
 
-(define-integrable (%tag-extra tag)
+(define-integrable (%dispatch-tag-extra tag)
   (%record-ref tag 11))
 
 (define-integrable (%tag-supersets tag)
@@ -103,19 +103,19 @@ USA.
     (lambda ()
       (random modulus state))))
 
-(define (make-metatag name)
-  (guarantee tag-name? name 'make-metatag)
+(define (make-dispatch-metatag name)
+  (guarantee tag-name? name 'make-dispatch-metatag)
   (letrec*
       ((predicate
 	(lambda (object)
 	  (and (%record? object)
 	       (eq? metatag (%record-ref object 0)))))
        (metatag (%make-tag metatag-tag name predicate '#())))
-    (set-tag<=! metatag metatag-tag)
+    (set-dispatch-tag<=! metatag metatag-tag)
     metatag))
 
-(define (metatag-constructor metatag #!optional caller)
-  (guarantee metatag? metatag 'metatag-constructor)
+(define (dispatch-metatag-constructor metatag #!optional caller)
+  (guarantee dispatch-metatag? metatag 'dispatch-metatag-constructor)
   (lambda (name predicate . extra)
     (guarantee tag-name? name caller)
     (guarantee unary-procedure? predicate caller)
@@ -123,60 +123,60 @@ USA.
 	(error "Can't assign multiple tags to the same predicate:" name))
     (%make-tag metatag name predicate (list->vector extra))))
 
-(define (metatag? object)
+(define (dispatch-metatag? object)
   (and (%record? object)
        (eq? metatag-tag (%record-ref object 0))))
 
 (define metatag-tag)
 (add-boot-init!
  (lambda ()
-   (set! metatag-tag (%make-tag #f 'metatag metatag? '#()))
+   (set! metatag-tag (%make-tag #f 'metatag dispatch-metatag? '#()))
    (%record-set! metatag-tag 0 metatag-tag)))
 
-(define (set-tag<=! t1 t2)
+(define (set-dispatch-tag<=! t1 t2)
   (defer-boot-action 'predicate-relations
     (lambda ()
-      (set-tag<=! t1 t2))))
+      (set-dispatch-tag<=! t1 t2))))
 
-(define (tag-metatag tag)
-  (guarantee tag? tag 'tag-metatag)
+(define (dispatch-tag-metatag tag)
+  (guarantee dispatch-tag? tag 'dispatch-tag-metatag)
   (%record-ref tag 0))
 
-(define (tag-name tag)
-  (guarantee tag? tag 'tag-name)
-  (%tag-name tag))
+(define (dispatch-tag-name tag)
+  (guarantee dispatch-tag? tag 'dispatch-tag-name)
+  (%dispatch-tag-name tag))
 
-(define (tag->predicate tag)
-  (guarantee tag? tag 'tag->predicate)
-  (%tag->predicate tag))
+(define (dispatch-tag->predicate tag)
+  (guarantee dispatch-tag? tag 'dispatch-tag->predicate)
+  (%dispatch-tag->predicate tag))
 
-(define (tag-extra tag index)
-  (guarantee tag? tag 'tag-extra)
-  (vector-ref (%tag-extra tag) index))
+(define (dispatch-tag-extra tag index)
+  (guarantee dispatch-tag? tag 'dispatch-tag-extra)
+  (vector-ref (%dispatch-tag-extra tag) index))
 
-(define (any-tag-superset procedure tag)
-  (guarantee tag? tag 'any-tag-superset)
+(define (any-dispatch-tag-superset procedure tag)
+  (guarantee dispatch-tag? tag 'any-dispatch-tag-superset)
   (%weak-set-any procedure (%tag-supersets tag)))
 
-(define (add-tag-superset tag superset)
-  (guarantee tag? tag 'add-tag-superset)
-  (guarantee tag? superset 'add-tag-superset)
+(define (add-dispatch-tag-superset tag superset)
+  (guarantee dispatch-tag? tag 'add-dispatch-tag-superset)
+  (guarantee dispatch-tag? superset 'add-dispatch-tag-superset)
   (%add-to-weak-set superset (%tag-supersets tag)))
 
 (defer-boot-action 'predicate-relations
   (lambda ()
-    (set-predicate<=! metatag? tag?)))
+    (set-predicate<=! dispatch-metatag? dispatch-tag?)))
 
-(define-unparser-method tag?
+(define-unparser-method dispatch-tag?
   (simple-unparser-method
    (lambda (tag)
-     (if (metatag? tag) 'metatag 'tag))
+     (if (dispatch-metatag? tag) 'metatag 'tag))
    (lambda (tag)
-     (list (tag-name tag)))))
+     (list (dispatch-tag-name tag)))))
 
-(define-pp-describer tag?
+(define-pp-describer dispatch-tag?
   (lambda (tag)
-    (list (list 'metatag (tag-metatag tag))
-	  (list 'name (tag-name tag))
-	  (list 'predicate (tag->predicate tag))
-	  (cons 'extra (vector->list (%tag-extra tag))))))
\ No newline at end of file
+    (list (list 'metatag (dispatch-tag-metatag tag))
+	  (list 'name (dispatch-tag-name tag))
+	  (list 'predicate (dispatch-tag->predicate tag))
+	  (cons 'extra (vector->list (%dispatch-tag-extra tag))))))
\ No newline at end of file
diff --git a/src/runtime/parametric-predicate.scm b/src/runtime/parametric-predicate.scm
index 69e626548..9e6fc918b 100644
--- a/src/runtime/parametric-predicate.scm
+++ b/src/runtime/parametric-predicate.scm
@@ -29,30 +29,30 @@ USA.
 
 (declare (usual-integrations))
 
-(define parametric-tag-metatag (make-metatag 'parametric-tag))
-(define parametric-tag? (tag->predicate parametric-tag-metatag))
+(define parametric-tag-metatag (make-dispatch-metatag 'parametric-tag))
+(define parametric-tag? (dispatch-tag->predicate parametric-tag-metatag))
 
 (define %make-parametric-tag
-  (metatag-constructor parametric-tag-metatag 'make-parametric-tag))
+  (dispatch-metatag-constructor parametric-tag-metatag 'make-parametric-tag))
 
 (define (make-parametric-tag name predicate template bindings)
   (%make-parametric-tag name predicate template bindings))
 
 (define-integrable (parametric-tag-template tag)
-  (tag-extra tag 0))
+  (dispatch-tag-extra tag 0))
 
 (define-integrable (parametric-tag-bindings tag)
-  (tag-extra tag 1))
+  (dispatch-tag-extra tag 1))
 
 (define (parametric-predicate? object)
   (and (predicate? object)
-       (parametric-tag? (predicate->tag object))))
+       (parametric-tag? (predicate->dispatch-tag object))))
 
 (define (parametric-predicate-template predicate)
-  (parametric-tag-template (predicate->tag predicate)))
+  (parametric-tag-template (predicate->dispatch-tag predicate)))
 
 (define (parametric-predicate-bindings predicate)
-  (parametric-tag-bindings (predicate->tag predicate)))
+  (parametric-tag-bindings (predicate->dispatch-tag predicate)))
 
 ;;;; Templates
 
@@ -93,17 +93,17 @@ USA.
 	       (cons name
 		     (map-template-pattern pattern
 					   patterned-tags
-					   tag-name
+					   dispatch-tag-name
 					   caller))
 	       (apply make-data-test
 		      (map-template-pattern pattern
 					    patterned-tags
-					    tag->predicate
+					    dispatch-tag->predicate
 					    caller))
 	       (get-template)
 	       (match-template-pattern pattern
 				       patterned-tags
-				       tag?
+				       dispatch-tag?
 				       caller))))
       tag)))
 
@@ -111,10 +111,10 @@ USA.
   (let ((instantiator (template-instantiator template))
         (pattern (predicate-template-pattern template)))
     (lambda patterned-predicates
-      (tag->predicate
+      (dispatch-tag->predicate
        (instantiator (map-template-pattern pattern
 					   patterned-predicates
-					   predicate->tag
+					   predicate->dispatch-tag
 					   caller)
 		     caller)))))
 
@@ -131,15 +131,16 @@ USA.
     (let ((valid? (predicate-template-predicate template))
           (convert
            (if (template-pattern-element-single-valued? elt)
-               tag->predicate
-	       (lambda (tags) (map tag->predicate tags)))))
+               dispatch-tag->predicate
+	       (lambda (tags) (map dispatch-tag->predicate tags)))))
       (lambda (predicate)
 	(guarantee valid? predicate caller)
         (convert
          (parameter-binding-value
           (find (lambda (binding)
                   (eqv? name (parameter-binding-name binding)))
-                (parametric-tag-bindings (predicate->tag predicate)))))))))
+                (parametric-tag-bindings
+		 (predicate->dispatch-tag predicate)))))))))
 
 ;;;; Template patterns
 
@@ -247,7 +248,7 @@ USA.
 
 (add-boot-init!
  (lambda ()
-   (define-tag<= parametric-tag? parametric-tag?
+   (define-dispatch-tag<= parametric-tag? parametric-tag?
      (lambda (tag1 tag2)
        (and (eqv? (parametric-tag-template tag1)
 		  (parametric-tag-template tag2))
@@ -257,9 +258,9 @@ USA.
 		       (and (= (length tags1) (length tags2))
 			    (every (case (parameter-binding-polarity
 					  bind1)
-				     ((+) tag<=)
-				     ((-) tag>=)
-				     (else tag=))
+				     ((+) dispatch-tag<=)
+				     ((-) dispatch-tag>=)
+				     (else dispatch-tag=))
 				   tags1
 				   tags2))))
 		   (parametric-tag-bindings tag1)
diff --git a/src/runtime/predicate-dispatch.scm b/src/runtime/predicate-dispatch.scm
index 8d767dc89..246bc9286 100644
--- a/src/runtime/predicate-dispatch.scm
+++ b/src/runtime/predicate-dispatch.scm
@@ -252,7 +252,9 @@ USA.
         (else (delegate operator))))))
 
 (define (cached-most-specific-handler-set default-handler)
-  (cached-handler-set (most-specific-handler-set default-handler) object->tag))
+  (cached-handler-set (most-specific-handler-set default-handler)
+		      object->dispatch-tag))
 
 (define (cached-chaining-handler-set default-handler)
-  (cached-handler-set (chaining-handler-set default-handler) object->tag))
\ No newline at end of file
+  (cached-handler-set (chaining-handler-set default-handler)
+		      object->dispatch-tag))
\ No newline at end of file
diff --git a/src/runtime/predicate-lattice.scm b/src/runtime/predicate-lattice.scm
index 287e7ae2d..c38ee3a27 100644
--- a/src/runtime/predicate-lattice.scm
+++ b/src/runtime/predicate-lattice.scm
@@ -30,55 +30,55 @@ USA.
 (declare (usual-integrations))
 
 (define (predicate<= predicate1 predicate2)
-  (tag<= (predicate->tag predicate1)
-         (predicate->tag predicate2)))
+  (dispatch-tag<= (predicate->dispatch-tag predicate1)
+		  (predicate->dispatch-tag predicate2)))
 
 (define (predicate>= predicate1 predicate2)
   (predicate<= predicate2 predicate1))
 
 (define (set-predicate<=! predicate superset)
-  (set-tag<=! (predicate->tag predicate 'set-predicate<=!)
-              (predicate->tag superset 'set-predicate<=!)))
+  (set-dispatch-tag<=! (predicate->dispatch-tag predicate 'set-predicate<=!)
+		       (predicate->dispatch-tag superset 'set-predicate<=!)))
 
-(define (tag= tag1 tag2)
-  (guarantee tag? tag1 'tag=)
-  (guarantee tag? tag2 'tag=)
+(define (dispatch-tag= tag1 tag2)
+  (guarantee dispatch-tag? tag1 'dispatch-tag=)
+  (guarantee dispatch-tag? tag2 'dispatch-tag=)
   (eq? tag1 tag2))
 
-(define (tag<= tag1 tag2)
-  (guarantee tag? tag1 'tag<=)
-  (guarantee tag? tag2 'tag<=)
-  (cached-tag<= tag1 tag2))
+(define (dispatch-tag<= tag1 tag2)
+  (guarantee dispatch-tag? tag1 'dispatch-tag<=)
+  (guarantee dispatch-tag? tag2 'dispatch-tag<=)
+  (cached-dispatch-tag<= tag1 tag2))
 
-(define (tag>= tag1 tag2)
-  (tag<= tag2 tag1))
+(define (dispatch-tag>= tag1 tag2)
+  (dispatch-tag<= tag2 tag1))
 
-(define (cached-tag<= tag1 tag2)
-  (hash-table-intern! tag<=-cache
+(define (cached-dispatch-tag<= tag1 tag2)
+  (hash-table-intern! dispatch-tag<=-cache
 		      (cons tag1 tag2)
-		      (lambda () (uncached-tag<= tag1 tag2))))
+		      (lambda () (uncached-dispatch-tag<= tag1 tag2))))
 
-(define (uncached-tag<= tag1 tag2)
+(define (uncached-dispatch-tag<= tag1 tag2)
   (or (eq? tag1 tag2)
-      (tag-is-bottom? tag1)
-      (tag-is-top? tag2)
-      (and (not (tag-is-top? tag1))
-	   (not (tag-is-bottom? tag2))
+      (dispatch-tag-is-bottom? tag1)
+      (dispatch-tag-is-top? tag2)
+      (and (not (dispatch-tag-is-top? tag1))
+	   (not (dispatch-tag-is-bottom? tag2))
 	   (let ((v
 		  (find (lambda (v)
 			  (and ((vector-ref v 0) tag1)
 			       ((vector-ref v 1) tag2)))
-			tag<=-overrides)))
+			dispatch-tag<=-overrides)))
 	     (if v
 		 ((vector-ref v 2) tag1 tag2)
-		 (any-tag-superset (lambda (tag)
-				     (cached-tag<= tag tag2))
-				   tag1))))))
+		 (any-dispatch-tag-superset (lambda (tag)
+					      (cached-dispatch-tag<= tag tag2))
+					    tag1))))))
 
-(define (define-tag<= test1 test2 handler)
-  (set! tag<=-overrides
+(define (define-dispatch-tag<= test1 test2 handler)
+  (set! dispatch-tag<=-overrides
 	(cons (vector test1 test2 handler)
-	      tag<=-overrides))
+	      dispatch-tag<=-overrides))
   unspecific)
 
 (define (any-object? object)
@@ -89,31 +89,34 @@ USA.
   (declare (ignore object))
   #f)
 
-(define (top-tag) the-top-tag)
-(define (bottom-tag) the-bottom-tag)
+(define (top-dispatch-tag) the-top-dispatch-tag)
+(define (bottom-dispatch-tag) the-bottom-dispatch-tag)
 
-(define-integrable (tag-is-top? tag) (eq? the-top-tag tag))
-(define-integrable (tag-is-bottom? tag) (eq? the-bottom-tag tag))
+(define-integrable (dispatch-tag-is-top? tag)
+  (eq? the-top-dispatch-tag tag))
 
-(define-deferred the-top-tag
+(define-integrable (dispatch-tag-is-bottom? tag)
+  (eq? the-bottom-dispatch-tag tag))
+
+(define-deferred the-top-dispatch-tag
   (make-compound-tag any-object? 'conjoin '()))
 
-(define-deferred the-bottom-tag
+(define-deferred the-bottom-dispatch-tag
   (make-compound-tag no-object? 'disjoin '()))
 
-(define tag<=-cache)
-(define tag<=-overrides)
+(define dispatch-tag<=-cache)
+(define dispatch-tag<=-overrides)
 (add-boot-init!
  (lambda ()
    ;; TODO(cph): should be a weak-key table, but we don't have tables that have
    ;; weak compound keys.
-   (set! tag<=-cache (make-equal-hash-table))
-   (set! tag<=-overrides '())
-   (set! set-tag<=!
-	 (named-lambda (set-tag<=! tag superset)
-	   (if (not (add-tag-superset tag superset))
+   (set! dispatch-tag<=-cache (make-equal-hash-table))
+   (set! dispatch-tag<=-overrides '())
+   (set! set-dispatch-tag<=!
+	 (named-lambda (set-dispatch-tag<=! tag superset)
+	   (if (not (add-dispatch-tag-superset tag superset))
 	       (error "Tag already has this superset:" tag superset))
-	   (if (tag>= tag superset)
+	   (if (dispatch-tag>= tag superset)
 	       (error "Not allowed to create a superset loop:" tag superset))
-	   (hash-table-clear! tag<=-cache)))
+	   (hash-table-clear! dispatch-tag<=-cache)))
    (run-deferred-boot-actions 'predicate-relations)))
\ No newline at end of file
diff --git a/src/runtime/predicate-metadata.scm b/src/runtime/predicate-metadata.scm
index ba95d6cf5..a97e56bf5 100644
--- a/src/runtime/predicate-metadata.scm
+++ b/src/runtime/predicate-metadata.scm
@@ -39,9 +39,9 @@ USA.
      (run-deferred-boot-actions 'set-predicate-tag!))))
 
 (define (predicate-name predicate)
-  (tag-name (predicate->tag predicate 'predicate-name)))
+  (dispatch-tag-name (predicate->dispatch-tag predicate 'predicate-name)))
 
-(define (predicate->tag predicate #!optional caller)
+(define (predicate->dispatch-tag predicate #!optional caller)
   (let ((tag (get-predicate-tag predicate #f)))
     (if (not tag)
         (error:not-a predicate? predicate caller))
@@ -52,16 +52,18 @@ USA.
 (add-boot-init!
  (lambda ()
    (set! simple-tag-metatag
-	 (make-metatag 'simple-tag))
+	 (make-dispatch-metatag 'simple-tag))
    (set! %make-simple-tag
-	 (metatag-constructor simple-tag-metatag 'register-predicate!))
-   (run-deferred-boot-actions 'make-metatag)
+	 (dispatch-metatag-constructor simple-tag-metatag 'register-predicate!))
+   (run-deferred-boot-actions 'make-dispatch-metatag)
    (set! register-predicate!
 	 (named-lambda (register-predicate! predicate name . keylist)
 	   (guarantee keyword-list? keylist 'register-predicate!)
 	   (let ((tag (%make-simple-tag name predicate #f)))
 	     (for-each (lambda (superset)
-			 (set-tag<=! tag (predicate->tag superset)))
+			 (set-dispatch-tag<=!
+			  tag
+			  (predicate->dispatch-tag superset)))
 		       (get-keyword-values keylist '<=))
 	     tag)))
    unspecific))
diff --git a/src/runtime/predicate-tagging.scm b/src/runtime/predicate-tagging.scm
index 7af96ca48..eec437270 100644
--- a/src/runtime/predicate-tagging.scm
+++ b/src/runtime/predicate-tagging.scm
@@ -30,9 +30,9 @@ USA.
 (declare (usual-integrations))
 
 (define (object->predicate object)
-  (tag->predicate (object->tag object)))
+  (dispatch-tag->predicate (object->dispatch-tag object)))
 
-(define (object->tag object)
+(define (object->dispatch-tag object)
   (let ((code (object-type object)))
     (or (vector-ref primitive-tags code)
 	((vector-ref primitive-tag-methods code) object)
@@ -44,14 +44,14 @@ USA.
       object))
 
 (define (predicate-tagger predicate)
-  (%tag-tagger (predicate->tag predicate 'predicate-tagger) predicate))
+  (%tag-tagger (predicate->dispatch-tag predicate 'predicate-tagger) predicate))
 
-(define (tag-tagger tag)
-  (%tag-tagger tag (tag->predicate tag)))
+(define (dispatch-tag-tagger tag)
+  (%tag-tagger tag (dispatch-tag->predicate tag)))
 
 (define (%tag-tagger tag predicate)
   (lambda (datum #!optional tagger-name)
-    (if (tag<= (object->tag datum) tag)
+    (if (dispatch-tag<= (object->dispatch-tag datum) tag)
 	datum
 	(begin
 	  (guarantee predicate datum tagger-name)
@@ -63,7 +63,7 @@ USA.
  (lambda ()
    (set! primitive-tags
 	 (make-vector (microcode-type/code-limit)
-		      (top-tag)))
+		      (top-dispatch-tag)))
    (set! primitive-tag-methods
 	 (make-vector (microcode-type/code-limit) #f))
    unspecific))
@@ -73,7 +73,7 @@ USA.
    (define (define-primitive-predicate type-name predicate)
      (vector-set! primitive-tags
 		  (microcode-type/name->code type-name)
-		  (predicate->tag predicate)))
+		  (predicate->dispatch-tag predicate)))
 
    (define-primitive-predicate 'bignum exact-integer?)
    (define-primitive-predicate 'bytevector bytevector?)
@@ -113,7 +113,7 @@ USA.
    (define-primitive-predicate-method 'constant
      (let* ((constant-tags
 	     (list->vector
-	      (map predicate->tag
+	      (map predicate->dispatch-tag
 		   (list boolean?
 			 undefined-value?
 			 undefined-value?
@@ -129,21 +129,21 @@ USA.
 	 (let ((datum (object-datum object)))
 	   (if (and (fix:fixnum? datum) (fix:< datum n-tags))
 	       (vector-ref constant-tags datum)
-	       (top-tag))))))
+	       (top-dispatch-tag))))))
 
    (define-primitive-predicate-method 'entity
-     (let ((apply-hook-tag (predicate->tag apply-hook?))
-	   (entity-tag (predicate->tag entity?)))
+     (let ((apply-hook-tag (predicate->dispatch-tag apply-hook?))
+	   (entity-tag (predicate->dispatch-tag entity?)))
        (lambda (object)
 	 (if (%entity-is-apply-hook? object)
 	     apply-hook-tag
 	     entity-tag))))
 
    (define-primitive-predicate-method 'compiled-entry
-     (let ((procedure-tag (predicate->tag compiled-procedure?))
-	   (return-tag (predicate->tag compiled-return-address?))
-	   (expression-tag (predicate->tag compiled-expression?))
-	   (default-tag (predicate->tag compiled-code-address?)))
+     (let ((procedure-tag (predicate->dispatch-tag compiled-procedure?))
+	   (return-tag (predicate->dispatch-tag compiled-return-address?))
+	   (expression-tag (predicate->dispatch-tag compiled-expression?))
+	   (default-tag (predicate->dispatch-tag compiled-code-address?)))
        (lambda (entry)
 	 (case (system-hunk3-cxr0
 		((ucode-primitive compiled-entry-kind 1) entry))
@@ -153,8 +153,8 @@ USA.
 	   (else default-tag)))))
 
    (define-primitive-predicate-method 'record
-     (let ((default-tag (predicate->tag %record?)))
+     (let ((default-tag (predicate->dispatch-tag %record?)))
        (lambda (object)
-	 (if (tag? (%record-ref object 0))
+	 (if (dispatch-tag? (%record-ref object 0))
 	     (%record-ref object 0)
 	     default-tag))))))
\ No newline at end of file
diff --git a/src/runtime/record.scm b/src/runtime/record.scm
index affa2c767..eff9a8128 100644
--- a/src/runtime/record.scm
+++ b/src/runtime/record.scm
@@ -107,10 +107,10 @@ USA.
 (define record-type-type-tag)
 (add-boot-init!
  (lambda ()
-   (set! record-tag-metatag (make-metatag 'record-tag))
-   (set! record-tag? (tag->predicate record-tag-metatag))
+   (set! record-tag-metatag (make-dispatch-metatag 'record-tag))
+   (set! record-tag? (dispatch-tag->predicate record-tag-metatag))
    (set! %make-record-tag
-	 (metatag-constructor record-tag-metatag 'make-record-type))
+	 (dispatch-metatag-constructor record-tag-metatag 'make-record-type))
    (let* ((field-names
 	   '#(dispatch-tag name field-names default-inits tag))
 	  (type
@@ -126,13 +126,13 @@ USA.
 
 (define (record-tag->type-descriptor tag)
   (guarantee record-tag? tag 'record-tag->type-descriptor)
-  (tag-extra tag 0))
+  (dispatch-tag-extra tag 0))
 
 (define (record-type? object)
   (%tagged-record? record-type-type-tag object))
 
 (define-integrable (%record-type-descriptor record)
-  (tag-extra (%record-tag record) 0))
+  (dispatch-tag-extra (%record-tag record) 0))
 
 (define-integrable (%record-type-dispatch-tag record-type)
   (%record-ref record-type 1))
@@ -147,7 +147,7 @@ USA.
   (%record-ref record-type 4))
 
 (define-integrable (%record-type-predicate record-type)
-  (tag->predicate (%record-type-dispatch-tag record-type)))
+  (dispatch-tag->predicate (%record-type-dispatch-tag record-type)))
 
 (define-integrable (%record-type-n-fields record-type)
   (vector-length (%record-type-field-names record-type)))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index af01c32df..1be5fcac8 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1842,7 +1842,7 @@ USA.
   (files "predicate-metadata")
   (parent (runtime))
   (export ()
-	  predicate->tag
+	  predicate->dispatch-tag
 	  predicate-name))
 
 (define-package (runtime predicate-lattice)
@@ -1850,19 +1850,19 @@ USA.
   (parent (runtime))
   (export ()
 	  any-object?
+	  bottom-dispatch-tag
+	  dispatch-tag-is-bottom?
+	  dispatch-tag-is-top?
+	  dispatch-tag<=
+	  dispatch-tag=
+	  dispatch-tag>=
+	  no-object?
 	  predicate<=
 	  predicate>=
-	  no-object?
-	  set-predicate<=!)
+	  set-predicate<=!
+	  top-dispatch-tag)
   (export (runtime)
-	  bottom-tag
-	  define-tag<=
-	  tag-is-bottom?
-	  tag-is-top?
-	  tag<=
-	  tag=
-	  tag>=
-	  top-tag))
+	  define-dispatch-tag<=))
 
 (define-package (runtime compound-predicate)
   (files "compound-predicate")
@@ -1903,12 +1903,11 @@ USA.
   (files "predicate-tagging")
   (parent (runtime))
   (export ()
+	  dispatch-tag-tagger
 	  object->datum
+	  object->dispatch-tag
 	  object->predicate
-	  predicate-tagger)
-  (export (runtime)
-	  object->tag
-	  tag-tagger))
+	  predicate-tagger))
 
 (define-package (runtime predicate-dispatch)
   (files "predicate-dispatch")
@@ -5101,19 +5100,18 @@ USA.
   (files "gentag" "gencache")
   (parent (runtime))
   (export ()
-	  make-metatag
-	  metatag-constructor
-	  metatag?)
-  (export (runtime)
-	  set-tag<=!
-	  tag->predicate
-	  tag-extra
-	  tag-metatag
-	  tag-name
-	  tag?)
+	  dispatch-metatag-constructor
+	  dispatch-metatag?
+	  dispatch-tag->predicate
+	  dispatch-tag-extra
+	  dispatch-tag-metatag
+	  dispatch-tag-name
+	  dispatch-tag?
+	  make-dispatch-metatag
+	  set-dispatch-tag<=!)
   (export (runtime predicate-lattice)
-	  add-tag-superset
-	  any-tag-superset)
+	  add-dispatch-tag-superset
+	  any-dispatch-tag-superset)
   (export (runtime predicate-metadata)
 	  set-predicate-tag!))
 
diff --git a/src/runtime/unpars.scm b/src/runtime/unpars.scm
index 3e429782b..a9d0cdd7a 100644
--- a/src/runtime/unpars.scm
+++ b/src/runtime/unpars.scm
@@ -891,8 +891,8 @@ USA.
   (*unparse-with-brackets 'tagged-object object context
     (lambda (context*)
       (*unparse-object (let ((tag (%tagged-object-tag object)))
-			 (if (tag? tag)
-			     (tag-name tag)
+			 (if (dispatch-tag? tag)
+			     (dispatch-tag-name tag)
 			     tag))
 		       context*)
       (*unparse-string " " context*)
diff --git a/src/sos/class.scm b/src/sos/class.scm
index f4af37585..d734af1cd 100644
--- a/src/sos/class.scm
+++ b/src/sos/class.scm
@@ -74,13 +74,13 @@ USA.
     class))
 
 (define class-metatag
-  (make-metatag 'class-tag))
+  (make-dispatch-metatag 'class-tag))
 
 (define class-tag?
-  (tag->predicate class-metatag))
+  (dispatch-tag->predicate class-metatag))
 
 (define make-class-tag
-  (metatag-constructor class-metatag 'make-class))
+  (dispatch-metatag-constructor class-metatag 'make-class))
 
 (define (make-trivial-subclass superclass . superclasses)
   (make-class (class-name superclass) (cons superclass superclasses) '()))
@@ -338,7 +338,7 @@ USA.
 (define-primitive-class <entity> <procedure>)
 
 (define (object-class object)
-  (dispatch-tag->class (object->tag object)))
+  (dispatch-tag->class (object->dispatch-tag object)))
 
 (define (record-type-class type)
   (dispatch-tag->class (record-type-dispatch-tag type)))
@@ -347,7 +347,7 @@ USA.
   (record-type-class (record-type-descriptor record)))
 
 (define (dispatch-tag->class tag)
-  (cond ((class-tag? tag) (tag-extra tag 0))
+  (cond ((class-tag? tag) (dispatch-tag-extra tag 0))
 	((hash-table/get built-in-class-table tag #f))
 	((record-tag? tag)
 	 (let ((class
@@ -383,7 +383,7 @@ USA.
 (let ((assign-type
        (lambda (predicate class)
 	 (hash-table/put! built-in-class-table
-			  (predicate->tag predicate)
+			  (predicate->dispatch-tag predicate)
 			  class))))
   (assign-type boolean? <boolean>)
   (assign-type char? <char>)
diff --git a/src/sos/generic.scm b/src/sos/generic.scm
index 60099c149..2d0a10faa 100644
--- a/src/sos/generic.scm
+++ b/src/sos/generic.scm
@@ -37,13 +37,13 @@ USA.
 	(generator (if (default-object? generator) #f generator)))
     (if (and name (not (symbol? name)))
 	(error:wrong-type-argument name "symbol" 'MAKE-GENERIC-PROCEDURE))
-    (if tag (guarantee tag? tag 'MAKE-GENERIC-PROCEDURE))
+    (if tag (guarantee dispatch-tag? tag 'MAKE-GENERIC-PROCEDURE))
     (guarantee procedure-arity? arity 'MAKE-GENERIC-PROCEDURE)
     (if (not (fix:> (procedure-arity-min arity) 0))
 	(error:bad-range-argument arity 'MAKE-GENERIC-PROCEDURE))
     (guarantee-generator generator 'MAKE-GENERIC-PROCEDURE)
     (let ((record
-	   (make-generic-record (predicate->tag generic-procedure?)
+	   (make-generic-record (predicate->dispatch-tag generic-procedure?)
 				(procedure-arity-min arity)
 				(procedure-arity-max arity)
 				generator
@@ -197,7 +197,7 @@ USA.
 			  (wna args))
 		      (loop (cdr args*)
 			    (fix:- n 1)
-			    (cons (object->tag (car args*)) tags)))))))
+			    (cons (object->dispatch-tag (car args*)) tags)))))))
 	   (wna
 	    (lambda (args)
 	      (error:wrong-number-of-arguments generic
@@ -209,7 +209,7 @@ USA.
   (let ((record
 	 (guarantee-generic-procedure procedure
 				      'GENERIC-PROCEDURE-APPLICABLE?))
-	(tags (map object->tag arguments)))
+	(tags (map object->dispatch-tag arguments)))
     (let ((generator (generic-record/generator record))
 	  (arity-min (generic-record/arity-min record))
 	  (arity-max (generic-record/arity-max record))
@@ -226,7 +226,7 @@ USA.
   (lambda (a1)
     (let ((procedure
 	   (probe-cache-1 (generic-record/cache record)
-			  (object->tag a1))))
+			  (object->dispatch-tag a1))))
       (if procedure
 	  (procedure a1)
 	  (compute-method-and-store record (list a1))))))
@@ -235,8 +235,8 @@ USA.
   (lambda (a1 a2)
     (let ((procedure
 	   (probe-cache-2 (generic-record/cache record)
-			  (object->tag a1)
-			  (object->tag a2))))
+			  (object->dispatch-tag a1)
+			  (object->dispatch-tag a2))))
       (if procedure
 	  (procedure a1 a2)
 	  (compute-method-and-store record (list a1 a2))))))
@@ -245,9 +245,9 @@ USA.
   (lambda (a1 a2 a3)
     (let ((procedure
 	   (probe-cache-3 (generic-record/cache record)
-			  (object->tag a1)
-			  (object->tag a2)
-			  (object->tag a3))))
+			  (object->dispatch-tag a1)
+			  (object->dispatch-tag a2)
+			  (object->dispatch-tag a3))))
       (if procedure
 	  (procedure a1 a2 a3)
 	  (compute-method-and-store record (list a1 a2 a3))))))
@@ -256,10 +256,10 @@ USA.
   (lambda (a1 a2 a3 a4)
     (let ((procedure
 	   (probe-cache-4 (generic-record/cache record)
-			  (object->tag a1)
-			  (object->tag a2)
-			  (object->tag a3)
-			  (object->tag a4))))
+			  (object->dispatch-tag a1)
+			  (object->dispatch-tag a2)
+			  (object->dispatch-tag a3)
+			  (object->dispatch-tag a4))))
       (if procedure
 	  (procedure a1 a2 a3 a4)
 	  (compute-method-and-store record (list a1 a2 a3 a4))))))
@@ -271,7 +271,7 @@ USA.
 		(p p (cdr p))
 		(i (generic-record/arity-min record) (fix:- i 1)))
 	       ((not (fix:> i 0)))
-	     (set-cdr! p (list (object->tag (car args)))))
+	     (set-cdr! p (list (object->dispatch-tag (car args)))))
 	   (cdr p))))
     (let ((procedure
 	   (let ((generator (generic-record/generator record))
diff --git a/src/sos/tvector.scm b/src/sos/tvector.scm
index e66cdd100..2b38f5be4 100644
--- a/src/sos/tvector.scm
+++ b/src/sos/tvector.scm
@@ -33,17 +33,17 @@ USA.
 ;;; calls to construct and access tagged vectors.
 
 (define (make-tagged-vector tag length)
-  (guarantee tag? tag 'MAKE-TAGGED-VECTOR)
+  (guarantee dispatch-tag? tag 'MAKE-TAGGED-VECTOR)
   (guarantee-index-integer length 'MAKE-TAGGED-VECTOR)
   (%make-record tag (fix:+ length 1) record-slot-uninitialized))
 
 (define (tagged-vector tag . elements)
-  (guarantee tag? tag 'MAKE-TAGGED-VECTOR)
+  (guarantee dispatch-tag? tag 'MAKE-TAGGED-VECTOR)
   (apply %record tag elements))
 
 (define (tagged-vector? object)
   (and (%record? object)
-       (tag? (%record-ref object 0))))
+       (dispatch-tag? (%record-ref object 0))))
 
 (define (tagged-vector-tag vector)
   (guarantee-tagged-vector vector 'TAGGED-VECTOR-TAG)
@@ -51,7 +51,7 @@ USA.
 
 (define (set-tagged-vector-tag! vector tag)
   (guarantee-tagged-vector vector 'SET-TAGGED-VECTOR-TAG!)
-  (guarantee tag? tag 'SET-TAGGED-VECTOR-TAG!)
+  (guarantee dispatch-tag? tag 'SET-TAGGED-VECTOR-TAG!)
   (%record-set! vector 0 tag))
 
 (define (tagged-vector-length vector)
diff --git a/tests/Clean.sh b/tests/Clean.sh
index 3d290a22d..6d483fd1a 100755
--- a/tests/Clean.sh
+++ b/tests/Clean.sh
@@ -10,6 +10,6 @@ COMMAND=${1}
 
 TOPDIR=../src ../src/etc/Clean.sh ${COMMAND}
 
-for SUBDIR in ffi microcode runtime star-parser xml; do
+for SUBDIR in ffi microcode runtime sos star-parser xml; do
     ( cd $SUBDIR; TOPDIR=../../src ../../src/etc/Clean.sh ${COMMAND} )
 done
diff --git a/tests/runtime/test-parametric-predicate.scm b/tests/runtime/test-parametric-predicate.scm
index 873dce8c0..092d056ad 100644
--- a/tests/runtime/test-parametric-predicate.scm
+++ b/tests/runtime/test-parametric-predicate.scm
@@ -238,11 +238,11 @@ USA.
 
 (define (test-predicate-operations predicate name)
   (assert-true (predicate? predicate))
-  (let ((tag (predicate->tag predicate)))
-    (assert-true (tag? tag))
-    (assert-eqv (tag->predicate tag) predicate)
+  (let ((tag (predicate->dispatch-tag predicate)))
+    (assert-true (dispatch-tag? tag))
+    (assert-eqv (dispatch-tag->predicate tag) predicate)
     (assert-equal (predicate-name predicate) name)
-    (assert-equal (tag-name tag) name)))
+    (assert-equal (dispatch-tag-name tag) name)))
 
 (define (test-parametric-predicate-operations predicate template parameters)
   (assert-true (parametric-predicate? predicate))
diff --git a/tests/runtime/test-predicate-metadata.scm b/tests/runtime/test-predicate-metadata.scm
index 8754007f4..f4b8ef4be 100644
--- a/tests/runtime/test-predicate-metadata.scm
+++ b/tests/runtime/test-predicate-metadata.scm
@@ -32,7 +32,7 @@ USA.
   (lambda ()
     (let ((np (lambda (object) object #f)))
       (assert-false (predicate? np))
-      (assert-type-error (lambda () (predicate->tag np)))
+      (assert-type-error (lambda () (predicate->dispatch-tag np)))
       (assert-type-error (lambda () (predicate-name np))))))
 
 (define-test 'simple-predicate
@@ -43,11 +43,11 @@ USA.
 
 (define (test-predicate-operations predicate name)
   (assert-true (predicate? predicate))
-  (let ((tag (predicate->tag predicate)))
-    (assert-true (tag? tag))
-    (assert-eqv (tag->predicate tag) predicate)
+  (let ((tag (predicate->dispatch-tag predicate)))
+    (assert-true (dispatch-tag? tag))
+    (assert-eqv (dispatch-tag->predicate tag) predicate)
     (assert-equal (predicate-name predicate) name)
-    (assert-equal (tag-name tag) name)))
+    (assert-equal (dispatch-tag-name tag) name)))
 
 (define-test 'simple-predicate-tagging
   (lambda ()
diff --git a/tests/sos/test-genmult.scm b/tests/sos/test-genmult.scm
index 2e3d7f229..8cc823da7 100644
--- a/tests/sos/test-genmult.scm
+++ b/tests/sos/test-genmult.scm
@@ -41,14 +41,14 @@ USA.
     ;; Add some named generators (for easier removal).
     (define (bool-generator p tags)
       p                                 ;ignore
-      (if (equal? tags (list (predicate->tag boolean?)))
+      (if (equal? tags (list (predicate->dispatch-tag boolean?)))
           (lambda (x) (cons 'boolean x))
           #f))
     (add-generic-procedure-generator generic bool-generator)
     (assert-equal (generic #t) '(boolean . #t))
     (define (fixnum-generator p tags)
       p                                 ;ignore
-      (if (equal? tags (list (predicate->tag fix:fixnum?)))
+      (if (equal? tags (list (predicate->dispatch-tag fix:fixnum?)))
           (lambda (x) (cons 'fixnum x))
           #f))
     (add-generic-procedure-generator generic fixnum-generator)
-- 
2.25.1