From 0b014dee824646461b7d402bf9bbcf954ff0eba3 Mon Sep 17 00:00:00 2001 From: David Robillard Date: Mon, 27 Dec 2010 17:51:29 +0000 Subject: Kill AType. git-svn-id: http://svn.drobilla.net/resp/resp@359 ad02d1e2-f140-0410-9f75-f8b11f17cedd --- src/c.cpp | 84 ++++++++++--------- src/compile.cpp | 57 ++++++------- src/constrain.cpp | 83 +++++++++---------- src/cps.cpp | 26 +++--- src/expand.cpp | 14 ++-- src/gc.cpp | 2 +- src/lift.cpp | 64 +++++++-------- src/llvm.cpp | 97 +++++++++++----------- src/parse.cpp | 2 +- src/pprint.cpp | 11 +-- src/repl.cpp | 15 ++-- src/resp.hpp | 237 ++++++++++++++++++++++++------------------------------ src/simplify.cpp | 29 +++---- src/unify.cpp | 102 +++++++++++------------ 14 files changed, 394 insertions(+), 429 deletions(-) diff --git a/src/c.cpp b/src/c.cpp index 65a939d..d139c35 100644 --- a/src/c.cpp +++ b/src/c.cpp @@ -41,25 +41,25 @@ struct CEngine : public Engine { { } - CFunc startFn(CEnv& cenv, const string& name, const ATuple* args, const AType* type); - void pushFnArgs(CEnv& cenv, const ATuple* prot, const AType* type, CFunc f); + CFunc startFn(CEnv& cenv, const string& name, const ATuple* args, const ATuple* type); + void pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f); void finishFn(CEnv& cenv, CFunc f, CVal ret); void eraseFn(CEnv& cenv, CFunc f); - CVal compileCall(CEnv& cenv, CFunc f, const AType* funcT, const vector& args); - CVal compileCons(CEnv& cenv, const AType* type, CVal rtti, const vector& fields); + CVal compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector& args); + CVal compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector& fields); CVal compileDot(CEnv& cenv, CVal tup, int32_t index); - CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AType* t); + CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t); CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v); CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse); - CVal compileIsA(CEnv& cenv, CVal rtti, const ASymbol* tag); + CVal compileIsA(CEnv& cenv, CVal rtti, CVal tag); CVal compileLiteral(CEnv& cenv, const AST* lit); CVal compilePrimitive(CEnv& cenv, const ATuple* prim); CVal compileString(CEnv& cenv, const char* str); void writeModule(CEnv& cenv, std::ostream& os); - const string call(CEnv& cenv, CFunc f, const AType* retT); + const string call(CEnv& cenv, CFunc f, const AST* retT); private: typedef string Type; @@ -73,34 +73,34 @@ private: inline Value* llVal(CVal v) { return static_cast(v); } inline Function* llFunc(CFunc f) { return static_cast(f); } - const Type* llType(const AType* t); + const Type* llType(const AST* t); std::string out; }; const CEngine::Type* -CEngine::llType(const AType* t) +CEngine::llType(const AST* t) { if (t == NULL) { return NULL; - } else if (t->kind == AType::NAME) { - if (t->head()->str() == "Nothing") return new string("void"); - if (t->head()->str() == "Bool") return new string("bool"); - if (t->head()->str() == "Int") return new string("int"); - if (t->head()->str() == "Float") return new string("float"); - if (t->head()->str() == "String") return new string("char*"); - if (t->head()->str() == "Quote") return new string("char*"); - } else if (t->kind == AType::EXPR && t->head()->str() == "Fn") { - AType::const_iterator i = t->begin(); - const ATuple* protT = (*++i)->to_tuple(); - const AType* retT = (*i)->as_type(); + } else if (AType::is_name(t)) { + const std::string sym(t->as_symbol()->sym()); + if (sym == "Nothing") return new string("void"); + if (sym == "Bool") return new string("bool"); + if (sym == "Int") return new string("int"); + if (sym == "Float") return new string("float"); + if (sym == "String") return new string("char*"); + if (sym == "Quote") return new string("char*"); + } else if (is_form(t, "Fn")){ + ATuple::const_iterator i = t->as_tuple()->begin(); + const ATuple* protT = (*++i)->to_tuple(); + const AST* retT = *i; if (!llType(retT)) return NULL; Type* ret = new Type(*llType(retT) + " (*)("); FOREACHP(ATuple::const_iterator, i, protT) { - const AType* at = (*i)->to_type(); - const Type* lt = llType(at); + const Type* lt = llType(*i); if (!lt) return NULL; *ret += *lt; @@ -108,10 +108,10 @@ CEngine::llType(const AType* t) *ret += ")"; return ret; - } else if (t->kind == AType::EXPR && t->head()->str() == "Tup") { + } else if (AType::is_expr(t) && isupper(t->as_tuple()->head()->str()[0])) { Type* ret = new Type("struct { void* me; "); - for (AType::const_iterator i = t->iter_at(1); i != t->end(); ++i) { - const Type* lt = llType((*i)->to_type()); + for (ATuple::const_iterator i = t->as_tuple()->iter_at(1); i != t->as_tuple()->end(); ++i) { + const Type* lt = llType(*i); if (!lt) return NULL; ret->append("; "); @@ -125,7 +125,7 @@ CEngine::llType(const AType* t) } CVal -CEngine::compileCall(CEnv& cenv, CFunc func, const AType* funcT, const vector& args) +CEngine::compileCall(CEnv& cenv, CFunc func, const ATuple* funcT, const vector& args) { Value* varname = new string(cenv.penv.gensymstr("x")); Function* f = llFunc(func); @@ -137,7 +137,7 @@ CEngine::compileCall(CEnv& cenv, CFunc func, const AType* funcT, const vector& fields) +CEngine::compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector& fields) { return NULL; } @@ -161,17 +161,16 @@ CEngine::compileString(CEnv& cenv, const char* str) } CFunc -CEngine::startFn(CEnv& cenv, const std::string& name, const ATuple* args, const AType* type) +CEngine::startFn(CEnv& cenv, const std::string& name, const ATuple* args, const ATuple* type) { - const AType* argsT = type->prot()->as_type(); - const AType* retT = type->list_ref(2)->as_type(); + const ATuple* argsT = type->prot(); + const AST* retT = type->list_ref(2); vector cprot; FOREACHP(ATuple::const_iterator, i, argsT) { - const AType* at = (*i)->as_type(); - THROW_IF(!llType(at), Cursor(), string("non-concrete parameter :: ") - + at->str()) - cprot.push_back(llType(at)); + THROW_IF(!llType(*i), Cursor(), string("non-concrete parameter :: ") + + (*i)->str()) + cprot.push_back(llType(*i)); } THROW_IF(!llType(retT), Cursor(), @@ -186,7 +185,7 @@ CEngine::startFn(CEnv& cenv, const std::string& name, const ATuple* args, const for (; ai != argsT->end(); ++ai, ++ni) { if (ai != argsT->begin()) f->text += ", "; - f->text += *llType((*ai)->as_type()) + " " + (*ni)->as_symbol()->sym(); + f->text += *llType(*ai) + " " + (*ni)->as_symbol()->sym(); } f->text += ")\n{\n"; @@ -196,21 +195,20 @@ CEngine::startFn(CEnv& cenv, const std::string& name, const ATuple* args, const } void -CEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const AType* type, CFunc f) +CEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f) { cenv.push(); - const AType* argsT = type->prot()->as_type(); + const ATuple* argsT = type->prot(); // Bind argument values in CEnv vector args; ATuple::const_iterator p = prot->begin(); ATuple::const_iterator pT = argsT->begin(); for (; p != prot->end(); ++p, ++pT) { - const AType* t = (*pT)->as_type(); - const Type* lt = llType(t); + const Type* lt = llType(*pT); THROW_IF(!lt, (*p)->loc, "untyped parameter\n"); - cenv.def((*p)->as_symbol(), *p, t, new string((*p)->str())); + cenv.def((*p)->as_symbol(), *p, (*pT), new string((*p)->str())); } } @@ -267,7 +265,7 @@ CEngine::compileIf(CEnv& cenv, const ATuple* aif) #endif CVal -CEngine::compileIsA(CEnv& cenv, CVal rtti, const ASymbol* tag) +CEngine::compileIsA(CEnv& cenv, CVal rtti, CVal tag) { return NULL; } @@ -303,7 +301,7 @@ CEngine::compilePrimitive(CEnv& cenv, const ATuple* prim) } CVal -CEngine::compileGlobalSet(CEnv& cenv, const string& sym, CVal val, const AType* type) +CEngine::compileGlobalSet(CEnv& cenv, const string& sym, CVal val, const AST* type) { return NULL; } @@ -321,7 +319,7 @@ CEngine::writeModule(CEnv& cenv, std::ostream& os) } const string -CEngine::call(CEnv& cenv, CFunc f, const AType* retT) +CEngine::call(CEnv& cenv, CFunc f, const AST* retT) { cenv.err << "C backend does not support JIT (call)" << endl; return ""; diff --git a/src/compile.cpp b/src/compile.cpp index 3c16fbf..4fed182 100644 --- a/src/compile.cpp +++ b/src/compile.cpp @@ -29,24 +29,39 @@ using namespace std; static CVal compile_symbol(CEnv& cenv, const ASymbol* sym) throw() { - if (cenv.repl && cenv.vals.topLevel(sym) && cenv.type(sym)->head()->str() != "Fn") { + if (cenv.repl && cenv.vals.topLevel(sym) && !is_form(cenv.type(sym), "Fn")) { return cenv.engine()->compileGlobalGet(cenv, sym->sym(), *cenv.vals.ref(sym)); } else { return *cenv.vals.ref(sym); } } +static CVal +compile_type(CEnv& cenv, const AST* type) throw() +{ + const ASymbol* sym = type->as_tuple()->head()->as_symbol(); + CVal* existing = cenv.vals.ref(sym); + if (existing) { + return *existing; + } else { + CVal compiled = cenv.engine()->compileString( + cenv, (string("__T_") + type->as_tuple()->head()->str()).c_str()); + cenv.vals.def(sym, compiled); + return compiled; + } +} + static CVal compile_cons(CEnv& cenv, const ATuple* cons) throw() { - AType* type = new AType(cons->head()->as_symbol(), NULL, Cursor()); - TList tlist(type); + ATuple* type = new ATuple(cons->head()->as_symbol(), NULL, Cursor()); + List tlist(type); vector fields; for (ATuple::const_iterator i = cons->iter_at(1); i != cons->end(); ++i) { tlist.push_back(cenv.type(*i)); fields.push_back(resp_compile(cenv, *i)); } - return cenv.engine()->compileCons(cenv, type, resp_compile(cenv, type), fields); + return cenv.engine()->compileCons(cenv, type, compile_type(cenv, type), fields); } static CVal @@ -67,7 +82,7 @@ compile_def(CEnv& cenv, const ATuple* def) throw() const AST* const body = def->list_ref(2); cenv.def(sym, body, cenv.type(body), NULL); // define stub first for recursion CVal val = resp_compile(cenv, body); - if (cenv.repl && cenv.vals.size() == 1 && cenv.type(body)->head()->str() != "Fn") { + if (cenv.repl && cenv.vals.size() == 1 && !is_form(cenv.type(body), "Fn")) { val = cenv.engine()->compileGlobalSet( cenv, sym->str(), val, cenv.type(body)); cenv.lock(def); @@ -91,14 +106,14 @@ compile_fn(CEnv& cenv, const ATuple* fn) throw() { assert(!cenv.currentFn); - const AType* type = cenv.type(fn); + const AST* type = cenv.type(fn); CFunc f = cenv.findImpl(fn, type); if (f) return f; // Write function declaration and push stack frame - f = cenv.engine()->startFn(cenv, cenv.name(fn), fn->prot(), type); - cenv.engine()->pushFnArgs(cenv, fn->prot(), type, f); + f = cenv.engine()->startFn(cenv, cenv.name(fn), fn->prot(), type->as_tuple()); + cenv.engine()->pushFnArgs(cenv, fn->prot(), type->as_tuple(), f); cenv.currentFn = f; // Write function body @@ -129,24 +144,11 @@ compile_if(CEnv& cenv, const ATuple* aif) throw() static CVal compile_tag_is(CEnv& cenv, const ATuple* call) throw() { - const AST* lhs = call->list_ref(1); - const ASymbol* rhs = call->list_ref(2)->as_symbol(); - return cenv.engine()->compileIsA(cenv, resp_compile(cenv, lhs), rhs); -} + const AST* lhs = call->list_ref(1); + const ASymbol* tag = call->list_ref(2)->as_symbol(); + const ATuple* patT = new ATuple(tag, 0, Cursor()); -static CVal -compile_type(CEnv& cenv, const AType* type) throw() -{ - const ASymbol* sym = type->head()->as_symbol(); - CVal* existing = cenv.vals.ref(sym); - if (existing) { - return *existing; - } else { - CVal compiled = cenv.engine()->compileString( - cenv, (string("__T_") + type->head()->str()).c_str()); - cenv.vals.def(sym, compiled); - return compiled; - } + return cenv.engine()->compileIsA(cenv, resp_compile(cenv, lhs), compile_type(cenv, patT)); } static CVal @@ -161,7 +163,7 @@ compile_call(CEnv& cenv, const ATuple* call) throw() for (ATuple::const_iterator e = call->iter_at(1); e != call->end(); ++e) args.push_back(resp_compile(cenv, *e)); - return cenv.engine()->compileCall(cenv, f, cenv.type(call->head()), args); + return cenv.engine()->compileCall(cenv, f, cenv.type(call->head())->as_tuple(), args); } CVal @@ -170,11 +172,10 @@ resp_compile(CEnv& cenv, const AST* ast) throw() switch (ast->tag()) { case T_UNKNOWN: return NULL; - case T_TYPE: - return compile_type(cenv, ast->as_type()); case T_BOOL: case T_FLOAT: case T_INT32: + case T_TVAR: return cenv.engine()->compileLiteral(cenv, ast); case T_STRING: return cenv.engine()->compileString(cenv, ((AString*)ast)->cppstr.c_str()); diff --git a/src/constrain.cpp b/src/constrain.cpp index 45fead8..39a0287 100644 --- a/src/constrain.cpp +++ b/src/constrain.cpp @@ -27,7 +27,7 @@ static void constrain_symbol(TEnv& tenv, Constraints& c, const ASymbol* sym) throw(Error) { - const AType** ref = tenv.ref(sym); + const AST** ref = tenv.ref(sym); THROW_IF(!ref, sym->loc, (format("undefined symbol `%1%'") % sym->sym()).str()); c.constrain(tenv, sym, *ref); } @@ -36,23 +36,23 @@ static void constrain_cons(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) { const ASymbol* sym = (*call->begin())->as_symbol(); - const AType* type = NULL; + const AST* type = NULL; for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i) resp_constrain(tenv, c, *i); if (!strcmp(sym->sym(), "Tup")) { - TList tupT(new AType(tenv.Tup, NULL, call->loc)); + List tupT(new ATuple(tenv.Tup, NULL, call->loc)); for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i) { tupT.push_back(tenv.var(*i)); } type = tupT; } else { - const AType** consTRef = tenv.ref(sym); + const AST** consTRef = tenv.ref(sym); THROW_IF(!consTRef, call->loc, (format("call to undefined constructor `%1%'") % sym->sym()).str()); - const AType* consT = *consTRef; - type = new AType(consT->head()->as_type(), 0, call->loc); + const AST* consT = *consTRef; + type = new ATuple(consT->as_tuple()->head(), 0, call->loc); } c.constrain(tenv, call, type); } @@ -61,19 +61,18 @@ static void constrain_dot(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) { THROW_IF(call->list_len() != 3, call->loc, "`.' requires exactly 2 arguments"); - ATuple::const_iterator i = call->begin(); - const AST* obj = *++i; - const AST* idx_ast = *++i; - THROW_IF(idx_ast->tag() != T_INT32, call->loc, "the 2nd argument to `.' must be a literal integer"); - const ALiteral* idx = (ALiteral*)idx_ast; + ATuple::const_iterator i = call->begin(); + const AST* obj = *++i; + const AST* idx = *++i; + THROW_IF(idx->tag() != T_INT32, call->loc, "the 2nd argument to `.' must be a literal integer"); resp_constrain(tenv, c, obj); - const AType* retT = tenv.var(call); + const AST* retT = tenv.var(call); c.constrain(tenv, call, retT); - TList objT(new AType(tenv.Tup, NULL, call->loc)); - for (int i = 0; i < idx->val; ++i) + List objT(new ATuple(tenv.Tup, NULL, call->loc)); + for (int i = 0; i < ((ALiteral*)idx)->val; ++i) objT.push_back(tenv.var()); objT.push_back(retT); objT.push_back(tenv.Dots); @@ -88,7 +87,7 @@ constrain_def(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) THROW_IF(!sym, call->loc, "`def' has no symbol") const AST* const body = call->list_ref(2); - const AType* tvar = tenv.var(body); + const AST* tvar = tenv.var(body); tenv.def(sym, tvar); resp_constrain(tenv, c, body); c.constrain(tenv, sym, tvar); @@ -105,16 +104,16 @@ constrain_def_type(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) const ASymbol* sym = (*prot->begin())->as_symbol(); THROW_IF(!sym, (*prot->begin())->loc, "type name is not a symbol"); THROW_IF(tenv.ref(sym), call->loc, "type redefinition"); - TList type(new AType(tenv.U, NULL, call->loc)); + List type(new ATuple(tenv.U, NULL, call->loc)); for (ATuple::const_iterator i = call->iter_at(2); i != call->end(); ++i) { const ATuple* exp = (*i)->as_tuple(); const ASymbol* tag = (*exp->begin())->as_symbol(); - TList consT; - consT.push_back(new AType(sym, AType::NAME)); + List consT; + consT.push_back(sym); for (ATuple::const_iterator i = exp->begin(); i != exp->end(); ++i) { const ASymbol* sym = (*i)->to_symbol(); THROW_IF(!sym, (*i)->loc, "type expression element is not a symbol"); - consT.push_back(new AType(sym, AType::NAME)); + consT.push_back(sym); } consT.head->loc = exp->loc; type.push_back(consT); @@ -129,17 +128,15 @@ constrain_fn(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) set defs; TEnv::Frame frame; - const ATuple* const prot = call->prot(); - // Add parameters to environment frame - TList protT; - for (ATuple::const_iterator i = prot->begin(); i != prot->end(); ++i) { + List protT; + FOREACHP(ATuple::const_iterator, i, call->prot()) { const ASymbol* sym = (*i)->to_symbol(); THROW_IF(!sym, (*i)->loc, "parameter name is not a symbol"); THROW_IF(defs.count(sym) != 0, sym->loc, (format("duplicate parameter `%1%'") % sym->str()).str()); defs.insert(sym); - const AType* tvar = tenv.fresh(sym); + const AST* tvar = tenv.fresh(sym); frame.push_back(make_pair(sym->sym(), tvar)); protT.push_back(tvar); } @@ -157,7 +154,7 @@ constrain_fn(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) THROW_IF(defs.count(sym) != 0, call->loc, (format("`%1%' defined twice") % sym->str()).str()); defs.insert(sym); - frame.push_back(make_pair(sym->sym(), (AType*)NULL)); + frame.push_back(make_pair(sym->sym(), (AST*)NULL)); } } @@ -169,8 +166,8 @@ constrain_fn(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) resp_constrain(tenv, c, exp); } - const AType* bodyT = tenv.var(exp); - const AType* fnT = tup(call->loc, tenv.Fn, protT.head, bodyT, 0); + const AST* bodyT = tenv.var(exp); + const ATuple* fnT = tup(call->loc, tenv.Fn, protT.head, bodyT, 0); Object::pool.addRoot(fnT); tenv.pop(); @@ -185,7 +182,7 @@ constrain_if(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) THROW_IF(call->list_len() % 2 != 0, call->loc, "`if' missing final else clause"); for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i) resp_constrain(tenv, c, *i); - const AType* retT = tenv.var(call); + const AST* retT = tenv.var(call); for (ATuple::const_iterator i = call->iter_at(1); true; ++i) { ATuple::const_iterator next = i; ++next; @@ -215,7 +212,7 @@ constrain_let(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) THROW_IF(val == vars->end(), sym->loc, "`let' variable missing value"); resp_constrain(tenv, c, *val); - const AType* tvar = tenv.var(*val); + const AST* tvar = tenv.var(*val); frame.push_back(make_pair(sym->sym(), tvar)); c.constrain(tenv, sym, tvar); //c.constrain(tenv, *val, tvar); @@ -235,9 +232,9 @@ static void constrain_match(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) { THROW_IF(call->list_len() < 5, call->loc, "`match' requires at least 4 arguments"); - const AST* matchee = call->list_ref(1); - const AType* retT = tenv.var(); - const AType* matcheeT = NULL;// = tup(loc, tenv.U, 0); + const AST* matchee = call->list_ref(1); + const AST* retT = tenv.var(); + const AST* matcheeT = NULL; resp_constrain(tenv, c, matchee); for (ATuple::const_iterator i = call->iter_at(2); i != call->end();) { const AST* exp = *i++; @@ -246,11 +243,11 @@ constrain_match(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) const ASymbol* name = (*pattern->begin())->to_symbol(); THROW_IF(!name, (*pattern->begin())->loc, "pattern does not start with a symbol"); - const AType* consT = *tenv.ref(name); + const AST* consT = *tenv.ref(name); if (!matcheeT) { - const AType* headT = consT->head()->as_type(); - matcheeT = new AType(headT, 0, call->loc); + const AST* headT = consT->as_tuple()->head(); + matcheeT = new ATuple(headT, 0, call->loc); } THROW_IF(i == call->end(), pattern->loc, "missing pattern body"); @@ -270,22 +267,22 @@ constrain_call(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) for (ATuple::const_iterator i = call->begin(); i != call->end(); ++i) resp_constrain(tenv, c, *i); - const AType* fnType = tenv.var(head); - if (fnType->kind != AType::VAR) { + const AST* fnType = tenv.var(head); + if (!AType::is_var(fnType)) { if (!is_form(fnType, "Fn")) throw Error(call->loc, (format("call to non-function `%1%'") % head->str()).str()); - size_t numArgs = fnType->prot()->list_len(); + size_t numArgs = fnType->as_tuple()->prot()->list_len(); THROW_IF(numArgs != call->list_len() - 1, call->loc, (format("expected %1% arguments, got %2%") % numArgs % (call->list_len() - 1)).str()); } - const AType* retT = tenv.var(call); - TList argsT; + const AST* retT = tenv.var(call); + List argsT; for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i) argsT.push_back(tenv.var(*i)); argsT.head->loc = call->loc; - c.constrain(tenv, head, tup(head->loc, tenv.Fn, argsT.head, retT, 0)); + c.constrain(tenv, head, tup(head->loc, tenv.Fn, argsT.head, retT, 0)); c.constrain(tenv, call, retT); } @@ -312,7 +309,7 @@ constrain_primitive(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) i = call->begin(); - const AType* var = NULL; + const AST* var = NULL; switch (type) { case ARITHMETIC: if (call->list_len() < 3) @@ -382,7 +379,7 @@ resp_constrain(TEnv& tenv, Constraints& c, const AST* ast) throw(Error) { switch (ast->tag()) { case T_UNKNOWN: - case T_TYPE: + case T_TVAR: break; case T_BOOL: c.constrain(tenv, ast, tenv.named("Bool")); diff --git a/src/cps.cpp b/src/cps.cpp index 694cbe6..3c4f38d 100644 --- a/src/cps.cpp +++ b/src/cps.cpp @@ -29,7 +29,7 @@ static const AST* cps_value(TEnv& tenv, AST* cont) const { - return tup(loc, cont, this, 0); + return tup(loc, cont, this, 0); } /** (cps (fn (a ...) body) cont) => (cont (fn (a ... k) (cps body k)) */ @@ -39,18 +39,18 @@ cps_fn(TEnv& tenv, AST* cont) const ATuple* copyProt = new ATuple(*prot()); ASymbol* contArg = tenv.penv.gensym("_k"); copyProt->push_back(contArg); - AFn* copy = tup(loc, tenv.penv.sym("fn"), copyProt, 0); + AFn* copy = tup(loc, tenv.penv.sym("fn"), copyProt, 0); const_iterator p = begin(); ++(++p); for (; p != end(); ++p) copy->push_back((*p)->(tenv, contArg)); - return tup(loc, cont, copy, 0); + return tup(loc, cont, copy, 0); } static const AST* cps_primitive(TEnv& tenv, AST* cont) const { - return value() ? tup(loc, cont, this, 0) : ATuple::(tenv, cont); + return value() ? tup(loc, cont, this, 0) : ATuple::(tenv, cont); } /** (cps (f a b ...)) => (a (fn (x) (b (fn (y) ... (cont (f x y ...)) */ @@ -74,8 +74,8 @@ cps_tuple(TEnv& tenv, AST* cont) const } else { arg = tenv.penv.gensym("a"); - AFn* thisFn = tup(loc, tenv.penv.sym("fn"), - tup((*i)->loc, arg, 0), + AFn* thisFn = tup(loc, tenv.penv.sym("fn"), + tup((*i)->loc, arg, 0), 0); if (firstFnIter == end()) { @@ -94,7 +94,7 @@ cps_tuple(TEnv& tenv, AST* cont) const if (firstFnIter != end()) { // Call this call's callee in the last argument evaluator - ATuple* call = tup(loc, 0); + ATuple* call = tup(loc, 0); assert(funcs.size() == size()); for (size_t i = 0; i < funcs.size(); ++i) call->push_back(funcs[i].second); @@ -104,7 +104,7 @@ cps_tuple(TEnv& tenv, AST* cont) const return (*firstFnIter)->(tenv, firstFn); } else { assert(head()->value()); - ATuple* ret = tup(loc, 0); + ATuple* ret = tup(loc, 0); FOREACHP(const_iterator, i, this) ret->push_back((*i)); if (!is_primitive(this)) @@ -120,7 +120,7 @@ cps_def(TEnv& tenv, AST* cont) const AST* val = body()->(tenv, cont); ATuple* valCall = val->to_tuple(); ATuple::iterator i = valCall->begin(); - return tup(loc, tenv.penv.sym("def"), sym(), *++i, 0); + return tup(loc, tenv.penv.sym("def"), sym(), *++i, 0); } /** (cps (if c t ... e)) => */ @@ -133,13 +133,13 @@ cps_iff(TEnv& tenv, AST* cont) const AST* exp = *++i; AST* next = *++i; if (cond->value()) { - return tup(loc, tenv.penv.sym("if"), cond, + return tup(loc, tenv.penv.sym("if"), cond, exp->(tenv, cont), next->(tenv, cont), 0); } else { - AFn* contFn = tup(loc, tenv.penv.sym("fn"), - tup(cond->loc, argSym, tenv.penv.gensym("_k"), 0), - tup(loc, tenv.penv.sym("if"), argSym, + AFn* contFn = tup(loc, tenv.penv.sym("fn"), + tup(cond->loc, argSym, tenv.penv.gensym("_k"), 0), + tup(loc, tenv.penv.sym("if"), argSym, exp->(tenv, cont), next->(tenv, cont), 0)); return cond->(tenv, contFn); diff --git a/src/expand.cpp b/src/expand.cpp index bd04e5f..020410e 100644 --- a/src/expand.cpp +++ b/src/expand.cpp @@ -26,7 +26,7 @@ using namespace std; static inline const ATuple* expand_list(PEnv& penv, const ATuple* e) { - List ret; + List ret; FOREACHP(ATuple::const_iterator, i, e) ret.push_back(penv.expand(*i)); return ret.head; @@ -40,7 +40,7 @@ expand_fn(PEnv& penv, const AST* exp, void* arg) THROW_IF(++a == tup->end(), exp->loc, "Unexpected end of `fn' form"); THROW_IF(!(*a)->to_tuple(), (*a)->loc, "First argument of `fn' is not a list"); const ATuple* prot = (*a++)->to_tuple(); - List ret(new ATuple(penv.sym("fn"), NULL, exp->loc)); + List ret(new ATuple(penv.sym("fn"), NULL, exp->loc)); ret.push_back(prot); while (a != tup->end()) ret.push_back(penv.expand(*a++)); @@ -62,21 +62,21 @@ expand_def(PEnv& penv, const AST* exp, void* arg) // (def (f x) y) => (def f (fn (x) y)) const ATuple* pat = arg1->to_tuple(); - List argsExp; + List argsExp; ATuple::const_iterator j = pat->begin(); for (++j; j != pat->end(); ++j) argsExp.push_back(*j); argsExp.head->loc = exp->loc; const AST* body = *(++i); - List fnExp; + List fnExp; fnExp.push_back(penv.sym("fn")); fnExp.push_back(argsExp.head); for (; i != tup->end(); ++i) fnExp.push_back(*i); fnExp.head->loc = body->loc; - List ret; + List ret; ret.push_back(tup->head()); ret.push_back(pat->head()); ret.push_back(fnExp.head); @@ -113,10 +113,10 @@ initLang(PEnv& penv, TEnv& tenv) { // Types const char* types[] = { - "Bool", "Float", "Int", "Lexeme", "Nothing", "Quote", "String", 0 }; + "Bool", "Float", "Int", "Nothing", "Quote", "String", 0 }; for (const char** t = types; *t; ++t) { const ASymbol* sym = penv.sym(*t); - tenv.def(sym, new AType(sym, AType::NAME)); + tenv.def(sym, sym); // FIXME: define to NULL? } const char* primitives[] = { diff --git a/src/gc.cpp b/src/gc.cpp index af62dde..5752457 100644 --- a/src/gc.cpp +++ b/src/gc.cpp @@ -86,7 +86,7 @@ GC::collect(const Roots& roots) assert(!(*i)->marked()); } else { const Tag tag = (*i)->tag(); - if (tag == T_TUPLE || tag == T_TYPE) + if (tag == T_TUPLE) free(((ATuple*)*i)->_vec); tlsf_free((tlsf_t*)_pool, ((char*)(*i) - sizeof(Object::Header))); diff --git a/src/lift.cpp b/src/lift.cpp index 25940f4..4b57637 100644 --- a/src/lift.cpp +++ b/src/lift.cpp @@ -46,10 +46,10 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw() * to the closure (the calling lift_fn will use cenv.liftStack.top() * to construct the closure after the fn body has been lifted). */ - return tup(sym->loc, cenv.penv.sym("."), - cenv.penv.sym("_me"), - new ALiteral(T_INT32, vars.index(sym) + 1, Cursor()), - NULL); + return tup(sym->loc, cenv.penv.sym("."), + cenv.penv.sym("_me"), + new ALiteral(T_INT32, vars.index(sym) + 1, Cursor()), + NULL); } } return sym; @@ -59,7 +59,7 @@ static const AST* lift_dot(CEnv& cenv, Code& code, const ATuple* dot) throw() { const ALiteral* index = (ALiteral*)(dot->list_ref(2)); - List copy; + List copy; copy.push_back(dot->head()); copy.push_back(resp_lift(cenv, code, dot->list_ref(1))); copy.push_back(new ALiteral(T_INT32, index->val + 1, Cursor())); // skip RTTI @@ -78,7 +78,7 @@ lift_def(CEnv& cenv, Code& code, const ATuple* def) throw() cenv.setName(body->as_tuple(), sym->str()); assert(def->list_ref(1)->to_symbol()); - List copy; + List copy; copy.push_back(def->head()); copy.push_back(resp_lift(cenv, code, def->list_ref(1))); for (ATuple::const_iterator t = def->iter_at(2); t != def->end(); ++t) @@ -99,7 +99,7 @@ lift_def(CEnv& cenv, Code& code, const ATuple* def) throw() static const AST* lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw() { - List impl; + List impl; impl.push_back(fn->head()); const string fnName = cenv.name(fn); @@ -113,20 +113,20 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw() // Create a new stub environment frame for parameters cenv.push(); - const AType* type = cenv.type(fn); - AType::const_iterator tp = type->prot()->begin(); + const ATuple* type = cenv.type(fn)->as_tuple(); + ATuple::const_iterator tp = type->prot()->begin(); - List implProt; - List implProtT; + List implProt; + List implProtT; // Prepend closure parameter implProt.push_back(cenv.penv.sym("_me")); for (ATuple::const_iterator p = fn->prot()->begin(); p != fn->prot()->end(); ++p) { - const AType* paramType = (*tp++)->as_type(); - if (paramType->kind == AType::EXPR && *paramType->head() == *cenv.tenv.Fn) { - const AType* fnType = new AType(cenv.tenv.var(), paramType, fnType->loc); - paramType = tup((*p)->loc, cenv.tenv.Tup, fnType, NULL); + const AST* paramType = (*tp++); + if (is_form(paramType, "Fn")) { + const ATuple* fnType = new ATuple(cenv.tenv.var(), paramType, fnType->loc); + paramType = tup((*p)->loc, cenv.tenv.Tup, fnType, NULL); } cenv.def((*p)->as_symbol(), *p, paramType, NULL); implProt.push_back(*p); @@ -136,7 +136,7 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw() impl.push_back(implProt); // Lift body - const AType* implRetT = NULL; + const AST* implRetT = NULL; for (ATuple::const_iterator i = fn->iter_at(2); i != fn->end(); ++i) { const AST* lifted = resp_lift(cenv, code, *i); impl.push_back(lifted); @@ -147,13 +147,13 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw() // Create definition for implementation fn ASymbol* implName = cenv.penv.sym(implNameStr); - ATuple* def = tup(fn->loc, cenv.penv.sym("def"), implName, impl.head, NULL); + ATuple* def = tup(fn->loc, cenv.penv.sym("def"), implName, impl.head, NULL); code.push_back(def); - TList implT; // Type of the implementation function - TList tupT(fn->loc, cenv.tenv.Tup, cenv.tenv.var(), NULL); - TList consT; - List cons(fn->loc, cenv.penv.sym("Closure"), implName, NULL); + List implT; // Type of the implementation function + List tupT(fn->loc, cenv.tenv.Tup, cenv.tenv.var(), NULL); + List consT; + List cons(fn->loc, cenv.penv.sym("Closure"), implName, NULL); const CEnv::FreeVars& freeVars = cenv.liftStack.top(); for (CEnv::FreeVars::const_iterator i = freeVars.begin(); i != freeVars.end(); ++i) { @@ -165,7 +165,7 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw() implProtT.push_front(tupT); - implT.push_back((AType*)type->head()); + implT.push_back(type->head()); implT.push_back(implProtT.head); implT.push_back(implRetT); @@ -185,7 +185,7 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw() static const AST* lift_call(CEnv& cenv, Code& code, const ATuple* call) throw() { - List copy; + List copy; // Lift all children (callee and arguments, recursively) for (ATuple::const_iterator i = call->begin(); i != call->end(); ++i) @@ -210,20 +210,20 @@ lift_call(CEnv& cenv, Code& code, const ATuple* call) throw() */ const ATuple* closure = copy.head->list_ref(0)->as_tuple(); const ASymbol* implSym = closure->list_ref(1)->as_symbol(); - const AType* implT = cenv.type(cenv.resolve(implSym)); + const ATuple* implT = cenv.type(cenv.resolve(implSym))->as_tuple(); copy.push_front(implSym); - cenv.setType(copy, implT->list_ref(2)->as_type()); + cenv.setType(copy, implT->list_ref(2)); } else { // Call to a closure, prepend code to access implementation function - ATuple* getFn = tup(call->loc, cenv.penv.sym("."), - copy.head->head(), - new ALiteral(T_INT32, 1, Cursor()), NULL); - const AType* calleeT = cenv.type(copy.head->head()); + ATuple* getFn = tup(call->loc, cenv.penv.sym("."), + copy.head->head(), + new ALiteral(T_INT32, 1, Cursor()), NULL); + const ATuple* calleeT = cenv.type(copy.head->head())->as_tuple(); assert(**calleeT->begin() == *cenv.tenv.Tup); - const AType* implT = calleeT->list_ref(1)->as_type(); + const ATuple* implT = calleeT->list_ref(1)->as_tuple(); copy.push_front(getFn); cenv.setType(getFn, implT); - cenv.setType(copy, implT->list_ref(2)->as_type()); + cenv.setType(copy, implT->list_ref(2)); } return copy; @@ -232,7 +232,7 @@ lift_call(CEnv& cenv, Code& code, const ATuple* call) throw() static const AST* lift_args(CEnv& cenv, Code& code, const ATuple* call) throw() { - List copy; + List copy; copy.push_back(call->head()); // Lift all arguments diff --git a/src/llvm.cpp b/src/llvm.cpp index 939eeeb..6ef25bb 100644 --- a/src/llvm.cpp +++ b/src/llvm.cpp @@ -56,25 +56,25 @@ struct LLVMEngine : public Engine { LLVMEngine(); virtual ~LLVMEngine(); - CFunc startFn(CEnv& cenv, const string& name, const ATuple* args, const AType* type); - void pushFnArgs(CEnv& cenv, const ATuple* prot, const AType* type, CFunc f); + CFunc startFn(CEnv& cenv, const string& name, const ATuple* args, const ATuple* type); + void pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f); void finishFn(CEnv& cenv, CFunc f, CVal ret); void eraseFn(CEnv& cenv, CFunc f); - CVal compileCall(CEnv& cenv, CFunc f, const AType* funcT, const vector& args); - CVal compileCons(CEnv& cenv, const AType* type, CVal rtti, const vector& fields); + CVal compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector& args); + CVal compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector& fields); CVal compileDot(CEnv& cenv, CVal tup, int32_t index); - CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AType* t); + CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t); CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v); CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse); - CVal compileIsA(CEnv& cenv, CVal rtti, const ASymbol* tag); + CVal compileIsA(CEnv& cenv, CVal rtti, CVal tag); CVal compileLiteral(CEnv& cenv, const AST* lit); CVal compilePrimitive(CEnv& cenv, const ATuple* prim); CVal compileString(CEnv& cenv, const char* str); void writeModule(CEnv& cenv, std::ostream& os); - const string call(CEnv& cenv, CFunc f, const AType* retT); + const string call(CEnv& cenv, CFunc f, const AST* retT); private: void appendBlock(LLVMEngine* engine, Function* function, BasicBlock* block) { @@ -84,7 +84,7 @@ private: inline Value* llVal(CVal v) { return static_cast(v); } inline Function* llFunc(CFunc f) { return static_cast(f); } - const Type* llType(const AType* t); + const Type* llType(const AST* t); LLVMContext context; Module* module; @@ -127,41 +127,42 @@ LLVMEngine::~LLVMEngine() } const Type* -LLVMEngine::llType(const AType* t) +LLVMEngine::llType(const AST* t) { if (t == NULL) { return NULL; - } else if (t->kind == AType::VAR) { + } else if (AType::is_var(t)) { // Kludge for _me closure parameter, will be casted return PointerType::get(Type::getInt8Ty(context), NULL); - } else if (t->kind == AType::NAME) { - if (t->head()->str() == "Nothing") return Type::getVoidTy(context); - if (t->head()->str() == "Bool") return Type::getInt1Ty(context); - if (t->head()->str() == "Int") return Type::getInt32Ty(context); - if (t->head()->str() == "Float") return Type::getFloatTy(context); - if (t->head()->str() == "String") return PointerType::get(Type::getInt8Ty(context), NULL); - if (t->head()->str() == "Quote") return PointerType::get(Type::getInt8Ty(context), NULL); - } else if (t->kind == AType::EXPR && t->head()->str() == "Fn") { - AType::const_iterator i = t->begin(); - const ATuple* protT = (*++i)->to_tuple(); - const AType* retT = (*++i)->as_type(); + } else if (AType::is_name(t)) { + const std::string sym(t->as_symbol()->sym()); + if (sym == "Nothing") return Type::getVoidTy(context); + if (sym == "Bool") return Type::getInt1Ty(context); + if (sym == "Int") return Type::getInt32Ty(context); + if (sym == "Float") return Type::getFloatTy(context); + if (sym == "String") return PointerType::get(Type::getInt8Ty(context), NULL); + if (sym == "Quote") return PointerType::get(Type::getInt8Ty(context), NULL); + } else if (is_form(t, "Fn")) { + ATuple::const_iterator i = t->as_tuple()->begin(); + const ATuple* protT = (*++i)->to_tuple(); + const AST* retT = (*++i); if (!llType(retT)) return NULL; vector cprot; FOREACHP(ATuple::const_iterator, i, protT) { - const Type* lt = llType((*i)->to_type()); + const Type* lt = llType(*i); if (!lt) return NULL; cprot.push_back(lt); } return PointerType::get(FunctionType::get(llType(retT), cprot, false), 0); - } else if (t->kind == AType::EXPR && isupper(t->head()->str()[0])) { + } else if (AType::is_expr(t) && isupper(t->as_tuple()->head()->str()[0])) { vector ctypes; ctypes.push_back(PointerType::get(Type::getInt8Ty(context), NULL)); // RTTI - for (AType::const_iterator i = t->iter_at(1); i != t->end(); ++i) { - const Type* lt = llType((*i)->to_type()); + for (ATuple::const_iterator i = t->as_tuple()->iter_at(1); i != t->as_tuple()->end(); ++i) { + const Type* lt = llType(*i); if (!lt) return NULL; ctypes.push_back(lt); @@ -180,25 +181,25 @@ bitsToBytes(size_t bits) } CVal -LLVMEngine::compileCall(CEnv& cenv, CFunc f, const AType* funcT, const vector& args) +LLVMEngine::compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector& args) { vector llArgs(*reinterpret_cast*>(&args)); Value* closure = builder.CreateBitCast(llArgs[0], - llType(funcT->prot()->head()->as_type()), + llType(funcT->prot()->head()), cenv.penv.gensymstr("you")); llArgs[0] = closure; return builder.CreateCall(llFunc(f), llArgs.begin(), llArgs.end()); } CVal -LLVMEngine::compileCons(CEnv& cenv, const AType* type, CVal rtti, const vector& fields) +LLVMEngine::compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector& fields) { // Find size of memory required size_t s = engine->getTargetData()->getTypeSizeInBits( PointerType::get(Type::getInt8Ty(context), NULL)); assert(type->begin() != type->end()); - for (AType::const_iterator i = type->iter_at(1); i != type->end(); ++i) - s += engine->getTargetData()->getTypeSizeInBits(llType((*i)->as_type())); + for (ATuple::const_iterator i = type->iter_at(1); i != type->end(); ++i) + s += engine->getTargetData()->getTypeSizeInBits(llType(*i)); // Allocate struct Value* structSize = ConstantInt::get(Type::getInt32Ty(context), bitsToBytes(s)); @@ -247,19 +248,18 @@ LLVMEngine::compileString(CEnv& cenv, const char* str) CFunc LLVMEngine::startFn( - CEnv& cenv, const std::string& name, const ATuple* args, const AType* type) + CEnv& cenv, const std::string& name, const ATuple* args, const ATuple* type) { - const AType* argsT = type->prot()->as_type(); - const AType* retT = type->list_last()->as_type(); + const ATuple* argsT = type->prot(); + const AST* retT = type->list_last(); Function::LinkageTypes linkage = Function::ExternalLinkage; vector cprot; FOREACHP(ATuple::const_iterator, i, argsT) { - const AType* at = (*i)->as_type(); - THROW_IF(!llType(at), Cursor(), string("non-concrete parameter :: ") - + at->str()) - cprot.push_back(llType(at)); + THROW_IF(!llType(*i), Cursor(), string("non-concrete parameter :: ") + + (*i)->str()) + cprot.push_back(llType(*i)); } THROW_IF(!llType(retT), Cursor(), @@ -285,12 +285,12 @@ LLVMEngine::startFn( } void -LLVMEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const AType* type, CFunc cfunc) +LLVMEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc cfunc) { cenv.push(); - const AType* argsT = type->prot()->as_type(); - Function* f = llFunc(cfunc); + const ATuple* argsT = type->prot(); + Function* f = llFunc(cfunc); // Bind argument values in CEnv ATuple::const_iterator p = prot->begin(); @@ -298,7 +298,7 @@ LLVMEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const AType* type, CFunc assert(prot->size() == argsT->size()); assert(prot->size() == f->num_args()); for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p, ++pT) { - const AType* t = cenv.resolveType((*pT)->as_type()); + const AST* t = cenv.resolveType(*pT); THROW_IF(!llType(t), (*p)->loc, "untyped parameter\n"); cenv.def((*p)->as_symbol(), *p, t, &*a); } @@ -332,7 +332,7 @@ LLVMEngine::compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* a BasicBlock* thenBB = BasicBlock::Create(context, (format("then%1%") % labelIndex).str()); BasicBlock* nextBB = BasicBlock::Create(context, (format("else%1%") % labelIndex).str()); - const AType* type = cenv.type(then); + const AST* type = cenv.type(then); ++labelIndex; @@ -365,11 +365,10 @@ LLVMEngine::compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* a } CVal -LLVMEngine::compileIsA(CEnv& cenv, CVal rtti, const ASymbol* tag) +LLVMEngine::compileIsA(CEnv& cenv, CVal rtti, CVal tag) { - LLVMEngine* engine = reinterpret_cast(cenv.engine()); - const AType* patT = new AType(tag, 0, Cursor()); - Value* typeV = llVal(resp_compile(cenv, patT)); + LLVMEngine* engine = reinterpret_cast(cenv.engine()); + Value* typeV = llVal(tag); return engine->builder.CreateICmp(CmpInst::ICMP_EQ, llVal(rtti), typeV); } @@ -421,7 +420,7 @@ LLVMEngine::compilePrimitive(CEnv& cenv, const ATuple* prim) } CVal -LLVMEngine::compileGlobalSet(CEnv& cenv, const string& sym, CVal val, const AType* type) +LLVMEngine::compileGlobalSet(CEnv& cenv, const string& sym, CVal val, const AST* type) { LLVMEngine* engine = reinterpret_cast(cenv.engine()); GlobalVariable* global = new GlobalVariable(*module, llType(type), false, @@ -449,7 +448,7 @@ LLVMEngine::writeModule(CEnv& cenv, std::ostream& os) } const string -LLVMEngine::call(CEnv& cenv, CFunc f, const AType* retT) +LLVMEngine::call(CEnv& cenv, CFunc f, const AST* retT) { void* fp = engine->getPointerToFunction(llFunc(f)); const Type* t = llType(retT); @@ -463,7 +462,7 @@ LLVMEngine::call(CEnv& cenv, CFunc f, const AType* retT) ss << showpoint << ((float (*)())fp)(); } else if (t == Type::getInt1Ty(context)) { ss << (((bool (*)())fp)() ? "#t" : "#f"); - } else if (retT->head()->str() == "String") { + } else if (retT->str() == "String") { const std::string s(((char* (*)())fp)()); ss << "\""; for (std::string::const_iterator i = s.begin(); i != s.end(); ++i) { diff --git a/src/parse.cpp b/src/parse.cpp index a725ca6..2d3ea02 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -89,7 +89,7 @@ read_line_comment(Cursor& cur, istream& in) static const AST* read_list(PEnv& penv, Cursor& cur, istream& in) { - List list; + List list; eat_char(cur, in, '('); while (true) { diff --git a/src/pprint.cpp b/src/pprint.cpp index d7ca0f8..a932065 100644 --- a/src/pprint.cpp +++ b/src/pprint.cpp @@ -96,15 +96,8 @@ print_to(ostream& out, const AST* ast, unsigned indent, CEnv* cenv, bool types) switch (ast->tag()) { case T_UNKNOWN: return out << "?"; - case T_TYPE: - { - const AType* type = ast->as_type(); - switch (type->kind) { - case AType::VAR: return out << "?" << type->id; - case AType::NAME: return out << type->head(); - case AType::EXPR: break; // will catch Tuple case below - } - } + case T_TVAR: + return out << "?" << AType::var_id(ast); case T_TUPLE: { const ATuple* tup = ast->as_tuple(); diff --git a/src/repl.cpp b/src/repl.cpp index 334cea3..02a2a8e 100644 --- a/src/repl.cpp +++ b/src/repl.cpp @@ -68,14 +68,15 @@ readParseType(CEnv& cenv, Cursor& cursor, istream& is, const AST*& exp, const AS } static void -callPrintCollect(CEnv& cenv, CFunc f, const AST* result, const AType* resultT, bool execute) +callPrintCollect(CEnv& cenv, CFunc f, const AST* result, const AST* resultT, bool execute) { if (execute) cenv.out << cenv.engine()->call(cenv, f, resultT); // Print type (if applicable) - if (resultT->head()->str() != "Nothing") - cenv.out << " : " << resultT << endl; + const std::string type_str = resultT->str(); + if (type_str != "Nothing") + cenv.out << " : " << type_str << endl; Object::pool.collect(Object::pool.roots()); } @@ -145,8 +146,8 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute) } } - const AType* type = cenv.type(exprs.back()); - const AType* fnT = tup(cursor, cenv.tenv.Fn, new AType(cursor), type, 0); + const AST* type = cenv.type(exprs.back()); + const ATuple* fnT = tup(cursor, cenv.tenv.Fn, new ATuple(cursor), type, 0); // Create function for top-level of program f = cenv.engine()->startFn(cenv, "main", new ATuple(cursor), fnT); @@ -193,8 +194,8 @@ repl(CEnv& cenv) Code lifted; ast = resp_lift(cenv, lifted, ast); - const AType* type = cenv.type(ast); - const AType* fnT = tup(cursor, cenv.tenv.Fn, new AType(cursor), type, 0); + const AST* type = cenv.type(ast); + const ATuple* fnT = tup(cursor, cenv.tenv.Fn, new ATuple(cursor), type, 0); CFunc f = NULL; try { // Create function for this repl loop diff --git a/src/resp.hpp b/src/resp.hpp index bc8c9ae..f601ac7 100644 --- a/src/resp.hpp +++ b/src/resp.hpp @@ -90,7 +90,7 @@ enum Tag { T_STRING = 10, T_SYMBOL = 12, T_TUPLE = 14, - T_TYPE = 16 + T_TVAR = 16 }; /// Garbage collector @@ -148,7 +148,6 @@ struct TEnv; ///< Type-Time Environment struct CEnv; ///< Compile-Time Environment struct ATuple; struct ASymbol; -struct AType; class AST; extern ostream& operator<<(ostream& out, const AST* ast); @@ -162,12 +161,12 @@ struct AST : public Object { string str() const { ostringstream ss; ss << this; return ss.str(); } const ATuple* as_tuple() const { - assert(tag() == T_TUPLE || tag() == T_TYPE); + assert(tag() == T_TUPLE); return (ATuple*)this; } const ATuple* to_tuple() const { - if (tag() == T_TUPLE || tag() == T_TYPE) + if (tag() == T_TUPLE) return (const ATuple*)this; return NULL; } @@ -187,22 +186,10 @@ struct AST : public Object { const ASymbol* as_symbol() const { return as_a(T_SYMBOL); } const ASymbol* to_symbol() const { return to_a(T_SYMBOL); } - const AType* as_type() const { return as_a(T_TYPE); } - const AType* to_type() const { return to_a(T_TYPE); } Cursor loc; }; -template -static T* tup(Cursor c, AST* ast, ...) -{ - va_list args; - va_start(args, ast); - T* ret = new T(c, ast, args); - va_end(args); - return ret; -} - /// Literal value template struct ALiteral : public AST { @@ -334,8 +321,19 @@ private: const AST** _vec; }; +inline ATuple* tup(Cursor c, AST* ast, ...) { + va_list args; + va_start(args, ast); + ATuple* ret = new ATuple(c, ast, args); + va_end(args); + return ret; +} + static bool list_contains(const ATuple* head, const AST* child) { + if (!head) + return false; + if (*head == *child) return true; @@ -351,70 +349,62 @@ list_contains(const ATuple* head, const AST* child) { return false; } -/// Type Expression, e.g. "Int", "(Fn (Int Int) Float)" -struct AType : public ATuple { - enum Kind { VAR, NAME, EXPR }; - AType(const ASymbol* s, Kind k) : ATuple(s, NULL, s->loc), kind(k), id(0) { tag(T_TYPE); } - AType(Cursor c, unsigned i) : ATuple(c), kind(VAR), id(i) { tag(T_TYPE); } - AType(Cursor c, Kind k=EXPR) : ATuple(c), kind(k), id(0) { tag(T_TYPE); } - AType(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args), kind(EXPR), id(0) { tag(T_TYPE); } - AType(const AST* first, const AST* rest, Cursor c) : ATuple(first, rest, c), kind(EXPR), id(0) { tag(T_TYPE); } - AType(const AType& copy, Cursor cur) : ATuple(copy), kind(copy.kind), id(copy.id) { - tag(T_TYPE); - loc = cur; - } - Kind kind; - unsigned id; +inline bool +list_equals(const ATuple* lhs, const ATuple* rhs) +{ + if (!rhs || rhs->tup_len() != lhs->tup_len()) return false; + ATuple::const_iterator l = lhs->begin(); + FOREACHP(ATuple::const_iterator, r, rhs) + if (!(*(*l++) == *(*r))) + return false; + return true; +} + +struct AType { + static inline bool is_var(const AST* type) { return type->tag() == T_TVAR; } + static inline bool is_name(const AST* type) { return type->tag() == T_SYMBOL; } + static inline bool is_expr(const AST* type) { return type->tag() == T_TUPLE; } + + static inline uint32_t var_id(const AST* type) { + assert(is_var(type)); + return ((ALiteral*)type)->val; + } }; // Utility class for easily building lists from left to right -template // ConsType, ElementType struct List { - explicit List(CT* h=0) : head(h), tail(0) {} - List(Cursor c, ET* ast, ...) : head(0), tail(0) { + explicit List(ATuple* h=0) : head(h), tail(0) {} + List(Cursor c, const AST* 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*)) + for (const AST* a = va_arg(args, const AST*); a; a = va_arg(args, const AST*)) push_back(a); va_end(args); } - void push_back(ET* ast) { + void push_back(const AST* ast) { if (!head) { - head = new CT(ast, NULL, Cursor()); + head = new ATuple(ast, NULL, Cursor()); } else if (!tail) { - CT* node = new CT(ast, NULL, Cursor()); + ATuple* node = new ATuple(ast, NULL, Cursor()); head->last(node); tail = node; } else { - CT* node = new CT(ast, NULL, Cursor()); + ATuple* node = new ATuple(ast, NULL, Cursor()); tail->last(node); tail = node; } } - void push_front(ET* ast) { - head = new CT(ast, head, Cursor()); + void push_front(const AST* ast) { + head = new ATuple(ast, head, Cursor()); } - operator CT*() const { return head; } - CT* head; - CT* tail; + operator ATuple*() const { return head; } + ATuple* head; + ATuple* tail; }; -typedef List TList; - -inline bool -list_equals(const ATuple* lhs, const ATuple* rhs) -{ - if (!rhs || rhs->tup_len() != lhs->tup_len()) return false; - ATuple::const_iterator l = lhs->begin(); - FOREACHP(ATuple::const_iterator, r, rhs) - if (!(*(*l++) == *(*r))) - return false; - return true; -} - template inline bool literal_equals(const ALiteral* lhs, const ALiteral* rhs) @@ -422,6 +412,7 @@ literal_equals(const ALiteral* lhs, const ALiteral* rhs) return lhs && rhs && lhs->val == rhs->val; } + inline bool AST::operator==(const AST& rhs) const { @@ -435,6 +426,7 @@ AST::operator==(const AST& rhs) const case T_FLOAT: return literal_equals((const ALiteral*)this, (const ALiteral*)&rhs); case T_INT32: + case T_TVAR: return literal_equals((const ALiteral*)this, (const ALiteral*)&rhs); case T_TUPLE: { @@ -442,22 +434,6 @@ AST::operator==(const AST& rhs) const const ATuple* rt = rhs.to_tuple(); return list_equals(me, rt); } - case T_TYPE: - { - const AType* me = this->as_type(); - const AType* rt = rhs.to_type(); - if (!rt || me->kind != rt->kind) { - assert(str() != rt->str()); - return false; - } else { - switch (me->kind) { - case AType::VAR: return me->id == rt->id; - case AType::NAME: return me->head()->str() == rt->head()->str(); - case AType::EXPR: return list_equals(me, rt); - } - } - return false; // never reached - } case T_STRING: return ((AString*)this)->cppstr == ((AString*)&rhs)->cppstr; case T_SYMBOL: @@ -557,39 +533,39 @@ struct PEnv : private map { ***************************************************************************/ /// Type constraint -struct Constraint : public pair { - Constraint(const AType* a, const AType* b) - : pair(a, b) {} +struct Constraint : public pair { + Constraint(const AST* a, const AST* b) + : pair(a, b) {} }; /// Type substitution struct Subst : public list { - Subst(const AType* s=0, const AType* t=0) { + Subst(const AST* s=0, const AST* t=0) { if (s && t) { assert(s != t); push_back(Constraint(s, t)); } } static Subst compose(const Subst& delta, const Subst& gamma); - void add(const AType* from, const AType* to) { + void add(const AST* from, const AST* to) { assert(from && to); push_back(Constraint(from, to)); } - const_iterator find(const AType* t) const { + const_iterator find(const AST* t) const { for (const_iterator j = begin(); j != end(); ++j) if (*j->first == *t) return j; return end(); } - const AType* apply(const AType* in) const { - if (in->kind == AType::EXPR) { - TList out; - for (ATuple::const_iterator i = in->begin(); i != in->end(); ++i) - out.push_back(apply((*i)->as_type())); + const AST* apply(const AST* in) const { + if (AType::is_expr(in)) { + List out; + for (ATuple::const_iterator i = in->as_tuple()->begin(); i != in->as_tuple()->end(); ++i) + out.push_back(apply((*i))); out.head->loc = in->loc; return out.head; } else { const_iterator i = find(in); if (i != end()) { - const AType* out = i->second->as_type(); - if (out->kind == AType::EXPR) + const AST* out = i->second; + if (AType::is_expr(out)) out = apply(out); return out; } else { @@ -597,11 +573,12 @@ struct Subst : public list { } } } - bool contains(const AType* type) const { + bool contains(const AST* type) const { if (find(type) != end()) return true; FOREACHP(const_iterator, j, this) - if (*j->second == *type || list_contains(j->second, type)) + if (*j->second == *type + || (AType::is_expr(j->second) && list_contains(j->second->as_tuple(), type))) return true; return false; } @@ -621,8 +598,8 @@ struct Constraints : public list { push_back(Constraint(i->first, i->second)); } Constraints(const_iterator begin, const_iterator end) : list(begin, end) {} - void constrain(TEnv& tenv, const AST* o, const AType* t); - Constraints& replace(const AType* s, const AType* t); + void constrain(TEnv& tenv, const AST* o, const AST* t); + Constraints& replace(const AST* s, const AST* t); }; inline ostream& operator<<(ostream& out, const Constraints& c) { @@ -632,51 +609,51 @@ inline ostream& operator<<(ostream& out, const Constraints& c) { } /// Type-Time Environment -struct TEnv : public Env { +struct TEnv : public Env { explicit TEnv(PEnv& p) : penv(p) , varID(1) - , Closure(new AType(penv.sym("Closure"), AType::NAME)) - , Dots(new AType(penv.sym("..."), AType::NAME)) - , Fn(new AType(penv.sym("Fn"), AType::NAME)) - , Tup(new AType(penv.sym("Tup"), AType::NAME)) - , U(new AType(penv.sym("U"), AType::NAME)) + , Closure(penv.sym("Closure")) + , Dots(penv.sym("...")) + , Fn(penv.sym("Fn")) + , Tup(penv.sym("Tup")) + , U(penv.sym("U")) { Object::pool.addRoot(Fn); } - const AType* fresh(const ASymbol* sym) { - return def(sym, new AType(sym->loc, varID++)); + const AST* fresh(const ASymbol* sym) { + return def(sym, new ALiteral(T_TVAR, varID++, sym->loc)); } - const AType* var(const AST* ast=0) { + const AST* var(const AST* ast=0) { if (!ast) - return new AType(Cursor(), varID++); + return new ALiteral(T_TVAR, varID++, Cursor()); - assert(!ast->to_type()); + assert(!AType::is_var(ast)); Vars::iterator v = vars.find(ast); if (v != vars.end()) return v->second; - return (vars[ast] = new AType(ast->loc, varID++)); + return (vars[ast] = new ALiteral(T_TVAR, varID++, ast->loc)); } - const AType** ref(const ASymbol* sym) { - return ((Env*)this)->ref(sym); + const AST** ref(const ASymbol* sym) { + return ((Env*)this)->ref(sym); } - const AType* named(const string& name) { + const AST* named(const string& name) { return *ref(penv.sym(name)); } - static Subst buildSubst(const AType* fnT, const AType& argsT); + static Subst buildSubst(const AST* fnT, const AST& argsT); - typedef map Vars; + typedef map Vars; Vars vars; PEnv& penv; unsigned varID; - AType* Closure; - AType* Dots; - AType* Fn; - AType* Tup; - AType* U; + ASymbol* Closure; + ASymbol* Dots; + ASymbol* Fn; + ASymbol* Tup; + ASymbol* U; }; Subst unify(const Constraints& c); @@ -686,8 +663,6 @@ Subst unify(const Constraints& c); * Code Generation * ***************************************************************************/ -typedef void* IfState; - /// Compiler backend struct Engine { virtual ~Engine() {} @@ -697,30 +672,30 @@ struct Engine { virtual CFunc startFn(CEnv& cenv, const std::string& name, const ATuple* args, - const AType* type) = 0; + const ATuple* type) = 0; virtual void pushFnArgs(CEnv& cenv, const ATuple* prot, - const AType* type, + const ATuple* type, CFunc f) = 0; virtual void finishFn(CEnv& cenv, CFunc f, CVal ret) = 0; virtual void eraseFn(CEnv& cenv, CFunc f) = 0; - virtual CVal compileCall(CEnv& cenv, CFunc f, const AType* fT, CVals& args) = 0; - virtual CVal compileCons(CEnv& cenv, const AType* t, CVal rtti, CVals& f) = 0; + virtual CVal compileCall(CEnv& cenv, CFunc f, const ATuple* fT, CVals& args) = 0; + virtual CVal compileCons(CEnv& cenv, const ATuple* t, CVal rtti, CVals& f) = 0; virtual CVal compileDot(CEnv& cenv, CVal tup, int32_t index) = 0; - virtual CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AType* t) = 0; + virtual CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t) = 0; virtual CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v) = 0; virtual CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse) = 0; - virtual CVal compileIsA(CEnv& cenv, CVal rtti, const ASymbol* tag) = 0; + virtual CVal compileIsA(CEnv& cenv, CVal rtti, CVal tag) = 0; virtual CVal compileLiteral(CEnv& cenv, const AST* lit) = 0; virtual CVal compilePrimitive(CEnv& cenv, const ATuple* prim) = 0; virtual CVal compileString(CEnv& cenv, const char* str) = 0; virtual void writeModule(CEnv& cenv, std::ostream& os) = 0; - virtual const string call(CEnv& cenv, CFunc f, const AType* retT) = 0; + virtual const string call(CEnv& cenv, CFunc f, const AST* retT) = 0; }; Engine* resp_new_llvm_engine(); @@ -744,28 +719,28 @@ struct CEnv { if (type(ast)) Object::pool.addRoot(type(ast)); } - const AType* resolveType(const AType* type) const { - if (type->kind == AType::NAME) - return tenv.named(type->head()->to_symbol()->sym()); + const AST* resolveType(const AST* type) const { + if (AType::is_name(type)) + return tenv.named(type->as_symbol()->sym()); return type; } - const AType* type(const AST* ast, const Subst& subst = Subst(), bool resolve=true) const { - const AType* ret = NULL; + const AST* type(const AST* ast, const Subst& subst = Subst(), bool resolve=true) const { + const AST* ret = NULL; const ASymbol* sym = ast->to_symbol(); if (sym) { - const AType** rec = tenv.ref(sym); + const AST** rec = tenv.ref(sym); if (rec) ret = *rec; } if (!ret) ret = tenv.vars[ast]; if (ret) - ret = tsubst.apply(subst.apply(ret))->to_type(); + ret = tsubst.apply(subst.apply(ret)); if (resolve && ret) ret = this->resolveType(ret); return ret; } - void def(const ASymbol* sym, const AST* c, const AType* t, CVal v) { + void def(const ASymbol* sym, const AST* c, const AST* t, CVal v) { code.def(sym, c); tenv.def(sym, t); vals.def(sym, v); @@ -775,9 +750,9 @@ struct CEnv { const AST** rec = code.ref(sym); return rec ? *rec : ast; } - void setType(const AST* ast, const AType* type) { + void setType(const AST* ast, const AST* type) { assert(!ast->to_symbol()); - const AType* tvar = tenv.var(); + const AST* tvar = tenv.var(); tenv.vars.insert(make_pair(ast, tvar)); tsubst.add(tvar, type); } @@ -797,7 +772,7 @@ struct CEnv { typedef map Impls; Impls impls; - CFunc findImpl(const ATuple* fn, const AType* type) { + CFunc findImpl(const ATuple* fn, const AST* type) { Impls::const_iterator i = impls.find(fn); return (i != impls.end()) ? i->second : NULL; } diff --git a/src/simplify.cpp b/src/simplify.cpp index 23acad7..715202a 100644 --- a/src/simplify.cpp +++ b/src/simplify.cpp @@ -28,7 +28,7 @@ using namespace std; static const AST* simplify_if(CEnv& cenv, const ATuple* aif) throw() { - List copy(aif->loc, cenv.penv.sym("if"), NULL); + List copy(aif->loc, cenv.penv.sym("if"), NULL); copy.push_back(aif->list_ref(1)); copy.push_back(aif->list_ref(2)); @@ -39,7 +39,7 @@ simplify_if(CEnv& cenv, const ATuple* aif) throw() if (++next == aif->end()) break; - List inner_if((*i)->loc, cenv.penv.sym("if"), *i, *next, NULL); + List inner_if((*i)->loc, cenv.penv.sym("if"), *i, *next, NULL); tail->last(new ATuple(inner_if.head, NULL, Cursor())); tail = inner_if.tail; @@ -58,22 +58,23 @@ simplify_match(CEnv& cenv, const ATuple* match) throw() { // Dot expression to get tag. Note index is -1 to compensate for the lift phase // which adds 1 to skip the RTTI, which we don't want here (FIXME: ick...) - List tval; + List tval; tval.push_back(cenv.penv.sym(".")); tval.push_back(resp_simplify(cenv, match->list_ref(1))); tval.push_back(new ALiteral(T_INT32, -1, Cursor())); const ASymbol* tsym = cenv.penv.gensym("_matchT"); - List def(match->loc, cenv.penv.sym("def"), tsym, tval.head, NULL); - - List copyIf; + List def(match->loc, cenv.penv.sym("def"), tsym, tval.head, NULL); + cenv.setType(tval.head, cenv.tenv.named("String")); + + List copyIf; copyIf.push_back(cenv.penv.sym("if")); for (ATuple::const_iterator i = match->iter_at(2); i != match->end();) { const ATuple* pat = (*i++)->as_tuple(); const AST* body = *i++; - List cond; + List cond; cond.push_back(cenv.penv.sym("__tag_is")); cond.push_back(tsym); cond.push_back(pat->head()); @@ -84,7 +85,7 @@ simplify_match(CEnv& cenv, const ATuple* match) throw() copyIf.push_back(cenv.penv.sym("__unreachable")); cenv.setTypeSameAs(copyIf, match); - List copy; + List copy; copy.push_back(cenv.penv.sym("do")); copy.push_back(def); copy.push_back(simplify_if(cenv, copyIf)); @@ -96,7 +97,7 @@ simplify_match(CEnv& cenv, const ATuple* match) throw() static const AST* simplify_list(CEnv& cenv, const ATuple* call) throw() { - List copy; + List copy; for (ATuple::const_iterator i = call->begin(); i != call->end(); ++i) copy.push_back(resp_simplify(cenv, *i)); @@ -110,11 +111,11 @@ simplify_let(CEnv& cenv, const ATuple* call) throw() { const ATuple* vars = call->list_ref(1)->to_tuple(); - List fn(Cursor(), cenv.penv.sym("fn"), NULL); + List fn(Cursor(), cenv.penv.sym("fn"), NULL); - List fnProt; - List fnArgs; - List fnProtT; + List fnProt; + List fnArgs; + List fnProtT; for (ATuple::const_iterator i = vars->begin(); i != vars->end();) { const ASymbol* sym = (*i++)->to_symbol(); const AST* val = (*i++); @@ -126,7 +127,7 @@ simplify_let(CEnv& cenv, const ATuple* call) throw() fn.push_back(fnProt.head); fn.push_back(resp_simplify(cenv, call->list_ref(2))); - List fnT; + List fnT; fnT.push_back(cenv.tenv.Fn); fnT.push_back(fnProtT); fnT.push_back(cenv.type(call->list_ref(2))); diff --git a/src/unify.cpp b/src/unify.cpp index 52a3265..a7f7822 100644 --- a/src/unify.cpp +++ b/src/unify.cpp @@ -26,29 +26,25 @@ * with a specific set of argument types */ Subst -TEnv::buildSubst(const AType* genericT, const AType& argsT) +TEnv::buildSubst(const AST* genericT, const AST& argsT) { Subst subst; // Build substitution to apply to generic type - const ATuple* genericProtT = genericT->list_ref(1)->as_tuple(); + const ATuple* genericProtT = genericT->as_tuple()->list_ref(1)->as_tuple(); ATuple::const_iterator g = genericProtT->begin(); - ATuple::const_iterator a = argsT.begin(); - for (; a != argsT.end(); ++a, ++g) { - const AType* genericArgT = (*g)->to_type(); - const AType* callArgT = (*a)->to_type(); - 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_type(); - const AType* aT = (*ci)->to_type(); - if (gT && aT) - subst.add(gT, aT); + ATuple::const_iterator a = argsT.as_tuple()->begin(); + for (; a != argsT.as_tuple()->end(); ++a, ++g) { + if (AType::is_expr(*a)) { + assert(AType::is_expr(*g)); + ATuple::const_iterator gi = (*g)->as_tuple()->begin(); + ATuple::const_iterator ci = (*a)->as_tuple()->begin(); + for (; gi != (*g)->as_tuple()->end(); ++gi, ++ci) { + if ((*gi) && (*ci)) + subst.add(*gi, *ci); } } else { - subst.add(genericArgT, callArgT); + subst.add(*g, *a); } } @@ -56,29 +52,34 @@ TEnv::buildSubst(const AType* genericT, const AType& argsT) } void -Constraints::constrain(TEnv& tenv, const AST* o, const AType* t) +Constraints::constrain(TEnv& tenv, const AST* o, const AST* t) { assert(o); assert(t); push_back(Constraint(tenv.var(o), t)); } -static const AType* -substitute(const AType* tup, const AType* from, const AType* to) +static const AST* +substitute(const AST* in, const AST* from, const AST* to) { - if (!tup) return NULL; - TList ret; - FOREACHP(AType::const_iterator, i, tup) { + if (in == from) + return to; + + const ATuple* tup = in->to_tuple(); + if (!tup) + return from; + + List ret; + FOREACHP(ATuple::const_iterator, i, tup->as_tuple()) { if (**i == *from) { - ret.push_back(new AType(*to, (*i)->loc)); + ret.push_back(to); // FIXME: should be a copy w/ (*i)->loc } else if (*i != to) { - const AType* elem = (*i)->as_type(); - if (elem->kind == AType::EXPR) - ret.push_back(substitute(elem, from, to)); + if (AType::is_expr(*i)) + ret.push_back(substitute(*i, from, to)); else - ret.push_back(elem); + ret.push_back(*i); } else { - ret.push_back((*i)->as_type()); + ret.push_back(*i); } } return ret.head; @@ -102,17 +103,17 @@ Subst::compose(const Subst& delta, const Subst& gamma) /// Replace all occurrences of @a s with @a t Constraints& -Constraints::replace(const AType* s, const AType* t) +Constraints::replace(const AST* s, const AST* t) { for (Constraints::iterator c = begin(); c != end(); ++c) { if (*c->first == *s) { - c->first = new AType(*t, c->first->loc); - } else if (c->first->kind == AType::EXPR) { + c->first = t; // FIXME: should be copy w/ c->first->loc; + } else if (AType::is_expr(c->first)) { c->first = substitute(c->first, s, t); } if (*c->second == *s) { - c->second = new AType(*t, c->second->loc); - } else if (c->second->kind == AType::EXPR) { + c->second = t; // FIXME: should be copy w/ c->second->loc; + } else if (AType::is_expr(c->second)) { c->second = substitute(c->second, s, t); } } @@ -120,10 +121,9 @@ Constraints::replace(const AType* s, const AType* t) } static inline bool -is_dots(const AST* ast) +is_dots(const AST* type) { - const AType* type = ast->as_type(); - return (type->kind == AType::NAME && type->head()->str() == "..."); + return (AType::is_name(type) && type->as_symbol()->str() == "..."); } /// Unify a type constraint set (TAPL 22.4) @@ -134,30 +134,30 @@ unify(const Constraints& constraints) return Subst(); Constraints::const_iterator i = constraints.begin(); - const AType* s = i->first; - const AType* t = i->second; + const AST* s = i->first; + const AST* t = i->second; Constraints cp(++i, constraints.end()); if (*s == *t) { return unify(cp); - } else if (s->kind == AType::VAR && !list_contains(t, s)) { + } else if (AType::is_var(s) && !list_contains(t->to_tuple(), s)) { return Subst::compose(unify(cp.replace(s, t)), Subst(s, t)); - } else if (t->kind == AType::VAR && !list_contains(s, t)) { + } else if (AType::is_var(t) && !list_contains(s->to_tuple(), t)) { return Subst::compose(unify(cp.replace(t, s)), Subst(t, s)); - } else if (s->kind == AType::EXPR && t->kind == AType::EXPR) { - AType::const_iterator si = s->begin(); - AType::const_iterator ti = t->begin(); - for (; si != s->end() && ti != t->end(); ++si, ++ti) { - const AType* st = (*si)->as_type(); - const AType* tt = (*ti)->as_type(); - if (is_dots(st) || is_dots(tt)) + } else if (AType::is_expr(s) && AType::is_expr(t)) { + const ATuple* const st = s->as_tuple(); + const ATuple* const tt = t->as_tuple(); + ATuple::const_iterator si = st->begin(); + ATuple::const_iterator ti = tt->begin(); + for (; si != st->end() && ti != tt->end(); ++si, ++ti) { + if (is_dots(*si) || is_dots(*ti)) return unify(cp); else - cp.push_back(Constraint(st, tt)); + cp.push_back(Constraint(*si, *ti)); } - if ((si == s->end() && ti == t->end()) - || (si != s->end() && is_dots(*si)) - || (ti != t->end() && is_dots(*ti))) + if ((si == st->end() && ti == tt->end()) + || (si != st->end() && is_dots(*si)) + || (ti != tt->end() && is_dots(*ti))) return unify(cp); } throw Error(s->loc, -- cgit v1.2.1