/* Resp: A programming language * Copyright (C) 2008-2009 David Robillard * * Resp is free software: you can redistribute it and/or modify it under * the terms of the GNU Affero General Public License as published by the * Free Software Foundation, either version 3 of the License, or (at your * option) any later version. * * Resp is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General * Public License for more details. * * You should have received a copy of the GNU Affero General Public License * along with Resp. If not, see . */ /** @file * @brief Simplify (reduce to simpler forms, e.g. match => if) */ #include #include "resp.hpp" using namespace std; static const AST* simplify_if(CEnv& cenv, const ATuple* aif) throw() { List copy(aif->loc, cenv.penv.sym("if"), NULL); copy.push_back(aif->list_ref(1)); copy.push_back(aif->list_ref(2)); ATuple* tail = copy.tail; ATuple::const_iterator i = aif->iter_at(3); for (; ; ++i) { ATuple::const_iterator next = i; if (++next == aif->end()) break; List inner_if((*i)->loc, cenv.penv.sym("if"), *i, *next, NULL); tail->last(new ATuple(inner_if.head, NULL, Cursor())); tail = inner_if.tail; cenv.setTypeSameAs(inner_if, aif); i = next; // jump 2 elements (to the next predicate) } tail->last(new ATuple(*i, NULL, Cursor())); cenv.setTypeSameAs(copy, aif); return copy; } static const AST* simplify_match(CEnv& cenv, const ATuple* match) throw() { const AST* const obj = resp_simplify(cenv, match->list_ref(1)); // Dot expression to get tag. Note index is -1 to compensate for the lift phase // which adds 1 to skip the RTTI, which we don't want here (FIXME: ick...) const AST* index = new ALiteral(T_INT32, -1, Cursor()); List tval(Cursor(), cenv.penv.sym("."), obj, index, 0); const ASymbol* tsym = cenv.penv.gensym("__tag"); List def(match->loc, cenv.penv.sym("def"), tsym, tval.head, NULL); cenv.setType(tval.head, cenv.tenv.named("Symbol")); List 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++; const ASymbol* consTag = cenv.penv.sym(pat->fst()->str(), pat->fst()->loc); const_cast(consTag)->tag(T_LITSYM); cenv.setType(consTag, cenv.tenv.named("Symbol")); const ATuple* texp = cenv.tenv.named(consTag->sym())->as_tuple(); // Append condition for this case List cond(Cursor(), cenv.penv.sym("="), tsym, consTag, 0); cenv.setType(cond, cenv.tenv.named("Bool")); copyIf.push_back(cond); // If constructor has no variables, append body and continue // (don't generate pointless fn) if (texp->list_len() == 2) { copyIf.push_back(body); continue; } // Build fn for the body of this case const ASymbol* osym = cenv.penv.gensym("__obj"); const ATuple* prot = new ATuple(osym, 0, Cursor()); const ATuple* protT = new ATuple(texp->rst(), 0, Cursor()); List fn(Cursor(), cenv.penv.sym("fn"), prot, 0); int idx = 0; ATuple::const_iterator ti = texp->iter_at(2); for (ATuple::const_iterator j = pat->iter_at(1); j != pat->end(); ++j, ++ti, ++idx) { const AST* index = new ALiteral(T_INT32, idx, Cursor()); const AST* dot = tup(Cursor(), cenv.penv.sym("."), osym, index, 0); const AST* def = tup(Cursor(), cenv.penv.sym("def"), *j, dot); fn.push_back(def); } fn.push_back(resp_simplify(cenv, body)); List fnT(Cursor(), cenv.tenv.Fn, protT, cenv.type(match), 0); assert(fnT.head->list_ref(1)); cenv.setType(fn, fnT); const ATuple* cast = tup(Cursor(), cenv.penv.sym("cast"), obj, 0); cenv.setType(cast, texp->rst()); List call(Cursor(), fn, cast, 0); cenv.setTypeSameAs(call, match); copyIf.push_back(call); } copyIf.push_back(cenv.penv.sym("__unreachable")); cenv.setTypeSameAs(copyIf, match); List copy(match->loc, cenv.penv.sym("do"), def.head, simplify_if(cenv, copyIf), 0); cenv.setTypeSameAs(copy, match); return copy; } static const AST* simplify_list(CEnv& cenv, const ATuple* call) throw() { List copy; for (ATuple::const_iterator i = call->begin(); i != call->end(); ++i) copy.push_back(resp_simplify(cenv, *i)); cenv.setTypeSameAs(copy.head, call); return copy; } static const AST* simplify_let(CEnv& cenv, const ATuple* call) throw() { const ATuple* vars = call->list_ref(1)->to_tuple(); List fn(Cursor(), cenv.penv.sym("fn"), NULL); List fnProt; List fnArgs; List fnProtT; for (ATuple::const_iterator i = vars->begin(); i != vars->end();) { const ASymbol* sym = (*i++)->to_symbol(); const AST* val = (*i++); fnProt.push_back(sym); fnArgs.push_back(resp_simplify(cenv, val)); fnProtT.push_back(cenv.type(val)); } fn.push_back(fnProt.head); fn.push_back(resp_simplify(cenv, call->list_ref(2))); List fnT; fnT.push_back(cenv.tenv.Fn); fnT.push_back(fnProtT); fnT.push_back(cenv.type(call->list_ref(2))); cenv.setType(fn, fnT); ATuple* copy = new ATuple(fn, fnArgs, call->loc); cenv.setTypeSameAs(copy, call); return copy; } static inline const AST* simplify_list_elem(CEnv& cenv, const ATuple* node, const AST* type) { if (!node) { const AST* empty = new ATuple(cenv.tenv.Empty, 0, Cursor()); cenv.setType(empty, type); return empty; } assert(cenv.type(node->fst())); const AST* const fst = tup(Cursor(), cenv.type(node->fst()), node->fst(), 0); const AST* const rst = simplify_list_elem(cenv, node->rst(), type); assert(node->fst()); assert(rst); List cons(node->loc, cenv.tenv.List, fst, rst, 0); cenv.setType(fst, tup(Cursor(), cenv.penv.sym("Expr"), 0)); cenv.setType(cons, type); return cons; } static const AST* simplify_quote(CEnv& cenv, const ATuple* call) throw() { switch (call->frst()->tag()) { case T_SYMBOL: // Symbols remain quoted so they are not interpreted as variables return call; case T_TUPLE: { // Lists are transformed into nested conses const ATuple* const list = call->frst()->as_tuple(); return simplify_list_elem(cenv, list, tup(Cursor(), cenv.tenv.List, cenv.penv.sym("Expr"), 0)); } default: // Other literals (e.g. numbers, strings) are self-evaluating, so the // quote can be removed, e.g. (quote 3) => 3 return call->frst(); } } const AST* resp_simplify(CEnv& cenv, const AST* ast) throw() { const ATuple* const list = ast->to_tuple(); if (!list) return ast; const ASymbol* const sym = list->fst()->to_symbol(); const std::string form = sym ? sym->sym() : ""; if (form == "match") return simplify_match(cenv, list); else if (form == "if") return simplify_if(cenv, list); else if (form == "let") return simplify_let(cenv, list); else if (form == "quote") return simplify_quote(cenv, list); else return simplify_list(cenv, list); }