aboutsummaryrefslogtreecommitdiffstats
path: root/src/lift.cpp
diff options
context:
space:
mode:
Diffstat (limited to 'src/lift.cpp')
-rw-r--r--src/lift.cpp83
1 files changed, 43 insertions, 40 deletions
diff --git a/src/lift.cpp b/src/lift.cpp
index 04bf61b..979f3c1 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -52,7 +52,9 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw()
static AST*
lift_fn(CEnv& cenv, Code& code, ATuple* fn) throw()
{
- ATuple* impl = new ATuple(*fn);
+ List<ATuple,AST> impl;
+ impl.push_back(fn->head());
+
const string fnName = cenv.name(fn);
const string nameBase = cenv.penv.gensymstr(((fnName != "") ? fnName : "fn").c_str());
const string implNameStr = string("_") + nameBase;
@@ -64,53 +66,48 @@ lift_fn(CEnv& cenv, Code& code, ATuple* fn) throw()
cenv.push();
const AType* type = cenv.type(fn);
AType::const_iterator tp = type->prot()->begin();
- AType* implProtT = new AType(*type->prot()->as_type());
- ATuple::iterator ip = implProtT->begin();
+ List<AType,AType> implProtT;
+
+ List<ATuple,AST> implProt;
+
+ // Prepend closure parameter
+ implProt.push_back(const_cast<ASymbol*>(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) {
- AType* fnType = new AType(*paramType);
- fnType->set_prot(new AType(const_cast<AType*>(cenv.tenv.var()),
- const_cast<AType*>(fnType->prot()->as_type()),
- Cursor()));
+ AType* fnType = new AType(const_cast<AType*>(cenv.tenv.var()),
+ const_cast<AType*>(paramType),
+ fnType->loc);
paramType = tup<const AType>((*p)->loc, cenv.tenv.Tup, fnType, NULL);
}
cenv.def((*p)->as_symbol(), *p, paramType, NULL);
- *ip++ = new AType(*paramType);
+ implProt.push_back(const_cast<AST*>(*p));
+ implProtT.push_back(new AType(*paramType));
}
- /* 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->set_prot(new ATuple(cenv.penv.sym("_"), impl->prot()));
+ impl.push_back(implProt);
// Lift body
const AType* implRetT = NULL;
- ATuple::iterator ci = impl->iter_at(2);
- for (ATuple::iterator i = fn->iter_at(2); i != fn->end(); ++i, ++ci) {
- *ci = resp_lift(cenv, code, *i);
- implRetT = cenv.type(*ci);
+ for (ATuple::const_iterator i = fn->iter_at(2); i != fn->end(); ++i) {
+ AST* lifted = resp_lift(cenv, code, const_cast<AST*>(*i));
+ impl.push_back(lifted);
+ implRetT = cenv.type(lifted);
}
cenv.pop();
- // Set name of closure parameter to "me"
- *impl->prot()->begin() = cenv.penv.sym("_me");
-
// Create definition for implementation fn
ASymbol* implName = cenv.penv.sym(implNameStr);
- ATuple* def = tup<ATuple>(fn->loc, cenv.penv.sym("def"), implName, impl, NULL);
+ ATuple* def = tup<ATuple>(fn->loc, cenv.penv.sym("def"), implName, impl.head, NULL);
code.push_back(def);
- AType* implT = new AType(*type); // Type of the implementation function
- TList tupT(fn->loc, cenv.tenv.Tup, cenv.tenv.var(), NULL);
- TList consT(fn->loc, cenv.tenv.Tup, implT, NULL);
+ TList implT; // Type of the implementation function
+ TList tupT(fn->loc, cenv.tenv.Tup, cenv.tenv.var(), NULL);
+ TList consT;
List<ATuple, AST> cons(fn->loc, cenv.penv.sym("Closure"), implName, NULL);
- 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(const_cast<ASymbol*>(*i));
@@ -119,9 +116,15 @@ lift_fn(CEnv& cenv, Code& code, ATuple* fn) throw()
}
cenv.liftStack.pop();
- implT->set_prot(new AType(tupT, implT->prot(), Cursor()));
- implT->list_ref(2) = const_cast<AType*>(implRetT);
+ implProtT.push_front(tupT);
+
+ implT.push_back(const_cast<AType*>((AType*)type->head()));
+ implT.push_back(const_cast<AType*>(implProtT.head));
+ implT.push_back(const_cast<AType*>(implRetT));
+ consT.push_front(implT.head);
+ consT.push_front(cenv.tenv.Tup);
+
cenv.setType(impl, implT);
cenv.setType(cons, consT);
@@ -138,8 +141,8 @@ lift_call(CEnv& cenv, Code& code, ATuple* call) throw()
List<ATuple, AST> copy;
// Lift all children (callee and arguments, recursively)
- for (ATuple::iterator i = call->begin(); i != call->end(); ++i)
- copy.push_back(resp_lift(cenv, code, *i));
+ for (ATuple::const_iterator i = call->begin(); i != call->end(); ++i)
+ copy.push_back(const_cast<AST*>(resp_lift(cenv, code, const_cast<AST*>(*i))));
copy.head->loc = call->loc;
@@ -159,9 +162,9 @@ lift_call(CEnv& cenv, Code& code, ATuple* call) throw()
* closure as the first parameter:
* (_impl (Fn _impl ...) ...)
*/
- ATuple* closure = copy.head->list_ref(0)->as_tuple();
- ASymbol* implSym = const_cast<ASymbol*>(closure->list_ref(1)->as_symbol());
- const AType* implT = cenv.type(cenv.resolve(implSym));
+ const ATuple* closure = copy.head->list_ref(0)->as_tuple();
+ ASymbol* implSym = const_cast<ASymbol*>(closure->list_ref(1)->as_symbol());
+ const AType* implT = cenv.type(cenv.resolve(implSym));
copy.push_front(implSym);
copyT = implT->list_ref(2)->as_type();
} else {
@@ -186,7 +189,7 @@ lift_def(CEnv& cenv, Code& code, ATuple* def) throw()
{
// Define stub first for recursion
const ASymbol* const sym = def->list_ref(1)->as_symbol();
- AST* const body = def->list_ref(2);
+ 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());
@@ -194,9 +197,9 @@ lift_def(CEnv& cenv, Code& code, ATuple* def) throw()
assert(def->list_ref(1)->to_symbol());
List<ATuple, AST> copy;
copy.push_back(def->head());
- copy.push_back(resp_lift(cenv, code, def->list_ref(1)));
- for (ATuple::iterator t = def->iter_at(2); t != def->end(); ++t)
- copy.push_back(resp_lift(cenv, code, *t));
+ copy.push_back(resp_lift(cenv, code, const_cast<AST*>(def->list_ref(1))));
+ for (ATuple::const_iterator t = def->iter_at(2); t != def->end(); ++t)
+ copy.push_back(resp_lift(cenv, code, const_cast<AST*>(*t)));
cenv.setTypeSameAs(copy, def);
@@ -217,8 +220,8 @@ lift_builtin_call(CEnv& cenv, Code& code, ATuple* call) throw()
copy.push_back(call->head());
// Lift all arguments
- for (ATuple::iterator i = call->iter_at(1); i != call->end(); ++i)
- copy.push_back(resp_lift(cenv, code, *i));
+ for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i)
+ copy.push_back(resp_lift(cenv, code, const_cast<AST*>(*i)));
cenv.setTypeSameAs(copy, call);
return copy;
generated by cgit v1.2.1 (git 2.18.0) at 2025-01-31 14:37:04 +0000