Make ASTClosure an ASTTuple.

Make Exp more generic (typedef list type).
Shrink.


git-svn-id: http://svn.drobilla.net/resp/llvm-lisp@21 ad02d1e2-f140-0410-9f75-f8b11f17cedd

1 files changed, 62 insertions, 64 deletions

diff --git a/ll.cpp b/ll.cpp
index eb8708a..1804f80 100644
--- a/ll.cpp
+++ b/ll.cpp
@@ -50,12 +50,12 @@ struct Error : public std::exception {
 
 template<typename A>
 struct Exp { // ::= Atom | (Exp*)
-	Exp()                        : type(LIST)          {}
-	Exp(const std::list<Exp>& l) : type(LIST), list(l) {}
-	Exp(const A&              a) : type(ATOM), atom(a) {}
+	Exp()           : type(LIST)          {}
+	Exp(const A& a) : type(ATOM), atom(a) {}
 	enum { ATOM, LIST } type;
-	A                   atom;
-	std::list< Exp<A> > list;
+	typedef std::vector< Exp<A> > List;
+	A    atom;
+	List list;
 };
 
 
@@ -72,20 +72,19 @@ readExpression(std::istream& in)
 	stack<SExp> stk;
 	string      tok;
 
-#define APPEND_TOK() { if (stk.empty()) { return tok; } else {\
-	stk.top().list.push_back(SExp(tok)); tok = ""; } }
+#define PUSH(t)  { if (t != "") { stk.top().list.push_back(t); t = ""; } }
+#define YIELD(t) { if (stk.empty()) return t; else PUSH(t) }
 
 	while (char ch = in.get()) {
 		switch (ch) {
 		case EOF:
 			return SExp();
 		case ' ': case '\t': case '\n':
-			if (tok != "") APPEND_TOK();
+			if (tok != "") YIELD(tok);
 			break;
 		case '"':
 			do { tok.push_back(ch); } while ((ch = in.get()) != '"');
-			tok.push_back('"');
-			APPEND_TOK();
+			YIELD(tok + '"');
 			break;
 		case '(':
 			stk.push(SExp());
@@ -95,21 +94,19 @@ readExpression(std::istream& in)
 			case 0:
 				throw SyntaxError("Unexpected ')'");
 			case 1:
-				if (tok != "") stk.top().list.push_back(SExp(tok));
+				PUSH(tok);
 				return stk.top();
 			default:
-				if (tok != "") stk.top().list.push_back(SExp(tok));
+				PUSH(tok);
 				SExp l = stk.top();
 				stk.pop();
 				stk.top().list.push_back(l);
 			}
-			tok = "";
 			break;
 		default:
-			tok.push_back(ch);
+			tok += ch;
 		}
 	}
-
 	switch (stk.size()) {
 	case 0:  return tok;       break;
 	case 1:  return stk.top(); break;
@@ -137,6 +134,20 @@ struct AST {
 	virtual Value* compile(CEnv& cenv)              = 0;
 };
 
+/// Literal
+template<typename VT>
+struct ASTLiteral : public AST {
+	ASTLiteral(VT v) : val(v) {}
+	bool operator==(const AST& rhs) const {
+		const ASTLiteral<VT>* r = dynamic_cast<const ASTLiteral<VT>*>(&rhs);
+		return r && val == r->val;
+	}
+	string str() const { ostringstream s; s << val; return s.str(); }
+	void   constrain(TEnv& tenv) const;
+	Value* compile(CEnv& cenv);
+	const VT val;
+};
+
 /// Symbol, e.g. "a"
 struct ASTSymbol : public AST {
 	ASTSymbol(const string& s) : cppstr(s) {}
@@ -156,14 +167,12 @@ struct ASTTuple : public AST {
 		string ret = "(";
 		for (size_t i = 0; i != tup.size(); ++i)
 			ret += tup[i]->str() + ((i != tup.size() - 1) ? " " : "");
-		ret.append(")");
-		return ret;
+		return ret + ")";
 	}
 	bool operator==(const AST& rhs) const {
-		const ASTTuple* rhst = dynamic_cast<const ASTTuple*>(&rhs);
-		if (!rhst || rhst->tup.size() != tup.size()) return false;
-		for (size_t i = 0; i < tup.size(); ++i)
-			if (tup[i] != rhst->tup[i])
+		TupV::const_iterator l = tup.begin();
+		FOREACH(TupV::const_iterator, r, tup)
+			if ((*l++) != (*r))
 				return false;
 		return true;
 	}
@@ -177,6 +186,18 @@ struct ASTTuple : public AST {
 	TupV tup;
 };
 
+static TupV
+tuple(AST* ast, ...)
+{
+	TupV tup(1, ast);
+	va_list args;
+	va_start(args, ast);
+	for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*))
+		tup.push_back(a);
+	va_end(args);
+	return tup;
+}
+
 /// Type Expression ::= (TName TExpr*) | ?Num
 struct AType : public ASTTuple {
 	AType(const TupV& t) : ASTTuple(t), var(false), ctype(0) {}
@@ -207,30 +228,16 @@ struct AType : public ASTTuple {
 	unsigned    id;
 };
 
-/// Literal
-template<typename VT>
-struct ASTLiteral : public AST {
-	ASTLiteral(VT v) : val(v) {}
-	bool operator==(const AST& rhs) const {
-		const ASTLiteral<VT>* r = dynamic_cast<const ASTLiteral<VT>*>(&rhs);
-		return r && val == r->val;
-	}
-	string str() const { ostringstream s; s << val; return s.str(); }
-	void   constrain(TEnv& tenv) const;
-	Value* compile(CEnv& cenv);
-	const VT val;
-};
-
 /// Closure (first-class function with captured lexical bindings)
-struct ASTClosure : public AST {
-	ASTClosure(ASTTuple* p, AST* b) : prot(p), body(b), func(0) {}
+struct ASTClosure : public ASTTuple {
+	ASTClosure(ASTTuple* p, AST* b)
+		: ASTTuple(tuple(0, p, b)), prot(p), func(0) {}
 	bool operator==(const AST& rhs) const { return this == &rhs; }
 	string str() const { ostringstream s; s << this; return s.str(); }
 	void   constrain(TEnv& tenv) const;
 	void   lift(CEnv& cenv);
 	Value* compile(CEnv& cenv);
 	ASTTuple* const prot;
-	AST* const      body;
 private:
 	Function* func;
 };
@@ -278,7 +285,7 @@ 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 list<SExp>&, UD); // Parse Function
+	typedef AST* (*PF)(PEnv&, const SExp::List&, UD); // Parse Function
 	struct Parser { Parser(PF f, UD d) : pf(f), ud(d) {} PF pf; UD ud; };
 	map<string, Parser> parsers;
 	void reg(const string& s, const Parser& p) {
@@ -311,7 +318,7 @@ parseExpression(PEnv& penv, const SExp& exp)
 		// Otherwise parse as a regular call
 		size_t n = 0;
 		TupV code(exp.list.size());
-		FOREACH(list<SExp>::const_iterator, e, exp.list)
+		FOREACH(SExp::List::const_iterator, e, exp.list)
 			code[n++] = parseExpression(penv, *e);
 		return new ASTCall(code);
 	} else if (isdigit(exp.atom[0])) {
@@ -326,31 +333,31 @@ parseExpression(PEnv& penv, const SExp& exp)
 // Special forms
 
 static TupV
-pmap(PEnv& penv, const list<SExp>& l)
+pmap(PEnv& penv, const SExp::List& l)
 {
 	TupV code(l.size());
 	size_t n = 0;
-	for (list<SExp>::const_iterator i = l.begin(); i != l.end(); ++i)
+	for (SExp::List::const_iterator i = l.begin(); i != l.end(); ++i)
 		code[n++] = parseExpression(penv, *i);
 	return code;
 }
 
 static AST*
-parseIf(PEnv& penv, const list<SExp>& c, UD)
+parseIf(PEnv& penv, const SExp::List& c, UD)
 	{ return new ASTIf(pmap(penv, c)); }
 
 static AST*
-parseDef(PEnv& penv, const list<SExp>& c, UD)
+parseDef(PEnv& penv, const SExp::List& c, UD)
 	{ return new ASTDefinition(pmap(penv, c)); }
 
 static AST*
-parsePrim(PEnv& penv, const list<SExp>& c, UD data)
+parsePrim(PEnv& penv, const SExp::List& c, UD data)
 	{ return new ASTPrimitive(pmap(penv, c), data.op, data.arg); }
 
 static AST*
-parseFn(PEnv& penv, const list<SExp>& c, UD)
+parseFn(PEnv& penv, const SExp::List& c, UD)
 {
-	list<SExp>::const_iterator a = c.begin(); ++a;
+	SExp::List::const_iterator a = c.begin(); ++a;
 	return new ASTClosure(
 			new ASTTuple(pmap(penv, (*a++).list)),
 			parseExpression(penv, *a++));
@@ -425,18 +432,6 @@ struct TEnv {
 
 #define OP_IS_A(o, t) ((o) >= t ## Begin && (o) < t ## End)
 
-TupV
-tuple(AST* ast, ...)
-{
-	TupV tup(1, ast);
-	va_list args;
-	va_start(args, ast);
-	for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*))
-		tup.push_back(a);
-	va_end(args);
-	return tup;
-}
-
 void
 ASTTuple::constrain(TEnv& tenv) const
 {
@@ -452,8 +447,8 @@ void
 ASTClosure::constrain(TEnv& tenv) const
 {
 	prot->constrain(tenv);
-	body->constrain(tenv);
-	AType* bodyT = tenv.type(body);
+	tup[2]->constrain(tenv);
+	AType* bodyT = tenv.type(tup[2]);
 	tenv.constrain(this, new AType(tuple(
 			tenv.penv.sym("Fn"), tenv.type(prot), bodyT, 0)));
 }
@@ -729,8 +724,11 @@ ASTCall::compile(CEnv& cenv)
 {
 	ASTClosure* c = dynamic_cast<ASTClosure*>(tup[0]);
 	if (!c) {
+		std::cout << "LOOKING UP" << endl;
 		AST** val = cenv.code.ref(tup[0]);
 		c = (val) ? dynamic_cast<ASTClosure*>(*val) : c;
+	} else {
+		std::cout << "FOUND" << endl;
 	}
 	
 	if (!c) throw CompileError("Call to non-closure");
@@ -789,7 +787,7 @@ void
 ASTClosure::lift(CEnv& cenv)
 {
 	// Can't lift a closure with variable types (lift later when called)
-	if (cenv.tenv.type(body)->var) return;
+	if (cenv.tenv.type(tup[2])->var) return;
 	for (size_t i = 0; i < prot->tup.size(); ++i)
 		if (cenv.tenv.type(prot->tup[i])->var)
 			return;
@@ -798,7 +796,7 @@ ASTClosure::lift(CEnv& cenv)
 	cenv.code.push_front();
 
 	// Write function declaration
-	Function* f = compileFunction(cenv, cenv.gensym("_fn"), *prot, cenv.tenv.type(body)->ctype);
+	Function* f = compileFunction(cenv, cenv.gensym("_fn"), *prot, cenv.tenv.type(tup[2])->ctype);
 	BasicBlock* bb = BasicBlock::Create("entry", f);
 	cenv.builder.SetInsertPoint(bb);
 	
@@ -810,7 +808,7 @@ ASTClosure::lift(CEnv& cenv)
 
 	// Write function body
 	try {
-		Value* retVal = body->compile(cenv);
+		Value* retVal = tup[2]->compile(cenv);
 		cenv.builder.CreateRet(retVal); // Finish function
 		verifyFunction(*f); // Validate generated code
 		cenv.fpm.run(*f); // Optimize function