diff options
| -rw-r--r-- | src/compile.cpp | 156 | ||||
| -rw-r--r-- | src/constrain.cpp | 228 | ||||
| -rw-r--r-- | src/lift.cpp | 80 |
3 files changed, 233 insertions, 231 deletions
diff --git a/src/compile.cpp b/src/compile.cpp index 127a981..a696836 100644 --- a/src/compile.cpp +++ b/src/compile.cpp @@ -34,63 +34,27 @@ compile_symbol(CEnv& cenv, const ASymbol* sym) throw() } static CVal -compile_fn(CEnv& cenv, const ATuple* fn) throw() -{ - assert(!cenv.currentFn); - - const AType* 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); - cenv.currentFn = f; - - // Write function body - CVal retVal = NULL; - for (ATuple::const_iterator i = fn->iter_at(2); i != fn->end(); ++i) - retVal = resp_compile(cenv, *i); - - // Write function conclusion and pop stack frame - cenv.engine()->finishFn(cenv, f, retVal); - cenv.pop(); - cenv.currentFn = NULL; - - cenv.vals.def(cenv.penv.sym(cenv.name(fn)), f); - cenv.addImpl(fn, f); - return f; -} - -static CVal -compile_type(CEnv& cenv, const AType* type) throw() +compile_cons(CEnv& cenv, const ATuple* cons) 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; + AType* type = new AType(cons->head()->as_symbol(), NULL, Cursor()); + TList tlist(type); + vector<CVal> 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); } static CVal -compile_call(CEnv& cenv, const ATuple* call) throw() +compile_dot(CEnv& cenv, const ATuple* dot) throw() { - CFunc f = resp_compile(cenv, call->head()); - - if (!f) - f = cenv.currentFn; // Recursive call (callee defined as a stub) - - vector<CVal> args; - 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); + ATuple::const_iterator i = dot->begin(); + const AST* tup = *++i; + const ALiteral<int32_t>* index = (ALiteral<int32_t>*)(*++i); + assert(index->tag() == T_INT32); + CVal tupVal = resp_compile(cenv, tup); + return cenv.engine()->compileDot(cenv, tupVal, index->val + 1); // + 1 to skip RTTI } static CVal @@ -110,27 +74,33 @@ compile_def(CEnv& cenv, const ATuple* def) throw() } static CVal -compile_cons(CEnv& cenv, const ATuple* cons) throw() +compile_fn(CEnv& cenv, const ATuple* fn) throw() { - AType* type = new AType(cons->head()->as_symbol(), NULL, Cursor()); - TList tlist(type); - vector<CVal> 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); -} + assert(!cenv.currentFn); + + const AType* type = cenv.type(fn); + CFunc f = cenv.findImpl(fn, type); + if (f) + return f; -static CVal -compile_dot(CEnv& cenv, const ATuple* dot) throw() -{ - ATuple::const_iterator i = dot->begin(); - const AST* tup = *++i; - const ALiteral<int32_t>* index = (ALiteral<int32_t>*)(*++i); - assert(index->tag() == T_INT32); - CVal tupVal = resp_compile(cenv, tup); - return cenv.engine()->compileDot(cenv, tupVal, index->val + 1); // + 1 to skip RTTI + // 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); + cenv.currentFn = f; + + // Write function body + CVal retVal = NULL; + for (ATuple::const_iterator i = fn->iter_at(2); i != fn->end(); ++i) + retVal = resp_compile(cenv, *i); + + // Write function conclusion and pop stack frame + cenv.engine()->finishFn(cenv, f, retVal); + cenv.pop(); + cenv.currentFn = NULL; + + cenv.vals.def(cenv.penv.sym(cenv.name(fn)), f); + cenv.addImpl(fn, f); + return f; } static CVal @@ -173,6 +143,36 @@ compile_match(CEnv& cenv, const ATuple* match) throw() return cenv.engine()->compileIfEnd(cenv, state, NULL, type); } +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; + } +} + +static CVal +compile_call(CEnv& cenv, const ATuple* call) throw() +{ + CFunc f = resp_compile(cenv, call->head()); + + if (!f) + f = cenv.currentFn; // Recursive call (callee defined as a stub) + + vector<CVal> args; + 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); +} + CVal resp_compile(CEnv& cenv, const AST* ast) throw() { @@ -196,20 +196,20 @@ resp_compile(CEnv& cenv, const AST* ast) throw() const std::string form = sym ? sym->sym() : ""; if (is_primitive(cenv.penv, call)) return cenv.engine()->compilePrimitive(cenv, ast->as_tuple()); - else if (form == "fn") - return compile_fn(cenv, call); - else if (form == "def") - return compile_def(cenv, call); - else if (form == "if") - return compile_if(cenv, call); else if (form == "cons" || isupper(form[0])) return compile_cons(cenv, call); else if (form == ".") return compile_dot(cenv, call); + else if (form == "def") + return compile_def(cenv, call); + else if (form == "def-type") + return NULL; // FIXME + else if (form == "fn") + return compile_fn(cenv, call); + else if (form == "if") + return compile_if(cenv, call); else if (form == "match") return compile_match(cenv, call); - else if (form == "def-type") - return NULL; else return compile_call(cenv, call); } diff --git a/src/constrain.cpp b/src/constrain.cpp index 7b437c8..c4a08ec 100644 --- a/src/constrain.cpp +++ b/src/constrain.cpp @@ -31,58 +31,51 @@ constrain_symbol(TEnv& tenv, Constraints& c, const ASymbol* sym) throw(Error) } static void -constrain_fn(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) +constrain_cons(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) { - set<const ASymbol*> 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) { - 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); - frame.push_back(make_pair(sym->sym(), tvar)); - protT.push_back(tvar); - } - protT.head->loc = call->loc; + const ASymbol* sym = (*call->begin())->as_symbol(); + const AType* type = NULL; - ATuple::const_iterator i = call->iter_at(1); - c.constrain(tenv, *i, protT); + for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i) + resp_constrain(tenv, c, *i); - // Add internal definitions to environment frame - for (++i; i != call->end(); ++i) { - const AST* exp = *i; - const ATuple* call = exp->to_tuple(); - if (call && is_form(call, "def")) { - const ASymbol* sym = call->list_ref(1)->as_symbol(); - 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)); + if (!strcmp(sym->sym(), "Tup")) { + TList tupT(new AType(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); + 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); } + c.constrain(tenv, call, type); +} - tenv.push(frame); - - const AST* exp = NULL; - for (i = call->iter_at(2); i != call->end(); ++i) { - exp = *i; - resp_constrain(tenv, c, exp); - } +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<int32_t>* idx = (ALiteral<int32_t>*)idx_ast; - const AType* bodyT = tenv.var(exp); - const AType* fnT = tup<const AType>(call->loc, tenv.Fn, protT.head, bodyT, 0); - Object::pool.addRoot(fnT); + resp_constrain(tenv, c, obj); - tenv.pop(); + const AType* retT = tenv.var(call); + c.constrain(tenv, call, retT); - c.constrain(tenv, call, fnT); + TList objT(new AType(tenv.Tup, NULL, call->loc)); + for (int i = 0; i < idx->val; ++i) + objT.push_back(tenv.var()); + objT.push_back(retT); + objT.push_back(tenv.Dots); + c.constrain(tenv, obj, objT); } static void @@ -129,34 +122,58 @@ constrain_def_type(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) } static void -constrain_match(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) +constrain_fn(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<AType>(loc, tenv.U, 0); - resp_constrain(tenv, c, matchee); - for (ATuple::const_iterator i = call->iter_at(2); i != call->end();) { - const AST* exp = *i++; - const ATuple* pattern = exp->to_tuple(); - THROW_IF(!pattern, exp->loc, "pattern expression expected"); - const ASymbol* name = (*pattern->begin())->to_symbol(); - THROW_IF(!name, (*pattern->begin())->loc, "pattern does not start with a symbol"); + set<const ASymbol*> defs; + TEnv::Frame frame; - const AType* consT = *tenv.ref(name); + const ATuple* const prot = call->prot(); + + // Add parameters to environment frame + TList protT; + for (ATuple::const_iterator i = prot->begin(); i != prot->end(); ++i) { + 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); + frame.push_back(make_pair(sym->sym(), tvar)); + protT.push_back(tvar); + } + protT.head->loc = call->loc; - if (!matcheeT) { - const AType* headT = consT->head()->as_type(); - matcheeT = new AType(headT, 0, call->loc); + ATuple::const_iterator i = call->iter_at(1); + c.constrain(tenv, *i, protT); + + // Add internal definitions to environment frame + for (++i; i != call->end(); ++i) { + const AST* exp = *i; + const ATuple* call = exp->to_tuple(); + if (call && is_form(call, "def")) { + const ASymbol* sym = call->list_ref(1)->as_symbol(); + 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)); } + } - THROW_IF(i == call->end(), pattern->loc, "missing pattern body"); - const AST* body = *i++; - resp_constrain(tenv, c, body); - c.constrain(tenv, body, retT); + tenv.push(frame); + + const AST* exp = NULL; + for (i = call->iter_at(2); i != call->end(); ++i) { + exp = *i; + resp_constrain(tenv, c, exp); } - c.constrain(tenv, call, retT); - c.constrain(tenv, matchee, matcheeT); + + const AType* bodyT = tenv.var(exp); + const AType* fnT = tup<const AType>(call->loc, tenv.Fn, protT.head, bodyT, 0); + Object::pool.addRoot(fnT); + + tenv.pop(); + + c.constrain(tenv, call, fnT); } static void @@ -182,51 +199,34 @@ constrain_if(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) } static void -constrain_cons(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) +constrain_match(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) { - const ASymbol* sym = (*call->begin())->as_symbol(); - const AType* type = NULL; + 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<AType>(loc, tenv.U, 0); + resp_constrain(tenv, c, matchee); + for (ATuple::const_iterator i = call->iter_at(2); i != call->end();) { + const AST* exp = *i++; + const ATuple* pattern = exp->to_tuple(); + THROW_IF(!pattern, exp->loc, "pattern expression expected"); + const ASymbol* name = (*pattern->begin())->to_symbol(); + THROW_IF(!name, (*pattern->begin())->loc, "pattern does not start with a symbol"); - for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i) - resp_constrain(tenv, c, *i); + const AType* consT = *tenv.ref(name); - if (!strcmp(sym->sym(), "Tup")) { - TList tupT(new AType(tenv.Tup, NULL, call->loc)); - for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i) { - tupT.push_back(tenv.var(*i)); + if (!matcheeT) { + const AType* headT = consT->head()->as_type(); + matcheeT = new AType(headT, 0, call->loc); } - type = tupT; - } else { - const AType** 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); - } - c.constrain(tenv, call, type); -} -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<int32_t>* idx = (ALiteral<int32_t>*)idx_ast; - - resp_constrain(tenv, c, obj); - - const AType* retT = tenv.var(call); + THROW_IF(i == call->end(), pattern->loc, "missing pattern body"); + const AST* body = *i++; + resp_constrain(tenv, c, body); + c.constrain(tenv, body, retT); + } c.constrain(tenv, call, retT); - - TList objT(new AType(tenv.Tup, NULL, call->loc)); - for (int i = 0; i < idx->val; ++i) - objT.push_back(tenv.var()); - objT.push_back(retT); - objT.push_back(tenv.Dots); - c.constrain(tenv, obj, objT); + c.constrain(tenv, matchee, matcheeT); } static void @@ -315,7 +315,7 @@ constrain_primitive(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) } static void -constrain_tuple(TEnv& tenv, Constraints& c, const ATuple* tup) throw(Error) +constrain_list(TEnv& tenv, Constraints& c, const ATuple* tup) throw(Error) { const ASymbol* const sym = tup->head()->to_symbol(); if (!sym) { @@ -326,20 +326,20 @@ constrain_tuple(TEnv& tenv, Constraints& c, const ATuple* tup) throw(Error) const std::string form = sym->sym(); if (is_primitive(tenv.penv, tup)) constrain_primitive(tenv, c, tup); - else if (form == "fn") - constrain_fn(tenv, c, tup); + else if (form == "cons" || isupper(form[0])) + constrain_cons(tenv, c, tup); + else if (form == ".") + constrain_dot(tenv, c, tup); else if (form == "def") constrain_def(tenv, c, tup); else if (form == "def-type") constrain_def_type(tenv, c, tup); - else if (form == "match") - constrain_match(tenv, c, tup); + else if (form == "fn") + constrain_fn(tenv, c, tup); else if (form == "if") constrain_if(tenv, c, tup); - else if (form == "cons" || isupper(form[0])) - constrain_cons(tenv, c, tup); - else if (form == ".") - constrain_dot(tenv, c, tup); + else if (form == "match") + constrain_match(tenv, c, tup); else constrain_call(tenv, c, tup); } @@ -367,7 +367,7 @@ resp_constrain(TEnv& tenv, Constraints& c, const AST* ast) throw(Error) constrain_symbol(tenv, c, ast->as_symbol()); break; case T_TUPLE: - constrain_tuple(tenv, c, ast->as_tuple()); + constrain_list(tenv, c, ast->as_tuple()); break; } } diff --git a/src/lift.cpp b/src/lift.cpp index 5ac3816..4e2159b 100644 --- a/src/lift.cpp +++ b/src/lift.cpp @@ -47,6 +47,35 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw() } static const AST* +lift_def(CEnv& cenv, Code& code, const ATuple* def) throw() +{ + // Define stub first for recursion + const ASymbol* const sym = def->list_ref(1)->as_symbol(); + const AST* const body = def->list_ref(2); + cenv.def(sym, body, cenv.type(body), NULL); + if (is_form(body, "fn")) + cenv.setName(body->as_tuple(), sym->str()); + + assert(def->list_ref(1)->to_symbol()); + List<ATuple, const AST> 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) + copy.push_back(resp_lift(cenv, code, *t)); + + cenv.setTypeSameAs(copy.head, def); + + if (copy.head->list_ref(1) == copy.head->list_ref(2)) + return NULL; // Definition created by lift_fn when body was lifted + + cenv.def(copy.head->list_ref(1)->as_symbol(), + copy.head->list_ref(2), + cenv.type(copy.head->list_ref(2)), + NULL); + return copy; +} + +static const AST* lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw() { List<ATuple, const AST> impl; @@ -180,36 +209,7 @@ lift_call(CEnv& cenv, Code& code, const ATuple* call) throw() } static const AST* -lift_def(CEnv& cenv, Code& code, const ATuple* def) throw() -{ - // Define stub first for recursion - const ASymbol* const sym = def->list_ref(1)->as_symbol(); - const AST* const body = def->list_ref(2); - cenv.def(sym, body, cenv.type(body), NULL); - if (is_form(body, "fn")) - cenv.setName(body->as_tuple(), sym->str()); - - assert(def->list_ref(1)->to_symbol()); - List<ATuple, const AST> 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) - copy.push_back(resp_lift(cenv, code, *t)); - - cenv.setTypeSameAs(copy.head, def); - - if (copy.head->list_ref(1) == copy.head->list_ref(2)) - return NULL; // Definition created by lift_fn when body was lifted - - cenv.def(copy.head->list_ref(1)->as_symbol(), - copy.head->list_ref(2), - cenv.type(copy.head->list_ref(2)), - NULL); - return copy; -} - -static const AST* -lift_builtin_call(CEnv& cenv, Code& code, const ATuple* call) throw() +lift_args(CEnv& cenv, Code& code, const ATuple* call) throw() { List<ATuple, const AST> copy; copy.push_back(call->head()); @@ -235,18 +235,20 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw() const ASymbol* const sym = call->head()->to_symbol(); const std::string form = sym ? sym->sym() : ""; if (is_primitive(cenv.penv, call)) - return lift_builtin_call(cenv, code, call); - else if (form == "fn") - return lift_fn(cenv, code, call); + return lift_args(cenv, code, call); + else if (form == "cons" || isupper(form[0])) + return lift_args(cenv, code, call); + else if (form == ".") + return lift_args(cenv, code, call); else if (form == "def") return lift_def(cenv, code, call); + else if (form == "def-type") + return call; // FIXME + else if (form == "fn") + return lift_fn(cenv, code, call); else if (form == "if") - return lift_builtin_call(cenv, code, call); - else if (form == "cons" || isupper(form[0])) - return lift_builtin_call(cenv, code, call); - else if (form == ".") - return lift_builtin_call(cenv, code, call); - else if (form == "match" || form == "def-type") + return lift_args(cenv, code, call); + else if (form == "match") return call; // FIXME else return lift_call(cenv, code, call); |