aboutsummaryrefslogtreecommitdiff
path: root/src/utils
diff options
context:
space:
mode:
Diffstat (limited to 'src/utils')
-rw-r--r--src/utils/Lisp.cc264
-rw-r--r--src/utils/Makefile.in8
-rw-r--r--src/utils/hash-table.H5
-rw-r--r--src/utils/string-pool.H2
-rw-r--r--src/utils/vm.H372
-rw-r--r--src/utils/vm.cc49
6 files changed, 317 insertions, 383 deletions
diff --git a/src/utils/Lisp.cc b/src/utils/Lisp.cc
new file mode 100644
index 00000000..c4533ab9
--- /dev/null
+++ b/src/utils/Lisp.cc
@@ -0,0 +1,264 @@
+// Copyright (C) 2013, Gabriel Dos Reis.
+// All rights reserved.
+// Written by Gabriel Dos Reis.
+//
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions are
+// met:
+//
+// - Redistributions of source code must retain the above copyright
+// notice, this list of conditions and the following disclaimer.
+//
+// - Redistributions in binary form must reproduce the above copyright
+// notice, this list of conditions and the following disclaimer in
+// the documentation and/or other materials provided with the
+// distribution.
+//
+// - Neither the name of OpenAxiom nor the names of its contributors
+// may be used to endorse or promote products derived from this
+// software without specific prior written permission.
+//
+// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+// IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+// TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+// PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+// OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+// EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+// PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+// PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+// LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+// NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+// SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+#include <open-axiom/Lisp>
+#include <typeinfo>
+#include <ostream>
+#include <sstream>
+
+namespace OpenAxiom {
+ namespace Lisp {
+ Unimplemented::Unimplemented(const std::string& s)
+ : BasicError(s)
+ { }
+
+ IntegerOverflow::IntegerOverflow(const std::string& s)
+ : BasicError(s)
+ { }
+
+ std::string
+ show(Value v) {
+ std::ostringstream os;
+ format(v, os);
+ return os.str();
+ }
+
+ Fixnum
+ retract_to_fixnum(Value 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))
+ throw Diagnostics::BasicError(show(v) + " is not a pair");
+ return to_pair(v);
+ }
+
+
+ static void
+ unimplemented(const Sexpr::Syntax& x) {
+ std::string s = "unimplemented eval for ";
+ throw Unimplemented{ s + typeid(x).name() };
+ }
+
+ static void
+ integer_too_large(const Sexpr::IntegerSyntax& x) {
+ std::string s { x.lexeme().begin(), x.lexeme().end() };
+ throw IntegerOverflow{ s + " is too large for Fixnum; max value is "
+ + std::to_string(fixnum_maximum) };
+ }
+
+ constexpr auto fixmax_by_ten = fixnum_maximum / 10;
+ constexpr auto fixmax_lsd = fixnum_maximum % 10;
+
+ static Value
+ construct(Evaluator* ctx, const Sexpr::IntegerSyntax& x) {
+ bool neg = false;
+ auto cur = x.lexeme().begin();
+ Fixnum val = 0;
+ switch (*cur) {
+ case '-': neg = true;
+ case '+': ++cur;
+ default:
+ for (; cur < x.lexeme().end(); ++cur) {
+ auto d = *cur - '0';
+ if (val < fixmax_by_ten)
+ val = 10 * val + d;
+ else if (val > fixmax_by_ten or d > fixmax_lsd)
+ integer_too_large(x);
+ else
+ val = 10 * val + d;
+ }
+ if (neg) {
+ if (val > fixnum_maximum)
+ integer_too_large(x);
+ val = -val;
+ }
+ }
+ return VM::from_fixnum(val);
+ }
+
+ static Value
+ construct(Evaluator* ctx, const Sexpr::ListSyntax& x) {
+ if (x.empty())
+ return nil;
+ auto result = nil;
+ auto p = x.rbegin();
+ if (x.dotted())
+ result = ctx->make_value(*p++);
+ while (p != x.rend())
+ result = from_pair(ctx->make_pair(ctx->make_value(*p++), result));
+ return result;
+ }
+
+ static Value
+ construct(Evaluator* ctx, const Sexpr::StringSyntax& x) {
+ auto s = ctx->intern(x.lexeme().begin(), x.lexeme().size());
+ return from_string(s);
+ }
+
+ static Value
+ construct(Evaluator* ctx, const Sexpr::SymbolSyntax& x) {
+ auto s = ctx->intern(x.lexeme().begin(), x.lexeme().size());
+ switch (x.kind()) {
+ case Sexpr::SymbolSyntax::uninterned:
+ return from_symbol(ctx->make_symbol(s, nullptr));
+
+ case Sexpr::SymbolSyntax::keyword:
+ return from_symbol(ctx->make_symbol(s, ctx->keyword_namespace()));
+
+ default:
+ return from_symbol(ctx->make_symbol(s, ctx->active_namespace()));
+ }
+ }
+
+ VM::Value
+ Evaluator::make_value(const Sexpr::Syntax* x) {
+ using namespace Sexpr;
+ struct V : Sexpr::Syntax::Visitor {
+ Evaluator* ctx;
+ Value result;
+ V(Evaluator* e) : ctx(e), result(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); }
+ void visit(const SymbolSyntax& x) { result = construct(ctx, x); }
+ void visit(const ReferenceSyntax& x) {
+ auto p = ctx->anchor_map.find(x.tag());
+ if (p == ctx->anchor_map.end())
+ throw Diagnostics::BasicError{ "undefined anchor "
+ + std::to_string(x.tag())
+ };
+ result = p->second;
+ }
+ void visit(const AnchorSyntax& x) {
+ auto& v = ctx->anchor_map[x.ref()];
+ if (v != nil)
+ throw Diagnostics::BasicError{
+ "duplicate anchor " + std::to_string(x.ref())
+ };
+ result = v = ctx->make_value(x.value());
+ }
+ void visit(const QuoteSyntax& x) { unimplemented(x); }
+ void visit(const AntiquoteSyntax& x) { unimplemented(x); }
+ void visit(const Expand& x) { unimplemented(x); }
+ void visit(const Eval& x) { unimplemented(x); }
+ void visit(const Splice& x) { unimplemented(x); }
+ void visit(const Function& x) { unimplemented(x); }
+ void visit(const Include& x) { unimplemented(x); }
+ void visit(const Exclude& x) { unimplemented(x); }
+ void visit(const ListSyntax& x) { result = construct(ctx, x); }
+ void visit(const VectorSyntax& x) { unimplemented(x); }
+ };
+
+ if (x == nullptr)
+ return nil;
+ V v { this };
+ x->accept(v);
+ return v.result;
+ }
+
+ Value
+ Evaluator::toplevel_form(const Sexpr::Syntax* x) {
+ auto anchors = std::move(anchor_map);
+ anchor_map = AnchorTable{ };
+ auto v = make_value(x);
+ anchor_map = std::move(anchors);
+ return v;
+ }
+
+ Evaluator::Evaluator() : keys(intern("KEYWORD")), ns() {
+ env_stack.push_back(Environment{ });
+ }
+
+ Environment*
+ Evaluator::global_environment() {
+ return &env_stack.front();
+ }
+
+
+ // -- Formatting
+
+ static void format(Pair p, std::ostream& os) {
+ os << '(';
+ while (true) {
+ format(p->head, os);
+ auto v = p->tail;
+ if (v == nil)
+ break;
+ os << ' ';
+ if (auto q = to_pair_if_can(v)) {
+ p = q;
+ continue;
+ }
+ os << '.' << ' ';
+ format(v, os);
+ break;
+ }
+ os << ')';
+ }
+
+ static void format(String s, std::ostream& os) {
+ os << '"';
+ for (auto c : *s) {
+ if (c == '"')
+ os << '\\';
+ os << char(c);
+ }
+ os << '"';
+ }
+
+ static void format(const Symbol* s, std::ostream& os) {
+ // FIXME: Handle escapes.
+ auto n = s->name();
+ std::copy(n->begin(), n->end(), std::ostream_iterator<char>(os));
+ }
+
+ void format(Value v, std::ostream& os) {
+ if (v == nil)
+ os << "NIL";
+ else if (is_fixnum(v))
+ os << to_fixnum(v);
+ else if (auto p = to_pair_if_can(v))
+ format(p, os);
+ else if (auto s = to_string_if_can(v))
+ format(s, os);
+ else if (auto s = to_symbol_if_can(v))
+ format(s, os);
+ else
+ os << "<unprintable>";
+ }
+ }
+}
diff --git a/src/utils/Makefile.in b/src/utils/Makefile.in
index 0ac6b300..758c1ae9 100644
--- a/src/utils/Makefile.in
+++ b/src/utils/Makefile.in
@@ -1,4 +1,4 @@
-# Copyright (C) 2013, Gabriel Dos Reis.
+# Copyright (C) 2011-2013, Gabriel Dos Reis.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -36,14 +36,14 @@ hammer_SOURCES = hammer.cc
hammer_OBJECTS = $(hammer_SOURCES:.cc=.lo)
hammer_LDADD = -L. -lOpenAxiom
-libOpenAxiom_HEADERS = hash-table.H string-pool.H vm.H
+libOpenAxiom_HEADERS = hash-table.H string-pool.H
libOpenAxiom_SOURCES = \
storage.cc string-pool.cc command.cc \
- filesystem.cc vm.cc
+ filesystem.cc vm.cc Lisp.cc
libOpenAxiom_OBJECTS = $(libOpenAxiom_SOURCES:.cc=.lo)
-oa_public_headers = hash-table string-pool vm
+oa_public_headers = hash-table string-pool
## Where we store public header files
oa_target_headerdir = $(oa_target_includedir)/open-axiom
diff --git a/src/utils/hash-table.H b/src/utils/hash-table.H
index f5a2c7d0..6d9da3d7 100644
--- a/src/utils/hash-table.H
+++ b/src/utils/hash-table.H
@@ -45,8 +45,11 @@ namespace OpenAxiom {
// --------------------
// Datatype for entries in a parameterized hash table.
// The type parameter is required to be a value-construcitble datatype.
+ // A table bucket entry is required to be at least 8-byte aligned
+ // so that an instance of it can be used directly as a VM value.
+ // See <open-axiom/vm> for more description.
template<typename T>
- struct HashTableEntry : T {
+ struct openaxiom_alignas(8) HashTableEntry : T {
HashTableEntry* chain; // previous item in the same bucket chain
size_t hash; // hash code of stored data
};
diff --git a/src/utils/string-pool.H b/src/utils/string-pool.H
index 5ed06fe3..2e40957b 100644
--- a/src/utils/string-pool.H
+++ b/src/utils/string-pool.H
@@ -1,4 +1,4 @@
-// Copyright (C) 2010-2011, Gabriel Dos Reis.
+// Copyright (C) 2010-2013, Gabriel Dos Reis.
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
diff --git a/src/utils/vm.H b/src/utils/vm.H
deleted file mode 100644
index 01000e9c..00000000
--- a/src/utils/vm.H
+++ /dev/null
@@ -1,372 +0,0 @@
-// Copyright (C) 2011-2012, Gabriel Dos Reis.
-// All rights reserved.
-//
-// Redistribution and use in source and binary forms, with or without
-// modification, are permitted provided that the following conditions are
-// met:
-//
-// - Redistributions of source code must retain the above copyright
-// notice, this list of conditions and the following disclaimer.
-//
-// - Redistributions in binary form must reproduce the above copyright
-// notice, this list of conditions and the following disclaimer in
-// the documentation and/or other materials provided with the
-// distribution.
-//
-// - Neither the name of OpenAxiom nor the names of its contributors
-// may be used to endorse or promote products derived from this
-// software without specific prior written permission.
-//
-// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-// IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-// TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-// PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-// OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-// EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-// PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-// PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-// LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-// NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-// SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-// --% Author: Gabriel Dos Reis
-// --% Description:
-// --% Interface and implementation of basic services of the
-// --% OpenAxiom Virtual Machine.
-
-#ifndef OPENAXIOM_VM_INCLUDED
-#define OPENAXIOM_VM_INCLUDED
-
-#include <open-axiom/storage>
-#if HAVE_STDINT_H
-# include <stdint.h>
-#endif
-#include <open-axiom/string-pool>
-#include <utility>
-#include <map>
-
-#define internal_type struct openaxiom_alignas(16)
-#define internal_data openaxiom_alignas(16)
-
-namespace OpenAxiom {
- namespace VM {
- // --%
- // --% Value representation
- // --%
- // A far reaching design decision is to provide a uniform
- // representation for values. That is all values, irrespective
- // of type have fit in a fixed format, i.e. a scalar register.
- // This means that values that are more complicated than a scalar,
- // that is the vast majority and most interesting values, have to
- // be stored in allocated objects and addresses of their container
- // objects used in place of the actual values. This is folklore
- // in the communities of garbage collected languages.
- //
- // An unfortunate but widely held belief is that AXIOM-based
- // systems (and computer algebra systems in general) are
- // Lisp-based systems. Nothing could be further from the truth
- // for OpenAxiom. The type system is believed to support
- // erasure semantics, at least for values.
- //
- // However the current implementation, being Lisp-based,
- // unwittingly makes use of some Lisp features that are not
- // strictly necessary. It would take a certain amount of effort
- // to get rid of them. Consequently, we must cope -- at least
- // for now -- with the notion of uniform value representation and
- // use runtime predicates to descriminate between values.
- // On the other hand, we do not want to carry an unduly expensive
- // abstraction penalty for perfectly well behaved and well
- // disciplined programs. So, here are a few constraints:
- // 1. Small integers should represent themselves -- not allocated.
- // Furthermore, the maximum range should be sought where possible.
- // 2. Since we have to deal with characters, they should be
- // directly represented -- not allocated.
- // 3. List values and list manipulation should be efficient.
- // Ideally, a pair should occupy no more than what it
- // takes to store two values in a type-erasure semantics.
- // 4. Idealy, pointers to foreign objects (at least) should be
- // left unmolested.
- //
- // * Assumptions:
- // (a) the host machine has sizeof(Value) quo 4 = 0.
- // (b) allocatd objects can be aligned on sizeof(Value) boundary.
- // (c) the host machine has 2's complement arithmetic.
- //
- // If:
- // -- we use a dedicated allocation pool for cons cells
- // -- we allocate the first cell in each cons-storage arena
- // on a 8-byte boundary
- // -- we use exactly 2 * sizeof(Value) to store a cons cell
- // therefore realizing constraint (3)
- // then:
- // every pointer to a cons cell will have its last 3 bits cleared.
- //
- // Therefore, we can use the last 3 bits to tag a cons value, instead
- // of storing the tag inside the cons cell. We can't leave those
- // bits cleared for we would not be able to easily and cheaply
- // distinguish a pointer to a cons cell from a pointer to other
- // objects, in particular foreign objects.
- //
- // To meet constraint (1), we must logically use at least one bit
- // to distinguish a small integer from a pointer to a cons cell.
- // The good news is that we need no more than that if pointers
- // to foreign pointers do not have the last bit set. Which is
- // the case with assumption (a). Furthermore, if we align all
- // other internal data on 16 byte boundary, then we have 4 spare bits
- // for use to categorize values.
- // Therefore we arrive at the first design:
- // I. the value representation of a small integer always has the
- // the least significant bit set. All other bits are
- // significant. In other words, the last four bits of a small
- // integer are 0bxxx1
- //
- // As a consequence, the last bit of all other values must be cleared.
- //
- // Next,
- // II. All foreign pointers must have the last two bits cleared.
- // As a consequence, the last four bits of all foreign addresses
- // follow the pattern 0bxx00.
- //
- // As a consequence, the second bit of a cons cell value must be set
- // so that we can distinguish it from foreign pointers.
- //
- // III. Cons cells are represented by their addresses with the
- // last 4 bits matching the pattern 0bx010.
- //
- // IV. All internal objects are allocated on 16-byte boundary.
- // Their last 4 bits are set to the pattern 0b0110.
- //
- // Finally:
- // V. The representation of a character shall have the last four
- // bits set to 0b1110.
- //
- // Note: These choices do not fully satisfy constraint 4. This is
- // because we restrict foreign pointers to address aligned
- // to 4-byte boundaries.
-
-
- // -----------
- // -- Value --
- // -----------
- // All VM values fit in a universal value datatype.
- typedef uintptr_t Value;
- const Value nil = Value();
-
- // -------------
- // -- Fixnum ---
- // -------------
- // VM integers are divided into classes: small numbers,
- // and large numbers. A small number fits entirely in a register.
- // A large number is allocated and represented by its address.
- typedef intptr_t Fixnum;
-
- const Value fix_tag = 0x1;
-
- inline bool is_fixnum(Value v) {
- return (v & 0x1) == fix_tag;
- }
-
- inline Fixnum to_fixnum(Value v) {
- return Fixnum(v >> 1);
- }
-
- inline Value from_fixnum(Fixnum i) {
- return (Fixnum(i) << 1 ) | fix_tag;
- }
-
- // -------------
- // -- Pointer --
- // -------------
- // Allocated objects are represented by their addresses.
- using Memory::Pointer;
-
- const Value ptr_tag = 0x0;
-
- inline bool is_pointer(Value v) {
- return (v & 0x3) == ptr_tag;
- }
-
- inline Pointer to_pointer(Value v) {
- return Pointer(v);
- }
-
- inline Value from_pointer(Pointer p) {
- return Value(p);
- }
-
- // ----------
- // -- Pair --
- // ----------
- struct ConsCell {
- Value head;
- Value tail;
- ConsCell(Value h, Value t) : head(h), tail(t) { }
- };
-
- typedef ConsCell* Pair;
-
- const Value pair_tag = 0x2;
-
- inline bool is_pair(Value v) {
- return (v & 0x7) == pair_tag;
- }
-
- inline Pair to_pair(Value v) {
- return Pair(v & ~0x7);
- }
-
- inline Value from_pair(Pair p) {
- return Value(p) | pair_tag;
- }
-
- // If `v' designates a pair, return a pointer to its
- // concrete representation.
- inline Pair pair_if_can(Value v) {
- return is_pair(v) ? to_pair(v) : 0;
- }
-
- // -- List<T> --
- // There is no dedicated list type. Any pair that ends with
- // nil is considered a list. Similarly, the notion of homogeneous
- // list is dynamic.
- template<typename T>
- struct List : ConsCell {
- List<T> rest() const {
- return static_cast<List<T>*>(pair_if_can(tail));
- }
- };
-
- // ---------------
- // -- Character --
- // ---------------
- // This datatype is prepared for Uncode characters even if
- // we do not handle UCN characters at the moment.
- typedef Value Character;
-
- const Value char_tag = 0xE;
-
- inline bool is_character(Value v) {
- return (v & 0xF) == char_tag;
- }
-
- inline Character to_character(Value v) {
- return Character(v >> 4);
- }
-
- inline Value from_character(Character c) {
- return (Value(c) << 4) | char_tag;
- }
-
- // ------------
- // -- Object --
- // ------------
- // Any internal object is of a class derived from this.
- internal_type BasicObject {
- Value kind;
- };
-
- typedef BasicObject* Object;
-
- const Value obj_tag = 0x6;
-
- inline bool is_object(Value v) {
- return (v & 0xF) == obj_tag;
- }
-
- inline Object to_object(Value v) {
- return Object(v & ~0xF);
- }
-
- inline Value from_object(Object* o) {
- return Value(o) | obj_tag;
- }
-
- // ------------
- // -- Symbol --
- // ------------
- struct SymbolObject : BasicObject, std::pair<BasicString, Value> {
- SymbolObject(BasicString n, Value s = nil)
- : std::pair<BasicString, Value>(n, s) { }
- BasicString name() const { return first; }
- Value scope() const { return second; }
- };
-
- typedef SymbolObject* Symbol;
-
- // -----------
- // -- Scope --
- // -----------
- struct ScopeObject : BasicObject, private std::map<Symbol, Value> {
- explicit ScopeObject(BasicString n) : id(n) { }
- BasicString name() const { return id; }
- Value* lookup(Symbol) const;
- Value* define(Symbol, Value);
- private:
- const BasicString id;
- };
-
- typedef ScopeObject* Scope;
-
- // --------------
- // -- Function --
- // --------------
- struct FunctionBase : BasicObject {
- const Symbol name;
- Value type;
- FunctionBase(Symbol n, Value t = nil)
- : name(n), type(t) { }
- };
-
- // ------------------------
- // -- Builtin Operations --
- // ------------------------
- // Types for native implementation of builtin operators.
- struct BasicContext;
- typedef Value (*NullaryCode)(BasicContext*);
- typedef Value (*UnaryCode)(BasicContext*, Value);
- typedef Value (*BinaryCode)(BasicContext*, Value, Value);
- typedef Value (*TernaryCode)(BasicContext*, Value, Value, Value);
-
- template<typename Code>
- struct BuiltinFunction : FunctionBase {
- Code code;
- BuiltinFunction(Symbol n, Code c) : FunctionBase(n), code(c) { }
- };
-
- typedef BuiltinFunction<NullaryCode> NullaryOperatorObject;
- typedef NullaryOperatorObject* NullaryOperator;
-
- typedef BuiltinFunction<UnaryCode> UnaryOperatorObject;
- typedef UnaryOperatorObject* UnaryOperator;
-
- typedef BuiltinFunction<BinaryCode> BinaryOperatorObject;
- typedef BinaryOperatorObject* BinaryOperator;
-
- typedef BuiltinFunction<TernaryCode> TernaryOperatorObject;
- typedef TernaryOperatorObject* TernaryOperator;
-
- // ------------------
- // -- BasicContext --
- // ------------------
- // Provides basic evaluation services.
- struct BasicContext : StringPool {
- BasicContext();
-
- Pair make_cons(Value, Value);
- NullaryOperator make_operator(Symbol, NullaryCode);
- UnaryOperator make_operator(Symbol, UnaryCode);
- BinaryOperator make_operator(Symbol, BinaryCode);
- TernaryOperator make_operator(Symbol, TernaryCode);
-
- protected:
- Memory::Factory<ConsCell> conses;
- Memory::Factory<NullaryOperatorObject> nullaries;
- Memory::Factory<UnaryOperatorObject> unaries;
- Memory::Factory<BinaryOperatorObject> binaries;
- Memory::Factory<TernaryOperatorObject> ternaries;
- };
- };
-}
-
-#endif // OPENAXIOM_VM_INCLUDED
-
diff --git a/src/utils/vm.cc b/src/utils/vm.cc
index ecb2a837..2fe4da1c 100644
--- a/src/utils/vm.cc
+++ b/src/utils/vm.cc
@@ -1,5 +1,6 @@
-// Copyright (C) 2011-2012, Gabriel Dos Reis.
+// Copyright (C) 2011-2013, Gabriel Dos Reis.
// All rights reserved.
+// Written by Gabriel Dos Reis.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions are
@@ -31,20 +32,58 @@
// --% Author: Gabriel Dos Reis
-#include "vm.H"
+#include <open-axiom/vm>
namespace OpenAxiom {
namespace VM {
+ Dynamic::~Dynamic() { }
+
+ Symbol::Symbol(String n, Scope* s)
+ : std::pair<String, Scope*>(n, s)
+ { }
+
+ Fixnum
+ count_nodes(Pair p) {
+ Fixnum n = 1;
+ for (; auto q = to_pair_if_can(p->tail); p = q)
+ ++n;
+ return n;
+ }
+
// -- BasicContext --
- Pair BasicContext::make_cons(Value h, Value t) {
+ Pair BasicContext::make_pair(Value h, Value t) {
return conses.make(h, t);
}
- NullaryOperator BasicContext::make_operator(Symbol n, NullaryCode c) {
- return nullaries.make(n,c);
+ const Symbol*
+ BasicContext::make_symbol(String n, Scope* s) {
+ return &*syms.insert({ n, s }).first;
+ }
+
+ const NullaryOperator*
+ BasicContext::make_operator(Symbol n, NullaryCode c) {
+ return nullaries.make(n, c);
+ }
+
+ const UnaryOperator*
+ BasicContext::make_operator(Symbol n, UnaryCode c) {
+ return unaries.make(n, c);
+ }
+
+ const BinaryOperator*
+ BasicContext::make_operator(Symbol n, BinaryCode c) {
+ return binaries.make(n, c);
+ }
+
+ const TernaryOperator*
+ BasicContext::make_operator(Symbol n, TernaryCode c) {
+ return ternaries.make(n, c);
}
BasicContext::BasicContext() {
}
+
+ BasicContext::~BasicContext() {
+ }
}
}