diff options
| -rw-r--r-- | Makefile | 3 | ||||
| -rw-r--r-- | cps.cpp | 86 | ||||
| -rw-r--r-- | tuplr.cpp | 6 | ||||
| -rw-r--r-- | tuplr.hpp | 26 |
4 files changed, 115 insertions, 6 deletions
@@ -16,7 +16,8 @@ OBJECTS = \ build/llvm.so \ build/gclib.so \ build/write.o \ - build/gc.o + build/gc.o \ + build/cps.o build/tuplr: $(OBJECTS) g++ -o $@ $^ $(LDFLAGS) @@ -0,0 +1,86 @@ +/* Tuplr Type Inferencing + * Copyright (C) 2008-2009 David Robillard <dave@drobilla.net> + * + * Tuplr 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. + * + * Tuplr 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 Tuplr. If not, see <http://www.gnu.org/licenses/>. + */ + +#include <set> +#include "tuplr.hpp" + +/*************************************************************************** + * CPS Conversion * + ***************************************************************************/ + +/** (cps x) => (cont x) */ +AST* +AST::cps(TEnv& tenv, AST* cont) +{ + return new ACall(loc, cont, this, 0); +} + +AST* +ATuple::cps(TEnv& tenv, AST* cont) +{ + ATuple* copy = new ATuple(loc, NULL); + FOREACH(const_iterator, p, *this) + copy->push_back((*p)->cps(tenv, cont)); + return copy; +} + +/** (cps (fn (a ...) body ...)) => */ +AST* +AFn::cps(TEnv& tenv, AST* cont) +{ + AFn* copy = new AFn(loc, tenv.penv.sym("fn"), prot()); + const_iterator p = begin(); + ++(++p); + for (; p != end(); ++p) + copy->push_back((*p)->cps(tenv, cont)); + return copy; + return ATuple::cps(tenv, cont); +} + +/** (cps (f a b ...)) => (a (fn (x) (b (fn (y) ... (cont (f x y ...)) */ +AST* +ACall::cps(TEnv& tenv, AST* cont) +{ + return new ACall(loc, cont, this, 0); +} + +/** (cps (def x y)) => (y (fn (x) (cont))) */ +AST* +ADef::cps(TEnv& tenv, AST* cont) +{ + ADef* copy = new ADef(loc, + ATuple(loc, tenv.penv.sym("def"), sym(), at(2)->cps(tenv, cont), 0)); + return copy; + /* + ASymbol* fnSym = tenv.penv.sym("deff"); + AFn* defFn = new AFn(loc, tenv.penv.sym("def"), + new ATuple(at(1)->loc, sym(), new ACall(loc, cont, this))); + ACall* defCall = new ACall(loc, at(2)->cps(tenv, defFn), 0); + */ +} + +/** (cps (if c t ... e)) => */ +AST* +AIf::cps(TEnv& tenv, AST* cont) +{ + AFn* contFn = new AFn(loc, tenv.penv.sym("if0"), + new ATuple(at(1)->loc, cont, 0)); + //ACall* contCall = new ACall(loc, cont, this, 0); + ACall* condCall = new ACall(loc, contFn, 0); + return condCall; +} + @@ -265,9 +265,13 @@ eval(CEnv& cenv, const string& name, istream& is) // Create function for top-level of program CFunction f = cenv.engine()->startFunction(cenv, "main", resultType, ATuple(cursor)); + + // Print CPS form + CValue val = NULL; + /*for (list< pair<SExp, AST*> >::const_iterator i = exprs.begin(); i != exprs.end(); ++i) + cout << "CPS: " << i->second->cps(cenv.tenv, cenv.penv.sym("cont")) << endl;*/ // Compile all expressions into it - CValue val = NULL; for (list< pair<SExp, AST*> >::const_iterator i = exprs.begin(); i != exprs.end(); ++i) val = cenv.compile(i->second); @@ -196,6 +196,7 @@ struct AST : public Object { virtual bool operator==(const AST& o) const = 0; virtual bool contains(const AST* child) const { return false; } virtual void constrain(TEnv& tenv, Constraints& c) const {} + virtual AST* cps(TEnv& tenv, AST* cont); virtual void lift(CEnv& cenv) {} virtual CValue compile(CEnv& cenv) = 0; string str() const { ostringstream ss; ss << this; return ss.str(); } @@ -254,7 +255,6 @@ struct ATuple : public AST, public vector<AST*> { return false; return true; } - void lift(CEnv& cenv) { FOREACH(iterator, t, *this) (*t)->lift(cenv); } bool contains(AST* child) const { if (*this == *child) return true; FOREACH(const_iterator, p, *this) @@ -262,7 +262,10 @@ struct ATuple : public AST, public vector<AST*> { return true; return false; } - void constrain(TEnv& tenv, Constraints& c) const; + void constrain(TEnv& tenv, Constraints& c) const; + AST* cps(TEnv& tenv, AST* cont); + void lift(CEnv& cenv) { FOREACH(iterator, t, *this) (*t)->lift(cenv); } + CValue compile(CEnv& cenv) { throw Error(loc, "tuple compiled"); } }; @@ -340,13 +343,13 @@ struct Subst : public map<const AType*,AType*,typeLessThan> { } }; - -/// Closure (first-class function with captured lexical bindings) +/// Fn (first-class function with captured lexical bindings) struct AFn : public ATuple { AFn(Cursor c, ASymbol* fn, ATuple* p, const string& n="") : ATuple(c, fn, p, NULL), name(n) {} bool operator==(const AST& rhs) const { return this == &rhs; } void constrain(TEnv& tenv, Constraints& c) const; + AST* cps(TEnv& tenv, AST* cont); void lift(CEnv& cenv); void liftCall(CEnv& cenv, const AType& argsT); CValue compile(CEnv& cenv); @@ -368,7 +371,19 @@ struct AFn : public ATuple { /// Function call/application, e.g. "(func arg1 arg2)" struct ACall : public ATuple { ACall(const SExp& e, const ATuple& t) : ATuple(e.loc, t) {} + ACall(Cursor c, const ATuple& code) : ATuple(c, code) {} + ACall(Cursor c, AST* fn, AST* arg, ...) : ATuple(c) { + push_back(fn); + if (!arg) return; + va_list args; va_start(args, arg); + if (arg) + push_back(arg); + for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*)) + push_back(a); + va_end(args); + } void constrain(TEnv& tenv, Constraints& c) const; + AST* cps(TEnv& tenv, AST* cont); void lift(CEnv& cenv); CValue compile(CEnv& cenv); }; @@ -376,6 +391,7 @@ struct ACall : public ATuple { /// Definition special form, e.g. "(def x 2)" struct ADef : public ACall { ADef(const SExp& e, const ATuple& t) : ACall(e, t) {} + ADef(Cursor c, const ATuple& code) : ACall(c, code) {} ASymbol* sym() const { ASymbol* sym = at(1)->to<ASymbol*>(); if (!sym) { @@ -386,6 +402,7 @@ struct ADef : public ACall { return sym; } void constrain(TEnv& tenv, Constraints& c) const; + AST* cps(TEnv& tenv, AST* cont); void lift(CEnv& cenv); CValue compile(CEnv& cenv); }; @@ -394,6 +411,7 @@ struct ADef : public ACall { struct AIf : public ACall { AIf(const SExp& e, const ATuple& t) : ACall(e, t) {} void constrain(TEnv& tenv, Constraints& c) const; + AST* cps(TEnv& tenv, AST* cont); CValue compile(CEnv& cenv); }; |