Add small Lisp evaluator for the benefit of new GUI.

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() {
+      }
    }
 }