Tidy value representation.

3 files changed, 110 insertions, 85 deletions

diff --git a/src/include/vm.H b/src/include/vm.H
index 3528bf27..c66a2e02 100644
--- a/src/include/vm.H
+++ b/src/include/vm.H
@@ -43,6 +43,7 @@
 #include <utility>
 #include <map>
 #include <set>
+#include <type_traits>
 
 #define internal_type struct alignas(16)
 #define internal_data alignas(16)
@@ -145,6 +146,10 @@ namespace OpenAxiom {
       // Note: These choices do not fully satisfy constraint 4.  This is 
       //     because we restrict foreign pointers to address aligned
       //     to 8-byte boundaries.  A modest constraint.
+      //
+      // Special Constants:
+      //     NIL    0x00
+      //     T      0x10
 
 
       // -----------
@@ -153,11 +158,62 @@ namespace OpenAxiom {
       // All VM values fit in a universal value datatype.
       using ValueBits = uintptr_t;
       using ValueMask = ValueBits;
-      enum class Value : ValueBits { };
+      enum class Value : ValueBits {
+         nil = 0x00,            // distinguished NIL value
+         t   = 0x10,            // distinguished T value
+      };
+
+      template<typename>
+      struct ValueTrait {
+      };
+
+      // Return the tag of an abstract value, when viewed as a potential
+      // T-value.
+      template<typename T>
+      constexpr ValueBits tag(Value v) {
+         return ValueBits(v) & ValueTrait<T>::tag_mask;
+      }
+
+      // Return true if the abstract value is, in fact, a T-value.
+      template<typename T>
+      constexpr bool is(Value v) {
+         return tag<T>(v) == ValueTrait<T>::tag;
+      }
+
+      // Return the pristine bits of an abstract value without its tag.
+      template<typename T>
+      constexpr ValueBits native(Value v) {
+         return ValueBits(v) & ~ValueTrait<T>::tag_mask;
+      }
+
+      // -------------
+      // -- Dynamic --
+      // -------------
+      // Any internal value is of a class derived from this.
+      internal_type Dynamic {
+         virtual ~Dynamic();
+      };
+
+      template<>
+      struct ValueTrait<Dynamic> {
+         enum Tag : ValueBits { tag = 0x6 };
+         enum Mask : ValueBits { tag_mask = 0xF };
+      };
 
-      // The distinguished `nil' value.
-      constexpr Value nil { };
+      inline Dynamic* to_dynamic(Value v) {
+         return reinterpret_cast<Dynamic*>(native<Dynamic>(v));
+      }
 
+      inline Dynamic* to_dynamic_if_can(Value v) {
+         return is<Dynamic>(v) ? to_dynamic(v) : nullptr;
+      }
+
+      inline Value from_dynamic(const Dynamic* o) {
+         return Value(ValueBits(o) | ValueTrait<Dynamic>::tag);
+      }
+
+      struct Scope;
+      
       // -------------
       // -- Fixnum ---
       // -------------
@@ -172,18 +228,18 @@ namespace OpenAxiom {
          maximum = FixnumBits(~ValueBits() >> 2),
       };
 
-      constexpr ValueBits fix_tag = 0x1;
-
-      constexpr bool is_fixnum(Value v) {
-         return (ValueBits(v) & 0x1) == fix_tag;
-      }
+      template<>
+      struct ValueTrait<Fixnum> {
+         enum Tag : ValueBits { tag = 0x1  };
+         enum Mask : ValueBits { tag_mask = 0x1 };
+      };
 
       constexpr Fixnum to_fixnum(Value v) {
          return Fixnum(FixnumBits(v) >> 1);
       }
 
       constexpr Value from_fixnum(Fixnum i) {
-         return Value((ValueBits(i) << 1 ) | fix_tag);
+         return Value((ValueBits(i) << 1 ) | ValueTrait<Fixnum>::tag);
       }
 
       // ------------
@@ -191,23 +247,22 @@ namespace OpenAxiom {
       // ------------
       using String = InternedString;
 
-      constexpr ValueBits str_tag = 0x4;
-
-      constexpr bool is_string(Value v) {
-         return (ValueBits(v) & 0x7) == str_tag;
-      }
+      template<>
+      struct ValueTrait<String> {
+         enum Tag : ValueBits { tag = 0x4 };
+         enum Mask : ValueBits { tag_mask = 0x7 };
+      };
 
       inline InternedString to_string(Value v) {
-         return reinterpret_cast<InternedString>
-            (ValueBits(v) & ~ValueBits(0x7));
+         return reinterpret_cast<String>(native<String>(v));
       }
 
       inline Value from_string(InternedString s) {
-         return Value(ValueBits(s) | str_tag);
+         return Value(ValueBits(s) | ValueTrait<String>::tag);
       }
 
       inline InternedString to_string_if_can(Value v) {
-         return is_string(v) ? to_string(v) : nullptr;
+         return is<String>(v) ? to_string(v) : nullptr;
       }
 
       // -------------
@@ -216,48 +271,48 @@ namespace OpenAxiom {
       // Allocated objects are represented by their addresses.
       using Memory::Pointer;
 
-      constexpr ValueBits ptr_tag = 0x0;
-
-      constexpr bool is_pointer(Value v) {
-         return (ValueBits(v) & 0x7) == ptr_tag;
-      }
+      template<>
+      struct ValueTrait<Memory::Pointer> {
+         enum Tag : ValueBits { tag = 0x0 };
+         enum Mask : ValueBits { tag_mask = 0x7 };
+      };
 
       inline Pointer to_pointer(Value v) {
          return Pointer(ValueBits(v));
       }
 
       inline Value from_pointer(Pointer p) {
-         return Value(ValueBits(p) | ptr_tag);
+         return Value(ValueBits(p) | ValueTrait<Memory::Pointer>::tag);
       }
 
       // ----------
       // -- Pair --
       // ----------
-      struct ConsCell {
+      struct alignas(8) ConsCell {
          Value head;
          Value tail;
       };
 
       using Pair = ConsCell*;
 
-      constexpr ValueBits pair_tag = 0x2;
-
-      constexpr bool is_pair(Value v) {
-         return (ValueBits(v) & 0x7) == pair_tag;
-      }
+      template<>
+      struct ValueTrait<Pair> {
+         enum Tag : ValueBits { tag = 0x2 };
+         enum Mask : ValueBits { tag_mask = 0x7 };
+      };
 
       inline Pair to_pair(Value v) {
-         return Pair(ValueBits(v) & ~0x7);
+         return reinterpret_cast<Pair>(native<Pair>(v));
       }
 
       inline Value from_pair(Pair p) {
-         return Value(ValueBits(p) | pair_tag);
+         return Value(ValueBits(p) | ValueTrait<Pair>::tag);
       }
 
       // If `v' designates a pair, return a pointer to its
       // concrete representation.
       inline Pair to_pair_if_can(Value v) {
-         return is_pair(v) ? to_pair(v) : nullptr;
+         return is<Pair>(v) ? to_pair(v) : nullptr;
       }
 
       Fixnum count_nodes(Pair);
@@ -274,18 +329,18 @@ namespace OpenAxiom {
       // we do not handle UCN characters at the moment.
       enum class Character : ValueBits { };
 
-      constexpr ValueBits char_tag = 0xE;
-
-      constexpr bool is_character(Value v) {
-         return (ValueBits(v) & 0xF) == char_tag;
-      }
+      template<>
+      struct ValueTrait<Character> {
+         enum Tag : ValueBits { tag = 0xE };
+         enum Mask : ValueBits { tag_mask = 0xF };
+      };
 
       constexpr Character to_character(Value v) {
          return Character(ValueBits(v) >> 4);
       }
 
       constexpr Value from_character(Character c) {
-         return Value((ValueBits(c) << 4) | char_tag);
+         return Value((ValueBits(c) << 4) | ValueTrait<Character>::tag);
       }
 
       // -- Object --
@@ -296,36 +351,6 @@ namespace OpenAxiom {
          const Type* type;
       };
 
-      // -------------
-      // -- Dynamic --
-      // -------------
-      // Any internal value is of a class derived from this.
-      internal_type Dynamic {
-         virtual ~Dynamic();
-      };
-
-      constexpr ValueBits dyn_tag = 0x6;
-
-      constexpr bool is_dynamic(Value v) {
-         return (ValueBits(v) & 0xF) == dyn_tag;
-      }
-
-      inline Dynamic* to_dynamic(Value v) {
-         return reinterpret_cast<Dynamic*>(ValueBits(v) & ~0xF);
-      }
-
-      inline Dynamic* to_dynamic_if_can(Value v) {
-         return is_dynamic(v)
-            ? reinterpret_cast<Dynamic*>(ValueBits(v) & ~0xF)
-            : nullptr;
-      }
-
-      inline Value from_dynamic(const Dynamic* o) {
-         return Value(ValueBits(o) | dyn_tag);
-      }
-
-      struct Scope;
-      
       // ------------
       // -- Symbol --
       // ------------
@@ -365,7 +390,7 @@ namespace OpenAxiom {
       struct FunctionBase : Dynamic {
          const Symbol name;
          Value type;
-         FunctionBase(Symbol n, Value t = nil)
+         FunctionBase(Symbol n, Value t = Value::nil)
                : name(n), type(t) { }
       };
 
diff --git a/src/rt/Database.cc b/src/rt/Database.cc
index 81d6f83a..3fc50039 100644
--- a/src/rt/Database.cc
+++ b/src/rt/Database.cc
@@ -53,10 +53,10 @@ namespace OpenAxiom {
          }
          else {
             auto data = Lisp::assoc(key, toc);
-            if (data != nil)
+            if (data != Value::nil)
                return dict.insert({ key, data }).first->second;
          }
-         return nil;
+         return Value::nil;
       }
    }
 }
diff --git a/src/rt/Lisp.cc b/src/rt/Lisp.cc
index 6f125bf7..f87db63c 100644
--- a/src/rt/Lisp.cc
+++ b/src/rt/Lisp.cc
@@ -54,14 +54,14 @@ namespace OpenAxiom {
 
       Fixnum
       retract_to_fixnum(Value v) {
-         if (not is_fixnum(v))
+         if (not is<Fixnum>(v))
             throw Diagnostics::BasicError(show(v) + " is not a fixnum");
          return to_fixnum(v);
       }
 
       Pair
       retract_to_pair(Value v) {
-         if (not is_pair(v))
+         if (not is<Pair>(v))
             throw Diagnostics::BasicError(show(v) + " is not a pair");
          return to_pair(v);
       }
@@ -113,8 +113,8 @@ namespace OpenAxiom {
       static Value
       construct(Evaluator* ctx, const Sexpr::ListSyntax& x) {
          if (x.empty())
-            return nil;
-         auto result = nil;
+            return Value::nil;
+         auto result = Value::nil;
          auto p = x.rbegin();
          if (x.dotted())
             result = ctx->make_value(*p++);
@@ -150,7 +150,7 @@ namespace OpenAxiom {
          struct V : Sexpr::Syntax::Visitor {
             Evaluator* ctx;
             Value result;
-            V(Evaluator* e) : ctx(e), result(nil) { }
+            V(Evaluator* e) : ctx(e), result(Value::nil) { }
             void visit(const IntegerSyntax& x) { result = construct(ctx, x); }
             void visit(const CharacterSyntax& x) { unimplemented(x); }
             void visit(const StringSyntax& x) { result = construct(ctx, x); }
@@ -165,7 +165,7 @@ namespace OpenAxiom {
             }
             void visit(const AnchorSyntax& x) {
                auto& v = ctx->anchor_map[x.ref()];
-               if (v != nil)
+               if (v != Value::nil)
                   throw Diagnostics::BasicError{
                      "duplicate anchor " + std::to_string(x.ref())
                         };
@@ -184,7 +184,7 @@ namespace OpenAxiom {
          };
 
          if (x == nullptr)
-            return nil;
+            return Value::nil;
          V v { this };
          x->accept(v);
          return v.result;
@@ -216,7 +216,7 @@ namespace OpenAxiom {
          while (true) {
             format(p->head, os);
             auto v = p->tail;
-            if (v == nil)
+            if (v == Value::nil)
                break;
             os << ' ';
             if (auto q = to_pair_if_can(v)) {
@@ -247,9 +247,9 @@ namespace OpenAxiom {
       }
       
       void format(Value v, std::ostream& os) {
-         if (v == nil)
+         if (v == Value::nil)
             os << "NIL";
-         else if (is_fixnum(v))
+         else if (is<Fixnum>(v))
             os << FixnumBits(to_fixnum(v));
          else if (auto p = to_pair_if_can(v))
             format(p, os);
@@ -267,11 +267,11 @@ namespace OpenAxiom {
             auto entry = retract_to_pair(al->head);
             if (entry->head == key)
                return entry->tail;
-            else if (al->tail == nil)
-               return nil;
+            else if (al->tail == Value::nil)
+               return Value::nil;
             al = retract_to_pair(al->tail);
          }
-         return nil;
+         return Value::nil;
       }
    }
 }