aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c.cpp6
-rw-r--r--src/compile.cpp33
-rw-r--r--src/lift.cpp88
-rw-r--r--src/resp.hpp4
4 files changed, 89 insertions, 42 deletions
diff --git a/src/c.cpp b/src/c.cpp
index a19f005..5bd3036 100644
--- a/src/c.cpp
+++ b/src/c.cpp
@@ -58,7 +58,7 @@ struct CEngine : public Engine {
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);
@@ -72,11 +72,11 @@ private:
string name;
string text;
};
-
+
inline Value* llVal(CVal v) { return static_cast<Value*>(v); }
inline Function* llFunc(CFunc f) { return static_cast<Function*>(f); }
const Type* llType(const AType* t);
-
+
std::string out;
};
diff --git a/src/compile.cpp b/src/compile.cpp
index b5d7222..123b403 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -57,7 +57,7 @@ compile_dot(CEnv& cenv, const ATuple* dot) throw()
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
+ return cenv.engine()->compileDot(cenv, tupVal, index->val);
}
static CVal
@@ -120,7 +120,10 @@ compile_if(CEnv& cenv, const ATuple* aif) throw()
i = next; // jump 2 each iteration (to the next predicate)
}
- CVal elseV = resp_compile(cenv, aif->list_last());
+ CVal elseV = NULL;
+ if (*aif->list_last() != *cenv.penv.sym("__unreachable"))
+ elseV = resp_compile(cenv, aif->list_last());
+
return cenv.engine()->compileIfEnd(cenv, state, elseV, cenv.type(aif));
}
@@ -147,25 +150,11 @@ compile_let(CEnv& cenv, const ATuple* let) throw()
}
static CVal
-compile_match(CEnv& cenv, const ATuple* match) throw()
+compile_tag_is(CEnv& cenv, const ATuple* call) throw()
{
- IfState state = cenv.engine()->compileIfStart(cenv);
- CVal matchee = resp_compile(cenv, match->list_ref(1));
- CVal rtti = cenv.engine()->compileDot(cenv, matchee, 0);
-
- size_t idx = 1;
- for (ATuple::const_iterator i = match->iter_at(2); i != match->end(); ++idx) {
- const AST* pat = *i++;
- const AST* body = *i++;
- const ASymbol* sym = pat->as_tuple()->head()->as_symbol();
-
- CVal condV = cenv.engine()->compileIsA(cenv, rtti, sym);
-
- cenv.engine()->compileIfBranch(cenv, state, condV, body);
- }
-
- const AType* type = cenv.type(match);
- return cenv.engine()->compileIfEnd(cenv, state, NULL, type);
+ 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);
}
static CVal
@@ -235,8 +224,8 @@ resp_compile(CEnv& cenv, const AST* ast) throw()
return compile_if(cenv, call);
else if (form == "let")
return compile_let(cenv, call);
- else if (form == "match")
- return compile_match(cenv, call);
+ else if (form == "__tag_is")
+ return compile_tag_is(cenv, call);
else
return compile_call(cenv, call);
}
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);
}
diff --git a/src/resp.hpp b/src/resp.hpp
index d90ccf0..266387c 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -157,6 +157,8 @@ extern ostream& operator<<(ostream& out, const AST* ast);
struct AST : public Object {
AST(Tag t, Cursor c=Cursor()) : loc(c) { this->tag(t); }
bool operator==(const AST& o) const;
+ bool operator!=(const AST& o) const;
+
string str() const { ostringstream ss; ss << this; return ss.str(); }
const ATuple* as_tuple() const {
@@ -485,6 +487,8 @@ AST::operator==(const AST& rhs) const
return false;
}
+inline bool AST::operator!=(const AST& rhs) const { return !(operator==(rhs)); }
+
/***************************************************************************
* Lexical Environmment *
generated by cgit v1.2.1 (git 2.18.0) at 2024-07-04 19:30:23 +0000