From 563a807be78bfe12e5bfbb9ff0d6da44242696c4 Mon Sep 17 00:00:00 2001 From: David Robillard Date: Thu, 2 Dec 2010 06:16:29 +0000 Subject: Represent code as list structure (i.e. traditional LISP lists built from pairs), rather than tuple structure. Remove unused/crufty depoly stage. Remove cps from AST interface (but keep cps.cpp code around for later). Improved command line interface for compilation stages (options -T -L -S). git-svn-id: http://svn.drobilla.net/resp/resp@277 ad02d1e2-f140-0410-9f75-f8b11f17cedd --- Makefile | 7 +- src/c.cpp | 14 +-- src/compile.cpp | 19 ++-- src/constrain.cpp | 107 ++++++++++++----------- src/depoly.cpp | 110 ----------------------- src/lex.cpp | 25 +++--- src/lift.cpp | 90 ++++++++++--------- src/llvm.cpp | 20 ++--- src/parse.cpp | 66 +++++++------- src/pprint.cpp | 104 ++++++++++++---------- src/repl.cpp | 63 ++++---------- src/resp.cpp | 7 +- src/resp.hpp | 254 +++++++++++++++++++++++++++++++++++++++++------------- src/unify.cpp | 46 +++++----- 14 files changed, 482 insertions(+), 450 deletions(-) delete mode 100644 src/depoly.cpp diff --git a/Makefile b/Makefile index 6b3107b..45a0977 100644 --- a/Makefile +++ b/Makefile @@ -25,8 +25,6 @@ OBJECTS = \ build/c.o \ build/compile.o \ build/constrain.o \ - build/cps.o \ - build/depoly.o \ build/gc.o \ build/lex.o \ build/lift.o \ @@ -34,12 +32,11 @@ OBJECTS = \ build/pprint.o \ build/repl.o \ build/resp.o \ + build/resp_gc.o \ build/tlsf.o \ - build/unify.o \ - build/resp_gc.o + build/unify.o LLVM_OBJECTS = build/llvm.o -#LLVM_OBJECTS = build/resp: $(OBJECTS) $(LLVM_OBJECTS) g++ -o $@ $(OBJECTS) $(LLVM_OBJECTS) $(LDFLAGS) $(LLVM_LDFLAGS) diff --git a/src/c.cpp b/src/c.cpp index e8f7c2a..b1eafe5 100644 --- a/src/c.cpp +++ b/src/c.cpp @@ -73,7 +73,7 @@ llType(const AType* t) return ret; } else if (t->kind == AType::EXPR && t->head()->str() == "Tup") { Type* ret = new Type("struct { void* me; "); - for (AType::const_iterator i = t->begin() + 1; i != t->end(); ++i) { + for (AType::const_iterator i = t->iter_at(1); i != t->end(); ++i) { const Type* lt = llType((*i)->to()); if (!lt) return NULL; @@ -104,11 +104,11 @@ struct CEngine : public Engine { const std::string& name, const ATuple* args, const AType* type) { const AType* argsT = type->prot()->as(); - const AType* retT = type->last()->as(); + const AType* retT = type->list_ref(2)->as(); vector cprot; FOREACHP(ATuple::const_iterator, i, argsT) { - AType* at = (*i)->as(); + const AType* at = (*i)->as(); THROW_IF(!llType(at), Cursor(), string("non-concrete parameter :: ") + at->str()) cprot.push_back(llType(at)); @@ -222,10 +222,10 @@ CEngine::pushFunctionArgs(CEnv& cenv, const AFn* fn, const AType* type, CFunc f) AFn::const_iterator p = fn->prot()->begin(); ATuple::const_iterator pT = argsT->begin(); for (; p != fn->prot()->end(); ++p, ++pT) { - AType* t = (*pT)->as(); + const AType* t = (*pT)->as(); const Type* lt = llType(t); THROW_IF(!lt, fn->loc, "untyped parameter\n"); - cenv.def((*p)->as(), *p, t, new string((*p)->str())); + cenv.def((*p)->as(), *p, t, new string((*p)->str())); } } @@ -235,7 +235,7 @@ CEngine::compileIf(CEnv& cenv, const AIf* aif) Value* varname = new string(cenv.penv.gensymstr("if")); out += (format("%s %s;\n") % *llType(cenv.type(aif)) % *varname).str(); size_t idx = 1; - for (AIf::const_iterator i = aif->begin() + 1; ; ++i, idx += 2) { + for (AIf::const_iterator i = aif->iter_at(1); ; ++i, idx += 2) { AIf::const_iterator next = i; if (++next == aif->end()) break; @@ -252,7 +252,7 @@ CEngine::compileIf(CEnv& cenv, const AIf* aif) // Emit final else block out += "else {\n"; - Value* elseV = llVal(aif->last()->compile(cenv)); + Value* elseV = llVal(aif->list_last()->compile(cenv)); out += (format("%s = %s;\n}\n") % *varname % *elseV).str(); for (size_t i = 1; i < idx / 2; ++i) diff --git a/src/compile.cpp b/src/compile.cpp index e2d306a..da9683e 100644 --- a/src/compile.cpp +++ b/src/compile.cpp @@ -40,7 +40,7 @@ AString::compile(CEnv& cenv) const throw() CVal AQuote::compile(CEnv& cenv) const throw() { - return (*(begin() + 1))->compile(cenv); + return list_ref(1)->compile(cenv); } CVal @@ -77,7 +77,7 @@ AFn::compile(CEnv& cenv) const throw() // Write function body CVal retVal = NULL; - for (AFn::const_iterator i = begin() + 2; i != end(); ++i) + for (AFn::const_iterator i = iter_at(2); i != end(); ++i) retVal = (*i)->compile(cenv); // Write function conclusion @@ -101,7 +101,7 @@ ACall::compile(CEnv& cenv) const throw() f = cenv.currentFn; // Recursive call (callee defined as a stub) vector args; - for (const_iterator e = begin() + 1; e != end(); ++e) + for (const_iterator e = iter_at(1); e != end(); ++e) args.push_back((*e)->compile(cenv)); return cenv.engine()->compileCall(cenv, f, cenv.type(head()), args); @@ -136,10 +136,11 @@ ACons::compile(CEnv& cenv) const throw() CVal ATuple::compile(CEnv& cenv) const throw() { - AType* type = tup(loc, const_cast(head()->as()), 0); + AType* type = new AType(const_cast(head()->as()), NULL, Cursor()); + TList tlist(type); vector fields; - for (const_iterator i = begin() + 1; i != end(); ++i) { - type->push_back(const_cast(cenv.type(*i))); + for (const_iterator i = iter_at(1); i != end(); ++i) { + tlist.push_back(const_cast(cenv.type(*i))); fields.push_back((*i)->compile(cenv)); } return cenv.engine()->compileTup(cenv, type, type->compile(cenv), fields); @@ -162,9 +163,9 @@ AType::compile(CEnv& cenv) const throw() CVal ADot::compile(CEnv& cenv) const throw() { - const_iterator i = begin(); - AST* tup = *++i; - ALiteral* index = (*++i)->as*>(); + const_iterator i = begin(); + const AST* tup = *++i; + const ALiteral* index = (*++i)->as*>(); CVal tupVal = tup->compile(cenv); return cenv.engine()->compileDot(cenv, tupVal, index->val); } diff --git a/src/constrain.cpp b/src/constrain.cpp index ef8e3bf..b9ce471 100644 --- a/src/constrain.cpp +++ b/src/constrain.cpp @@ -49,7 +49,7 @@ void AQuote::constrain(TEnv& tenv, Constraints& c) const throw(Error) { c.constrain(tenv, this, tenv.named("Quote")); - (*(begin() + 1))->constrain(tenv, c); + list_ref(1)->constrain(tenv, c); } void @@ -63,11 +63,12 @@ ASymbol::constrain(TEnv& tenv, Constraints& c) const throw(Error) void ATuple::constrain(TEnv& tenv, Constraints& c) const throw(Error) { - AType* t = tup(loc, NULL); + TList t; FOREACHP(const_iterator, p, this) { (*p)->constrain(tenv, c); - t->push_back(const_cast(tenv.var(*p))); + t.push_back(const_cast(tenv.var(*p))); } + t.head->loc = loc; c.constrain(tenv, this, t); } @@ -78,7 +79,7 @@ AFn::constrain(TEnv& tenv, Constraints& c) const throw(Error) TEnv::Frame frame; // Add parameters to environment frame - AType* protT = tup(loc, NULL); + TList protT; for (ATuple::const_iterator i = prot()->begin(); i != prot()->end(); ++i) { const ASymbol* sym = (*i)->to(); THROW_IF(!sym, (*i)->loc, "parameter name is not a symbol"); @@ -87,10 +88,11 @@ AFn::constrain(TEnv& tenv, Constraints& c) const throw(Error) defs.insert(sym); const AType* tvar = tenv.fresh(sym); frame.push_back(make_pair(sym, tvar)); - protT->push_back(const_cast(tvar)); + protT.push_back(const_cast(tvar)); } + protT.head->loc = loc; - const_iterator i = begin() + 1; + const_iterator i = iter_at(1); c.constrain(tenv, *i, protT); // Add internal definitions to environment frame @@ -108,12 +110,14 @@ AFn::constrain(TEnv& tenv, Constraints& c) const throw(Error) tenv.push(frame); - AST* exp = NULL; - for (i = begin() + 2; i != end(); ++i) - (exp = *i)->constrain(tenv, c); + const AST* exp = NULL; + for (i = iter_at(2); i != end(); ++i) { + exp = *i; + exp->constrain(tenv, c); + } const AType* bodyT = tenv.var(exp); - const AType* fnT = tup(loc, tenv.Fn, protT, bodyT, 0); + const AType* fnT = tup(loc, tenv.Fn, protT.head, bodyT, 0); Object::pool.addRoot(fnT); tenv.pop(); @@ -130,28 +134,28 @@ ACall::constrain(TEnv& tenv, Constraints& c) const throw(Error) const AType* fnType = tenv.var(head()); if (fnType->kind != AType::VAR) { if (fnType->kind == AType::PRIM - || fnType->size() < 2 + || fnType->list_len() < 2 || fnType->head()->str() != "Fn") throw Error(loc, (format("call to non-function `%1%'") % head()->str()).str()); - size_t numArgs = fnType->prot()->size(); - THROW_IF(numArgs != size() - 1, loc, - (format("expected %1% arguments, got %2%") % numArgs % (size() - 1)).str()); + size_t numArgs = fnType->prot()->list_len(); + THROW_IF(numArgs != list_len() - 1, loc, + (format("expected %1% arguments, got %2%") % numArgs % (list_len() - 1)).str()); } const AType* retT = tenv.var(this); - AType* argsT = tup(loc, 0); - for (const_iterator i = begin() + 1; i != end(); ++i) - argsT->push_back(const_cast(tenv.var(*i))); - - c.constrain(tenv, head(), tup(head()->loc, tenv.Fn, argsT, retT, 0)); + TList argsT; + for (const_iterator i = iter_at(1); i != end(); ++i) + argsT.push_back(const_cast(tenv.var(*i))); + argsT.head->loc = loc; + c.constrain(tenv, head(), tup(head()->loc, tenv.Fn, argsT.head, retT, 0)); c.constrain(tenv, this, retT); } void ADef::constrain(TEnv& tenv, Constraints& c) const throw(Error) { - THROW_IF(size() != 3, loc, "`def' requires exactly 2 arguments"); + THROW_IF(list_len() != 3, loc, "`def' requires exactly 2 arguments"); const ASymbol* sym = this->sym(); THROW_IF(!sym, loc, "`def' has no symbol") @@ -165,12 +169,12 @@ ADef::constrain(TEnv& tenv, Constraints& c) const throw(Error) void AIf::constrain(TEnv& tenv, Constraints& c) const throw(Error) { - THROW_IF(size() < 4, loc, "`if' requires at least 3 arguments"); - THROW_IF(size() % 2 != 0, loc, "`if' missing final else clause") - for (const_iterator i = begin() + 1; i != end(); ++i) + THROW_IF(list_len() < 4, loc, "`if' requires at least 3 arguments"); + THROW_IF(list_len() % 2 != 0, loc, "`if' missing final else clause"); + for (const_iterator i = iter_at(1); i != end(); ++i) (*i)->constrain(tenv, c); const AType* retT = tenv.var(this); - for (const_iterator i = begin() + 1; true; ++i) { + for (const_iterator i = iter_at(1); true; ++i) { const_iterator next = i; ++next; if (next == end()) { // final (else) expression @@ -187,12 +191,12 @@ AIf::constrain(TEnv& tenv, Constraints& c) const throw(Error) void AMatch::constrain(TEnv& tenv, Constraints& c) const throw(Error) { - THROW_IF(size() < 5, loc, "`match' requires at least 4 arguments"); - const AST* matchee = (*(begin() + 1)); + THROW_IF(list_len() < 5, loc, "`match' requires at least 4 arguments"); + const AST* matchee = list_ref(1); const AType* retT = tenv.var(); const AType* matcheeT = NULL;// = tup(loc, tenv.U, 0); matchee->constrain(tenv, c); - for (const_iterator i = begin() + 2; i != end();) { + for (const_iterator i = iter_at(2); i != end();) { const AST* exp = *i++; const ATuple* pattern = exp->to(); THROW_IF(!pattern, exp->loc, "pattern expression expected"); @@ -218,25 +222,26 @@ AMatch::constrain(TEnv& tenv, Constraints& c) const throw(Error) void ADefType::constrain(TEnv& tenv, Constraints& c) const throw(Error) { - THROW_IF(size() < 3, loc, "`def-type' requires at least 2 arguments"); - const_iterator i = begin() + 1; + THROW_IF(list_len() < 3, loc, "`def-type' requires at least 2 arguments"); + const_iterator i = iter_at(1); const ATuple* prot = (*i)->to(); THROW_IF(!prot, (*i)->loc, "first argument of `def-type' is not a tuple"); const ASymbol* sym = (*prot->begin())->as(); THROW_IF(!sym, (*prot->begin())->loc, "type name is not a symbol"); THROW_IF(tenv.ref(sym), loc, "type redefinition"); - AType* type = tup(loc, tenv.U, 0); - for (const_iterator i = begin() + 2; i != end(); ++i) { + TList type(new AType(tenv.U, NULL, loc)); + for (const_iterator i = iter_at(2); i != end(); ++i) { const ATuple* exp = (*i)->as(); const ASymbol* tag = (*exp->begin())->as(); - AType* consT = new AType(exp->loc, AType::EXPR); - consT->push_back(new AType(const_cast(sym), AType::NAME)); + TList consT; + consT.push_back(new AType(const_cast(sym), AType::NAME)); for (ATuple::const_iterator i = exp->begin(); i != exp->end(); ++i) { const ASymbol* sym = (*i)->to(); THROW_IF(!sym, (*i)->loc, "type expression element is not a symbol"); - consT->push_back(new AType(const_cast(sym), AType::NAME)); + consT.push_back(new AType(const_cast(sym), AType::NAME)); } - type->push_back(consT); + consT.head->loc = exp->loc; + type.push_back(consT); tenv.def(tag, consT); } tenv.def(sym, type); @@ -248,13 +253,13 @@ ACons::constrain(TEnv& tenv, Constraints& c) const throw(Error) const ASymbol* sym = (*begin())->as(); const AType* type = NULL; - for (const_iterator i = begin() + 1; i != end(); ++i) + for (const_iterator i = iter_at(1); i != end(); ++i) (*i)->constrain(tenv, c); if (sym->cppstr == "Tup") { - AType* tupT = tup(loc, tenv.Tup, 0); - for (const_iterator i = begin() + 1; i != end(); ++i) { - tupT->push_back(const_cast(tenv.var(*i))); + TList tupT(new AType(tenv.Tup, NULL, loc)); + for (const_iterator i = iter_at(1); i != end(); ++i) { + tupT.push_back(const_cast(tenv.var(*i))); } type = tupT; } else { @@ -269,21 +274,21 @@ ACons::constrain(TEnv& tenv, Constraints& c) const throw(Error) void ADot::constrain(TEnv& tenv, Constraints& c) const throw(Error) { - THROW_IF(size() != 3, loc, "`.' requires exactly 2 arguments"); - const_iterator i = begin(); - AST* obj = *++i; - ALiteral* idx = (*++i)->to*>(); + THROW_IF(list_len() != 3, loc, "`.' requires exactly 2 arguments"); + const_iterator i = begin(); + const AST* obj = *++i; + const ALiteral* idx = (*++i)->to*>(); THROW_IF(!idx, loc, "the 2nd argument to `.' must be a literal integer"); obj->constrain(tenv, c); const AType* retT = tenv.var(this); c.constrain(tenv, this, retT); - AType* objT = tup(loc, tenv.Tup, 0); + TList objT(new AType(tenv.Tup, NULL, loc)); for (int i = 0; i < idx->val; ++i) - objT->push_back(const_cast(tenv.var())); - objT->push_back(const_cast(retT)); - objT->push_back(new AType(obj->loc, AType::DOTS)); + objT.push_back(const_cast(tenv.var())); + objT.push_back(const_cast(retT)); + objT.push_back(new AType(obj->loc, AType::DOTS)); c.constrain(tenv, obj, objT); } @@ -313,26 +318,26 @@ APrimitive::constrain(TEnv& tenv, Constraints& c) const throw(Error) const AType* var = NULL; switch (type) { case ARITHMETIC: - if (size() < 3) + if (list_len() < 3) throw Error(loc, (format("`%1%' requires at least 2 arguments") % n).str()); for (++i; i != end(); ++i) c.constrain(tenv, *i, tenv.var(this)); break; case BINARY: - if (size() != 3) + if (list_len() != 3) throw Error(loc, (format("`%1%' requires exactly 2 arguments") % n).str()); c.constrain(tenv, *++i, tenv.var(this)); c.constrain(tenv, *++i, tenv.var(this)); break; case LOGICAL: - if (size() != 3) + if (list_len() != 3) throw Error(loc, (format("`%1%' requires exactly 2 arguments") % n).str()); c.constrain(tenv, this, tenv.named("Bool")); c.constrain(tenv, *++i, tenv.named("Bool")); c.constrain(tenv, *++i, tenv.named("Bool")); break; case COMPARISON: - if (size() != 3) + if (list_len() != 3) throw Error(loc, (format("`%1%' requires exactly 2 arguments") % n).str()); var = tenv.var(*++i); c.constrain(tenv, this, tenv.named("Bool")); diff --git a/src/depoly.cpp b/src/depoly.cpp deleted file mode 100644 index cd9c5e8..0000000 --- a/src/depoly.cpp +++ /dev/null @@ -1,110 +0,0 @@ -/* Resp: A programming language - * Copyright (C) 2008-2009 David Robillard - * - * Resp is free software: you can redistribute it and/or modify it under - * the terms of the GNU Affero General Public License as published by the - * Free Software Foundation, either version 3 of the License, or (at your - * option) any later version. - * - * Resp is distributed in the hope that it will be useful, but WITHOUT - * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY - * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General - * Public License for more details. - * - * You should have received a copy of the GNU Affero General Public License - * along with Resp. If not, see . - */ - -/** @file - * @brief Remove polymorphism (compilation pass 2) - * After this pass: - * - All functions definitions have concrete type - */ - -#include "resp.hpp" - -using namespace std; - -AST* -ATuple::depoly(CEnv& cenv, Code& code) throw() -{ - ATuple* ret = new ATuple(*this); - iterator ri = ret->begin(); - FOREACHP(const_iterator, t, this) - *ri++ = (*t)->depoly(cenv, code); - return ret; -} - -AST* -AFn::depoly(CEnv& cenv, Code& code) throw() -{ - return (cenv.type(this)->concrete()) ? this : NULL; -} - -template -AST* -depoly_call(CEnv& cenv, T* call, Code& code) throw() -{ - const AST* head = cenv.resolve(call->head()); - const AFn* callee = head->to(); - - if (!callee || cenv.type(callee)->concrete()) - return call; - - /*pair r = cenv.defs.equal_range(this); - for (CEnv::Defs::iterator i = r.first; i != r.second; ++i) { - if (*i->second.type == *cenv.type(this)) { - ADef* def = i->second.def; - cout << "CACHED LIFTED FN " << def << endl; - return *(def->begin() + 2); - } - }*/ - - // Build arguments type - AType argsT(call->loc); - for (typename T::const_iterator i = call->begin() + 1; i != call->end(); ++i) - argsT.push_back(const_cast(cenv.type(*i))); - - const AType* genericType = cenv.type(callee); - Subst argsSubst = cenv.tenv.buildSubst(genericType, argsT); - const AType* thisType = argsSubst.apply(genericType)->as(); - - // Create a new version of callee for this type - AFn* concreteCallee = new AFn(callee); - ASymbol* newName = cenv.penv.gensym(callee->name.c_str()); - cenv.setType(concreteCallee, thisType); - concreteCallee->name = newName->cppstr; - ADef* def = tup(Cursor(), cenv.penv.sym("def"), newName, concreteCallee, NULL); - cenv.setType(concreteCallee, thisType); - cenv.setType(def, cenv.tenv.named("Nothing")); - code.push_back(def); - - // Create copy of call that calls new concrete callee - ATuple* copy = new T(call); - *copy->begin() = newName; - cenv.setType(copy, (*(thisType->begin() + 2))->as()); - return copy; -} - -AST* -ADef::depoly(CEnv& cenv, Code& code) throw() -{ - // Define stub first for recursion - cenv.def(sym(), body(), cenv.type(body()), NULL); - AFn* c = body()->to(); - if (c) - c->name = sym()->str(); - - ADef* copy = new ADef(ATuple::depoly(cenv, code)->as()); - if (copy->body() == NULL) - return NULL; // Don't attempt to compile polymorphic functions - - cenv.setType(copy, cenv.type(this)); - return copy; -} - -AST* ACall::depoly(CEnv& cenv, Code& code) throw() { return depoly_call(cenv, this, code); } -AST* AIf::depoly(CEnv& cenv, Code& code) throw() { return depoly_call(cenv, this, code); } -AST* ACons::depoly(CEnv& cenv, Code& code) throw() { return depoly_call(cenv, this, code); } -AST* ADot::depoly(CEnv& cenv, Code& code) throw() { return depoly_call(cenv, this, code); } -AST* APrimitive::depoly(CEnv& cenv, Code& code) throw() { return depoly_call(cenv, this, code); } diff --git a/src/lex.cpp b/src/lex.cpp index f633b00..5b6eb73 100644 --- a/src/lex.cpp +++ b/src/lex.cpp @@ -41,15 +41,15 @@ readChar(Cursor& cur, istream& in) AST* readExpression(Cursor& cur, istream& in) { -#define PUSH(s, t) { if (t != "") { s.top()->push_back(new ALexeme(loc, t)); t = ""; } } +#define PUSH(s, t) { if (t != "") { s.top().push_back(new ALexeme(loc, t)); t = ""; } } #define YIELD(s, t) { if (s.empty()) { return new ALexeme(loc, t); } else PUSH(s, t) } - stack stk; - string tok; - Cursor loc; // start of tok + stack< List > stk; + string tok; + Cursor loc; // start of tok while (int c = readChar(cur, in)) { switch (c) { case EOF: - THROW_IF(!stk.empty(), cur, "unexpected end of file") + THROW_IF(!stk.empty(), cur, "unexpected end of file"); return new ATuple(cur); case ';': while ((c = readChar(cur, in)) != '\n') {} @@ -80,7 +80,7 @@ readExpression(Cursor& cur, istream& in) YIELD(stk, tok); break; case '(': - stk.push(new ATuple(cur)); + stk.push(List()); break; case ')': switch (stk.size()) { @@ -89,12 +89,12 @@ readExpression(Cursor& cur, istream& in) throw Error(cur, "unexpected `)'"); case 1: PUSH(stk, tok); - return stk.top(); + return stk.top().head; default: PUSH(stk, tok); - ATuple* l = stk.top(); + List l = stk.top(); stk.pop(); - stk.top()->push_back(l); + stk.top().push_back(l.head); } break; case '#': @@ -109,8 +109,9 @@ readExpression(Cursor& cur, istream& in) } switch (stk.size()) { case 0: return new AString(loc, tok); - case 1: return stk.top(); - default: throw Error(cur, "missing `)'"); + case 1: return stk.top().head; + default: throw Error(cur, "missing `)'"); } - return new ATuple(cur); + assert(false); + return new ATuple(cur); // never reached } diff --git a/src/lift.cpp b/src/lift.cpp index 563fd5d..81b157d 100644 --- a/src/lift.cpp +++ b/src/lift.cpp @@ -57,12 +57,8 @@ AQuote::lift(CEnv& cenv, Code& code) throw() AST* ATuple::lift(CEnv& cenv, Code& code) throw() { - ATuple* ret = new ATuple(*this); - iterator ri = ret->begin(); - FOREACHP(const_iterator, t, this) - *ri++ = (*t)->lift(cenv, code); - cenv.setTypeSameAs(ret, this); - return ret; + assert(false); + return NULL; } AST* @@ -84,24 +80,24 @@ AFn::lift(CEnv& cenv, Code& code) throw() const AType* paramType = (*tp++)->as(); if (paramType->kind == AType::EXPR && *paramType->head() == *cenv.tenv.Fn) { AType* fnType = new AType(*paramType); - fnType->prot()->push_front(const_cast(cenv.tenv.var())); + fnType->prot(new AType(const_cast(cenv.tenv.var()), fnType->prot()->as(), Cursor())); paramType = tup((*p)->loc, cenv.tenv.Tup, fnType, NULL); } - cenv.def((*p)->as(), *p, paramType, NULL); + cenv.def((*p)->as(), *p, paramType, NULL); *ip++ = new AType(*paramType); } - /* Add closure parameter with dummy name (undefined symbol). + /* Prepend closure parameter with dummy name (undefined symbol). * The name of this parameter will be changed to the name of this * function after lifting the body (so recursive references correctly * refer to this function by the closure parameter). */ - impl->prot()->push_front(cenv.penv.sym("_")); + impl->prot(new ATuple(cenv.penv.sym("_"), impl->prot())); // Lift body const AType* implRetT = NULL; - iterator ci = impl->begin() + 2; - for (const_iterator i = begin() + 2; i != end(); ++i, ++ci) { + iterator ci = impl->iter_at(2); + for (iterator i = iter_at(2); i != end(); ++i, ++ci) { *ci = (*i)->lift(cenv, code); implRetT = cenv.type(*ci); } @@ -117,22 +113,22 @@ AFn::lift(CEnv& cenv, Code& code) throw() code.push_back(def); AType* implT = new AType(*type); // Type of the implementation function - AType* tupT = tup(loc, cenv.tenv.Tup, cenv.tenv.var(), NULL); - AType* consT = tup(loc, cenv.tenv.Tup, implT, NULL); - ACons* cons = tup(loc, cenv.penv.sym("Closure"), implName, NULL); + TList tupT(loc, cenv.tenv.Tup, cenv.tenv.var(), NULL); + TList consT(loc, cenv.tenv.Tup, implT, NULL); + List cons(loc, cenv.penv.sym("Closure"), implName, NULL); - *(implT->begin() + 1) = implProtT; + implT->list_ref(1) = implProtT; const CEnv::FreeVars& freeVars = cenv.liftStack.top(); for (CEnv::FreeVars::const_iterator i = freeVars.begin(); i != freeVars.end(); ++i) { - cons->push_back(*i); - tupT->push_back(const_cast(cenv.type(*i))); - consT->push_back(const_cast(cenv.type(*i))); + cons.push_back(*i); + tupT.push_back(const_cast(cenv.type(*i))); + consT.push_back(const_cast(cenv.type(*i))); } cenv.liftStack.pop(); - implT->prot()->push_front(tupT); - *(implT->begin() + 2) = const_cast(implRetT); + implT->prot(new AType(tupT, implT->prot(), Cursor())); + implT->list_ref(2) = const_cast(implRetT); cenv.setType(impl, implT); cenv.setType(cons, consT); @@ -147,19 +143,22 @@ AFn::lift(CEnv& cenv, Code& code) throw() AST* ACall::lift(CEnv& cenv, Code& code) throw() { - ACall* copy = new ACall(this); - ATuple::iterator ri = copy->begin(); + List copy; // Lift all children (callee and arguments, recursively) - for (const_iterator i = begin(); i != end(); ++i) - *ri++ = (*i)->lift(cenv, code); + for (iterator i = begin(); i != end(); ++i) + copy.push_back((*i)->lift(cenv, code)); + + copy.head->loc = loc; + const AType* copyT = NULL; + ASymbol* sym = head()->to(); if (sym && !cenv.liftStack.empty() && sym->cppstr == cenv.liftStack.top().fn->name) { /* Recursive call to innermost function, call implementation directly, * reusing the current "_me" closure parameter (no cons or .). */ - copy->push_front(cenv.penv.sym(cenv.liftStack.top().implName)); + copy.push_front(cenv.penv.sym(cenv.liftStack.top().implName)); } else if (head()->to()) { /* Special case: ((fn ...) ...) * Lifting (fn ...) yields: (Fn _impl ...). @@ -168,24 +167,25 @@ ACall::lift(CEnv& cenv, Code& code) throw() * closure as the first parameter: * (_impl (Fn _impl ...) ...) */ - ACons* closure = (*copy->begin())->as(); - ASymbol* implSym = (*(closure->begin() + 1))->as(); + ACons* closure = copy.head->list_ref(0)->as(); + ASymbol* implSym = closure->list_ref(1)->as(); const AType* implT = cenv.type(cenv.resolve(implSym)); - copy->push_front(implSym); - cenv.setType(copy, (*(implT->begin() + 2))->as()); + copy.push_front(implSym); + copyT = implT->list_ref(2)->as(); } else { // Call to a closure, prepend code to access implementation function ADot* getFn = tup(loc, cenv.penv.sym("."), - copy->head(), - new ALiteral(0, Cursor()), NULL); - const AType* calleeT = cenv.type(copy->head()); + copy.head->head(), + new ALiteral(0, Cursor()), NULL); + const AType* calleeT = cenv.type(copy.head->head()); assert(**calleeT->begin() == *cenv.tenv.Tup); - const AType* implT = (*(calleeT->begin() + 1))->as(); - copy->push_front(getFn); + const AType* implT = calleeT->list_ref(1)->as(); + copy.push_front(getFn); cenv.setType(getFn, implT); - cenv.setType(copy, (*(implT->begin() + 2))->as()); + copyT = implT->list_ref(2)->as(); } + cenv.setType(copy, copyT); return copy; } @@ -198,13 +198,19 @@ ADef::lift(CEnv& cenv, Code& code) throw() if (c) c->name = sym()->str(); - ADef* copy = new ADef(ATuple::lift(cenv, code)->as()); + assert(list_ref(1)->to()); + List copy; + copy.push_back(head()); + copy.push_back(list_ref(1)->lift(cenv, code)); + for (iterator t = iter_at(2); t != end(); ++t) + copy.push_back((*t)->lift(cenv, code)); + + cenv.setTypeSameAs(copy, this); - if (copy->sym() == copy->body()) + if (copy.head->sym() == copy.head->body()) return NULL; // Definition created by AFn::lift when body was lifted - cenv.def(copy->sym(), copy->body(), cenv.type(copy->body()), NULL); - cenv.setTypeSameAs(copy, this); + cenv.def(copy.head->sym(), copy.head->body(), cenv.type(copy.head->body()), NULL); return copy; } @@ -213,10 +219,10 @@ AST* lift_builtin_call(CEnv& cenv, T* call, Code& code) throw() { ATuple* copy = new T(call); - ATuple::iterator ri = copy->begin() + 1; + ATuple::iterator ri = copy->iter_at(1); // Lift all arguments - for (typename T::const_iterator i = call->begin() + 1; i != call->end(); ++i) + for (typename T::iterator i = call->iter_at(1); i != call->end(); ++i) *ri++ = (*i)->lift(cenv, code); cenv.setTypeSameAs(copy, call); diff --git a/src/llvm.cpp b/src/llvm.cpp index 24846cc..3e55b98 100644 --- a/src/llvm.cpp +++ b/src/llvm.cpp @@ -116,7 +116,7 @@ struct LLVMEngine : public Engine { } else if (t->kind == AType::EXPR && isupper(t->head()->str()[0])) { vector ctypes; ctypes.push_back(PointerType::get(Type::getInt8Ty(context), NULL)); // RTTI - for (AType::const_iterator i = t->begin() + 1; i != t->end(); ++i) { + for (AType::const_iterator i = t->iter_at(1); i != t->end(); ++i) { const Type* lt = llType((*i)->to()); if (!lt) return NULL; @@ -132,13 +132,13 @@ struct LLVMEngine : public Engine { const std::string& name, const ATuple* args, const AType* type) { const AType* argsT = type->prot()->as(); - const AType* retT = type->last()->as(); + const AType* retT = type->list_last()->as(); Function::LinkageTypes linkage = Function::ExternalLinkage; vector cprot; FOREACHP(ATuple::const_iterator, i, argsT) { - AType* at = (*i)->as(); + const AType* at = (*i)->as(); THROW_IF(!llType(at), Cursor(), string("non-concrete parameter :: ") + at->str()) cprot.push_back(llType(at)); @@ -278,8 +278,8 @@ LLVMEngine::compileTup(CEnv& cenv, const AType* type, CVal rtti, const vectorgetTargetData()->getTypeSizeInBits(PointerType::get(Type::getInt8Ty(context), NULL)); assert(type->begin() != type->end()); - for (AType::const_iterator i = type->begin() + 1; i != type->end(); ++i) - s += engine->getTargetData()->getTypeSizeInBits(llType((*i)->as())); + for (AType::const_iterator i = type->iter_at(1); i != type->end(); ++i) + s += engine->getTargetData()->getTypeSizeInBits(llType((*i)->as())); // Allocate struct Value* structSize = ConstantInt::get(Type::getInt32Ty(context), bitsToBytes(s)); @@ -346,7 +346,7 @@ LLVMEngine::pushFunctionArgs(CEnv& cenv, const AFn* fn, const AType* type, CFunc const AType* t = (*pT)->as(); const Type* lt = llType(t); THROW_IF(!lt, fn->loc, "untyped parameter\n"); - cenv.def((*p)->as(), *p, t, &*a); + cenv.def((*p)->as(), *p, t, &*a); } } @@ -360,7 +360,7 @@ LLVMEngine::compileIf(CEnv& cenv, const AIf* aif) BasicBlock* nextBB = NULL; Branches branches; size_t idx = 1; - for (AIf::const_iterator i = aif->begin() + 1; ; ++i, idx += 2) { + for (AIf::const_iterator i = aif->iter_at(1); ; ++i, idx += 2) { AIf::const_iterator next = i; if (++next == aif->end()) break; @@ -386,7 +386,7 @@ LLVMEngine::compileIf(CEnv& cenv, const AIf* aif) } // Emit final else block - Value* elseV = llVal(aif->last()->compile(cenv)); + Value* elseV = llVal(aif->list_last()->compile(cenv)); engine->builder.CreateBr(mergeBB); branches.push_back(make_pair(elseV, engine->builder.GetInsertBlock())); @@ -405,7 +405,7 @@ CVal LLVMEngine::compileMatch(CEnv& cenv, const AMatch* match) { typedef vector< pair > Branches; - Value* matchee = llVal((*(match->begin() + 1))->compile(cenv)); + Value* matchee = llVal(match->list_ref(1)->compile(cenv)); Value* rttiPtr = builder.CreateStructGEP(matchee, 0, "matchRTTIPtr"); Value* rtti = builder.CreateLoad(rttiPtr, 0, "matchRTTI"); @@ -416,7 +416,7 @@ LLVMEngine::compileMatch(CEnv& cenv, const AMatch* match) Branches branches; size_t idx = 1; - for (AMatch::const_iterator i = match->begin() + 2; i != match->end(); ++idx) { + for (AMatch::const_iterator i = match->iter_at(2); i != match->end(); ++idx) { const AST* pat = *i++; const AST* body = *i++; const ASymbol* sym = pat->to()->head()->as(); diff --git a/src/parse.cpp b/src/parse.cpp index 28279f9..066db76 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -23,13 +23,14 @@ using namespace std; -ATuple* +template +T* parseTuple(PEnv& penv, const ATuple* e) { - ATuple* ret = new ATuple(e->loc); + List ret; FOREACHP(ATuple::const_iterator, i, e) - ret->push_back(penv.parse(*i)); - return ret; + ret.push_back(penv.parse(*i)); + return ret.head; } AST* @@ -57,10 +58,10 @@ PEnv::parse(const AST* exp) return h->func(*this, exp, h->arg); // Parse special form if (isupper(form->c_str()[0])) // Call constructor (any uppercase symbol) - return new ACons(parseTuple(*this, tup)); + return parseTuple(*this, tup); } - return new ACall(parseTuple(*this, tup)); // Parse regular call + return parseTuple(*this, tup); // Parse regular call } const ALexeme* lex = exp->to(); @@ -92,29 +93,34 @@ macDef(PEnv& penv, const AST* exp) const ATuple* tup = exp->to(); ATuple::const_iterator i = tup->begin(); THROW_IF(i == tup->end(), tup->loc, "Unexpected end of `def' macro call"); - const AST* name = *(++i); - THROW_IF(i == tup->end(), name->loc, "Unexpected end of `def' macro call"); - if (name->to()) { + const AST* arg1 = *(++i); + THROW_IF(i == tup->end(), arg1->loc, "Unexpected end of `def' macro call"); + if (arg1->to()) { return const_cast(exp); } else { - const ATuple* pat = name->to(); - name = pat->head(); // (def (f x) y) => (def f (fn (x) y)) - ATuple* argsExp = new ATuple(exp->loc); + const ATuple* pat = arg1->to(); + + List argsExp; ATuple::const_iterator j = pat->begin(); for (++j; j != pat->end(); ++j) - argsExp->push_back(*j); + argsExp.push_back(const_cast(*j)); + argsExp.head->loc = exp->loc; const AST* body = *(++i); - ATuple* fnExp = new ATuple(body->loc); - fnExp->push_back(new ALexeme(exp->loc, "fn")); - fnExp->push_back(argsExp); + + List fnExp; + fnExp.push_back(new ALexeme(exp->loc, "fn")); + fnExp.push_back(argsExp.head); for (; i != tup->end(); ++i) - fnExp->push_back(*i); - ATuple* ret = new ATuple(exp->loc); - ret->push_back(const_cast(tup->head())); - ret->push_back(const_cast(name)); - ret->push_back(fnExp); - return ret; + fnExp.push_back(const_cast(*i)); + fnExp.head->loc = body->loc; + + List ret; + ret.push_back(const_cast(tup->head())); + ret.push_back(const_cast(pat->head())); + ret.push_back(fnExp.head); + ret.head->loc = exp->loc; + return ret.head; } } @@ -127,7 +133,7 @@ template inline AST* parseCall(PEnv& penv, const AST* exp, void* arg) { - return new C(parseTuple(penv, exp->to())); + return parseTuple(penv, exp->to()); } template @@ -143,19 +149,21 @@ parseFn(PEnv& penv, const AST* exp, void* arg) const ATuple* texp = exp->to(); ATuple::const_iterator a = texp->begin(); THROW_IF(++a == texp->end(), exp->loc, "Unexpected end of `fn' form"); - ATuple* prot = parseTuple(penv, (*a++)->to()); - AFn* ret = tup(exp->loc, penv.sym("fn"), prot, 0); + ATuple* prot = parseTuple(penv, (*a++)->to()); + List ret(new ATuple(penv.sym("fn"), NULL)); + ret.push_back(prot); while (a != texp->end()) - ret->push_back(penv.parse(*a++)); - return ret; + ret.push_back(penv.parse(*a++)); + ret.head->loc = exp->loc; + return new AFn(ret.head); } inline AST* parseQuote(PEnv& penv, const AST* exp, void* arg) { const ATuple* texp = exp->to(); - THROW_IF(texp->size() != 2, exp->loc, "`quote' requires exactly 1 argument"); - const AST* quotee = (*(texp->begin() + 1))->to(); + THROW_IF(texp->list_len() != 2, exp->loc, "`quote' requires exactly 1 argument"); + const ALexeme* quotee = texp->list_ref(1)->to(); THROW_IF(!quotee, exp->loc, "`quote' argument is not a lexeme"); return new AQuote(texp); } diff --git a/src/pprint.cpp b/src/pprint.cpp index 7a463cc..003d447 100644 --- a/src/pprint.cpp +++ b/src/pprint.cpp @@ -32,7 +32,7 @@ newline(ostream& out, unsigned indent) out << " "; } -void +ostream& print_tuple(ostream& out, const ATuple* tup, ATuple::const_iterator i, unsigned indent, bool newlines, CEnv* cenv, bool types, bool elem_types) { @@ -53,6 +53,8 @@ print_tuple(ostream& out, const ATuple* tup, ATuple::const_iterator i, i = next; } + + return (out << ")"); } ostream& @@ -97,62 +99,70 @@ print_to(ostream& out, const AST* ast, unsigned indent, CEnv* cenv, bool types) if (tup) { out << "("; ATuple::const_iterator i = tup->begin(); - const ASymbol* head = (i == tup->end()) ? NULL : (*i)->to(); - if (head) { - if (head == cenv->penv.sym("def")) { - out << (*i++) << " "; - - // Print symbol (possibly with type annotation) - const AST* sym = *i++; - out << sym; - if (types) - out << " :" << cenv->tsubst.apply(cenv->tenv.var(sym)); - - // Print value on following lines, indented - newline(out, indent + 2); - print_tuple(out, tup, i, indent, true, cenv, types, false); - return out << ")"; + + std::string form = ""; + if (i != tup->end()) { + const ASymbol* sym = (*i)->to(); + if (sym) { + form = sym->cppstr; + } else { + const ALexeme* lexeme = (*i)->to(); + if (lexeme) + form = *lexeme; + } + } + + if (form == "def") { + out << (*i++) << " "; + + // Print symbol (possibly with type annotation) + const AST* sym = *i++; + out << sym; + if (types) + out << " :" << cenv->tsubst.apply(cenv->tenv.var(sym)); + + // Print value on following lines, indented + newline(out, indent + 2); + return print_tuple(out, tup, i, indent, true, cenv, types, false); - } else if (head == cenv->penv.sym("fn")) { - out << (*i++) << " "; - const ATuple* pat = (*i++)->as(); + } else if (form == "fn") { + out << (*i++) << " "; + const ATuple* pat = (*i++)->as(); - // Print prototype (possibly with parameter type annotations) - out << "("; - print_tuple(out, pat, pat->begin(), indent, false, cenv, types, types); - out << ")"; + // Print prototype (possibly with parameter type annotations) + out << "("; + print_tuple(out, pat, pat->begin(), indent, false, cenv, types, types); - // Print body expression(s) on following lines, indented - newline(out, indent + 2); - print_tuple(out, tup, i, indent + 2, true, cenv, types, false); - return out << ")"; + // Print body expression(s) on following lines, indented + newline(out, indent + 2); + return print_tuple(out, tup, i, indent + 2, true, cenv, types, false); - } else if (head == cenv->penv.sym("if")) { - out << (*i++) << " "; + } else if (form == "if") { + out << (*i++) << " "; - // Print each condition and consequent pair separated by blank lines - for (; i != tup->end(); ) { - ATuple::const_iterator next = i; - ++next; + // Print each condition and consequent pair separated by blank lines + for (; i != tup->end(); ) { + ATuple::const_iterator next = i; + ++next; - print_to(out, *i, indent + 2, cenv, types); - if (next != tup->end()) { - newline(out, indent + 2); - print_to(out, *next++, indent + 2, cenv, types); - newline(out, 0); - newline(out, indent + 2); - } - - i = next; + print_to(out, *i, indent + 2, cenv, types); + if (next != tup->end()) { + newline(out, indent + 2); + print_to(out, *next++, indent + 2, cenv, types); + newline(out, 0); + newline(out, indent + 2); } + + i = next; } - } - // Print plain tuple - print_tuple(out, tup, i, indent + 1, false, cenv, types, false); - return out << ")"; + return out; + + } else { + return print_tuple(out, tup, i, indent + 1, false, cenv, types, false); + } } - + return out << "?"; } diff --git a/src/repl.cpp b/src/repl.cpp index c2a50f5..d0a251b 100644 --- a/src/repl.cpp +++ b/src/repl.cpp @@ -35,7 +35,7 @@ readParseType(CEnv& cenv, Cursor& cursor, istream& is, AST*& exp, AST*& ast) is.ignore(std::numeric_limits::max(), '\n'); // Skip REPL junk throw e; } - + if (exp->to() && exp->to()->empty()) return false; @@ -87,39 +87,16 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute) try { while (readParseType(cenv, cursor, is, exp, ast)) parsed.push_back(ast); - if (cenv.args.find("-T") != cenv.args.end()) { for (list::const_iterator i = parsed.begin(); i != parsed.end(); ++i) - pprint(cout, (*i), &cenv, true); + pprint(cout, *i, &cenv, true); return 0; } CVal val = NULL; CFunc f = NULL; - /* - // De-poly all expressions - Code concrete; - for (list::iterator i = parsed.begin(); i != parsed.end(); ++i) { - AST* c = (*i)->depoly(cenv, concrete); - if (c) - concrete.push_back(c); - } - - if (cenv.args.find("-d") != cenv.args.end()) { - cout << endl << ";;;; CONCRETE {" << endl << endl; - for (Code::iterator i = concrete.begin(); i != concrete.end(); ++i) { - cout << *i << endl; - ADef* def = (*i)->to(); - if (def) - std::cout << " :: " << cenv.type(def->body()) << std::endl; - cout << endl; - } - cout << ";;;; } CONCRETE" << endl << endl; - } - */ - // Lift all expressions Code lifted; for (list::iterator i = parsed.begin(); i != parsed.end(); ++i) { @@ -128,32 +105,29 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute) lifted.push_back(l); } - if (cenv.args.find("-d") != cenv.args.end()) { - cout << endl << ";;;; LIFTED {" << endl << endl; - for (Code::iterator i = lifted.begin(); i != lifted.end(); ++i) { - cout << *i << endl; - ADef* def = (*i)->to(); - if (def) - std::cout << " :: " << cenv.type(def->body()) << std::endl; - cout << endl; - } - cout << ";;;; } LIFTED" << endl << endl; + if (cenv.args.find("-L") != cenv.args.end()) { + for (Code::const_iterator i = lifted.begin(); i != lifted.end(); ++i) + pprint(cout, *i, &cenv, true); + return 0; } // Compile top-level (lifted) functions Code exprs; - for (Code::iterator i = lifted.begin(); i != lifted.end(); ++i) { - ADef* def = (*i)->to(); - if (def && (*(def->begin() + 2))->to()) { + for (Code::const_iterator i = lifted.begin(); i != lifted.end(); ++i) { + const ADef* def = (*i)->to(); + if (def && def->list_ref(2)->to()) { val = def->compile(cenv); } else { - exprs.push_back(*i); + assert(*i); + ATuple* tup = (*i)->to(); + if (!tup || (tup->tup_len() > 0)) + exprs.push_back(*i); } } const AType* type = cenv.type(exprs.back()); const AType* fnT = tup(cursor, cenv.tenv.Fn, new AType(cursor), type, 0); - + // Create function for top-level of program f = cenv.engine()->startFunction(cenv, "main", new ATuple(cursor), fnT); @@ -164,12 +138,13 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute) // Finish compilation cenv.engine()->finishFunction(cenv, f, val); - if (cenv.args.find("-d") != cenv.args.end()) + if (cenv.args.find("-S") != cenv.args.end()) { cenv.engine()->writeModule(cenv, cenv.out); + return 0; + } - // Call and print ast - if (cenv.args.find("-S") == cenv.args.end()) - callPrintCollect(cenv, f, ast, type, execute); + // Call and print result + callPrintCollect(cenv, f, ast, type, execute); } catch (Error& e) { cenv.err << e.what() << endl; diff --git a/src/resp.cpp b/src/resp.cpp index 4da92e3..96df3b7 100644 --- a/src/resp.cpp +++ b/src/resp.cpp @@ -39,9 +39,9 @@ print_usage(char* name, bool error) os << " -r Enter REPL after evaluating files" << endl; os << " -b BACKEND Use backend (llvm or c)" << endl; os << " -g Debug (disable optimisation)" << endl; - os << " -d Dump generated code during compilation" << endl; os << " -P Parse and pretty-print only" << endl; os << " -T Type check and annotate only" << endl; + os << " -L Lambda lift only" << endl; os << " -S Compile to assembly only (do not evaluate)" << endl; os << " -e EXPRESSION Evaluate EXPRESSION" << endl; os << " -o FILE Compile output to FILE (don't run)" << endl; @@ -61,9 +61,9 @@ main(int argc, char** argv) files.push_back(argv[i]); } else if (!strncmp(argv[i], "-r", 3) || !strncmp(argv[i], "-g", 3) - || !strncmp(argv[i], "-d", 3) || !strncmp(argv[i], "-P", 3) || !strncmp(argv[i], "-T", 3) + || !strncmp(argv[i], "-L", 3) || !strncmp(argv[i], "-S", 3)) { args.insert(make_pair(argv[i], "")); } else if (i == argc-1 || argv[i+1][0] == '-') { @@ -116,6 +116,9 @@ main(int argc, char** argv) while (is.good() && !is.eof()) { Cursor loc(*f); AST* exp = readExpression(loc, is); + if (!exp || (exp->as() && exp->as()->tup_len() == 1)) + break; + AST* ast = penv.parse(exp); pprint(os, ast, cenv, false); is.ignore(std::numeric_limits::max(), '\n'); // Skip newlines diff --git a/src/resp.hpp b/src/resp.hpp index 3f73f2f..26038b6 100644 --- a/src/resp.hpp +++ b/src/resp.hpp @@ -204,9 +204,7 @@ struct AST : public Object { virtual bool operator==(const AST& o) const = 0; virtual bool contains(const AST* child) const { return false; } virtual void constrain(TEnv& tenv, Constraints& c) const throw(Error) {} - virtual AST* cps(TEnv& tenv, AST* cont) const; virtual AST* lift(CEnv& cenv, Code& code) throw() { return this; } - virtual AST* depoly(CEnv& cenv, Code& code) throw() { return this; } virtual CVal compile(CEnv& env) const throw() = 0; string str() const { ostringstream ss; ss << this; return ss.str(); } template T to() { return dynamic_cast(this); } @@ -280,42 +278,148 @@ struct ATuple : public AST { _vec = (AST**)malloc(sizeof(AST*) * _len); memcpy(_vec, exp._vec, sizeof(AST*) * _len); } + ATuple(AST* first, AST* rest, Cursor c=Cursor()) : AST(c), _len(2) { + _vec = (AST**)malloc(sizeof(AST*) * _len); + _vec[0] = first; + _vec[1] = rest; + } ATuple(Cursor c, AST* ast, va_list args) : AST(c), _len(0), _vec(0) { if (!ast) return; - push_back(ast); - for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*)) - push_back(a); + + _len = 2; + _vec = (AST**)malloc(sizeof(AST*) * _len); + _vec[0] = ast; + _vec[1] = NULL; + + ATuple* tail = this; + for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*)) { + ATuple* tup = new ATuple(a, NULL); + tail->last(tup); + tail = tup; + } } + ~ATuple() { free(_vec); } - void push_back(AST* ast) { - AST** newvec = (AST**)realloc(_vec, sizeof(AST*) * (_len + 1)); - newvec[_len++] = ast; - _vec = newvec; - } - void push_front(AST* ast) { - AST** newvec = (AST**)malloc(sizeof(AST*) * (_len + 1)); - newvec[0] = ast; - memcpy(newvec + 1, _vec, sizeof(AST*) * _len++); - _vec = newvec; - } const AST* head() const { assert(_len > 0); return _vec[0]; } - AST* head() { assert(_len > 0); return _vec[0]; } + AST*& head() { assert(_len > 0); return _vec[0]; } const AST* last() const { return _vec[_len - 1]; } - AST* last() { return _vec[_len - 1]; } - size_t size() const { return _len; } + AST*& last() { return _vec[_len - 1]; } bool empty() const { return _len == 0; } - typedef AST** iterator; - typedef AST* const* const_iterator; - const_iterator begin() const { return _vec; } - iterator begin() { return _vec; } - const_iterator end() const { return _vec + _len; } - iterator end() { return _vec + _len; } + size_t tup_len() const { return _len; } + size_t list_len() const { + size_t ret = 0; + for (const_iterator i = begin(); i != end(); ++i, ++ret) {} + return ret; + } + + const AST* list_last() const { + for (const_iterator i = begin(); i != end();) { + const_iterator next = i; + ++next; + + if (next == end()) + return *i; + i = next; + } + + return NULL; + } + + void last(AST* ast) { _vec[_len - 1] = ast; } + + struct iterator { + iterator(ATuple* n) : node(n) { + assert(!n || n->tup_len() == 0 || n->tup_len() == 2); + if (!n || n->tup_len() == 0) + node = NULL; + } + inline void increment() { + if (node->last()) + node = node->last()->as(); + else + node = NULL; + } + inline iterator& operator++() { + assert(node); + increment(); + return *this; + } + inline iterator operator++(int) { + assert(node); + const iterator ret(node); + increment(); + return ret; + } + inline bool operator==(const iterator& i) const { return node == i.node; } + inline bool operator!=(const iterator& i) const { return node != i.node; } + AST*& operator*() { return node->head(); } + ATuple* node; + }; + + struct const_iterator { + const_iterator(const ATuple* n) : node(n) { + assert(!n || n->tup_len() == 0 || n->tup_len() == 2); + if (!n || n->tup_len() == 0) + node = NULL; + } + const_iterator(const iterator& i) : node(i.node) {} + inline void increment() { + if (node->last()) + node = node->last()->as(); + else + node = NULL; + } + inline const_iterator& operator++() { + assert(node); + increment(); + return *this; + } + inline const_iterator operator++(int) { + assert(node); + const const_iterator ret(node); + increment(); + return ret; + } + inline bool operator==(const const_iterator& i) const { + return node == i.node || (!node && i.node->tup_len() == 0); + } + inline bool operator!=(const const_iterator& i) const { + return !operator==(i); + } + const AST* operator*() { return node->head(); } + const ATuple* node; + }; + + const_iterator begin() const { assert(_len == 0 || _len == 2); return const_iterator(this); } + iterator begin() { assert(_len == 0 || _len == 2); return iterator(this); } + const_iterator end() const { return const_iterator(NULL); } + iterator end() { return iterator(NULL); } + + const_iterator iter_at(unsigned index) const { + const_iterator i = begin(); + for (unsigned idx = 0; idx != index; ++i, ++idx) { + assert(i != end()); + } + return i; + } + + iterator iter_at(unsigned index) { + iterator i = begin(); + for (unsigned idx = 0; idx != index; ++i, ++idx) { + assert(i != end()); + } + return i; + } + + AST*& list_ref(unsigned index) { return *iter_at(index); } + const AST* list_ref(unsigned index) const { return *iter_at(index); } + bool value() const { return false; } bool operator==(const AST& rhs) const { const ATuple* rt = rhs.to(); - if (!rt || rt->size() != size()) return false; + if (!rt || rt->tup_len() != tup_len()) return false; const_iterator l = begin(); FOREACHP(const_iterator, r, rt) if (!(*(*l++) == *(*r))) @@ -331,8 +435,6 @@ struct ATuple : public AST { } void constrain(TEnv& tenv, Constraints& c) const throw(Error); AST* lift(CEnv& cenv, Code& code) throw(); - AST* depoly(CEnv& cenv, Code& code) throw(); - CVal compile(CEnv& env) const throw(); private: @@ -340,17 +442,21 @@ private: AST** _vec; }; + /// Type Expression, e.g. "Int", "(Fn (Int Int) Float)" struct AType : public ATuple { enum Kind { VAR, NAME, PRIM, EXPR, DOTS }; - AType(ASymbol* s, Kind k) : ATuple(s->loc), kind(k), id(0) { push_back(s); } + AType(ASymbol* s, Kind k) : ATuple(s, NULL, s->loc), kind(k), id(0) {} AType(Cursor c, unsigned i) : ATuple(c), kind(VAR), id(i) {} AType(Cursor c, Kind k=EXPR) : ATuple(c), kind(k), id(0) {} AType(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args), kind(EXPR), id(0) {} - AType(const AType& copy) : ATuple(copy), kind(copy.kind), id(copy.id) { } + AType(AST* first, AST* rest, Cursor c) : ATuple(first, rest, c), kind(EXPR), id(0) {} + AType(const AType& copy) : ATuple(copy), kind(copy.kind), id(copy.id) {} CVal compile(CEnv& cenv) const throw(); - const ATuple* prot() const { assert(kind == EXPR); return (*(begin() + 1))->to(); } - ATuple* prot() { assert(kind == EXPR); return (*(begin() + 1))->to(); } + const ATuple* prot() const { assert(kind == EXPR); return list_ref(1)->to(); } + ATuple* prot() { assert(kind == EXPR); return list_ref(1)->to(); } + void prot(ATuple* prot) { assert(kind == EXPR); *iter_at(1) = prot; } + bool concrete() const { switch (kind) { case VAR: return false; @@ -358,7 +464,7 @@ struct AType : public ATuple { case PRIM: return head()->str() != "Nothing"; case EXPR: FOREACHP(const_iterator, t, this) { - AType* kid = (*t)->to(); + const AType* kid = (*t)->to(); if (kid && !kid->concrete()) return false; } @@ -385,18 +491,54 @@ struct AType : public ATuple { unsigned id; }; +// Utility class for easily building lists from left to right +template // ConsType, ElementType +struct List { + List(CT* h=0) : head(h), tail(0) {} + List(Cursor c, ET* ast, ...) : head(0), tail(0) { + push_back(ast); + assert(*head->begin() == ast); + head->loc = c; + va_list args; + va_start(args, ast); + for (ET* a = va_arg(args, ET*); a; a = va_arg(args, ET*)) + push_back(a); + va_end(args); + } + void push_back(ET* ast) { + if (!head) { + head = new CT(ast, NULL, Cursor()); + } else if (!tail) { + CT* node = new CT(ast, NULL, Cursor()); + head->last(node); + tail = node; + } else { + CT* node = new CT(ast, NULL, Cursor()); + tail->last(node); + tail = node; + } + } + void push_front(ET* ast) { + head = new CT(ast, head, Cursor()); + } + operator CT*() const { return head; } + CT* head; + CT* tail; +}; + +typedef List TList; + /// Fn (first-class function with captured lexical bindings) struct AFn : public ATuple { AFn(const ATuple* exp) : ATuple(*exp) {} AFn(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args) {} bool operator==(const AST& rhs) const { return this == &rhs; } void constrain(TEnv& tenv, Constraints& c) const throw(Error); - AST* cps(TEnv& tenv, AST* cont) const; AST* lift(CEnv& cenv, Code& code) throw(); - AST* depoly(CEnv& cenv, Code& code) throw(); CVal compile(CEnv& env) const throw(); - const ATuple* prot() const { return (*(begin() + 1))->to(); } - ATuple* prot() { return (*(begin() + 1))->to(); } + const ATuple* prot() const { return list_ref(1)->to(); } + ATuple* prot() { return list_ref(1)->to(); } + void prot(ATuple* prot) { *iter_at(1) = prot; } string name; }; @@ -404,10 +546,9 @@ struct AFn : public ATuple { struct ACall : public ATuple { ACall(const ATuple* exp) : ATuple(*exp) {} ACall(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args) {} + ACall(AST* first, AST* rest, Cursor c) : ATuple(first, rest, c) {} void constrain(TEnv& tenv, Constraints& c) const throw(Error); - AST* cps(TEnv& tenv, AST* cont) const; AST* lift(CEnv& cenv, Code& code) throw(); - AST* depoly(CEnv& cenv, Code& code) throw(); CVal compile(CEnv& env) const throw(); }; @@ -415,8 +556,9 @@ struct ACall : public ATuple { struct ADef : public ACall { ADef(const ATuple* exp) : ACall(exp) {} ADef(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {} + ADef(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {} const ASymbol* sym() const { - const AST* name = *(begin() + 1); + const AST* name = list_ref(1); const ASymbol* sym = name->to(); if (!sym) { const ATuple* tup = name->to(); @@ -425,33 +567,29 @@ struct ADef : public ACall { } return sym; } - const AST* body() const { return *(begin() + 2); } - AST* body() { return *(begin() + 2); } + const AST* body() const { return list_ref(2); } + AST* body() { return list_ref(2); } void constrain(TEnv& tenv, Constraints& c) const throw(Error); - AST* cps(TEnv& tenv, AST* cont) const; AST* lift(CEnv& cenv, Code& code) throw(); - AST* depoly(CEnv& cenv, Code& code) throw(); CVal compile(CEnv& env) const throw(); }; struct ADefType : public ACall { ADefType(const ATuple* exp) : ACall(exp) {} ADefType(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {} - const ASymbol* sym() const { return (*(begin() + 1))->as(); } + ADefType(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {} + const ASymbol* sym() const { return list_ref(1)->as(); } void constrain(TEnv& tenv, Constraints& c) const throw(Error); - AST* cps(TEnv& tenv, AST* cont) const; AST* lift(CEnv& cenv, Code& code) throw() { return this; } - AST* depoly(CEnv& cenv, Code& code) throw() { return this; } CVal compile(CEnv& env) const throw() { return NULL; } }; struct AMatch : public ACall { AMatch(const ATuple* exp) : ACall(exp) {} AMatch(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {} + AMatch(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {} void constrain(TEnv& tenv, Constraints& c) const throw(Error); - AST* cps(TEnv& tenv, AST* cont) const; AST* lift(CEnv& cenv, Code& code) throw() { return this; } - AST* depoly(CEnv& cenv, Code& code) throw() { return this; } CVal compile(CEnv& env) const throw(); }; @@ -459,34 +597,34 @@ struct AMatch : public ACall { struct AIf : public ACall { AIf(const ATuple* exp) : ACall(exp) {} AIf(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {} + AIf(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {} void constrain(TEnv& tenv, Constraints& c) const throw(Error); - AST* cps(TEnv& tenv, AST* cont) const; AST* lift(CEnv& cenv, Code& code) throw(); - AST* depoly(CEnv& cenv, Code& code) throw(); CVal compile(CEnv& env) const throw(); }; struct ACons : public ACall { ACons(const ATuple* exp) : ACall(exp) {} ACons(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {} + ACons(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {} void constrain(TEnv& tenv, Constraints& c) const throw(Error); AST* lift(CEnv& cenv, Code& code) throw(); - AST* depoly(CEnv& cenv, Code& code) throw(); CVal compile(CEnv& env) const throw(); }; struct ADot : public ACall { ADot(const ATuple* exp) : ACall(exp) {} ADot(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {} + ADot(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {} void constrain(TEnv& tenv, Constraints& c) const throw(Error); AST* lift(CEnv& cenv, Code& code) throw(); - AST* depoly(CEnv& cenv, Code& code) throw(); CVal compile(CEnv& env) const throw(); }; /// Primitive (builtin arithmetic function), e.g. "(+ 2 3)" struct APrimitive : public ACall { APrimitive(const ATuple* exp) : ACall(exp) {} + APrimitive(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {} bool value() const { ATuple::const_iterator i = begin(); for (++i; i != end(); ++i) @@ -495,14 +633,13 @@ struct APrimitive : public ACall { return true; } void constrain(TEnv& tenv, Constraints& c) const throw(Error); - AST* cps(TEnv& tenv, AST* cont) const; AST* lift(CEnv& cenv, Code& code) throw(); - AST* depoly(CEnv& cenv, Code& code) throw(); CVal compile(CEnv& env) const throw(); }; struct AQuote : public ACall { AQuote(const ATuple* exp) : ACall(exp) {} + AQuote(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {} void constrain(TEnv& tenv, Constraints& c) const throw(Error); AST* lift(CEnv& cenv, Code& code) throw(); CVal compile(CEnv& env) const throw(); @@ -579,10 +716,11 @@ struct Subst : public list { } const AType* apply(const AType* in) const { if (in->kind == AType::EXPR) { - AType* out = tup(in->loc, NULL); + TList out; for (ATuple::const_iterator i = in->begin(); i != in->end(); ++i) - out->push_back(const_cast(apply((*i)->as()))); - return out; + out.push_back(const_cast(apply((*i)->as()))); + out.head->loc = in->loc; + return out.head; } else { const_iterator i = find(in); if (i != end()) { diff --git a/src/unify.cpp b/src/unify.cpp index a4ea035..9165d49 100644 --- a/src/unify.cpp +++ b/src/unify.cpp @@ -31,19 +31,19 @@ TEnv::buildSubst(const AType* genericT, const AType& argsT) Subst subst; // Build substitution to apply to generic type - const ATuple* genericProtT = (*(genericT->begin() + 1))->as(); + const ATuple* genericProtT = genericT->list_ref(1)->as(); ATuple::const_iterator g = genericProtT->begin(); AType::const_iterator a = argsT.begin(); for (; a != argsT.end(); ++a, ++g) { const AType* genericArgT = (*g)->to(); - AType* callArgT = (*a)->to(); + const AType* callArgT = (*a)->to(); if (callArgT->kind == AType::EXPR) { assert(genericArgT->kind == AType::EXPR); ATuple::const_iterator gi = genericArgT->begin(); ATuple::const_iterator ci = callArgT->begin(); for (; gi != genericArgT->end(); ++gi, ++ci) { const AType* gT = (*gi)->to(); - AType* aT = (*ci)->to(); + const AType* aT = (*ci)->to(); if (gT && aT) subst.add(gT, aT); } @@ -64,29 +64,27 @@ Constraints::constrain(TEnv& tenv, const AST* o, const AType* t) push_back(Constraint(tenv.var(o), t)); } -template -static const T* -substitute(const T* tup, const E* from, const E* to) +static const AType* +substitute(const AType* tup, const AType* from, const AType* to) { if (!tup) return NULL; - T* ret = new T(*tup); - typename T::iterator ri = ret->begin(); - FOREACHP(typename T::const_iterator, i, tup) { + TList ret; + FOREACHP(AType::const_iterator, i, tup) { if (**i == *from) { - T* type = new T(*to); + AType* type = new AType(*to); type->loc = (*i)->loc; - *ri++ = type; - } else if (static_cast(*i) != static_cast(to)) { - const T* subTup = dynamic_cast(*i); - if (subTup) - *ri++ = const_cast(substitute(subTup, from, to)); + ret.push_back(type); + } else if (*i != to) { + const AType* elem = (*i)->as(); + if (elem->kind == AType::EXPR) + ret.push_back(const_cast(substitute(elem, from, to))); else - *ri++ = *i; + ret.push_back(const_cast(elem)); } else { - ++ri; + ret.push_back(const_cast((*i)->as())); } } - return ret; + return ret.head; } /// Compose two substitutions (TAPL 22.1.1) @@ -114,14 +112,14 @@ Constraints::replace(const AType* s, const AType* t) AType* type = new AType(*t); type->loc = c->first->loc; c->first = type; - } else { + } else if (c->first->kind == AType::EXPR) { c->first = substitute(c->first, s, t); } if (*c->second == *s) { AType* type = new AType(*t); type->loc = c->second->loc; c->second = type; - } else { + } else if (c->second->kind == AType::EXPR) { c->second = substitute(c->second, s, t); } } @@ -150,15 +148,15 @@ unify(const Constraints& constraints) AType::const_iterator si = s->begin(); AType::const_iterator ti = t->begin(); for (; si != s->end() && ti != t->end(); ++si, ++ti) { - AType* st = (*si)->as(); - AType* tt = (*ti)->as(); + const AType* st = (*si)->as(); + const AType* tt = (*ti)->as(); if (st->kind == AType::DOTS || tt->kind == AType::DOTS) return unify(cp); else cp.push_back(Constraint(st, tt)); } - if ( (si == s->end() && (ti == t->end() || (*ti)->as()->kind == AType::DOTS)) - || (ti == t->end() && (*si)->as()->kind == AType::DOTS)) + if ( (si == s->end() && (ti == t->end() || (*ti)->as()->kind == AType::DOTS)) + || (ti == t->end() && (*si)->as()->kind == AType::DOTS)) return unify(cp); } throw Error(s->loc, -- cgit v1.2.1