diff options
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -rw-r--r-- | src/Makefile.am | 4 | ||||
| -rw-r--r-- | src/Makefile.in | 4 | ||||
| -rw-r--r-- | src/gui/main-window.cc | 12 | ||||
| -rw-r--r-- | src/gui/server.h | 3 | ||||
| -rw-r--r-- | src/include/Lisp.H | 116 | ||||
| -rw-r--r-- | src/include/sexpr.H | 40 | ||||
| -rw-r--r-- | src/include/storage.H | 4 | ||||
| -rw-r--r-- | src/include/vm.H (renamed from src/utils/vm.H) | 228 | ||||
| -rw-r--r-- | src/syntax/sexpr.cc | 58 | ||||
| -rw-r--r-- | src/utils/Lisp.cc | 264 | ||||
| -rw-r--r-- | src/utils/Makefile.in | 8 | ||||
| -rw-r--r-- | src/utils/hash-table.H | 5 | ||||
| -rw-r--r-- | src/utils/string-pool.H | 2 | ||||
| -rw-r--r-- | src/utils/vm.cc | 49 |
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() { + } } } |