Refactor (system base types internal) to use more macros

* module/system/base/types/internal.scm (visit-immediate-tags)
  (visit-heap-tags): New helpers.
* module/system/base/types/internal.scm (define-tags, define-tag): New
  helpers.
  (immediate-tags, heap-tags): Use define-tags to define all of the tag
  values.  For consistency some names are changed:
  (%tc2-fixnum): Renamed from %tc2-inum.
  (%tc8-flag): Removed.
  (%tc16-null): Renamed from %tc16-eol.
  (%tc7-weak-vector): Renamed from %tc7-wvect.
  (%tc7-hash-table): Renamed from %tc7-hashtable.
  (%tc7-flonum): Renamed from %tc7-real.
  (visit-heap-tags, visit-immediate-tags): New exports.
* module/system/base/types.scm (cell->object): Adapt to renamings.
  (match-bit-pattern): Add a case to match immediate SCM bits
  literally.
  (scm->object): Adapt to use the special immediate values directly.
* module/system/vm/disassembler.scm (immediate-tag-annotations):
  (heap-tag-annotations): Adapt to new names.

1 files changed, 15 insertions, 14 deletions

diff --git a/module/system/base/types.scm b/module/system/base/types.scm
index e8f51ba9a..cc37acdc2 100644
--- a/module/system/base/types.scm
+++ b/module/system/base/types.scm
@@ -162,6 +162,10 @@ SIZE is omitted, return an unbounded port to the memory at ADDRESS."
                  (a (logand bits (bitwise-not n))))
              consequent)
            alternate)))
+    ((match-bit-pattern bits (= c) consequent alternate)
+     (if (= bits c)
+         consequent
+         alternate))
     ((match-bit-pattern bits (x & n = c) consequent alternate)
      (let ((tag (logand bits n)))
        (if (= tag c)
@@ -396,7 +400,7 @@ using BACKEND."
                           (bytevector->uint-list words (native-endianness)
                                                  %word-size)))
                vector)))
-          (((_ & #x7f = %tc7-wvect))
+          (((_ & #x7f = %tc7-weak-vector))
            (inferior-object 'weak-vector address))   ; TODO: show elements
           (((_ & #x7f = %tc7-fluid) init-value)
            (inferior-object 'fluid address))
@@ -408,14 +412,14 @@ using BACKEND."
            (inferior-object 'program address))
           (((_ & #xffff = %tc16-bignum))
            (inferior-object 'bignum address))
-          (((_ & #xffff = %tc16-real) pad)
+          (((_ & #xffff = %tc16-flonum) pad)
            (let* ((address (+ address (* 2 %word-size)))
                   (port    (memory-port backend address (sizeof double)))
                   (words   (get-bytevector-n port (sizeof double))))
              (bytevector-ieee-double-ref words 0 (native-endianness))))
           (((_ & #x7f = %tc7-number) mpi)
            (inferior-object 'number address))
-          (((_ & #x7f = %tc7-hashtable) buckets meta-data unused)
+          (((_ & #x7f = %tc7-hash-table) buckets meta-data unused)
            (inferior-object 'hash-table address))
           (((_ & #x7f = %tc7-pointer) address)
            (make-pointer address))
@@ -443,7 +447,7 @@ using BACKEND."
   "Return the Scheme object corresponding to BITS, the bits of an 'SCM'
 object."
   (match-scm bits
-    (((integer << 2) || %tc2-inum)
+    (((integer << 2) || %tc2-fixnum)
      integer)
     ((address & 7 = %tc3-heap-object)
      (let* ((type  (dereference-word backend address))
@@ -462,16 +466,13 @@ object."
            (cell->object address backend))))
     (((char << 8) || %tc8-char)
      (integer->char char))
-    (((flag << 8) || %tc8-flag)
-     (case flag
-       ((0)  #f)
-       ((1)  #nil)
-       ((3)  '())
-       ((4)  #t)
-       ((8)  (if #f #f))
-       ((9)  (inferior-object 'undefined bits))
-       ((10) (eof-object))
-       ((11) (inferior-object 'unbound bits))))))
+    ((= %tc16-false) #f)
+    ((= %tc16-nil) #nil)
+    ((= %tc16-null) '())
+    ((= %tc16-true) #t)
+    ((= %tc16-unspecified) (if #f #f))
+    ((= %tc16-undefined) (inferior-object 'undefined bits))
+    ((= %tc16-eof) (eof-object))))
 
 ;;; Local Variables:
 ;;; eval: (put 'match-scm 'scheme-indent-function 1)