More CPS conversion work.

git-svn-id: http://svn.drobilla.net/resp/tuplr@150 ad02d1e2-f140-0410-9f75-f8b11f17cedd

1 files changed, 16 insertions, 4 deletions

diff --git a/tuplr.hpp b/tuplr.hpp
index b54f72a..37a09db 100644
--- a/tuplr.hpp
+++ b/tuplr.hpp
@@ -193,6 +193,7 @@ extern ostream& operator<<(ostream& out, const AST* ast);
 struct AST : public Object {
 	AST(Cursor c=Cursor()) : loc(c) {}
 	virtual ~AST() {}
+	virtual bool   value() const { return true; }
 	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 {}
@@ -254,6 +255,7 @@ struct ATuple : public AST, public vector<AST*> {
 		for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*))
 			push_back(a);
 	}
+	bool value() const { return false; }
 	bool operator==(const AST& rhs) const {
 		const ATuple* rt = rhs.to<const ATuple*>();
 		if (!rt || rt->size() != size()) return false;
@@ -271,7 +273,6 @@ struct ATuple : public AST, public vector<AST*> {
 		return false;
 	}
 	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"); }
@@ -408,6 +409,7 @@ struct ADef : public ACall {
 /// Conditional special form, e.g. "(if cond thenexp elseexp)"
 struct AIf : public ACall {
 	AIf(const SExp& e, const ATuple& t) : ACall(e, t) {}
+	AIf(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
 	void   constrain(TEnv& tenv, Constraints& c) const;
 	AST*   cps(TEnv& tenv, AST* cont);
 	CValue compile(CEnv& cenv);
@@ -416,7 +418,14 @@ struct AIf : public ACall {
 /// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
 struct APrimitive : public ACall {
 	APrimitive(const SExp& e, const ATuple& t) : ACall(e, t) {}
+	bool value() const {
+		for (size_t i = 1; i < size(); ++i)
+			if (!at(i)->value())
+				return false;;
+		return true;
+	}
 	void   constrain(TEnv& tenv, Constraints& c) const;
+	AST*   cps(TEnv& tenv, AST* cont);
 	CValue compile(CEnv& cenv);
 };
 
@@ -427,6 +436,7 @@ struct APrimitive : public ACall {
 
 /// Parse Time Environment (really just a symbol table)
 struct PEnv : private map<const string, ASymbol*> {
+	PEnv() : symID(0) {}
 	typedef AST* (*PF)(PEnv&, const SExp&, void*); ///< Parse Function
 	typedef SExp (*MF)(PEnv&, const SExp&); ///< Macro Function
 	struct Handler { Handler(PF f, void* a=0) : func(f), arg(a) {} PF func; void* arg; };
@@ -448,6 +458,8 @@ struct PEnv : private map<const string, ASymbol*> {
 		map<string, MF>::const_iterator i = macros.find(s);
 		return (i != macros.end()) ? i->second : NULL;
 	}
+	string gensymstr(const char* s="_") { return (format("%s%d") % s % symID++).str(); }
+	ASymbol* gensym(const char* s="_") { return sym(gensymstr(s)); }
 	ASymbol* sym(const string& s, Cursor c=Cursor()) {
 		const const_iterator i = find(s);
 		if (i != end()) {
@@ -489,6 +501,7 @@ struct PEnv : private map<const string, ASymbol*> {
 		}
 		return sym(exp.atom, exp.loc);
 	}
+	unsigned symID;
 };
 
 
@@ -542,6 +555,7 @@ struct TEnv : public Env< const ASymbol*, pair<AST*, AType*> > {
 		ASymbol* sym = ast->to<ASymbol*>();
 		return (sym && sym->addr) ? ref(sym)->first : ast;
 	}
+
 	static Subst unify(const Constraints& c);
 
 	typedef map<const AST*, AType*>       Vars;
@@ -575,7 +589,7 @@ void    tuplr_free_engine(Engine* engine);
 /// Compile-Time Environment
 struct CEnv {
 	CEnv(PEnv& p, TEnv& t, Engine* e, ostream& os=std::cout, ostream& es=std::cerr)
-		: out(os), err(es), penv(p), tenv(t), symID(0), _engine(e)
+		: out(os), err(es), penv(p), tenv(t), _engine(e)
 	{}
 
 	~CEnv() { Object::pool.collect(GC::Roots()); }
@@ -584,7 +598,6 @@ struct CEnv {
 	typedef Env<const AST*, CValue>   Vals;
 
 	Engine* engine() { return _engine; }
-	string  gensym(const char* s="_") { return (format("%s%d") % s % symID++).str(); }
 	void    push() { tenv.push(); vals.push(); }
 	void    pop()  { tenv.pop();  vals.pop();  }
 	void    precompile(AST* obj, CValue value) { vals.def(obj, value); }
@@ -610,7 +623,6 @@ struct CEnv {
 	TEnv&     tenv;
 	Vals      vals;
 
-	unsigned  symID;
 	Subst     tsubst;
 
 	map<string,string> args;