aboutsummaryrefslogtreecommitdiffstats
path: root/src/constrain.cpp
diff options
context:
space:
mode:
Diffstat (limited to 'src/constrain.cpp')
-rw-r--r--src/constrain.cpp228
1 files changed, 114 insertions, 114 deletions
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;
}
}
generated by cgit v1.2.1 (git 2.18.0) at 2024-07-02 16:52:10 +0000