diff options
| -rw-r--r-- | src/ChangeLog | 30 | ||||
| -rw-r--r-- | src/include/Lisp.H | 26 | ||||
| -rw-r--r-- | src/include/sexpr.H | 37 | ||||
| -rw-r--r-- | src/include/vm.H | 117 | ||||
| -rw-r--r-- | src/rt/Lisp.cc | 40 | ||||
| -rw-r--r-- | src/rt/vm.cc | 75 | ||||
| -rw-r--r-- | src/syntax/sexpr.cc | 34 |
7 files changed, 277 insertions, 82 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 1a2e80f0..3a792c7f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,33 @@ +2014-09-16 Gabriel Dos Reis <gdr@integrable-solutions.net> + + * rt/vm.cc (VM::Environment::Environment): Define. + (VM::Environment::~Environment): Likewise. + (VM::Symbol::Symbol): Rework. + (VM::BasicContext::make_package): Define. + (VM::BasicContext::make_keyword): Likewise. + (VM:BasicContext::make_symbol): Remove. + (VM::BasicContext::make_operator): Tidy. + * include/vm.H (VM::to_bool): New. + (VM::to_value): Likewise. + (VM::SymbolAttribute): Likewise. + (VM::Symbol): Rework. + (VM::CmpByName): New helper class. + (VM::setf_symbol_function): New helper function. + (VM::Environment): Move from Lisp.H. + (VM::FunctionBase): Derive from VM::Callable. + * include/sexpr.H (Sexpr::SymbolSyntax::Kind): Now bitmask type. + (Sexpr::binary_form): New. + (Sexpr::Include): Derive from it. + (Sexpr::Exclude): Likewise. + (Sexpr::Allocator): Adjust. + * syntax/sexpr.cc (Sexpr::finish_include): New. + (Sexpr::finish_exclude): Likewise. + (Sexpr::read_sharp_et_al): Use them. + * include/Lisp.H: Adjust. Move Environment to vm.H. + (Lisp::Evaluator): Tidy. + * rt/Lisp.cc (define_special_value_constants): New. + (Lisp::Evaluator::Evaluator): Call it. + 2014-08-26 Raoul B. <raoulb@bluewin.ch> * algebra/combfunc.spad.pamphlet 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; }; }; } diff --git a/src/rt/Lisp.cc b/src/rt/Lisp.cc index f87db63c..fd1f5289 100644 --- a/src/rt/Lisp.cc +++ b/src/rt/Lisp.cc @@ -1,4 +1,4 @@ -// Copyright (C) 2013, Gabriel Dos Reis. +// Copyright (C) 2013-2014, Gabriel Dos Reis. // All rights reserved. // Written by Gabriel Dos Reis. // @@ -37,6 +37,30 @@ namespace OpenAxiom { namespace Lisp { + namespace { + template<typename T> + struct NamedConstant { + const char* const name; + const T value; + }; + } + + constexpr NamedConstant<Value> value_constants[] = { + { "NIL", Value::nil }, + { "T", Value::t }, + { "MOST-NEGATIVE-FIXNUM", from_fixnum(Fixnum::minimum) }, + { "MOST-POSITIVE-FIXNUM", from_fixnum(Fixnum::maximum) }, + }; + + static void define_special_value_constants(Evaluator* ctx) { + auto core = ctx->core_package(); + for (auto& x : value_constants) { + auto sym = core->make_symbol(ctx->intern(x.name)); + sym->value = x.value; + sym->attributes = SymbolAttribute::SpecialConstant; + } + } + Unimplemented::Unimplemented(const std::string& s) : BasicError(s) { } @@ -134,13 +158,13 @@ namespace OpenAxiom { 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)); + return to_value(ctx->homeless_package()->make_symbol(s)); case Sexpr::SymbolSyntax::keyword: - return from_symbol(ctx->make_symbol(s, ctx->keyword_namespace())); + return to_value(ctx->make_keyword(s)); default: - return from_symbol(ctx->make_symbol(s, ctx->active_namespace())); + return to_value(ctx->current_package()->make_symbol(s)); } } @@ -199,7 +223,11 @@ namespace OpenAxiom { return v; } - Evaluator::Evaluator() : keys(intern("KEYWORD")), ns() { + Evaluator::Evaluator() + : core(make_package(intern("AxiomCore"))), + ns(core) + { + define_special_value_constants(this); env_stack.push_back(Environment{ }); } @@ -242,7 +270,7 @@ namespace OpenAxiom { static void format(const Symbol* s, std::ostream& os) { // FIXME: Handle escapes. - auto n = s->name(); + auto n = s->name; std::copy(n->begin(), n->end(), std::ostream_iterator<char>(os)); } diff --git a/src/rt/vm.cc b/src/rt/vm.cc index a0f4f2e3..7f5cd5fc 100644 --- a/src/rt/vm.cc +++ b/src/rt/vm.cc @@ -1,4 +1,4 @@ -// Copyright (C) 2011-2013, Gabriel Dos Reis. +// Copyright (C) 2011-2014, Gabriel Dos Reis. // All rights reserved. // Written by Gabriel Dos Reis. // @@ -36,12 +36,41 @@ namespace OpenAxiom { namespace VM { + // -- Environement + Environment::Environment() = default; + + Environment::~Environment() { + // Restore value of special variables bound in this environment. + const auto end = dynamic.rend(); + for (auto p = dynamic.rbegin(); p != end; ++p) + p->symbol->value = p->value; + } + + // -- Dynamic Dynamic::~Dynamic() { } - Symbol::Symbol(String n, Scope* s) - : std::pair<String, Scope*>(n, s) + // -- Symbol + Symbol::Symbol(InternedString s) + : name(s), + value(), + function(), + properties(), + package(), + attributes() { } + // -- Package + Package::Package(InternedString s) + : name(s) + { } + + Symbol* + Package::make_symbol(InternedString s) { + auto sym = const_cast<Symbol*>(&*symbols.insert(Symbol(s)).first); + sym->package = this; + return sym; + } + Fixnum count_nodes(Pair p) { FixnumBits n = 1; @@ -51,36 +80,48 @@ namespace OpenAxiom { } // -- BasicContext -- - Pair BasicContext::make_pair(Value h, Value t) { - return conses.make(h, t); + Package* + BasicContext::make_package(InternedString n) { + auto p = &*packages.insert(Package(n)).first; + return const_cast<Package*>(p); + } + + Symbol* + BasicContext::make_keyword(InternedString n) { + auto sym = keyword_package()->make_symbol(n); + sym->value = to_value(sym); + sym->attributes = SymbolAttribute::Keyword; + return sym; } - const Symbol* - BasicContext::make_symbol(String n, Scope* s) { - return &*syms.insert({ n, s }).first; + Pair BasicContext::make_pair(Value h, Value t) { + return conses.make(h, t); } const NullaryOperator* - BasicContext::make_operator(Symbol n, NullaryCode c) { - return nullaries.make(n, c); + BasicContext::make_operator(Symbol* n, NullaryCode c) { + return setf_symbol_function(n, nullaries.make(n, c)); } const UnaryOperator* - BasicContext::make_operator(Symbol n, UnaryCode c) { - return unaries.make(n, c); + BasicContext::make_operator(Symbol* n, UnaryCode c) { + return setf_symbol_function(n, unaries.make(n, c)); } const BinaryOperator* - BasicContext::make_operator(Symbol n, BinaryCode c) { - return binaries.make(n, c); + BasicContext::make_operator(Symbol* n, BinaryCode c) { + return setf_symbol_function(n, binaries.make(n, c)); } const TernaryOperator* - BasicContext::make_operator(Symbol n, TernaryCode c) { - return ternaries.make(n, c); + BasicContext::make_operator(Symbol* n, TernaryCode c) { + return setf_symbol_function(n, ternaries.make(n, c)); } - BasicContext::BasicContext() { + BasicContext::BasicContext() + : keywords(make_package(intern("KEYWORD"))), + homeless(make_package(nullptr)) + { } BasicContext::~BasicContext() { diff --git a/src/syntax/sexpr.cc b/src/syntax/sexpr.cc index 6b73d5a0..97413935 100644 --- a/src/syntax/sexpr.cc +++ b/src/syntax/sexpr.cc @@ -223,10 +223,14 @@ namespace OpenAxiom { Function::Function(const Syntax* s) : unary_form<Function>(s) { } // -- Include -- - Include::Include(const Syntax* s) : unary_form<Include>(s) { } + Include::Include(const Syntax* c, const Syntax* s) + : binary_form<Include>(c, s) + { } // -- Exclude -- - Exclude::Exclude(const Syntax* s) : unary_form<Exclude>(s) { } + Exclude::Exclude(const Syntax* c, const Syntax* s) + : binary_form<Exclude>(c, s) + { } // -- ListSyntax -- ListSyntax::ListSyntax() : dot(false) { } @@ -325,13 +329,13 @@ namespace OpenAxiom { } const Include* - Allocator::make_include(const Syntax* s) { - return incs.make(s); + Allocator::make_include(const Syntax* c, const Syntax* s) { + return incs.make(c, s); } const Exclude* - Allocator::make_exclude(const Syntax* s) { - return excs.make(s); + Allocator::make_exclude(const Syntax* c, const Syntax* s) { + return excs.make(c, s); } const ListSyntax* @@ -553,6 +557,22 @@ namespace OpenAxiom { } static const Syntax* + finish_include(Reader::State& s) { + ++s.cur; + auto cond = read_sexpr(s); + auto form = read_sexpr(s); + return s.alloc.make_include(cond, form); + } + + static const Syntax* + finish_exclude(Reader::State& s) { + ++s.cur; + auto cond = read_sexpr(s); + auto form = read_sexpr(s); + return s.alloc.make_exclude(cond, form); + } + + static const Syntax* read_sharp_et_al(Reader::State& s) { if (++s.cur >= s.end) syntax_error("end-of-input reached after sharp sign"); @@ -562,6 +582,8 @@ namespace OpenAxiom { case ':': return finish_uninterned_symbol(s); case '.': return finish_readtime_eval(s); case '\\': return finish_character(s); + case '+': return finish_include(s); + case '-': return finish_exclude(s); default: if (isdigit(*s.cur)) |