diff options
| -rw-r--r-- | src/compile.cpp | 24 | ||||
| -rw-r--r-- | src/constrain.cpp | 33 | ||||
| -rw-r--r-- | src/lift.cpp | 34 | ||||
| -rw-r--r-- | src/pprint.cpp | 27 | ||||
| -rw-r--r-- | src/resp.hpp | 6 | ||||
| -rwxr-xr-x | test.sh | 1 | ||||
| -rw-r--r-- | test/let.resp | 7 |
7 files changed, 129 insertions, 3 deletions
diff --git a/src/compile.cpp b/src/compile.cpp index a696836..2132c91 100644 --- a/src/compile.cpp +++ b/src/compile.cpp @@ -122,6 +122,28 @@ compile_if(CEnv& cenv, const ATuple* aif) throw() } static CVal +compile_let(CEnv& cenv, const ATuple* let) throw() +{ + const ATuple* vars = let->list_ref(1)->to_tuple(); + + cenv.push(); + + for (ATuple::const_iterator i = vars->begin(); i != vars->end();) { + const ASymbol* sym = (*i++)->to_symbol(); + const AST* val = (*i++); + cenv.def(sym, val, cenv.type(val), resp_compile(cenv, val)); + } + + CVal ret = NULL; + for (ATuple::const_iterator i = let->iter_at(2); i != let->end(); ++i) + ret = resp_compile(cenv, *i); + + cenv.pop(); + + return ret; +} + +static CVal compile_match(CEnv& cenv, const ATuple* match) throw() { IfState state = cenv.engine()->compileIfStart(cenv); @@ -208,6 +230,8 @@ resp_compile(CEnv& cenv, const AST* ast) throw() return compile_fn(cenv, call); else if (form == "if") return compile_if(cenv, call); + else if (form == "let") + return compile_let(cenv, call); else if (form == "match") return compile_match(cenv, call); else diff --git a/src/constrain.cpp b/src/constrain.cpp index c4a08ec..047a5b0 100644 --- a/src/constrain.cpp +++ b/src/constrain.cpp @@ -199,6 +199,37 @@ constrain_if(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) } static void +constrain_let(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) +{ + THROW_IF(call->list_len() < 3, call->loc, "`let' requires at least 2 arguments"); + const ATuple* vars = call->list_ref(1)->to_tuple(); + THROW_IF(!vars, call->list_ref(1)->loc, "first argument of `let' is not a list"); + + TEnv::Frame frame; + for (ATuple::const_iterator i = vars->begin(); i != vars->end(); ++i) { + const ASymbol* sym = (*i)->to_symbol(); + THROW_IF(!sym, (*i)->loc, "`let' binding name is not a symbol"); + ATuple::const_iterator val = ++i; + THROW_IF(val == vars->end(), sym->loc, "`let' variable missing value"); + + resp_constrain(tenv, c, *val); + const AType* tvar = tenv.var(*val); + frame.push_back(make_pair(sym->sym(), tvar)); + c.constrain(tenv, sym, tvar); + //c.constrain(tenv, *val, tvar); + } + + tenv.push(frame); + + for (ATuple::const_iterator i = call->iter_at(2); i != call->end(); ++i) + resp_constrain(tenv, c, *i); + + c.constrain(tenv, call, tenv.var(call->list_last())); + + tenv.pop(); +} + +static void constrain_match(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) { THROW_IF(call->list_len() < 5, call->loc, "`match' requires at least 4 arguments"); @@ -338,6 +369,8 @@ constrain_list(TEnv& tenv, Constraints& c, const ATuple* tup) throw(Error) constrain_fn(tenv, c, tup); else if (form == "if") constrain_if(tenv, c, tup); + else if (form == "let") + constrain_let(tenv, c, tup); else if (form == "match") constrain_match(tenv, c, tup); else diff --git a/src/lift.cpp b/src/lift.cpp index ad377d7..e3a741b 100644 --- a/src/lift.cpp +++ b/src/lift.cpp @@ -32,7 +32,7 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw() { if (!cenv.liftStack.empty() && cenv.name(cenv.liftStack.top().fn) == sym->sym()) { return cenv.penv.sym("_me"); // Reference to innermost function - } else if (!cenv.code.innermost(sym)) { + } else if (!cenv.liftStack.empty() && !cenv.code.innermost(sym)) { // Replace symbol with code to access free variable from closure const int32_t index = cenv.liftStack.top().index(sym); return tup<ATuple>(sym->loc, cenv.penv.sym("."), @@ -158,6 +158,36 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw() } 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++); + cenv.def(sym, val, cenv.type(val), NULL); + copyVars.push_back(sym); + copyVars.push_back(val); + resp_lift(cenv, code, val); + } + copy.push_back(copyVars); + + for (ATuple::const_iterator i = let->iter_at(2); i != let->end(); ++i) + copy.push_back(resp_lift(cenv, code, *i)); + + cenv.pop(); + + cenv.setTypeSameAs(copy, let); + + return copy; +} + +static const AST* lift_call(CEnv& cenv, Code& code, const ATuple* call) throw() { List<ATuple, const AST> copy; @@ -246,6 +276,8 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw() return lift_fn(cenv, code, call); else if (form == "if") return lift_args(cenv, code, call); + else if (form == "let") + return lift_let(cenv, code, call); else if (form == "match") return call; // FIXME else diff --git a/src/pprint.cpp b/src/pprint.cpp index d082b5d..5ceb039 100644 --- a/src/pprint.cpp +++ b/src/pprint.cpp @@ -141,6 +141,31 @@ print_to(ostream& out, const AST* ast, unsigned indent, CEnv* cenv, bool types) newline(out, 0); return out; + } else if (form == "let") { + out << (*i++) << " ("; + const ATuple* vars = (*i)->as_tuple(); + for (ATuple::const_iterator v = vars->begin(); v != vars->end();) { + out << (*v); + + if (types) + out << " :" << cenv->tsubst.apply(cenv->tenv.var(*v)); + + out << " " << (*++v); + + if (++v != vars->end()) + newline(out, indent + 6); + else + out << ")"; + } + newline(out, indent + 2); + for (ATuple::const_iterator i = tup->iter_at(2); i != tup->end(); ++i) + print_to(out, *i, indent + 2, cenv, types); + out << ")"; + if (types) + out << " :" << cenv->tsubst.apply(cenv->tenv.var(tup->list_last())); + + return out; + } else { return print_tuple(out, tup, i, indent + 1, false, cenv, types, false); } @@ -157,7 +182,7 @@ print_to(ostream& out, const AST* ast, unsigned indent, CEnv* cenv, bool types) case T_SYMBOL: return out << ((const ASymbol*)ast)->sym(); } - + return out << "?"; } diff --git a/src/resp.hpp b/src/resp.hpp index 1fbf3cf..d5ea459 100644 --- a/src/resp.hpp +++ b/src/resp.hpp @@ -829,7 +829,11 @@ struct CEnv { const ATuple* const fn; const std::string implName; int32_t index(const ASymbol* sym) { - const_iterator i = find(begin(), end(), sym); + const_iterator i = begin(); + for (; i != end(); ++i) + if ((*i)->sym() == sym->sym()) + break; + if (i != end()) { return i - begin() + 1; } else { @@ -22,6 +22,7 @@ run './test/inlinefn.resp' '2 : Int' run './test/nest.resp' '8 : Int' run './test/tup.resp' '5 : Int' run './test/string.resp' '"Hello, world!" : String' +run './test/let.resp' '5 : Int' run './test/match.resp' '"Hello, rectangle!" : String' #run './test/poly.resp' '#t : Bool' diff --git a/test/let.resp b/test/let.resp new file mode 100644 index 0000000..49623a6 --- /dev/null +++ b/test/let.resp @@ -0,0 +1,7 @@ +(def one 1) + +(let (two (+ one 1) + three (+ one 2)) + (+ two three)) + +
\ No newline at end of file |