Add more functionalities to the VM.

3 files changed, 127 insertions, 53 deletions

diff --git a/src/include/Lisp.H b/src/include/Lisp.H
index 724ab54b..119d07f8 100644
--- a/src/include/Lisp.H
+++ b/src/include/Lisp.H
@@ -47,21 +47,21 @@
 
 namespace std {
    template<>
-   struct hash<OpenAxiom::VM::Scope>  {
+   struct hash<OpenAxiom::VM::Package>  {
       hash<OpenAxiom::VM::String>::result_type
-      operator()(const OpenAxiom::VM::Scope& s) const {
-         return h(s.name());
+      operator()(const OpenAxiom::VM::Package& s) const {
+         return h(s.name);
       }
       hash<OpenAxiom::VM::String> h;
    };
 
    template<>
-   struct equal_to<OpenAxiom::VM::Scope> {
-      using arg_type = OpenAxiom::VM::Scope;
+   struct equal_to<OpenAxiom::VM::Package> {
+      using arg_type = OpenAxiom::VM::Package;
       bool operator()(const arg_type& x, const arg_type& y) const {
-         return p(x.name(), y.name());
+         constexpr equal_to<OpenAxiom::VM::String> eq { };
+         return eq(x.name, y.name);
       }
-         equal_to<OpenAxiom::VM::String> p;
    };
 }
 
@@ -79,24 +79,20 @@ namespace OpenAxiom {
          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; }
+         Package* core_package() { return core; }
+         Package* current_package() { 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;
+         Package* core;
+         Package* ns;
          std::list<Environment> env_stack;
          AnchorTable anchor_map;
       };
diff --git a/src/include/sexpr.H b/src/include/sexpr.H
index 84513a8b..d3dafcb7 100644
--- a/src/include/sexpr.H
+++ b/src/include/sexpr.H
@@ -139,10 +139,10 @@ namespace OpenAxiom {
       // ------------------
       struct SymbolSyntax : AtomSyntax {
          enum Kind {
-            uninterned,         // uninterned symbol
-            ordinary,           // an interned symbol
-            absolute,           // case-sensitive symbol
-            keyword             // a keyword symbol
+            ordinary   = 0x0,   // an interned symbol
+            uninterned = 0x1,   // uninterned symbol
+            absolute   = 0x2,   // case-sensitive symbol
+            keyword    = 0x4,   // a keyword symbol
          };
          SymbolSyntax(const Lexeme&, Kind);
          Kind kind() const { return sort; }
@@ -188,6 +188,17 @@ namespace OpenAxiom {
          const Syntax* const form;
       };
 
+      template<typename T>
+      struct binary_form : Syntax {
+         const Syntax* first() const { return rep.first; }
+         const Syntax* second() const { return rep.second; }
+         void accept(Visitor&) const;
+      protected:
+         binary_form(const Syntax* f, const Syntax* s) : rep(f, s) { }
+      private:
+         std::pair<const Syntax*, const Syntax*> rep;
+      };
+
       // -----------------
       // -- QuoteSyntax --
       // -----------------
@@ -240,16 +251,16 @@ namespace OpenAxiom {
       // -- Include --
       // -------------
       // Conditional inclusion syntax object
-      struct Include : unary_form<Include> {
-         explicit Include(const Syntax*);
+      struct Include : binary_form<Include> {
+         Include(const Syntax*, const Syntax*);
       };
 
       // -------------
       // -- Exclude --
       // -------------
       // Conditional exclusion syntax object
-      struct Exclude : unary_form<Exclude> {
-         explicit Exclude(const Syntax*);
+      struct Exclude : binary_form<Exclude> {
+         Exclude(const Syntax*, const Syntax*);
       };
 
       // ----------------
@@ -322,6 +333,12 @@ namespace OpenAxiom {
          v.visit(static_cast<const T&>(*this));
       }
 
+      template<typename T>
+      void
+      binary_form<T>::accept(Visitor& v) const {
+         v.visit(static_cast<const T&>(*this));
+      }
+
       // ---------------
       // -- Allocator --
       // ---------------
@@ -342,8 +359,8 @@ namespace OpenAxiom {
          const Eval* make_eval(const Syntax*);
          const Splice* make_splice(const Syntax*);
          const Function* make_function(const Syntax*);
-         const Include* make_include(const Syntax*);
-         const Exclude* make_exclude(const Syntax*);
+         const Include* make_include(const Syntax*, const Syntax*);
+         const Exclude* make_exclude(const Syntax*, const Syntax*);
          const ListSyntax* make_list(const std::vector<const Syntax*>&, bool = false);
          const VectorSyntax* make_vector(const std::vector<const Syntax*>&);
          
diff --git a/src/include/vm.H b/src/include/vm.H
index c66a2e02..9337955b 100644
--- a/src/include/vm.H
+++ b/src/include/vm.H
@@ -41,8 +41,8 @@
 #include <open-axiom/string-pool>
 #include <stdint.h>
 #include <utility>
-#include <map>
 #include <set>
+#include <vector>
 #include <type_traits>
 
 #define internal_type struct alignas(16)
@@ -163,6 +163,14 @@ namespace OpenAxiom {
          t   = 0x10,            // distinguished T value
       };
 
+      constexpr bool to_bool(Value v) {
+         return v != Value::nil;
+      }
+
+      constexpr Value to_value(bool b) {
+         return b ? Value::t : Value::nil;
+      }
+
       template<typename>
       struct ValueTrait {
       };
@@ -208,11 +216,18 @@ namespace OpenAxiom {
          return is<Dynamic>(v) ? to_dynamic(v) : nullptr;
       }
 
-      inline Value from_dynamic(const Dynamic* o) {
+      template<typename T>
+      using IfDynamic = typename
+         std::enable_if<std::is_base_of<Dynamic, T>::value, Value>::type;
+
+      template<typename T>
+      inline IfDynamic<T> to_value(const T* o) {
          return Value(ValueBits(o) | ValueTrait<Dynamic>::tag);
       }
 
-      struct Scope;
+      // -- Callable --
+      struct Callable : Dynamic {
+      };
       
       // -------------
       // -- Fixnum ---
@@ -351,13 +366,27 @@ namespace OpenAxiom {
          const Type* type;
       };
 
+      struct Package;
+
+      enum class SymbolAttribute {
+         None             = 0x0,    // No particular attribute.
+         Constant         = 0x1,    // Symbol defined constant.
+         SpecialBinding   = 0x2,    // Symbol declared special.
+         Keyword          = 0x4,    // A keyword symbol.
+         SpecialConstant  = Constant | SpecialBinding,
+      };
+
       // ------------
       // -- Symbol --
       // ------------
-      struct Symbol : Dynamic, std::pair<String, Scope*> {
-         Symbol(String, Scope*);
-         String name() const { return first; }
-         Scope* scope() const { return second; }
+      struct Symbol : Dynamic {
+         const InternedString name;
+         Value value;
+         const Callable* function;
+         Pair properties;
+         Package* package;
+         SymbolAttribute attributes;
+         explicit Symbol(InternedString);
       };
 
       inline Symbol* to_symbol_if_can(Value v) {
@@ -368,29 +397,53 @@ namespace OpenAxiom {
          return to_symbol_if_can(v) != nullptr;
       }
 
-      inline Value from_symbol(const Symbol* s) {
-         return from_dynamic(s);
+      struct CmpByName {
+         template<typename T>
+         bool operator()(const T& x, const T& y) const {
+            return std::less<String>()(x.name, y.name);
+         }
+      };
+
+      template<typename T>
+      inline const T* setf_symbol_function(Symbol* sym, const T* fun) {
+         sym->function = fun;
+         return fun;
       }
+      
+      // -- Environments.
+      struct Environment {
+         struct Binding {
+            Symbol* symbol;
+            Value value;
+         };
 
-      // -----------
-      // -- Scope --
-      // -----------
-      struct Scope : Dynamic, private std::map<Symbol*, Value> {
-         explicit Scope(InternedString n) : id(n) { }
-         InternedString name() const { return id; }
-         Value* lookup(Symbol*) const;
-         Value* define(Symbol*, Value);
+         Environment();
+         ~Environment();
+
+         void bind(Symbol*, Value);
       private:
-         const InternedString id;
+         std::vector<Binding> lexical;
+         std::vector<Binding> dynamic;
+      };
+
+      // -------------
+      // -- Package --
+      // -------------
+      struct Package : Dynamic {
+         const InternedString name;
+         std::set<Symbol, CmpByName> symbols;
+
+         explicit Package(InternedString);
+         Symbol* make_symbol(InternedString);
       };
 
       // --------------
       // -- Function --
       // --------------
-      struct FunctionBase : Dynamic {
-         const Symbol name;
+      struct FunctionBase : Callable {
+         const Symbol* name;
          Value type;
-         FunctionBase(Symbol n, Value t = Value::nil)
+         FunctionBase(const Symbol* n, Value t = Value::nil)
                : name(n), type(t) { }
       };
 
@@ -407,7 +460,9 @@ namespace OpenAxiom {
       template<typename Code>
       struct BuiltinFunction : FunctionBase {
          Code code;
-         BuiltinFunction(Symbol n, Code c) : FunctionBase(n), code(c) { }
+         BuiltinFunction(const Symbol* n, Code c)
+               : FunctionBase(n), code(c)
+         { }
       };
 
       using NullaryOperator = BuiltinFunction<NullaryCode>;
@@ -423,20 +478,26 @@ namespace OpenAxiom {
          BasicContext();
          ~BasicContext();
 
+         Package* make_package(InternedString);
+         Symbol* make_keyword(InternedString);
          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);
+         const NullaryOperator* make_operator(Symbol*, NullaryCode);
+         const UnaryOperator* make_operator(Symbol*, UnaryCode);
+         const BinaryOperator* make_operator(Symbol*, BinaryCode);
+         const TernaryOperator* make_operator(Symbol*, TernaryCode);
+
+         Package* keyword_package() const { return keywords; }
+         Package* homeless_package() const { return homeless; }
 
       protected:
-         std::set<Symbol> syms;
+         std::set<Package, CmpByName> packages;
          Memory::Factory<ConsCell> conses;
          Memory::Factory<NullaryOperator> nullaries;
          Memory::Factory<UnaryOperator> unaries;
          Memory::Factory<BinaryOperator> binaries;
          Memory::Factory<TernaryOperator> ternaries;
+         Package* keywords;
+         Package* homeless;
       };
    };
 }