From 10174ffc7ea08b7845dbe409a11811e820536468 Mon Sep 17 00:00:00 2001 From: David Robillard Date: Sat, 15 Dec 2012 07:06:22 +0000 Subject: Compile constructors as LLVM struct types. Use LLVM type names instead of hyper verbose literal types in more places in general. More work on quoting. git-svn-id: http://svn.drobilla.net/resp/trunk@439 ad02d1e2-f140-0410-9f75-f8b11f17cedd --- src/c.cpp | 4 ++-- src/compile.cpp | 18 +++++++++++------- src/constrain.cpp | 8 ++++---- src/llvm.cpp | 50 ++++++++++++++++++++++++++++++++++++++------------ src/resp.hpp | 4 +++- src/simplify.cpp | 36 +++++++++++++++++++----------------- 6 files changed, 77 insertions(+), 43 deletions(-) (limited to 'src') diff --git a/src/c.cpp b/src/c.cpp index 0f56b5a..b2d17d1 100644 --- a/src/c.cpp +++ b/src/c.cpp @@ -55,7 +55,7 @@ struct CEngine : public Engine { CVal compileLiteral(CEnv& cenv, const AST* lit); CVal compilePrimitive(CEnv& cenv, const ATuple* prim); CVal compileString(CEnv& cenv, const char* str); - CType compileType(CEnv& cenv, const char* name, const AST* exp); + CType compileType(CEnv& cenv, const std::string& name, const AST* exp); void writeModule(CEnv& cenv, std::ostream& os); @@ -169,7 +169,7 @@ CEngine::compileString(CEnv& cenv, const char* str) } CType -CEngine::compileType(CEnv& cenv, const char* name, const AST* expr) +CEngine::compileType(CEnv& cenv, const std::string& name, const AST* expr) { return NULL; } diff --git a/src/compile.cpp b/src/compile.cpp index de53388..917944a 100644 --- a/src/compile.cpp +++ b/src/compile.cpp @@ -60,17 +60,21 @@ compile_cons(CEnv& cenv, const ATuple* cons) throw() return compile_literal_symbol(cenv, cons->frst()->as_symbol()); } - const ASymbol* tname = cons->fst()->as_symbol(); - ATuple* type = new ATuple(tname, NULL, Cursor()); + const ASymbol* sym = cons->fst()->as_symbol(); + ATuple* type = new ATuple(sym, NULL, Cursor()); List tlist(type); vector fields; for (ATuple::const_iterator i = cons->iter_at(1); i != cons->end(); ++i) { tlist.push_back(cenv.type(*i)); fields.push_back(resp_compile(cenv, *i)); } - const std::string tstr = cenv.type(cons, Subst(), false)->as_symbol()->str(); + + std::string name = sym->str(); + if (name == "Closure") { + name = cenv.type(cons, Subst(), false)->as_symbol()->str(); + } return cenv.engine()->compileCons( - cenv, tstr.c_str(), type, compile_literal_symbol(cenv, tname), fields); + cenv, name.c_str(), type, compile_literal_symbol(cenv, sym), fields); } static CVal @@ -107,11 +111,11 @@ compile_def_type(CEnv& cenv, const ATuple* def) throw() { const ASymbol* name = def->frst()->to_symbol(); if (name) { - cenv.engine()->compileType(cenv, name->sym(), def->frrst()); + cenv.engine()->compileType(cenv, name->str(), def->frrst()); cenv.tenv.def(name, def->frrst()); } else { name = def->frst()->as_tuple()->fst()->as_symbol(); - cenv.engine()->compileType(cenv, name->sym(), def->frst()); + cenv.engine()->compileType(cenv, name->str(), def->frst()); for (ATuple::const_iterator i = def->iter_at(2); i != def->end(); ++i) { const ATuple* exp = (*i)->as_tuple(); const ASymbol* tag = (*exp->begin())->as_symbol(); @@ -143,7 +147,7 @@ compile_call(CEnv& cenv, const ATuple* call) throw() ATuple::const_iterator p = protT->iter_at(0); for (ATuple::const_iterator a = call->iter_at(2); a != call->end(); ++a, ++p) { CVal arg = resp_compile(cenv, *a); - if (cenv.type(*a) != cenv.resolveType(*p)) { + if (cenv.type(*a) != *p && cenv.type(*a) != cenv.resolveType(*p)) { args.push_back(cenv.engine()->compileCast(cenv, arg, *p)); } else { args.push_back(arg); diff --git a/src/constrain.cpp b/src/constrain.cpp index 83a027a..e6e81a3 100644 --- a/src/constrain.cpp +++ b/src/constrain.cpp @@ -135,7 +135,7 @@ constrain_def_type(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) THROW_IF(!prot, (*i)->loc, "first argument of `def-type' is not a tuple"); const ASymbol* sym = (*prot->begin())->as_symbol(); THROW_IF(!sym, (*prot->begin())->loc, "type name is not a symbol"); - THROW_IF(tenv.ref(sym), call->loc, "type redefinition"); + //THROW_IF(tenv.ref(sym), call->loc, "type redefinition"); List type(call->loc, tenv.penv.sym("Lambda"), prot->rst(), NULL); for (ATuple::const_iterator i = call->iter_at(2); i != call->end(); ++i) { const ATuple* exp = (*i)->as_tuple(); @@ -306,11 +306,10 @@ resp_constrain_quoted(TEnv& tenv, Constraints& c, const AST* ast) throw(Error) if (ast->tag() == T_SYMBOL) { c.constrain(tenv, ast, tenv.named("Symbol")); } else if (ast->tag() == T_TUPLE) { - List tupT(new ATuple(tenv.List, NULL, ast->loc)); + List tupT(new ATuple(tenv.Expr, NULL, ast->loc)); const ATuple* tup = ast->as_tuple(); const AST* fstT = tenv.var(tup->fst()); - tupT.push_back(tenv.penv.sym("Expr")); c.constrain(tenv, ast, tupT); c.constrain(tenv, tup->fst(), fstT); FOREACHP(ATuple::const_iterator, i, ast->as_tuple()) { @@ -327,7 +326,8 @@ constrain_quote(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error) { THROW_IF(call->list_len() != 2, call->loc, "`quote' requires exactly 1 argument"); resp_constrain_quoted(tenv, c, call->frst()); - c.constrain(tenv, call, tenv.var(call->frst())); + List type(call->loc, tenv.Expr, NULL); + c.constrain(tenv, call, type); } static void diff --git a/src/llvm.cpp b/src/llvm.cpp index 7f521b7..795cd8c 100644 --- a/src/llvm.cpp +++ b/src/llvm.cpp @@ -100,7 +100,7 @@ struct LLVMEngine : public Engine { CVal compileLiteral(CEnv& cenv, const AST* lit); CVal compilePrimitive(CEnv& cenv, const ATuple* prim); CVal compileString(CEnv& cenv, const char* str); - CType compileType(CEnv& cenv, const char* name, const AST* exp); + CType compileType(CEnv& cenv, const std::string& name, const AST* exp); void writeModule(CEnv& cenv, std::ostream& os); @@ -193,7 +193,6 @@ LLVMEngine::llType(const AST* t, const char* name) if (sym == "Float") return Type::getFloatTy(context); if (sym == "String") return PointerType::get(Type::getInt8Ty(context), 0); if (sym == "Symbol") return PointerType::get(Type::getInt8Ty(context), 0); - if (sym == "Expr") return PointerType::get(Type::getInt8Ty(context), 0); if (sym == opaqueName) { THROW_IF(!opaqueT, t->loc, "Broken recursive type"); return PointerType::getUnqual(opaqueT); @@ -233,6 +232,21 @@ LLVMEngine::llType(const AST* t, const char* name) Type* ret = NULL; vector ctypes; + + if (!name) { + const ASymbol* tag = t->as_tuple()->fst()->as_symbol(); + if (tag->str() != "Tup" && tag->str() != "Closure") { + name = tag->str().c_str(); + } + } + + if (name) { + CTypes::const_iterator i = compiledTypes.find(name); + if (i != compiledTypes.end()) { + return i->second; + } + } + // Define opaque type to stand for name in recursive type body if (name) { THROW_IF(opaqueT, t->loc, "Nested recursive types"); @@ -279,7 +293,17 @@ LLVMEngine::compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vectorto_tuple(); + string name; + if (tup) { + const ASymbol* head = tup->fst()->to_symbol(); + if (head && head->str() != "Fn" && isupper(head->str()[0])) { + name = head->str(); + } + } else if (t->to_symbol()) { + name = t->to_symbol()->str(); + } + return builder.CreateBitCast(llVal(v), (Type*)compileType(cenv, name, cenv.resolveType(t)), "cast"); } CVal @@ -291,7 +315,7 @@ LLVMEngine::compileCons(CEnv& cenv, const char* tname, const ATuple* type, CVal assert(type->begin() != type->end()); for (ATuple::const_iterator i = type->iter_at(1); i != type->end(); ++i) s += engine->getTargetData()->getTypeSizeInBits( - (Type*)compileType(cenv, NULL, *i)); + (Type*)compileType(cenv, (*i)->str(), *i)); // Allocate struct const std::string name = type->fst()->str(); @@ -354,17 +378,18 @@ LLVMEngine::compileString(CEnv& cenv, const char* str) } CType -LLVMEngine::compileType(CEnv& cenv, const char* name, const AST* expr) +LLVMEngine::compileType(CEnv& cenv, const std::string& name, const AST* expr) { - if (name) { + if (!name.empty()) { CTypes::const_iterator i = compiledTypes.find(name); - if (i != compiledTypes.end()) + if (i != compiledTypes.end()) { return i->second; + } } - Type* const type = llType(expr, name); + Type* const type = llType(expr, name.c_str()); - if (name) + if (!name.empty()) compiledTypes.insert(make_pair(name, type)); return type; @@ -381,8 +406,9 @@ LLVMEngine::startFn( vector cprot; FOREACHP(ATuple::const_iterator, i, argsT) { - const char* name = (*i)->to_symbol() ? (*i)->as_symbol()->sym() : NULL; - CType iT = compileType(cenv, name, cenv.resolveType(*i)); + const CType iT = ((*i)->to_symbol()) + ? compileType(cenv, (*i)->str(), cenv.resolveType(*i)) + : compileType(cenv, (*i)->as_tuple()->fst()->str(), *i); THROW_IF(!iT, Cursor(), string("non-concrete parameter :: ") + (*i)->str()); cprot.push_back((Type*)iT); } @@ -432,7 +458,7 @@ LLVMEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc assert(prot->size() == argsT->size()); assert(prot->size() == f->num_args()); for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p, ++pT) { - const AST* t = cenv.resolveType(*pT); + const AST* t = *pT;//cenv.resolveType(*pT); // THROW_IF(!llType(t), (*p)->loc, "untyped parameter\n"); cenv.def((*p)->as_symbol(), *p, t, &*a); } diff --git a/src/resp.hpp b/src/resp.hpp index f4689a0..d56b5ae 100644 --- a/src/resp.hpp +++ b/src/resp.hpp @@ -613,6 +613,7 @@ struct TEnv : public Env { , List(penv.sym("List")) , Empty(penv.sym("Empty")) , Tup(penv.sym("Tup")) + , Expr(penv.sym("Expr")) , U(penv.sym("U")) { Object::pool.addRoot(Fn); @@ -661,6 +662,7 @@ struct TEnv : public Env { ASymbol* List; ASymbol* Empty; ASymbol* Tup; + ASymbol* Expr; ASymbol* U; }; @@ -699,7 +701,7 @@ struct Engine { virtual CVal compileLiteral(CEnv& cenv, const AST* lit) = 0; virtual CVal compilePrimitive(CEnv& cenv, const ATuple* prim) = 0; virtual CVal compileString(CEnv& cenv, const char* str) = 0; - virtual CType compileType(CEnv& cenv, const char* name, const AST* exp) = 0; + virtual CType compileType(CEnv& cenv, const std::string& name, const AST* exp) = 0; virtual void writeModule(CEnv& cenv, std::ostream& os) = 0; diff --git a/src/simplify.cpp b/src/simplify.cpp index 921c6e6..d8d23f2 100644 --- a/src/simplify.cpp +++ b/src/simplify.cpp @@ -172,6 +172,9 @@ simplify_let(CEnv& cenv, Code& code, const ATuple* call) throw() return copy; } +static inline const AST* +quote(CEnv& cenv, const AST* ast); + static inline const AST* simplify_list_elem(CEnv& cenv, const ATuple* node, const AST* type) { @@ -187,30 +190,29 @@ simplify_list_elem(CEnv& cenv, const ATuple* node, const AST* type) const AST* const rst = simplify_list_elem(cenv, node->rst(), type); assert(node->fst()); assert(rst); - List cons(node->loc, cenv.tenv.Tup, fst, rst, 0); - cenv.setType(fst, tup(Cursor(), cenv.penv.sym("Expr"), 0)); + List cons(node->loc, cenv.tenv.List, fst, rst, 0); + cenv.setType(fst, tup(Cursor(), cenv.tenv.Expr, 0)); cenv.setType(cons, type); return cons; } +static inline const AST* +quote(CEnv& cenv, const AST* ast) +{ + if (ast->tag() == T_TUPLE) { + const ATuple* const list = ast->as_tuple(); + return simplify_list_elem(cenv, list, tup(Cursor(), cenv.tenv.Expr, 0)); + } else { + const AST* cons = tup(Cursor(), cenv.type(ast), ast, 0); + cenv.setType(cons, tup(Cursor(), cenv.tenv.Expr, 0)); + return cons; + } +} + static const AST* simplify_quote(CEnv& cenv, Code& code, const ATuple* call) throw() { - switch (call->frst()->tag()) { - case T_SYMBOL: - // Symbols remain quoted so they are not interpreted as variables - return call; - case T_TUPLE: { - // Lists are transformed into nested conses - const ATuple* const list = call->frst()->as_tuple(); - return simplify_list_elem(cenv, list, - tup(Cursor(), cenv.tenv.Tup, cenv.penv.sym("Expr"), 0)); - } - default: - // Other literals (e.g. numbers, strings) are self-evaluating, so the - // quote can be removed, e.g. (quote 3) => 3 - return call->frst(); - } + return quote(cenv, call->frst()); } const AST* -- cgit v1.2.1