aboutsummaryrefslogtreecommitdiffstats
path: root/src/lift.cpp
diff options
context:
space:
mode:
Diffstat (limited to 'src/lift.cpp')
-rw-r--r--src/lift.cpp88
1 files changed, 71 insertions, 17 deletions
diff --git a/src/lift.cpp b/src/lift.cpp
index 24f0265..239b02e 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -38,7 +38,7 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw()
if (cenv.name(vars.fn) == sym->sym()) {
// Reference to innermost function, replace with "_me"
return cenv.penv.sym("_me");
-
+
} else if (!cenv.code.innermost(sym)) {
/* Free variable, replace with "(. _me i)" where i is the index
* of the free variable in the closure.
@@ -48,7 +48,7 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw()
*/
return tup<ATuple>(sym->loc, cenv.penv.sym("."),
cenv.penv.sym("_me"),
- new ALiteral<int32_t>(T_INT32, vars.index(sym), Cursor()),
+ new ALiteral<int32_t>(T_INT32, vars.index(sym) + 1, Cursor()),
NULL);
}
}
@@ -56,6 +56,18 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw()
}
static const AST*
+lift_dot(CEnv& cenv, Code& code, const ATuple* dot) throw()
+{
+ const ALiteral<int32_t>* index = (ALiteral<int32_t>*)(dot->list_ref(2));
+ List<ATuple, const AST> copy;
+ copy.push_back(dot->head());
+ copy.push_back(resp_lift(cenv, code, dot->list_ref(1)));
+ copy.push_back(new ALiteral<int32_t>(T_INT32, index->val + 1, Cursor())); // skip RTTI
+ cenv.setTypeSameAs(copy, dot);
+ return copy;
+}
+
+static const AST*
lift_def(CEnv& cenv, Code& code, const ATuple* def) throw()
{
// Define stub first for recursion
@@ -71,7 +83,7 @@ lift_def(CEnv& cenv, Code& code, const ATuple* def) throw()
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))
@@ -98,7 +110,7 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
cenv.setName(impl, implNameStr);
cenv.liftStack.push(CEnv::FreeVars(fn, implNameStr));
-
+
// Create a new stub environment frame for parameters
cenv.push();
const AType* type = cenv.type(fn);
@@ -152,14 +164,14 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
cenv.liftStack.pop();
implProtT.push_front(tupT);
-
+
implT.push_back((AType*)type->head());
implT.push_back(implProtT.head);
implT.push_back(implRetT);
consT.push_front(implT.head);
consT.push_front(cenv.tenv.Tup);
-
+
cenv.setType(impl, implT);
cenv.setType(cons, consT);
@@ -174,12 +186,12 @@ static const AST*
lift_let(CEnv& cenv, Code& code, const ATuple* let) throw()
{
const ATuple* vars = let->list_ref(1)->to_tuple();
-
+
List<ATuple, const AST> copy(let->loc, let->head(), NULL);
List<ATuple, const AST> copyVars;
-
+
cenv.push();
-
+
for (ATuple::const_iterator i = vars->begin(); i != vars->end();) {
const ASymbol* sym = (*i++)->to_symbol();
const AST* val = (*i++);
@@ -194,9 +206,51 @@ lift_let(CEnv& cenv, Code& code, const ATuple* let) throw()
copy.push_back(resp_lift(cenv, code, *i));
cenv.pop();
-
+
cenv.setTypeSameAs(copy, let);
-
+
+ return copy;
+}
+
+static const AST*
+lift_match(CEnv& cenv, Code& code, const ATuple* match) throw()
+{
+ List<ATuple, const AST> copy(match->loc, cenv.penv.sym("let"), NULL);
+ List<ATuple, const AST> copyVars;
+
+ const ASymbol* tsym = cenv.penv.gensym("_matchT");
+
+ List<ATuple, const AST> tval;
+ tval.push_back(cenv.penv.sym("."));
+ tval.push_back(resp_lift(cenv, code, match->list_ref(1)));
+ tval.push_back(new ALiteral<int32_t>(T_INT32, 0, Cursor()));
+
+ copyVars.push_back(tsym);
+ copyVars.push_back(tval);
+ copy.push_back(copyVars);
+
+ List<ATuple, const AST> 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<ATuple, const AST> cond;
+ cond.push_back(cenv.penv.sym("__tag_is"));
+ cond.push_back(tsym);
+ cond.push_back(pat->head());
+
+ copyIf.push_back(cond);
+ const AST* liftedBody = resp_lift(cenv, code, body);
+ assert(liftedBody);
+ copyIf.push_back(liftedBody);
+ }
+ copyIf.push_back(cenv.penv.sym("__unreachable"));
+ copy.push_back(copyIf);
+
+ cenv.setTypeSameAs(copyIf, match);
+ cenv.setTypeSameAs(copy, match);
+
return copy;
}
@@ -212,7 +266,7 @@ lift_call(CEnv& cenv, Code& code, const ATuple* call) throw()
copy.head->loc = call->loc;
const AType* copyT = NULL;
-
+
const ASymbol* sym = call->head()->to_symbol();
if (sym && !cenv.liftStack.empty() && sym->sym() == cenv.name(cenv.liftStack.top().fn)) {
/* Recursive call to innermost function, call implementation directly,
@@ -236,7 +290,7 @@ lift_call(CEnv& cenv, Code& code, const ATuple* call) throw()
// Call to a closure, prepend code to access implementation function
ATuple* getFn = tup<ATuple>(call->loc, cenv.penv.sym("."),
copy.head->head(),
- new ALiteral<int32_t>(T_INT32, 0, Cursor()), NULL);
+ new ALiteral<int32_t>(T_INT32, 1, Cursor()), NULL);
const AType* calleeT = cenv.type(copy.head->head());
assert(**calleeT->begin() == *cenv.tenv.Tup);
const AType* implT = calleeT->list_ref(1)->as_type();
@@ -258,7 +312,7 @@ lift_args(CEnv& cenv, Code& code, const ATuple* call) throw()
// Lift all arguments
for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i)
copy.push_back(resp_lift(cenv, code, *i));
-
+
cenv.setTypeSameAs(copy.head, call);
return copy;
@@ -280,11 +334,11 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw()
else if (form == "cons" || isupper(form[0]))
return lift_args(cenv, code, call);
else if (form == ".")
- return lift_args(cenv, code, call);
+ return lift_dot(cenv, code, call);
else if (form == "def")
return lift_def(cenv, code, call);
else if (form == "def-type")
- return call; // FIXME
+ return call;
else if (form == "fn")
return lift_fn(cenv, code, call);
else if (form == "if")
@@ -292,7 +346,7 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw()
else if (form == "let")
return lift_let(cenv, code, call);
else if (form == "match")
- return call; // FIXME
+ return lift_match(cenv, code, call);
else
return lift_call(cenv, code, call);
}
generated by cgit v1.2.1 (git 2.18.0) at 2025-04-16 08:52:49 +0000