Less parser specialmagic cruft.

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

1 files changed, 31 insertions, 54 deletions

diff --git a/tuplr.cpp b/tuplr.cpp
index e3e439f..4403922 100644
--- a/tuplr.cpp
+++ b/tuplr.cpp
@@ -60,14 +60,14 @@ struct Error {
 	Cursor loc;
 };
 
-template<typename A>
+template<typename Atom>
 struct Exp { // ::= Atom | (Exp*)
-	Exp(Cursor c)             : type(LIST), loc(c)          {}
-	Exp(Cursor c, const A& a) : type(ATOM), loc(c), atom(a) {}
-	typedef std::vector< Exp<A> > List;
+	Exp(Cursor c)                : type(LIST), loc(c)          {}
+	Exp(Cursor c, const Atom& a) : type(ATOM), loc(c), atom(a) {}
+	typedef std::vector< Exp<Atom> > List;
 	enum { ATOM, LIST } type;
 	Cursor loc;
-	A      atom;
+	Atom   atom;
 	List   list;
 };
 
@@ -142,11 +142,13 @@ readExpression(Cursor& cur, std::istream& in)
 struct TEnv;  ///< Type-Time Environment
 struct CEnv;  ///< Compile-Time Environment
 
+/// Constructor user data argument (LLVM opcode)
+struct CArg { CArg(int o=0, int a=0) : op(o), arg(a) {} int op; int arg; };
+
 /// Base class for all AST nodes
 struct AST {
 	virtual ~AST() {}
 	virtual bool   contains(AST* child)     const { return false; }
-	virtual bool   operator!=(const AST& o) const { return !operator==(o); }
 	virtual bool   operator==(const AST& o) const = 0;
 	virtual string str()                    const = 0;
 	virtual void   constrain(TEnv& tenv)    const {}
@@ -321,7 +323,7 @@ struct ASTCall : public ASTTuple {
 
 /// Definition special form, e.g. "(def x 2)"
 struct ASTDefinition : public ASTCall {
-	ASTDefinition(const SExp& e, const ASTTuple& t) : ASTCall(e, t) {}
+	ASTDefinition(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
 	void   constrain(TEnv& tenv) const;
 	void   lift(CEnv& cenv);
 	Value* compile(CEnv& cenv);
@@ -329,14 +331,15 @@ struct ASTDefinition : public ASTCall {
 
 /// Conditional special form, e.g. "(if cond thenexp elseexp)"
 struct ASTIf : public ASTCall {
-	ASTIf(const SExp& e, const ASTTuple& t) : ASTCall(e, t) {}
+	ASTIf(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
 	void   constrain(TEnv& tenv) const;
 	Value* compile(CEnv& cenv);
 };
 
 /// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
 struct ASTPrimitive : public ASTCall {
-	ASTPrimitive(const SExp& e, const ASTTuple& t, int o, int a=0) : ASTCall(e, t), op(o), arg(a) {}
+	ASTPrimitive(const SExp& e, const ASTTuple& t, CArg ca=CArg())
+		: ASTCall(e, t), op(ca.op), arg(ca.arg) {}
 	void   constrain(TEnv& tenv) const;
 	Value* compile(CEnv& cenv);
 	unsigned op;
@@ -345,7 +348,7 @@ struct ASTPrimitive : public ASTCall {
 
 /// Cons special form, e.g. "(cons 1 2)"
 struct ASTConsCall : public ASTCall {
-	ASTConsCall(const SExp& e, const ASTTuple& t) : ASTCall(e, t) {}
+	ASTConsCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
 	AType* functionType(CEnv& cenv);
 	void   constrain(TEnv& tenv) const;
 	void   lift(CEnv& cenv);
@@ -357,14 +360,14 @@ Funcs ASTConsCall::funcs;
 
 /// Car special form, e.g. "(car p)"
 struct ASTCarCall : public ASTCall {
-	ASTCarCall(const SExp& e, const ASTTuple& t) : ASTCall(e, t) {}
+	ASTCarCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
 	void   constrain(TEnv& tenv) const;
 	Value* compile(CEnv& cenv);
 };
 
 /// Cdr special form, e.g. "(cdr p)"
 struct ASTCdrCall : public ASTCall {
-	ASTCdrCall(const SExp& e, const ASTTuple& t) : ASTCall(e, t) {}
+	ASTCdrCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
 	void   constrain(TEnv& tenv) const;
 	Value* compile(CEnv& cenv);
 };
@@ -374,15 +377,10 @@ struct ASTCdrCall : public ASTCall {
  * Parser - S-Expressions (SExp) -> AST Nodes (AST)                        *
  ***************************************************************************/
 
-/// LLVM Operation
-struct Op { Op(int o=0, int a=0) : op(o), arg(a) {} int op; int arg; };
-
-typedef Op UD; // User Data argument for parse functions
-
 // Parse Time Environment (symbol table)
 struct PEnv : private map<const string, ASTSymbol*> {
-	typedef AST* (*PF)(PEnv&, const SExp&, UD); // Parse Function
-	struct Parser { Parser(PF f, UD d) : pf(f), ud(d) {} PF pf; UD ud; };
+	typedef AST* (*PF)(PEnv&, const SExp&, CArg); // Parse Function
+	struct Parser { Parser(PF f, CArg a=CArg()) : func(f), arg(a) {} PF func; CArg arg; };
 	map<string, Parser> parsers;
 	void reg(const string& s, const Parser& p) {
 		parsers.insert(make_pair(sym(s)->str(), p));
@@ -420,7 +418,7 @@ parseExpression(PEnv& penv, const SExp& exp)
 		if (exp.list.front().type == SExp::ATOM) {
 			const PEnv::Parser* handler = penv.parser(exp.list.front().atom);
 			if (handler) // Dispatch to parse function
-				return handler->pf(penv, exp, handler->ud);
+				return handler->func(penv, exp, handler->arg);
 		}
 		return new ASTCall(exp, pmap(penv, exp.list)); // Parse as regular call
 	} else if (isdigit(exp.atom[0])) {
@@ -436,22 +434,15 @@ parseExpression(PEnv& penv, const SExp& exp)
 	return penv.sym(exp.atom, exp.loc);
 }
 
-// Special forms
-
-static AST*
-parseIf(PEnv& penv, const SExp& exp, UD)
-	{ return new ASTIf(exp, pmap(penv, exp.list)); }
-
-static AST*
-parseDef(PEnv& penv, const SExp& exp, UD)
-	{ return new ASTDefinition(exp, pmap(penv, exp.list)); }
-
+template<typename C>
 static AST*
-parsePrim(PEnv& penv, const SExp& exp, UD data)
-	{ return new ASTPrimitive(exp, pmap(penv, exp.list), data.op, data.arg); }
+parseAST(PEnv& penv, const SExp& exp, CArg arg=CArg())
+{
+	return new C(exp, pmap(penv, exp.list), arg);
+}
 
 static AST*
-parseFn(PEnv& penv, const SExp& exp, UD)
+parseFn(PEnv& penv, const SExp& exp, CArg arg)
 {
 	SExp::List::const_iterator a = exp.list.begin(); ++a;
 	return new ASTClosure(
@@ -459,18 +450,6 @@ parseFn(PEnv& penv, const SExp& exp, UD)
 			parseExpression(penv, *a++));
 }
 
-static AST*
-parseCons(PEnv& penv, const SExp& exp, UD)
-	{ return new ASTConsCall(exp, pmap(penv, exp.list)); }
-
-static AST*
-parseCar(PEnv& penv, const SExp& exp, UD)
-	{ return new ASTCarCall(exp, pmap(penv, exp.list)); }
-
-static AST*
-parseCdr(PEnv& penv, const SExp& exp, UD)
-	{ return new ASTCdrCall(exp, pmap(penv, exp.list)); }
-
 
 /***************************************************************************
  * Generic Lexical Environment                                             *
@@ -700,8 +679,6 @@ TEnv::unify(const Constraints& constraints) // TAPL 22.4
 	AType*      s  = constraints.begin()->first;
 	AType*      t  = constraints.begin()->second;
 	Constraints cp = constraints;
-	//FOREACH(Constraints::const_iterator, c, cp)
-	//	out << c->first->str() << " : " << c->second->str() << endl;
 	cp.erase(cp.begin());
 
 	if (*s == *t) {
@@ -1243,14 +1220,14 @@ repl(CEnv& cenv, ExecutionEngine* engine)
 int
 main(int argc, char** argv)
 {
-#define PRIM(O, A) PEnv::Parser(parsePrim, Op(Instruction:: O, A))
+#define PRIM(O, A) PEnv::Parser(parseAST<ASTPrimitive>, CArg(Instruction:: O, A))
 	PEnv penv;
-	penv.reg("fn",   PEnv::Parser(parseFn,   Op()));
-	penv.reg("if",   PEnv::Parser(parseIf,   Op()));
-	penv.reg("def",  PEnv::Parser(parseDef,  Op()));
-	penv.reg("cons", PEnv::Parser(parseCons, Op()));
-	penv.reg("car",  PEnv::Parser(parseCar, Op()));
-	penv.reg("cdr",  PEnv::Parser(parseCdr, Op()));
+	penv.reg("fn",   PEnv::Parser(parseFn));
+	penv.reg("if",   PEnv::Parser(parseAST<ASTIf>));
+	penv.reg("def",  PEnv::Parser(parseAST<ASTDefinition>));
+	penv.reg("cons", PEnv::Parser(parseAST<ASTConsCall>));
+	penv.reg("car",  PEnv::Parser(parseAST<ASTCarCall>));
+	penv.reg("cdr",  PEnv::Parser(parseAST<ASTCdrCall>));
 	penv.reg("+",    PRIM(Add,  0));
 	penv.reg("-",    PRIM(Sub,  0));
 	penv.reg("*",    PRIM(Mul,  0));