aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDavid Robillard <d@drobilla.net>2012-12-15 07:06:22 +0000
committerDavid Robillard <d@drobilla.net>2012-12-15 07:06:22 +0000
commit10174ffc7ea08b7845dbe409a11811e820536468 (patch)
treec74187d11b7f35c739045e7000d2fa505ac9499a
parent8148e755d3f587e6c212ba90efc151ea07de2703 (diff)
downloadresp-10174ffc7ea08b7845dbe409a11811e820536468.tar.gz
resp-10174ffc7ea08b7845dbe409a11811e820536468.tar.bz2
resp-10174ffc7ea08b7845dbe409a11811e820536468.zip
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
-rw-r--r--src/c.cpp4
-rw-r--r--src/compile.cpp18
-rw-r--r--src/constrain.cpp8
-rw-r--r--src/llvm.cpp50
-rw-r--r--src/resp.hpp4
-rw-r--r--src/simplify.cpp36
-rw-r--r--test/quote.resp25
-rw-r--r--wscript3
8 files changed, 105 insertions, 43 deletions
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<CVal> 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<Type*> 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 vector<C
CVal
LLVMEngine::compileCast(CEnv& cenv, CVal v, const AST* t)
{
- return builder.CreateBitCast(llVal(v), (Type*)compileType(cenv, NULL, t), "cast");
+ const ATuple* tup = t->to_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<Type*> 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<const AST*> {
, 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<const AST*> {
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
@@ -173,6 +173,9 @@ simplify_let(CEnv& cenv, Code& code, const ATuple* call) throw()
}
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)
{
if (!node) {
@@ -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*
diff --git a/test/quote.resp b/test/quote.resp
new file mode 100644
index 0000000..741a7a7
--- /dev/null
+++ b/test/quote.resp
@@ -0,0 +1,25 @@
+(def-type (Expr)
+ (Symbol Symbol)
+ (Int Int)
+ (List Expr Expr)
+ (Empty))
+
+
+(def l (quote (2 3)))
+
+(match l
+ (Symbol s)
+ 0
+
+ (Int i)
+ 1
+
+ (List h t)
+ 2
+
+ (Empty)
+ 3)
+
+;(def (car l)
+;(. l 0)
+;l
diff --git a/wscript b/wscript
index c5ee607..52e2a99 100644
--- a/wscript
+++ b/wscript
@@ -116,3 +116,6 @@ def test(ctx):
# Algebraic data types
run_test('./test/match.resp', '12.0000 : Float')
+
+ # Quoting
+ run_test('./test/quote.resp', '2 : Int')