Remove crufty cons/car/cdr implementation that doesn't work anyway.

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

5 files changed, 1 insertions, 154 deletions

diff --git a/llvm.cpp b/llvm.cpp
index 6f81f94..85e4a14 100644
--- a/llvm.cpp
+++ b/llvm.cpp
@@ -486,94 +486,6 @@ APrimitive::compile(CEnv& cenv)
 	throw Error(loc, "unknown primitive");
 }
 
-AType*
-AConsCall::functionType(CEnv& cenv)
-{
-	ATuple* protTypes = new ATuple(loc, cenv.type(at(1)), cenv.type(at(2)), 0);
-	AType* cellType = new AType(loc,
-			cenv.penv.sym("Pair"), cenv.type(at(1)), cenv.type(at(2)), 0);
-	return new AType(at(0)->loc, cenv.penv.sym("Fn"), protTypes, cellType, 0);
-}
-
-void
-AConsCall::lift(CEnv& cenv)
-{
-	AType* funcType = functionType(cenv);
-	if (funcs.find(functionType(cenv)))
-		return;
-
-	ACall::lift(cenv);
-
-	ATuple* protT = new ATuple(loc, cenv.type(at(1)), cenv.type(at(2)), 0);
-
-	vector<const Type*> types;
-	size_t sz = 0;
-	for (size_t i = 1; i < size(); ++i) {
-		const Type* t = lltype(cenv.type(at(i)));
-		types.push_back(t);
-		sz += t->getPrimitiveSizeInBits();
-	}
-	sz = (sz % 8 == 0) ? sz / 8 : sz / 8 + 1;
-
-	llvm::IRBuilder<>& builder = llengine(cenv)->builder;
-
-	StructType* sT = StructType::get(types, false);
-	Type*       pT = PointerType::get(sT, 0);
-
-	// Write function declaration
-	vector<string> argNames;
-	argNames.push_back("car");
-	argNames.push_back("cdr");
-	Function* func = compileFunction(cenv, cenv.gensym("cons"), pT, *protT, loc, argNames);
-
-	Value* mem  = builder.CreateCall(LLVal(cenv.alloc), ConstantInt::get(Type::Int32Ty, sz), "mem");
-	Value* cell = builder.CreateBitCast(mem, pT, "cell");
-	Value* s    = builder.CreateGEP(cell, ConstantInt::get(Type::Int32Ty, 0), "pair");
-	Value* carP = builder.CreateStructGEP(s, 0, "car");
-	Value* cdrP = builder.CreateStructGEP(s, 1, "cdr");
-
-	Function::arg_iterator ai = func->arg_begin();
-	Value& carArg = *ai++;
-	Value& cdrArg = *ai++;
-	builder.CreateStore(&carArg, carP);
-	builder.CreateStore(&cdrArg, cdrP);
-	builder.CreateRet(cell);
-
-	cenv.optimise(func);
-	funcs.push_back(make_pair(funcType, func));
-}
-
-CValue
-AConsCall::compile(CEnv& cenv)
-{
-	vector<Value*> params(size() - 1);
-	for (size_t i = 1; i < size(); ++i)
-		params[i-1] = LLVal(cenv.compile(at(i)));
-
-	return llengine(cenv)->builder.CreateCall(LLFunc(funcs.find(functionType(cenv))),
-			params.begin(), params.end());
-}
-
-CValue
-ACarCall::compile(CEnv& cenv)
-{
-	AST*   arg  = cenv.tenv.resolve(at(1));
-	Value* sP   = LLVal(cenv.compile(arg));
-	Value* s    = llengine(cenv)->builder.CreateGEP(sP, ConstantInt::get(Type::Int32Ty, 0), "pair");
-	Value* carP = llengine(cenv)->builder.CreateStructGEP(s, 0, "car");
-	return llengine(cenv)->builder.CreateLoad(carP);
-}
-
-CValue
-ACdrCall::compile(CEnv& cenv)
-{
-	AST*   arg  = cenv.tenv.resolve(at(1));
-	Value* sP   = LLVal(cenv.compile(arg));
-	Value* s    = llengine(cenv)->builder.CreateGEP(sP, ConstantInt::get(Type::Int32Ty, 0), "pair");
-	Value* cdrP = llengine(cenv)->builder.CreateStructGEP(s, 1, "cdr");
-	return llengine(cenv)->builder.CreateLoad(cdrP);
-}
-
 
 /***************************************************************************
  * EVAL/REPL                                                               *
diff --git a/test/list.tpr b/test/list.tpr
deleted file mode 100644
index 947fe97..0000000
--- a/test/list.tpr
+++ /dev/null
@@ -1,3 +0,0 @@
-(def l (cons 1 (cons 2 (cons 3 4))))
-
-(car (cdr (cdr l)))
diff --git a/tuplr.cpp b/tuplr.cpp
index f3d0c66..ae9caf7 100644
--- a/tuplr.cpp
+++ b/tuplr.cpp
@@ -26,8 +26,7 @@
 using namespace std;
 using boost::format;
 
-Funcs AConsCall::funcs;
-GC    Object::pool;
+GC Object::pool;
 
 template<typename Atom>
 ostream&
@@ -208,9 +207,6 @@ initLang(PEnv& penv, TEnv& tenv)
 	penv.reg(true, "fn",   PEnv::Handler(parseFn));
 	penv.reg(true, "if",   PEnv::Handler(parseCall<AIf>));
 	penv.reg(true, "def",  PEnv::Handler(parseCall<ADefinition>));
-	penv.reg(true, "cons", PEnv::Handler(parseCall<AConsCall>));
-	penv.reg(true, "car",  PEnv::Handler(parseCall<ACarCall>));
-	penv.reg(true, "cdr",  PEnv::Handler(parseCall<ACdrCall>));
 
 	// Numeric primitives
 	penv.reg(true, "+",   PEnv::Handler(parseCall<APrimitive>));
diff --git a/tuplr.hpp b/tuplr.hpp
index 97a5988..f8ef33b 100644
--- a/tuplr.hpp
+++ b/tuplr.hpp
@@ -410,30 +410,6 @@ struct APrimitive : public ACall {
 	CValue compile(CEnv& cenv);
 };
 
-/// Cons special form, e.g. "(cons 1 2)"
-struct AConsCall : public ACall {
-	AConsCall(const SExp& e, const ATuple& t) : ACall(e, t) {}
-	AType* functionType(CEnv& cenv);
-	void   constrain(TEnv& tenv, Constraints& c) const;
-	void   lift(CEnv& cenv);
-	CValue compile(CEnv& cenv);
-	static Funcs funcs;
-};
-
-/// Car special form, e.g. "(car p)"
-struct ACarCall : public ACall {
-	ACarCall(const SExp& e, const ATuple& t) : ACall(e, t) {}
-	void   constrain(TEnv& tenv, Constraints& c) const;
-	CValue compile(CEnv& cenv);
-};
-
-/// Cdr special form, e.g. "(cdr p)"
-struct ACdrCall : public ACall {
-	ACdrCall(const SExp& e, const ATuple& t) : ACall(e, t) {}
-	void   constrain(TEnv& tenv, Constraints& c) const;
-	CValue compile(CEnv& cenv);
-};
-
 
 /***************************************************************************
  * Parser: S-Expressions (SExp) -> AST Nodes (AST)                         *
diff --git a/typing.cpp b/typing.cpp
index 3b14a1f..06b936e 100644
--- a/typing.cpp
+++ b/typing.cpp
@@ -228,40 +228,6 @@ APrimitive::constrain(TEnv& tenv, Constraints& c) const
 	}
 }
 
-void
-AConsCall::constrain(TEnv& tenv, Constraints& c) const
-{
-	THROW_IF(size() != 3, loc, "`cons' requires exactly 2 arguments")
-	AType* t = new AType(loc, tenv.penv.sym("Pair"), 0);
-	for (size_t i = 1; i < size(); ++i) {
-		at(i)->constrain(tenv, c);
-		t->push_back(tenv.var(at(i)));
-	}
-	c.constrain(tenv, this, t);
-}
-
-void
-ACarCall::constrain(TEnv& tenv, Constraints& c) const
-{
-	THROW_IF(size() != 2, loc, "`car' requires exactly 1 argument")
-	at(1)->constrain(tenv, c);
-	AType* carT  = tenv.var(this);
-	AType* pairT = new AType(at(1)->loc, tenv.penv.sym("Pair"), carT, tenv.var(), 0);
-	c.constrain(tenv, at(1), pairT);
-	c.constrain(tenv, this, carT);
-}
-
-void
-ACdrCall::constrain(TEnv& tenv, Constraints& c) const
-{
-	THROW_IF(size() != 2, loc, "`cdr' requires exactly 1 argument")
-	at(1)->constrain(tenv, c);
-	AType* cdrT  = tenv.var(this);
-	AType* pairT = new AType(at(1)->loc, tenv.penv.sym("Pair"), tenv.var(), cdrT, 0);
-	c.constrain(tenv, at(1), pairT);
-	c.constrain(tenv, this, cdrT);
-}
-
 
 /***************************************************************************
  * Type Inference/Substitution                                             *