From 22e329617866a6580ccff5636f148d72603fa8fc Mon Sep 17 00:00:00 2001 From: David Robillard Date: Fri, 10 Dec 2010 04:24:20 +0000 Subject: Move simplification from lift stage to a new (post-typing) simplify stage. git-svn-id: http://svn.drobilla.net/resp/resp@344 ad02d1e2-f140-0410-9f75-f8b11f17cedd --- Makefile | 1 + src/lift.cpp | 46 ++------------------------- src/repl.cpp | 17 ++++++++-- src/resp.cpp | 2 ++ src/resp.hpp | 1 + src/simplify.cpp | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 115 insertions(+), 46 deletions(-) create mode 100644 src/simplify.cpp diff --git a/Makefile b/Makefile index c5af049..cbb3ace 100644 --- a/Makefile +++ b/Makefile @@ -32,6 +32,7 @@ OBJECTS = \ build/pprint.o \ build/repl.o \ build/resp.o \ + build/simplify.o \ build/tlsf.o \ build/unify.o diff --git a/src/lift.cpp b/src/lift.cpp index 239b02e..5791e41 100644 --- a/src/lift.cpp +++ b/src/lift.cpp @@ -212,48 +212,6 @@ lift_let(CEnv& cenv, Code& code, const ATuple* let) throw() return copy; } -static const AST* -lift_match(CEnv& cenv, Code& code, const ATuple* match) throw() -{ - List copy(match->loc, cenv.penv.sym("let"), NULL); - List copyVars; - - const ASymbol* tsym = cenv.penv.gensym("_matchT"); - - List tval; - tval.push_back(cenv.penv.sym(".")); - tval.push_back(resp_lift(cenv, code, match->list_ref(1))); - tval.push_back(new ALiteral(T_INT32, 0, Cursor())); - - copyVars.push_back(tsym); - copyVars.push_back(tval); - copy.push_back(copyVars); - - 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++; - - List 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; -} - static const AST* lift_call(CEnv& cenv, Code& code, const ATuple* call) throw() { @@ -345,8 +303,8 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw() return lift_args(cenv, code, call); else if (form == "let") return lift_let(cenv, code, call); - else if (form == "match") - return lift_match(cenv, code, call); + else if (form == "__tag_is") + return call; else return lift_call(cenv, code, call); } diff --git a/src/repl.cpp b/src/repl.cpp index 52d35c5..063f1e7 100644 --- a/src/repl.cpp +++ b/src/repl.cpp @@ -100,12 +100,26 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute) return 0; } + // Simplify all expressions + Code simplified; + for (Parsed::const_iterator i = parsed.begin(); i != parsed.end(); ++i) { + const AST* l = resp_simplify(cenv, *i); + if (l) + simplified.push_back(l); + } + + if (cenv.args.find("-R") != cenv.args.end()) { + for (Code::const_iterator i = simplified.begin(); i != simplified.end(); ++i) + pprint(cout, *i, &cenv, (cenv.args.find("-a") != cenv.args.end())); + return 0; + } + CVal val = NULL; CFunc f = NULL; // Lift all expressions Code lifted; - for (Parsed::const_iterator i = parsed.begin(); i != parsed.end(); ++i) { + for (Parsed::const_iterator i = simplified.begin(); i != simplified.end(); ++i) { const AST* l = resp_lift(cenv, lifted, *i); if (l) lifted.push_back(l); @@ -114,7 +128,6 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute) if (cenv.args.find("-L") != cenv.args.end()) { for (Code::const_iterator i = lifted.begin(); i != lifted.end(); ++i) pprint(cout, *i, &cenv, (cenv.args.find("-a") != cenv.args.end())); - return 0; } diff --git a/src/resp.cpp b/src/resp.cpp index 765939c..5f45bdd 100644 --- a/src/resp.cpp +++ b/src/resp.cpp @@ -77,6 +77,7 @@ print_usage(char* name, bool error) os << " -r Enter REPL after evaluating files" << endl; os << " -P Parse only" << endl; os << " -T Type check only" << endl; + os << " -R Reduce to simpler forms only" << endl; os << " -L Lambda lift only" << endl; os << " -S Compile to assembly only (do not execute)" << endl; @@ -96,6 +97,7 @@ main(int argc, char** argv) files.push_back(argv[i]); } else if (!strncmp(argv[i], "-L", 3) || !strncmp(argv[i], "-P", 3) + || !strncmp(argv[i], "-R", 3) || !strncmp(argv[i], "-S", 3) || !strncmp(argv[i], "-T", 3) || !strncmp(argv[i], "-a", 3) diff --git a/src/resp.hpp b/src/resp.hpp index 266387c..a2b5cf8 100644 --- a/src/resp.hpp +++ b/src/resp.hpp @@ -877,6 +877,7 @@ int eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute); int repl(CEnv& cenv); void resp_constrain(TEnv& tenv, Constraints& c, const AST* ast) throw(Error); +const AST* resp_simplify(CEnv& cenv, const AST* ast) throw(); const AST* resp_lift(CEnv& cenv, Code& code, const AST* ast) throw(); CVal resp_compile(CEnv& cenv, const AST* ast) throw(); diff --git a/src/simplify.cpp b/src/simplify.cpp new file mode 100644 index 0000000..31eb83a --- /dev/null +++ b/src/simplify.cpp @@ -0,0 +1,94 @@ +/* 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_match(CEnv& cenv, const ATuple* match) throw() +{ + List copy(match->loc, cenv.penv.sym("let"), NULL); + List copyVars; + + const ASymbol* tsym = cenv.penv.gensym("_matchT"); + + List tval; + tval.push_back(cenv.penv.sym(".")); + tval.push_back(resp_simplify(cenv, match->list_ref(1))); + tval.push_back(new ALiteral(T_INT32, 0, Cursor())); + + copyVars.push_back(tsym); + copyVars.push_back(tval); + copy.push_back(copyVars); + + 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++; + + List cond; + cond.push_back(cenv.penv.sym("__tag_is")); + cond.push_back(tsym); + cond.push_back(pat->head()); + + copyIf.push_back(cond); + copyIf.push_back(resp_simplify(cenv, body)); + } + copyIf.push_back(cenv.penv.sym("__unreachable")); + copy.push_back(copyIf); + + cenv.setTypeSameAs(copyIf, match); + 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; +} + +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->head()->to_symbol(); + const std::string form = sym ? sym->sym() : ""; + + if (form == "match") + return simplify_match(cenv, list); + else + return simplify_list(cenv, list); +} -- cgit v1.2.1