Shrink.

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

1 files changed, 68 insertions, 79 deletions

diff --git a/ll.cpp b/ll.cpp
index d14ce53..8de28fc 100644
--- a/ll.cpp
+++ b/ll.cpp
@@ -145,9 +145,11 @@ private:
 	const string cppstr;
 };
 
+typedef vector<AST*> TupV;
+
 /// Tuple (heterogeneous sequence of known length), e.g. "(a b c)"
 struct ASTTuple : public AST {
-	ASTTuple(vector<AST*> t=vector<AST*>()) : tup(t) {}
+	ASTTuple(const TupV& t=TupV()) : tup(t) {}
 	string str() const {
 		string ret = "(";
 		for (size_t i = 0; i != tup.size(); ++i)
@@ -157,8 +159,7 @@ struct ASTTuple : public AST {
 	}
 	bool operator==(const AST& rhs) const {
 		const ASTTuple* rhst = dynamic_cast<const ASTTuple*>(&rhs);
-		if (!rhst) return false;
-		if (rhst->tup.size() != tup.size()) return false;
+		if (!rhst || rhst->tup.size() != tup.size()) return false;
 		for (size_t i = 0; i < tup.size(); ++i)
 			if (tup[i] != rhst->tup[i])
 				return false;
@@ -166,17 +167,17 @@ struct ASTTuple : public AST {
 	}
 	bool operator!=(const ASTTuple& t) const { return ! operator==(t); }
 	void lift(CEnv& cenv) {
-		FOREACH(vector<AST*>::iterator, t, tup)
+		FOREACH(TupV::iterator, t, tup)
 			(*t)->lift(cenv);
 	}
 	void   constrain(TEnv& tenv) const;
 	Value* compile(CEnv& cenv) { return NULL; }
-	vector<AST*> tup;
+	TupV tup;
 };
 
 /// Type Expression ::= (TName TExpr*) | ?Num
 struct AType : public ASTTuple {
-	AType(const vector<AST*>& t) : ASTTuple(t), var(false), ctype(0) {}
+	AType(const TupV& t) : ASTTuple(t), var(false), ctype(0) {}
 	AType(unsigned i) : var(true), ctype(0), id(i) {}
 	AType(ASTSymbol* n, const Type* t) : var(false), ctype(t) {
 		tup.push_back(n);
@@ -192,7 +193,7 @@ struct AType : public ASTTuple {
 	Value* compile(CEnv& cenv) { return NULL; }
 	bool   concrete() const {
 		if (var) return false;
-		FOREACH(vector<AST*>::const_iterator, t, tup) {
+		FOREACH(TupV::const_iterator, t, tup) {
 			AType* kid = dynamic_cast<AType*>(*t);
 			if (kid && !kid->concrete())
 				return false;
@@ -209,8 +210,8 @@ template<typename VT>
 struct ASTLiteral : public AST {
 	ASTLiteral(VT v) : val(v) {}
 	bool operator==(const AST& rhs) const {
-		const ASTLiteral<VT>* rhsl = dynamic_cast<const ASTLiteral<VT>*>(&rhs);
-		return rhsl && val == rhsl->val;
+		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;
@@ -226,15 +227,15 @@ struct ASTClosure : public AST {
 	void   constrain(TEnv& tenv) const;
 	void   lift(CEnv& cenv);
 	Value* compile(CEnv& cenv);
-	ASTTuple* const          prot;
-	AST* const               body;
+	ASTTuple* const prot;
+	AST* const      body;
 private:
 	Function* func;
 };
 	
 /// Function call/application, e.g. "(func arg1 arg2)"
 struct ASTCall : public ASTTuple {
-	ASTCall(const vector<AST*>& t) : ASTTuple(t) {}
+	ASTCall(const TupV& t) : ASTTuple(t) {}
 	void   constrain(TEnv& tenv) const;
 	void   lift(CEnv& cenv);
 	Value* compile(CEnv& cenv);
@@ -242,22 +243,21 @@ struct ASTCall : public ASTTuple {
 
 /// Definition special form, e.g. "(def x 2)" or "(def (next y) (+ y 1))"
 struct ASTDefinition : public ASTCall {
-	ASTDefinition(const vector<AST*>& c) : ASTCall(c) {}
+	ASTDefinition(const TupV& t) : ASTCall(t) {}
 	void   constrain(TEnv& tenv) const;
 	Value* compile(CEnv& cenv);
 };
 
 /// Conditional special form, e.g. "(if cond thenexp elseexp)"
 struct ASTIf : public ASTCall {
-	ASTIf(const vector<AST*>& c) : ASTCall(c) {}
+	ASTIf(const TupV& t) : ASTCall(t) {}
 	void   constrain(TEnv& tenv) const;
 	Value* compile(CEnv& cenv);
 };
 
 /// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
 struct ASTPrimitive : public ASTCall {
-	ASTPrimitive(const vector<AST*>& c, unsigned o, unsigned a=0)
-		: ASTCall(c), op(o), arg(a) {}
+	ASTPrimitive(const TupV& t, int o, int a=0) : ASTCall(t), op(o), arg(a) {}
 	void   constrain(TEnv& tenv) const;
 	Value* compile(CEnv& cenv);
 	unsigned op;
@@ -278,12 +278,12 @@ typedef Op UD; // User Data argument for parse functions
 struct PEnv : private map<const string, ASTSymbol*> {
 	typedef AST* (*PF)(PEnv&, const list<SExp>&, UD); // Parse Function
 	struct Parser { Parser(PF f, UD d) : pf(f), ud(d) {} PF pf; UD ud; };
-	map<const ASTSymbol*, Parser> parsers;
-	void reg(const ASTSymbol* s, const Parser& p) {
-		parsers.insert(make_pair(s, p));
+	map<string, Parser> parsers;
+	void reg(const string& s, const Parser& p) {
+		parsers.insert(make_pair(sym(s)->str(), p));
 	}
-	const Parser* parser(const ASTSymbol* s) const {
-		map<const ASTSymbol*, Parser>::const_iterator i = parsers.find(s);
+	const Parser* parser(const string& s) const {
+		map<string, Parser>::const_iterator i = parsers.find(s);
 		return (i != parsers.end()) ? &i->second : NULL;
 	}
 	ASTSymbol* sym(const string& s) {
@@ -299,23 +299,19 @@ static AST*
 parseExpression(PEnv& penv, const SExp& exp)
 {
 	if (exp.type == SExp::LIST) {
-		// Parse head of list
 		if (exp.list.empty()) throw SyntaxError("Call to empty list");
-		vector<AST*> code(exp.list.size());
-		code[0] = parseExpression(penv, exp.list.front());
-
 		// Dispatch to parse function if possible
-		ASTSymbol* sym = dynamic_cast<ASTSymbol*>(code[0]);
-		const PEnv::Parser* handler = sym ? penv.parser(sym) : NULL;
-		if (handler)
-			return handler->pf(penv, exp.list, handler->ud);
-
-		// Parse as a regular call
-		list<SExp>::const_iterator i = exp.list.begin(); ++i;
-		for (size_t n = 1; i != exp.list.end(); ++i)
-			code[n++] = parseExpression(penv, *i);
+		if (exp.list.front().type == SExp::ATOM) {
+			const PEnv::Parser* handler = penv.parser(exp.list.front().atom);
+			if (handler)
+				return handler->pf(penv, exp.list, handler->ud);
+		}
+		// Otherwise parse as a regular call
+		size_t n = 0;
+		TupV code(exp.list.size());
+		FOREACH(list<SExp>::const_iterator, e, exp.list)
+			code[n++] = parseExpression(penv, *e);
 		return new ASTCall(code);
-
 	} else if (isdigit(exp.atom[0])) {
 		if (exp.atom.find('.') == string::npos)
 			return new ASTLiteral<int32_t>(strtol(exp.atom.c_str(), NULL, 10));
@@ -327,10 +323,10 @@ parseExpression(PEnv& penv, const SExp& exp)
 
 // Special forms
 
-static vector<AST*>
+static TupV
 pmap(PEnv& penv, const list<SExp>& l)
 {
-	vector<AST*> code(l.size());
+	TupV code(l.size());
 	size_t n = 0;
 	for (list<SExp>::const_iterator i = l.begin(); i != l.end(); ++i)
 		code[n++] = parseExpression(penv, *i);
@@ -427,10 +423,10 @@ struct TEnv {
 
 #define OP_IS_A(o, t) ((o) >= t ## Begin && (o) < t ## End)
 
-vector<AST*>
+TupV
 tuple(AST* ast, ...)
 {
-	vector<AST*> tup(1, 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*))
@@ -442,12 +438,10 @@ tuple(AST* ast, ...)
 void
 ASTTuple::constrain(TEnv& tenv) const
 {
-	vector<AST*> texp;
-	FOREACH(vector<AST*>::const_iterator, p, tup) {
+	TupV texp;
+	FOREACH(TupV::const_iterator, p, tup) {
 		(*p)->constrain(tenv);
-		AType* tvar = tenv.var();
-		texp.push_back(tvar);
-		tenv.constrain(*p, tvar);
+		texp.push_back(tenv.type(*p));
 	}
 	tenv.constrain(this, new AType(texp));
 }
@@ -457,8 +451,7 @@ ASTClosure::constrain(TEnv& tenv) const
 {
 	prot->constrain(tenv);
 	body->constrain(tenv);
-	AType* bodyT = tenv.var();
-	tenv.constrain(body, bodyT);
+	AType* bodyT = tenv.type(body);
 	tenv.constrain(this, new AType(tuple(
 			tenv.penv.sym("Fn"), tenv.type(prot), bodyT, 0)));
 }
@@ -466,48 +459,44 @@ ASTClosure::constrain(TEnv& tenv) const
 void
 ASTCall::constrain(TEnv& tenv) const
 {
-	FOREACH(vector<AST*>::const_iterator, p, tup)
+	FOREACH(TupV::const_iterator, p, tup)
 		(*p)->constrain(tenv);
-	AType*       retT = tenv.var();
-	vector<AST*> texp = tuple(tenv.penv.sym("Fn"), tenv.var(), retT, NULL);
-	tenv.constrain(new AType(texp), tenv.var());
-	tenv.constrain(this, retT);
+	AType*       retT = tenv.type(this);
+	TupV texp = tuple(tenv.penv.sym("Fn"), tenv.var(), retT, NULL);
+	tenv.constrain(tup[0], new AType(texp));
 }
 
 void
 ASTDefinition::constrain(TEnv& tenv) const
 {
-	FOREACH(vector<AST*>::const_iterator, p, tup)
+	FOREACH(TupV::const_iterator, p, tup)
 		(*p)->constrain(tenv);
-	AType* tvar = tenv.var();
+	AType* tvar = tenv.type(this);
 	tenv.constrain(tup[1], tvar);
 	tenv.constrain(tup[2], tvar);
-	tenv.constrain(this, tvar);
 }
 
 void
 ASTIf::constrain(TEnv& tenv) const
 {
-	FOREACH(vector<AST*>::const_iterator, p, tup)
+	FOREACH(TupV::const_iterator, p, tup)
 		(*p)->constrain(tenv);
-	AType* tvar = tenv.var();
+	AType* tvar = tenv.type(this);
 	tenv.constrain(tup[1], tenv.named("Bool"));
 	tenv.constrain(tup[2], tvar);
 	tenv.constrain(tup[3], tvar);
-	tenv.constrain(this,   tvar);
 }
 
 void
 ASTPrimitive::constrain(TEnv& tenv) const
 {
-	FOREACH(vector<AST*>::const_iterator, p, tup)
+	FOREACH(TupV::const_iterator, p, tup)
 		(*p)->constrain(tenv);
 	if (OP_IS_A(op, Instruction::BinaryOps)) {
 		if (tup.size() <= 1) throw SyntaxError("Primitive call with 0 args");
-		AType* tvar = tenv.var();
+		AType* tvar = tenv.type(this);
 		for (size_t i = 1; i < tup.size(); ++i)
 			tenv.constrain(tup[i], tvar);
-		tenv.constrain(this, tvar);
 	} else if (op == Instruction::ICmp) {
 		if (tup.size() != 3) throw SyntaxError("Comparison call with != 2 args");
 		tenv.constrain(tup[1], tenv.type(tup[2]));
@@ -643,7 +632,7 @@ compileFunction(CEnv& cenv, const std::string& name, ASTTuple& prot, const Type*
 {
 	Function::LinkageTypes linkage = Function::ExternalLinkage;
 
-	const vector<AST*>& texp = cenv.tenv.type(&prot)->tup;
+	const TupV& texp = cenv.tenv.type(&prot)->tup;
 	vector<const Type*> cprot;
 	for (size_t i = 0; i < texp.size(); ++i) {
 		const Type* t = cenv.tenv.type(texp[i])->ctype;
@@ -816,7 +805,7 @@ ASTClosure::lift(CEnv& cenv)
 	
 	// Bind argument values in CEnv
 	vector<Value*> args;
-	vector<AST*>::const_iterator p = prot->tup.begin();
+	TupV::const_iterator p = prot->tup.begin();
 	for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p)
 		cenv.vals.def(dynamic_cast<ASTSymbol*>(*p), &*a);
 
@@ -888,23 +877,23 @@ main()
 {
 #define PRIM(O, A) PEnv::Parser(parsePrim, Op(Instruction:: O, A))
 	PEnv penv;
-	penv.reg(penv.sym("fn"),  PEnv::Parser(parseFn,   Op()));
-	penv.reg(penv.sym("if"),  PEnv::Parser(parseIf,   Op()));
-	penv.reg(penv.sym("def"), PEnv::Parser(parseDef,  Op()));
-	penv.reg(penv.sym("+"),   PRIM(Add,  0));
-	penv.reg(penv.sym("-"),   PRIM(Sub,  0));
-	penv.reg(penv.sym("*"),   PRIM(Mul,  0));
-	penv.reg(penv.sym("/"),   PRIM(FDiv, 0));
-	penv.reg(penv.sym("%"),   PRIM(FRem, 0));
-	penv.reg(penv.sym("&"),   PRIM(And,  0));
-	penv.reg(penv.sym("|"),   PRIM(Or,   0));
-	penv.reg(penv.sym("^"),   PRIM(Xor,  0));
-	penv.reg(penv.sym("="),   PRIM(ICmp, CmpInst::ICMP_EQ));
-	penv.reg(penv.sym("!="),  PRIM(ICmp, CmpInst::ICMP_NE));
-	penv.reg(penv.sym(">"),   PRIM(ICmp, CmpInst::ICMP_SGT));
-	penv.reg(penv.sym(">="),  PRIM(ICmp, CmpInst::ICMP_SGE));
-	penv.reg(penv.sym("<"),   PRIM(ICmp, CmpInst::ICMP_SLT));
-	penv.reg(penv.sym("<="),  PRIM(ICmp, CmpInst::ICMP_SLE));
+	penv.reg("fn",  PEnv::Parser(parseFn,   Op()));
+	penv.reg("if",  PEnv::Parser(parseIf,   Op()));
+	penv.reg("def", PEnv::Parser(parseDef,  Op()));
+	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));
 
 	Module*          module = new Module("repl");
 	ExecutionEngine* engine = ExecutionEngine::create(module);