More generic parser function mechanism that works for atoms too.

Use atom parser methods to parse literals.
Remove the last of the language and backend specific things from core code.


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

2 files changed, 83 insertions, 61 deletions

diff --git a/tuplr.hpp b/tuplr.hpp
index d769982..ba4f9a9 100644
--- a/tuplr.hpp
+++ b/tuplr.hpp
@@ -31,6 +31,7 @@ typedef const void* CType;     ///< Compiled type (opaque)
 typedef void*       CFunction; ///< Compiled function (opaque)
 
 struct CEngine; ///< Backend data (opaque)
+struct CArg;    ///< Parser function argument (opaque)
 
 #define FOREACH(IT, i, c) for (IT i = (c).begin(); i != (c).end(); ++i)
 
@@ -55,8 +56,6 @@ struct Error {
 	Cursor loc;
 };
 
-struct CArg { CArg(int o=0, int a=0) : op(o), arg(a) {} int op; int arg; };
-
 template<typename Atom>
 struct Exp { // ::= Atom | (Exp*)
 	Exp(Cursor c)                : type(LIST), loc(c)          {}
@@ -245,7 +244,7 @@ struct ASTCall : public ASTTuple {
 
 /// Definition special form, e.g. "(def x 2)"
 struct ASTDefinition : public ASTCall {
-	ASTDefinition(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+	ASTDefinition(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t) {}
 	void   constrain(TEnv& tenv) const;
 	void   lift(CEnv& cenv);
 	CValue compile(CEnv& cenv);
@@ -253,22 +252,22 @@ struct ASTDefinition : public ASTCall {
 
 /// Conditional special form, e.g. "(if cond thenexp elseexp)"
 struct ASTIf : public ASTCall {
-	ASTIf(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+	ASTIf(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t) {}
 	void   constrain(TEnv& tenv) const;
 	CValue compile(CEnv& cenv);
 };
 
 /// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
 struct ASTPrimitive : public ASTCall {
-	ASTPrimitive(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t), arg(ca) {}
+	ASTPrimitive(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t), arg(ca) {}
 	void   constrain(TEnv& tenv) const;
 	CValue compile(CEnv& cenv);
-	CArg arg;
+	CArg* arg;
 };
 
 /// Cons special form, e.g. "(cons 1 2)"
 struct ASTConsCall : public ASTCall {
-	ASTConsCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+	ASTConsCall(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t) {}
 	AType* functionType(CEnv& cenv);
 	void   constrain(TEnv& tenv) const;
 	void   lift(CEnv& cenv);
@@ -278,14 +277,14 @@ struct ASTConsCall : public ASTCall {
 
 /// Car special form, e.g. "(car p)"
 struct ASTCarCall : public ASTCall {
-	ASTCarCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+	ASTCarCall(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t) {}
 	void   constrain(TEnv& tenv) const;
 	CValue compile(CEnv& cenv);
 };
 
 /// Cdr special form, e.g. "(cdr p)"
 struct ASTCdrCall : public ASTCall {
-	ASTCdrCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+	ASTCdrCall(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t) {}
 	void   constrain(TEnv& tenv) const;
 	CValue compile(CEnv& cenv);
 };
@@ -297,15 +296,17 @@ struct ASTCdrCall : public ASTCall {
 
 // Parse Time Environment (symbol table)
 struct PEnv : private map<const string, ASTSymbol*> {
-	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));
+	typedef AST* (*PF)(PEnv&, const SExp&, CArg*); // Parse Function
+	struct Handler { Handler(PF f, CArg* a=0) : func(f), arg(a) {} PF func; CArg* arg; };
+	map<const string, Handler> aHandlers; ///< Atom parse functions
+	map<const string, Handler> lHandlers; ///< List parse functions
+	void reg(bool list, const string& s, const Handler& h) {
+		(list ? lHandlers : aHandlers).insert(make_pair(sym(s)->str(), h));
 	}
-	const Parser* parser(const string& s) const {
-		map<string, Parser>::const_iterator i = parsers.find(s);
-		return (i != parsers.end()) ? &i->second : NULL;
+	const Handler* handler(bool list, const string& s) const {
+		const map<const string, Handler>& handlers = list ? lHandlers : aHandlers;
+		map<string, Handler>::const_iterator i = handlers.find(s);
+		return (i != handlers.end()) ? &i->second : NULL;
 	}
 	ASTSymbol* sym(const string& s, Cursor c=Cursor()) {
 		const const_iterator i = find(s);
@@ -334,8 +335,8 @@ parseExpression(PEnv& penv, const SExp& exp)
 	if (exp.type == SExp::LIST) {
 		if (exp.list.empty()) throw Error("call to empty list", exp.loc);
 		if (exp.list.front().type == SExp::ATOM) {
-			const PEnv::Parser* handler = penv.parser(exp.list.front().atom);
-			if (handler) // Dispatch to parse function
+			const PEnv::Handler* handler = penv.handler(true, exp.list.front().atom);
+			if (handler) // Dispatch to list parse function
 				return handler->func(penv, exp, handler->arg);
 		}
 		return new ASTCall(exp, pmap(penv, exp.list)); // Parse as regular call
@@ -344,23 +345,30 @@ parseExpression(PEnv& penv, const SExp& exp)
 			return new ASTLiteral<int32_t>(strtol(exp.atom.c_str(), NULL, 10));
 		else
 			return new ASTLiteral<float>(strtod(exp.atom.c_str(), NULL));
-	} else if (exp.atom == "true") {
-		return new ASTLiteral<bool>(true);
-	} else if (exp.atom == "false") {
-		return new ASTLiteral<bool>(false);
+	} else {
+		const PEnv::Handler* handler = penv.handler(false, exp.atom);
+		if (handler) // Dispatch to atom parse function
+			return handler->func(penv, exp, handler->arg);
 	}
 	return penv.sym(exp.atom, exp.loc);
 }
 
 template<typename C>
 inline AST*
-parseAST(PEnv& penv, const SExp& exp, CArg arg=CArg())
+parseCall(PEnv& penv, const SExp& exp, CArg* arg)
 {
 	return new C(exp, pmap(penv, exp.list), arg);
 }
 
+template<typename T>
+inline AST*
+parseLiteral(PEnv& penv, const SExp& exp, CArg* arg)
+{
+	return new ASTLiteral<T>(*reinterpret_cast<T*>(arg));
+}
+
 inline AST*
-parseFn(PEnv& penv, const SExp& exp, CArg arg)
+parseFn(PEnv& penv, const SExp& exp, CArg* arg)
 {
 	SExp::List::const_iterator a = exp.list.begin(); ++a;
 	return new ASTClosure(
diff --git a/tuplr_llvm.cpp b/tuplr_llvm.cpp
index 8d1f1db..3c5ee17 100644
--- a/tuplr_llvm.cpp
+++ b/tuplr_llvm.cpp
@@ -40,6 +40,12 @@ struct CEngine {
 	llvm::IRBuilder<>      builder;
 };
 
+struct CArg {
+	CArg(int o=0, int a=0) : op(o), arg(a) {}
+	int op;
+	int arg;
+};
+
 using namespace llvm;
 using namespace std;
 using boost::format;
@@ -76,13 +82,13 @@ ASTPrimitive::constrain(TEnv& tenv) const
 {
 	FOREACH(const_iterator, p, *this)
 		(*p)->constrain(tenv);
-	if (OP_IS_A(arg.op, Instruction::BinaryOps)) {
+	if (OP_IS_A(arg->op, Instruction::BinaryOps)) {
 		if (size() <= 2) throw Error((format("`%1%' requires at least 2 arguments")
 				% at(0)->str()).str(), exp.loc);
 		AType* tvar = tenv.type(this);
 		for (size_t i = 1; i < size(); ++i)
 			tenv.constrain(at(i), tvar);
-	} else if (arg.op == Instruction::ICmp) {
+	} else if (arg->op == Instruction::ICmp) {
 		if (size() != 3) throw Error((format("`%1%' requires exactly 2 arguments")
 			   % at(0)->str()).str(), exp.loc);
 		tenv.constrain(at(1), tenv.type(at(2)));
@@ -362,30 +368,30 @@ ASTPrimitive::compile(CEnv& cenv)
 	Value* a = LLVal(cenv.compile(at(1)));
 	Value* b = LLVal(cenv.compile(at(2)));
 
-	if (OP_IS_A(arg.op, Instruction::BinaryOps)) {
-		const Instruction::BinaryOps bo = (Instruction::BinaryOps)arg.op;
+	if (OP_IS_A(arg->op, Instruction::BinaryOps)) {
+		const Instruction::BinaryOps bo = (Instruction::BinaryOps)arg->op;
 		if (size() == 2)
 			return cenv.compile(at(1));
 		Value* val = cenv.engine.builder.CreateBinOp(bo, a, b);
 		for (size_t i = 3; i < size(); ++i)
 			val = cenv.engine.builder.CreateBinOp(bo, val, LLVal(cenv.compile(at(i))));
 		return val;
-	} else if (arg.op == Instruction::ICmp) {
+	} else if (arg->op == Instruction::ICmp) {
 		bool isInt = cenv.tenv.type(at(1))->str() == "Int";
 		if (isInt) {
-			return cenv.engine.builder.CreateICmp((CmpInst::Predicate)arg.arg, a, b);
+			return cenv.engine.builder.CreateICmp((CmpInst::Predicate)arg->arg, a, b);
 		} else {
 			// Translate to floating point operation
-			switch (arg.arg) {
-			case CmpInst::ICMP_EQ:  arg.arg = CmpInst::FCMP_OEQ; break;
-			case CmpInst::ICMP_NE:  arg.arg = CmpInst::FCMP_ONE; break;
-			case CmpInst::ICMP_SGT: arg.arg = CmpInst::FCMP_OGT; break;
-			case CmpInst::ICMP_SGE: arg.arg = CmpInst::FCMP_OGE; break;
-			case CmpInst::ICMP_SLT: arg.arg = CmpInst::FCMP_OLT; break;
-			case CmpInst::ICMP_SLE: arg.arg = CmpInst::FCMP_OLE; break;
+			switch (arg->arg) {
+			case CmpInst::ICMP_EQ:  arg->arg = CmpInst::FCMP_OEQ; break;
+			case CmpInst::ICMP_NE:  arg->arg = CmpInst::FCMP_ONE; break;
+			case CmpInst::ICMP_SGT: arg->arg = CmpInst::FCMP_OGT; break;
+			case CmpInst::ICMP_SGE: arg->arg = CmpInst::FCMP_OGE; break;
+			case CmpInst::ICMP_SLT: arg->arg = CmpInst::FCMP_OLT; break;
+			case CmpInst::ICMP_SLE: arg->arg = CmpInst::FCMP_OLE; break;
 			default: throw Error("Unknown primitive", exp.loc);
 			}
-			return cenv.engine.builder.CreateFCmp((CmpInst::Predicate)arg.arg, a, b);
+			return cenv.engine.builder.CreateFCmp((CmpInst::Predicate)arg->arg, a, b);
 		}
 	}
 	throw Error("Unknown primitive", exp.loc);
@@ -598,31 +604,39 @@ repl(CEnv& cenv)
 int
 main(int argc, char** argv)
 {
-#define PRIM(O, A) PEnv::Parser(parseAST<ASTPrimitive>, CArg(Instruction:: O, A))
 	PEnv penv;
-	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));
-	penv.reg("/",    PRIM(FDiv, 0));
-	penv.reg("%",    PRIM(FRem, 0));
-	penv.reg("&",    PRIM(And,  0));
-	penv.reg("|",    PRIM(Or,   0));
-	penv.reg("^",    PRIM(Xor,  0));
-	penv.reg("=",    PRIM(ICmp, CmpInst::ICMP_EQ));
-	penv.reg("!=",   PRIM(ICmp, CmpInst::ICMP_NE));
-	penv.reg(">",    PRIM(ICmp, CmpInst::ICMP_SGT));
-	penv.reg(">=",   PRIM(ICmp, CmpInst::ICMP_SGE));
-	penv.reg("<",    PRIM(ICmp, CmpInst::ICMP_SLT));
-	penv.reg("<=",   PRIM(ICmp, CmpInst::ICMP_SLE));
+	penv.reg(true, "fn",   PEnv::Handler(parseFn));
+	penv.reg(true, "if",   PEnv::Handler(parseCall<ASTIf>));
+	penv.reg(true, "def",  PEnv::Handler(parseCall<ASTDefinition>));
+	penv.reg(true, "cons", PEnv::Handler(parseCall<ASTConsCall>));
+	penv.reg(true, "car",  PEnv::Handler(parseCall<ASTCarCall>));
+	penv.reg(true, "cdr",  PEnv::Handler(parseCall<ASTCdrCall>));
+
+	bool trueVal  = true;
+	bool falseVal = false;
+	penv.reg(false, "true",  PEnv::Handler(parseLiteral<bool>, (CArg*)&trueVal));
+	penv.reg(false, "false", PEnv::Handler(parseLiteral<bool>, (CArg*)&falseVal));
+
+	map<string, CArg> prims;
+	prims.insert(make_pair("+",  CArg(Instruction::Add)));
+	prims.insert(make_pair("-",  CArg(Instruction::Sub)));
+	prims.insert(make_pair("*",  CArg(Instruction::Mul)));
+	prims.insert(make_pair("/",  CArg(Instruction::FDiv)));
+	prims.insert(make_pair("%",  CArg(Instruction::FRem)));
+	prims.insert(make_pair("&",  CArg(Instruction::And)));
+	prims.insert(make_pair("|",  CArg(Instruction::Or)));
+	prims.insert(make_pair("^",  CArg(Instruction::Xor)));
+	prims.insert(make_pair("=",  CArg(Instruction::ICmp, CmpInst::ICMP_EQ)));
+	prims.insert(make_pair("!=", CArg(Instruction::ICmp, CmpInst::ICMP_NE)));
+	prims.insert(make_pair(">",  CArg(Instruction::ICmp, CmpInst::ICMP_SGT)));
+	prims.insert(make_pair(">=", CArg(Instruction::ICmp, CmpInst::ICMP_SGE)));
+	prims.insert(make_pair("<",  CArg(Instruction::ICmp, CmpInst::ICMP_SLT)));
+	prims.insert(make_pair("<=", CArg(Instruction::ICmp, CmpInst::ICMP_SLE)));
+	for (map<string,CArg>::iterator p = prims.begin(); p != prims.end(); ++p)
+		penv.reg(true, p->first, PEnv::Handler(parseCall<ASTPrimitive>, &p->second));
 
 	CEngine engine;
-	CEnv cenv(penv, engine);
+	CEnv    cenv(penv, engine);
 
 	cenv.tenv.def(penv.sym("Bool"),  new AType(penv.sym("Bool"),  Type::Int1Ty));
 	cenv.tenv.def(penv.sym("Int"),   new AType(penv.sym("Int"),   Type::Int32Ty));