diff options
| -rw-r--r-- | llvm.cpp | 88 | ||||
| -rw-r--r-- | test/list.tpr | 3 | ||||
| -rw-r--r-- | tuplr.cpp | 6 | ||||
| -rw-r--r-- | tuplr.hpp | 24 | ||||
| -rw-r--r-- | typing.cpp | 34 |
5 files changed, 1 insertions, 154 deletions
@@ -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))) @@ -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>)); @@ -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) * @@ -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 * |