aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/include/vm.H165
-rw-r--r--src/rt/Database.cc4
-rw-r--r--src/rt/Lisp.cc26
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;
}
}
}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-08 21:23:50 +0000