Add small Lisp evaluator for the benefit of new GUI.

15 files changed, 635 insertions, 172 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index be61bc0d..65e244b4 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,15 @@
 2013-06-27  Gabriel Dos Reis  <gdr@integrable-solutions.net>
 
+	* include/Lisp.H: New.
+	* utils/Lisp.cc: Likewise.
+	* gui/server.h (Server::lisp): Give access to embedded Lisp evaluator.
+	* gui/main-window.cc (MainWind::read_databases): Use embedded Lisp
+	evaluator.
+	* include/vm.H: Move from src/utils/.
+	* Makefile.am (oa_src_include_headers): Include vm.H.
+
+2013-06-27  Gabriel Dos Reis  <gdr@integrable-solutions.net>
+
 	* interp/lisplib.boot (compDefineLisplib): Close the file
 	contained generated code before handing over to backend.
 	* interp/c-util.boot (moveLibdirByCopy): The inferred destination
diff --git a/src/Makefile.am b/src/Makefile.am
index d4084173..5a35b8ac 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -57,8 +57,10 @@ oa_src_include_headers = \
 	Input.H    \
 	diagnostics.H \
 	dialect.H \
+	vm.H \
 	token.H \
-	sexpr.H
+	sexpr.H \
+	Lisp.H
 
 if OA_BUILD_SMAN
 OA_SMAN_TARGETS = all-sman all-clef
diff --git a/src/Makefile.in b/src/Makefile.in
index b8e9d18b..2825fc40 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -402,8 +402,10 @@ oa_src_include_headers = \
 	Input.H    \
 	diagnostics.H \
 	dialect.H \
+	vm.H \
 	token.H \
-	sexpr.H
+	sexpr.H \
+	Lisp.H
 
 @OA_BUILD_SMAN_TRUE@OA_SMAN_TARGETS = all-sman all-clef
 @OA_BUILD_GRAPHICS_TRUE@OA_GRAPHICS_GRAPH_TARGET = all-graph
diff --git a/src/gui/main-window.cc b/src/gui/main-window.cc
index 1ef6ec56..9c4969b0 100644
--- a/src/gui/main-window.cc
+++ b/src/gui/main-window.cc
@@ -54,8 +54,16 @@ namespace OpenAxiom {
          const auto& fs = server()->system_root();
          Memory::FileMapping db { fs.dbdir() + "/interp.daase" };
          Sexpr::Reader rd { db.begin(), db.end() };
-         while (rd.read())
-            ;
+         auto header = server()->lisp()->make_value(rd.read());
+         if (auto p = Lisp::to_pair_if_can(header)) {
+            auto offset = Lisp::retract_to_fixnum(p->head);
+            rd.position(offset);
+            auto table = server()->lisp()->toplevel_form(rd.read());
+         }
+         else {
+            QMessageBox::critical(this, tr("Malformed Database Header"),
+                                  QString(Lisp::show(header).c_str()));
+         }
       }
       catch(const Diagnostics::BasicError& e) {
          display_error(e.message());
diff --git a/src/gui/server.h b/src/gui/server.h
index acb691d7..b6a63dc5 100644
--- a/src/gui/server.h
+++ b/src/gui/server.h
@@ -35,6 +35,7 @@
 
 #include <QProcess>
 #include "open-axiom.h"
+#include <open-axiom/Lisp>
 
 namespace OpenAxiom {
    struct Server : QProcess {
@@ -42,6 +43,7 @@ namespace OpenAxiom {
       ~Server();
 
       const Filesystem& system_root() const { return fs; }
+      Lisp::Evaluator* lisp() { return &lsp; }
       
       void launch();
       void input(const QString&);
@@ -49,6 +51,7 @@ namespace OpenAxiom {
    private:
       Command cmd;
       Filesystem fs;
+      Lisp::Evaluator lsp;
       
       Server(const Server&) = delete;
       Server& operator=(const Server&) = delete;
diff --git a/src/include/Lisp.H b/src/include/Lisp.H
new file mode 100644
index 00000000..cfd79f38
--- /dev/null
+++ b/src/include/Lisp.H
@@ -0,0 +1,116 @@
+// 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.
+
+// --% Author: Gabriel Dos Reis
+// --% Abstract:
+// --%    Very simple support for some core Lisp-like operations.
+
+#ifndef OPENAXIOM_LISP_included
+#define OPENAXIOM_LISP_included
+
+#include <list>
+#include <open-axiom/sexpr>
+#include <open-axiom/vm>
+#include <map>
+#include <open-axiom/diagnostics>
+#include <iosfwd>
+#include <unordered_set>
+
+namespace std {
+   template<>
+   struct hash<OpenAxiom::VM::Scope>  {
+      hash<OpenAxiom::VM::String>::result_type
+      operator()(const OpenAxiom::VM::Scope& s) const {
+         return h(s.name());
+      }
+      hash<OpenAxiom::VM::String> h;
+   };
+
+   template<>
+   struct equal_to<OpenAxiom::VM::Scope> {
+      using arg_type = OpenAxiom::VM::Scope;
+      bool operator()(const arg_type& x, const arg_type& y) const {
+         return p(x.name(), y.name());
+      }
+         equal_to<OpenAxiom::VM::String> p;
+   };
+}
+
+namespace OpenAxiom {
+   namespace Lisp {
+      using namespace VM;
+
+      // -- Unimplemented features
+      struct Unimplemented : Diagnostics::BasicError {
+         explicit Unimplemented(const std::string&);
+      };
+
+      // -- Integer overflow
+      struct IntegerOverflow : Diagnostics::BasicError {
+         explicit IntegerOverflow(const std::string&);
+      };
+      
+      // -- Environments.
+      using Environment = std::map<Symbol*, Value>;
+
+      // -- Anchor maps
+      using AnchorTable = std::map<Ordinal, Value>;
+
+      // -- Evaluator --
+      struct Evaluator : VM::BasicContext {
+         Evaluator();
+         Scope* keyword_namespace() { return &keys; }
+         Scope* active_namespace() { return ns; }
+         Value toplevel_form(const Sexpr::Syntax*);
+         Value make_value(const Sexpr::Syntax*);
+         Environment* global_environment();
+      private:
+         Scope keys;
+         std::unordered_set<Scope> packages;
+         Scope* ns;
+         std::list<Environment> env_stack;
+         AnchorTable anchor_map;
+      };
+
+      // -- Format a value onto an output stream.
+      void format(Value, std::ostream&);
+      std::string show(Value);
+
+      // -- Retracts
+      Fixnum retract_to_fixnum(Value);
+      Pair retract_to_pair(Value);
+      Symbol* retract_to_symbol(Value);
+   }
+}
+
+#endif  // OPENAXIOM_LISP_included
+
diff --git a/src/include/sexpr.H b/src/include/sexpr.H
index 73e21f31..aa4cfc09 100644
--- a/src/include/sexpr.H
+++ b/src/include/sexpr.H
@@ -81,6 +81,9 @@ namespace OpenAxiom {
 
          std::pair<const Byte*, const Byte*> boundary;
          Ordinal line;
+         const Byte* begin() const { return boundary.first; }
+         const Byte* end() const { return boundary.second; }
+         Ordinal size() const { return end() - begin(); }
       };
 
       // ------------
@@ -100,7 +103,6 @@ namespace OpenAxiom {
       // in Lisp languages. 
       struct AtomSyntax : Syntax {
          const Lexeme& lexeme() const { return lex; }
-         void accept(Visitor&) const;
       protected:
          Lexeme lex;
          explicit AtomSyntax(const Lexeme&);
@@ -150,12 +152,12 @@ namespace OpenAxiom {
          const Kind sort;
       };
 
-      // ---------------
-      // -- Reference --
-      // ---------------
+      // ---------------------
+      // -- ReferenceSyntax --
+      // ---------------------
       // Back reference object to a syntax object.
-      struct Reference : AtomSyntax {
-         Reference(const Lexeme&, Ordinal);
+      struct ReferenceSyntax : AtomSyntax {
+         ReferenceSyntax(const Lexeme&, Ordinal);
          size_t tag() const { return pos; }
          void accept(Visitor&) const;
       private:
@@ -251,15 +253,17 @@ namespace OpenAxiom {
          explicit Exclude(const Syntax*);
       };
 
-      // ----------
+      // ----------------
       // -- ListSyntax --
-      // ----------
+      // ----------------
       // List syntax objects.
       struct ListSyntax : Syntax, private std::vector<const Syntax*> {
          typedef std::vector<const Syntax*> base;
          using base::const_iterator;
          using base::begin;
          using base::end;
+         using base::rbegin;
+         using base::rend;
          using base::size;
          using base::empty;
 
@@ -272,9 +276,9 @@ namespace OpenAxiom {
          bool dot;
       };
       
-      // ------------
+      // ------------------
       // -- VectorSyntax --
-      // ------------
+      // ------------------
       // VectorSyntax syntax objects.
       struct VectorSyntax : Syntax, private std::vector<const Syntax*> {
          typedef std::vector<const Syntax*> base;
@@ -295,12 +299,11 @@ namespace OpenAxiom {
       // -- Syntax::Visitor --
       // ---------------------
       struct Syntax::Visitor {
-         virtual void visit(const AtomSyntax&) = 0;
-         virtual void visit(const IntegerSyntax&);
-         virtual void visit(const CharacterSyntax&);
-         virtual void visit(const StringSyntax&);
-         virtual void visit(const SymbolSyntax&);
-         virtual void visit(const Reference&);
+         virtual void visit(const IntegerSyntax&) = 0;
+         virtual void visit(const CharacterSyntax&) = 0;
+         virtual void visit(const StringSyntax&) = 0;
+         virtual void visit(const SymbolSyntax&) = 0;
+         virtual void visit(const ReferenceSyntax&) = 0;
          virtual void visit(const AnchorSyntax&) = 0;
          virtual void visit(const QuoteSyntax&) = 0;
          virtual void visit(const AntiquoteSyntax&) = 0;
@@ -332,7 +335,7 @@ namespace OpenAxiom {
          const CharacterSyntax* make_character(const Lexeme&);
          const StringSyntax* make_string(const Lexeme&);
          const SymbolSyntax* make_symbol(SymbolSyntax::Kind, const Lexeme&);
-         const Reference* make_reference(size_t, const Lexeme&);
+         const ReferenceSyntax* make_reference(size_t, const Lexeme&);
          const AnchorSyntax* make_anchor(size_t, const Syntax*);
          const QuoteSyntax* make_quote(const Syntax*);
          const AntiquoteSyntax* make_antiquote(const Syntax*);
@@ -351,7 +354,7 @@ namespace OpenAxiom {
          Memory::Factory<StringSyntax> strs;
          Memory::Factory<SymbolSyntax> syms;
          Memory::Factory<AnchorSyntax> ancs;
-         Memory::Factory<Reference> refs;
+         Memory::Factory<ReferenceSyntax> refs;
          Memory::Factory<QuoteSyntax> quotes;
          Memory::Factory<AntiquoteSyntax> antis;
          Memory::Factory<Expand> exps;
@@ -378,6 +381,7 @@ namespace OpenAxiom {
          };
 
          Reader(const Byte*, const Byte*);
+         const Byte* position(Ordinal);
          const Syntax* read();
       private:
          State st;
diff --git a/src/include/storage.H b/src/include/storage.H
index 6800dc16..afd5f51f 100644
--- a/src/include/storage.H
+++ b/src/include/storage.H
@@ -266,13 +266,13 @@ namespace OpenAxiom {
 
          // Allocate storage and value-construct an object of type `T'.
          T* make() {
-            return new(this->allocate(1)) T();
+            return new(this->allocate(1)) T{ };
          }
 
          // Allocate storage and construct an object of type `T'.
          template<typename... Args>
          T* make(const Args&... args) {
-            return new(this->allocate(1)) T(args...);
+            return new(this->allocate(1)) T{args...};
          }
 
       private:
diff --git a/src/utils/vm.H b/src/include/vm.H
index 01000e9c..45bbc393 100644
--- a/src/utils/vm.H
+++ b/src/include/vm.H
@@ -1,4 +1,4 @@
-// Copyright (C) 2011-2012, Gabriel Dos Reis.
+// Copyright (C) 2011-2013, Gabriel Dos Reis.
 // All rights reserved.
 //
 // Redistribution and use in source and binary forms, with or without
@@ -34,8 +34,8 @@
 // --%   Interface and implementation of basic services of the 
 // --%   OpenAxiom Virtual Machine.
 
-#ifndef OPENAXIOM_VM_INCLUDED
-#define OPENAXIOM_VM_INCLUDED
+#ifndef OPENAXIOM_VM_included
+#define OPENAXIOM_VM_included
 
 #include <open-axiom/storage>
 #if HAVE_STDINT_H
@@ -44,6 +44,7 @@
 #include <open-axiom/string-pool>
 #include <utility>
 #include <map>
+#include <set>
 
 #define internal_type struct openaxiom_alignas(16)
 #define internal_data  openaxiom_alignas(16)
@@ -86,10 +87,11 @@ namespace OpenAxiom {
       //      takes to store two values in a type-erasure semantics.
       //   4. Idealy, pointers to foreign objects (at least) should be
       //      left unmolested.
+      //   5. Ideally, we want efficient access to string literals
       // 
       // * Assumptions:
       //     (a) the host machine has sizeof(Value) quo 4 = 0.
-      //     (b) allocatd objects can be aligned on sizeof(Value) boundary.
+      //     (b) allocated objects can be aligned on sizeof(Value) boundary.
       //     (c) the host machine has 2's complement arithmetic.
       //
       // If:
@@ -123,12 +125,11 @@ namespace OpenAxiom {
       // 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.
+      //   II. All foreign pointers that are aligned on 8-boundary are
+      //       directly represented.  Any foreign pointer not meeting
+      //       this condition is allocated in internal obejcts.  As a
+      //       consequence, the last four bits of all foreign addresses 
+      //       directly represented follow the pattern 0bx000.
       // 
       //  III. Cons cells are represented by their addresses with the
       //       last 4 bits matching the pattern 0bx010.
@@ -136,21 +137,26 @@ namespace OpenAxiom {
       //   IV. All internal objects are allocated on 16-byte boundary.
       //       Their last 4 bits are set to the pattern 0b0110.
       //
+      //    V. String literals are represented by their addressed with
+      //       the last four bits following the pattern 0bx100..
+      //
       // Finally:
-      //    V. The representation of a character shall have the last four
+      //   IV. 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.
+      //     to 8-byte boundaries.
 
 
       // -----------
       // -- Value --
       // -----------
       // All VM values fit in a universal value datatype.
-      typedef uintptr_t Value;
-      const Value nil = Value();
+      using Value = uintptr_t;
+
+      // The distinguished `nil' value.
+      constexpr Value nil { };
 
       // -------------
       // -- Fixnum ---
@@ -158,32 +164,58 @@ namespace OpenAxiom {
       // 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;
+      using Fixnum = intptr_t;
 
-      const Value fix_tag = 0x1;
+      constexpr Value fix_tag = 0x1;
 
-      inline bool is_fixnum(Value v) {
+      constexpr bool is_fixnum(Value v) {
          return (v & 0x1) == fix_tag;
       }
 
-      inline Fixnum to_fixnum(Value v) {
+      constexpr Fixnum to_fixnum(Value v) {
          return Fixnum(v >> 1);
       }
 
-      inline Value from_fixnum(Fixnum i) {
+      constexpr Value from_fixnum(Fixnum i) {
          return (Fixnum(i) << 1 ) | fix_tag;
       }
 
+      constexpr Fixnum fixnum_maximum = to_fixnum(~Value{ });
+      constexpr Fixnum fixnum_minimum = -fixnum_maximum - 1;
+
+      // ------------
+      // -- String --
+      // ------------
+      using String = BasicString;
+
+      constexpr Value str_tag = 0x4;
+
+      constexpr bool is_string(Value v) {
+         return (v & 0x7) == str_tag;
+      }
+
+      inline BasicString to_string(Value v) {
+         return reinterpret_cast<BasicString>(v & ~Value(0x7));
+      }
+
+      inline Value from_string(BasicString s) {
+         return Value(s) | str_tag;
+      }
+
+      inline BasicString to_string_if_can(Value v) {
+         return is_string(v) ? to_string(v) : nullptr;
+      }
+
       // -------------
       // -- Pointer --
       // -------------
       // Allocated objects are represented by their addresses.
       using Memory::Pointer;
 
-      const Value ptr_tag = 0x0;
+      constexpr Value ptr_tag = 0x0;
 
-      inline bool is_pointer(Value v) {
-         return (v & 0x3) == ptr_tag;
+      constexpr bool is_pointer(Value v) {
+         return (v & 0x7) == ptr_tag;
       }
 
       inline Pointer to_pointer(Value v) {
@@ -200,12 +232,11 @@ namespace OpenAxiom {
       struct ConsCell {
          Value head;
          Value tail;
-         ConsCell(Value h, Value t) : head(h), tail(t) { }
       };
 
-      typedef ConsCell* Pair;
+      using Pair = ConsCell*;
 
-      const Value pair_tag = 0x2;
+      constexpr Value pair_tag = 0x2;
 
       inline bool is_pair(Value v) {
          return (v & 0x7) == pair_tag;
@@ -221,96 +252,113 @@ namespace OpenAxiom {
 
       // 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;
+      inline Pair to_pair_if_can(Value v) {
+         return is_pair(v) ? to_pair(v) : nullptr;
       }
 
-      // -- 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));
-         }
-      };
+      Fixnum count_nodes(Pair);
+      inline Fixnum count_nodes(Value v) {
+         if (auto p = to_pair_if_can(v))
+            return count_nodes(p);
+         return 0;
+      }
 
       // ---------------
       // -- Character --
       // ---------------
       // This datatype is prepared for Uncode characters even if
       // we do not handle UCN characters at the moment.
-      typedef Value Character;
+      using Character = Value;
 
-      const Value char_tag = 0xE;
+      constexpr Value char_tag = 0xE;
 
-      inline bool is_character(Value v) {
+      constexpr bool is_character(Value v) {
          return (v & 0xF) == char_tag;
       }
 
-      inline Character to_character(Value v) {
+      constexpr Character to_character(Value v) {
          return Character(v >> 4);
       }
 
-      inline Value from_character(Character c) {
+      constexpr 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;
+      // An object is a typed value.
+      struct Type;
+      struct Object {
+         Value value;
+         const Type* type;
       };
 
-      typedef BasicObject* Object;
+      // -------------
+      // -- Dynamic --
+      // -------------
+      // Any internal value is of a class derived from this.
+      internal_type Dynamic {
+         virtual ~Dynamic();
+      };
 
-      const Value obj_tag = 0x6;
+      constexpr Value dyn_tag = 0x6;
 
-      inline bool is_object(Value v) {
-         return (v & 0xF) == obj_tag;
+      constexpr bool is_dynamic(Value v) {
+         return (v & 0xF) == dyn_tag;
       }
 
-      inline Object to_object(Value v) {
-         return Object(v & ~0xF);
+      inline Dynamic* to_dynamic(Value v) {
+         return reinterpret_cast<Dynamic*>(v & ~0xF);
       }
 
-      inline Value from_object(Object* o) {
-         return Value(o) | obj_tag;
+      inline Dynamic* to_dynamic_if_can(Value v) {
+         return is_dynamic(v)
+            ? reinterpret_cast<Dynamic*>(v & ~0xF)
+            : nullptr;
       }
 
+      inline Value from_dynamic(const Dynamic* o) {
+         return Value(o) | dyn_tag;
+      }
+
+      struct Scope;
+      
       // ------------
       // -- 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; }
+      struct Symbol : Dynamic, std::pair<String, Scope*> {
+         Symbol(String, Scope*);
+         String name() const { return first; }
+         Scope* scope() const { return second; }
       };
 
-      typedef SymbolObject* Symbol;
+      inline Symbol* to_symbol_if_can(Value v) {
+         return dynamic_cast<Symbol*>(to_dynamic_if_can(v));
+      }
+
+      inline bool is_symbol(Value v) {
+         return to_symbol_if_can(v) != nullptr;
+      }
+
+      inline Value from_symbol(const Symbol* s) {
+         return from_dynamic(s);
+      }
 
       // -----------
       // -- Scope --
       // -----------
-      struct ScopeObject : BasicObject, private std::map<Symbol, Value> {
-         explicit ScopeObject(BasicString n) : id(n) { }
+      struct Scope : Dynamic, private std::map<Symbol*, Value> {
+         explicit Scope(BasicString n) : id(n) { }
          BasicString name() const { return id; }
-         Value* lookup(Symbol) const;
-         Value* define(Symbol, Value);
+         Value* lookup(Symbol*) const;
+         Value* define(Symbol*, Value);
       private:
          const BasicString id;
       };
 
-      typedef ScopeObject* Scope;
-
       // --------------
       // -- Function --
       // --------------
-      struct FunctionBase : BasicObject {
+      struct FunctionBase : Dynamic {
          const Symbol name;
          Value type;
          FunctionBase(Symbol n, Value t = nil)
@@ -322,10 +370,10 @@ namespace OpenAxiom {
       // ------------------------
       // 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);
+      using NullaryCode = Value (*)(BasicContext*);
+      using UnaryCode = Value (*)(BasicContext*, Value);
+      using BinaryCode = Value (*)(BasicContext*, Value, Value);
+      using TernaryCode = Value (*)(BasicContext*, Value, Value, Value);
 
       template<typename Code>
       struct BuiltinFunction : FunctionBase {
@@ -333,17 +381,10 @@ namespace OpenAxiom {
          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;
+      using NullaryOperator = BuiltinFunction<NullaryCode>;
+      using UnaryOperator = BuiltinFunction<UnaryCode>;
+      using BinaryOperator = BuiltinFunction<BinaryCode>;
+      using TernaryOperator = BuiltinFunction<TernaryCode>;
 
       // ------------------
       // -- BasicContext --
@@ -351,19 +392,22 @@ namespace OpenAxiom {
       // Provides basic evaluation services.
       struct BasicContext : StringPool {
          BasicContext();
+         ~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);
+         Pair make_pair(Value, Value);
+         const Symbol* make_symbol(String, Scope*);
+         const NullaryOperator* make_operator(Symbol, NullaryCode);
+         const UnaryOperator* make_operator(Symbol, UnaryCode);
+         const BinaryOperator* make_operator(Symbol, BinaryCode);
+         const TernaryOperator* make_operator(Symbol, TernaryCode);
 
       protected:
+         std::set<Symbol> syms;
          Memory::Factory<ConsCell> conses;
-         Memory::Factory<NullaryOperatorObject> nullaries;
-         Memory::Factory<UnaryOperatorObject> unaries;
-         Memory::Factory<BinaryOperatorObject> binaries;
-         Memory::Factory<TernaryOperatorObject> ternaries;
+         Memory::Factory<NullaryOperator> nullaries;
+         Memory::Factory<UnaryOperator> unaries;
+         Memory::Factory<BinaryOperator> binaries;
+         Memory::Factory<TernaryOperator> ternaries;
       };
    };
 }
diff --git a/src/syntax/sexpr.cc b/src/syntax/sexpr.cc
index 0a3b8071..6b73d5a0 100644
--- a/src/syntax/sexpr.cc
+++ b/src/syntax/sexpr.cc
@@ -148,11 +148,6 @@ namespace OpenAxiom {
       // -- AtomSyntax --
       AtomSyntax::AtomSyntax(const Lexeme& t) : lex(t) { }
 
-      void
-      AtomSyntax::accept(Visitor& v) const {
-         v.visit(*this);
-      }
-
       // -- IntegerSyntax --
       IntegerSyntax::IntegerSyntax(const Lexeme& t) : AtomSyntax(t) { }
 
@@ -195,13 +190,13 @@ namespace OpenAxiom {
          v.visit(*this);
       }
 
-      // -- Reference --
-       Reference::Reference(const Lexeme& t, Ordinal n)
+      // -- ReferenceSyntax --
+       ReferenceSyntax::ReferenceSyntax(const Lexeme& t, Ordinal n)
              : AtomSyntax(t), pos(n)
       { }
 
       void
-      Reference::accept(Visitor& v) const {
+      ReferenceSyntax::accept(Visitor& v) const {
          v.visit(*this);
       }
 
@@ -259,42 +254,6 @@ namespace OpenAxiom {
          v.visit(*this);
       }
 
-      // ---------------------
-      // -- Syntax::Visitor --
-      // ---------------------
-
-      // implicitly convert a reference to `T' to a reference to `S'.
-      template<typename S, typename T>
-      inline const S&
-      as(const T& t) {
-         return t;
-      }
-
-      void
-      Syntax::Visitor::visit(const IntegerSyntax& i) {
-         visit(as<AtomSyntax>(i));
-      }
-
-      void
-      Syntax::Visitor::visit(const CharacterSyntax& c) {
-         visit(as<AtomSyntax>(c));
-      }
-
-      void
-      Syntax::Visitor::visit(const StringSyntax& s) {
-         visit(as<AtomSyntax>(s));
-      }
-
-      void
-      Syntax::Visitor::visit(const SymbolSyntax& s) {
-         visit(as<AtomSyntax>(s));
-      }
-
-      void
-      Syntax::Visitor::visit(const Reference& r) {
-         visit(as<AtomSyntax>(r));
-      }
-
       // ---------------
       // -- Allocator --
       // ---------------
@@ -325,7 +284,7 @@ namespace OpenAxiom {
          return syms.make(t, k);
       }
 
-      const Reference*
+      const ReferenceSyntax*
       Allocator::make_reference(size_t i, const Lexeme& t) {
          return refs.make(t, i);
       }
@@ -672,5 +631,14 @@ namespace OpenAxiom {
          return read_sexpr(st);
       }
 
+      const Byte*
+      Reader::position(Ordinal p) {
+         st.cur = st.start + p;
+         st.line = st.cur;
+         // while (st.line > st.start and st.line[-1] != '\n')
+         //    --st.line;
+         return st.cur;
+      }
+
    }
 }
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.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() {
+      }
    }
 }