aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--tuplr.hpp58
-rw-r--r--tuplr_llvm.cpp86
2 files changed, 83 insertions, 61 deletions
diff --git a/tuplr.hpp b/tuplr.hpp
index d769982..ba4f9a9 100644
--- a/tuplr.hpp
+++ b/tuplr.hpp
@@ -31,6 +31,7 @@ typedef const void* CType; ///< Compiled type (opaque)
typedef void* CFunction; ///< Compiled function (opaque)
struct CEngine; ///< Backend data (opaque)
+struct CArg; ///< Parser function argument (opaque)
#define FOREACH(IT, i, c) for (IT i = (c).begin(); i != (c).end(); ++i)
@@ -55,8 +56,6 @@ struct Error {
Cursor loc;
};
-struct CArg { CArg(int o=0, int a=0) : op(o), arg(a) {} int op; int arg; };
-
template<typename Atom>
struct Exp { // ::= Atom | (Exp*)
Exp(Cursor c) : type(LIST), loc(c) {}
@@ -245,7 +244,7 @@ struct ASTCall : public ASTTuple {
/// Definition special form, e.g. "(def x 2)"
struct ASTDefinition : public ASTCall {
- ASTDefinition(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+ ASTDefinition(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t) {}
void constrain(TEnv& tenv) const;
void lift(CEnv& cenv);
CValue compile(CEnv& cenv);
@@ -253,22 +252,22 @@ struct ASTDefinition : public ASTCall {
/// Conditional special form, e.g. "(if cond thenexp elseexp)"
struct ASTIf : public ASTCall {
- ASTIf(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+ ASTIf(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t) {}
void constrain(TEnv& tenv) const;
CValue compile(CEnv& cenv);
};
/// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
struct ASTPrimitive : public ASTCall {
- ASTPrimitive(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t), arg(ca) {}
+ ASTPrimitive(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t), arg(ca) {}
void constrain(TEnv& tenv) const;
CValue compile(CEnv& cenv);
- CArg arg;
+ CArg* arg;
};
/// Cons special form, e.g. "(cons 1 2)"
struct ASTConsCall : public ASTCall {
- ASTConsCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+ ASTConsCall(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t) {}
AType* functionType(CEnv& cenv);
void constrain(TEnv& tenv) const;
void lift(CEnv& cenv);
@@ -278,14 +277,14 @@ struct ASTConsCall : public ASTCall {
/// Car special form, e.g. "(car p)"
struct ASTCarCall : public ASTCall {
- ASTCarCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+ ASTCarCall(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t) {}
void constrain(TEnv& tenv) const;
CValue compile(CEnv& cenv);
};
/// Cdr special form, e.g. "(cdr p)"
struct ASTCdrCall : public ASTCall {
- ASTCdrCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+ ASTCdrCall(const SExp& e, const ASTTuple& t, CArg* ca=0) : ASTCall(e, t) {}
void constrain(TEnv& tenv) const;
CValue compile(CEnv& cenv);
};
@@ -297,15 +296,17 @@ struct ASTCdrCall : public ASTCall {
// Parse Time Environment (symbol table)
struct PEnv : private map<const string, ASTSymbol*> {
- typedef AST* (*PF)(PEnv&, const SExp&, CArg); // Parse Function
- struct Parser { Parser(PF f, CArg a=CArg()) : func(f), arg(a) {} PF func; CArg arg; };
- map<string, Parser> parsers;
- void reg(const string& s, const Parser& p) {
- parsers.insert(make_pair(sym(s)->str(), p));
+ typedef AST* (*PF)(PEnv&, const SExp&, CArg*); // Parse Function
+ struct Handler { Handler(PF f, CArg* a=0) : func(f), arg(a) {} PF func; CArg* arg; };
+ map<const string, Handler> aHandlers; ///< Atom parse functions
+ map<const string, Handler> lHandlers; ///< List parse functions
+ void reg(bool list, const string& s, const Handler& h) {
+ (list ? lHandlers : aHandlers).insert(make_pair(sym(s)->str(), h));
}
- const Parser* parser(const string& s) const {
- map<string, Parser>::const_iterator i = parsers.find(s);
- return (i != parsers.end()) ? &i->second : NULL;
+ const Handler* handler(bool list, const string& s) const {
+ const map<const string, Handler>& handlers = list ? lHandlers : aHandlers;
+ map<string, Handler>::const_iterator i = handlers.find(s);
+ return (i != handlers.end()) ? &i->second : NULL;
}
ASTSymbol* sym(const string& s, Cursor c=Cursor()) {
const const_iterator i = find(s);
@@ -334,8 +335,8 @@ parseExpression(PEnv& penv, const SExp& exp)
if (exp.type == SExp::LIST) {
if (exp.list.empty()) throw Error("call to empty list", exp.loc);
if (exp.list.front().type == SExp::ATOM) {
- const PEnv::Parser* handler = penv.parser(exp.list.front().atom);
- if (handler) // Dispatch to parse function
+ const PEnv::Handler* handler = penv.handler(true, exp.list.front().atom);
+ if (handler) // Dispatch to list parse function
return handler->func(penv, exp, handler->arg);
}
return new ASTCall(exp, pmap(penv, exp.list)); // Parse as regular call
@@ -344,23 +345,30 @@ parseExpression(PEnv& penv, const SExp& exp)
return new ASTLiteral<int32_t>(strtol(exp.atom.c_str(), NULL, 10));
else
return new ASTLiteral<float>(strtod(exp.atom.c_str(), NULL));
- } else if (exp.atom == "true") {
- return new ASTLiteral<bool>(true);
- } else if (exp.atom == "false") {
- return new ASTLiteral<bool>(false);
+ } else {
+ const PEnv::Handler* handler = penv.handler(false, exp.atom);
+ if (handler) // Dispatch to atom parse function
+ return handler->func(penv, exp, handler->arg);
}
return penv.sym(exp.atom, exp.loc);
}
template<typename C>
inline AST*
-parseAST(PEnv& penv, const SExp& exp, CArg arg=CArg())
+parseCall(PEnv& penv, const SExp& exp, CArg* arg)
{
return new C(exp, pmap(penv, exp.list), arg);
}
+template<typename T>
+inline AST*
+parseLiteral(PEnv& penv, const SExp& exp, CArg* arg)
+{
+ return new ASTLiteral<T>(*reinterpret_cast<T*>(arg));
+}
+
inline AST*
-parseFn(PEnv& penv, const SExp& exp, CArg arg)
+parseFn(PEnv& penv, const SExp& exp, CArg* arg)
{
SExp::List::const_iterator a = exp.list.begin(); ++a;
return new ASTClosure(
diff --git a/tuplr_llvm.cpp b/tuplr_llvm.cpp
index 8d1f1db..3c5ee17 100644
--- a/tuplr_llvm.cpp
+++ b/tuplr_llvm.cpp
@@ -40,6 +40,12 @@ struct CEngine {
llvm::IRBuilder<> builder;
};
+struct CArg {
+ CArg(int o=0, int a=0) : op(o), arg(a) {}
+ int op;
+ int arg;
+};
+
using namespace llvm;
using namespace std;
using boost::format;
@@ -76,13 +82,13 @@ ASTPrimitive::constrain(TEnv& tenv) const
{
FOREACH(const_iterator, p, *this)
(*p)->constrain(tenv);
- if (OP_IS_A(arg.op, Instruction::BinaryOps)) {
+ if (OP_IS_A(arg->op, Instruction::BinaryOps)) {
if (size() <= 2) throw Error((format("`%1%' requires at least 2 arguments")
% at(0)->str()).str(), exp.loc);
AType* tvar = tenv.type(this);
for (size_t i = 1; i < size(); ++i)
tenv.constrain(at(i), tvar);
- } else if (arg.op == Instruction::ICmp) {
+ } else if (arg->op == Instruction::ICmp) {
if (size() != 3) throw Error((format("`%1%' requires exactly 2 arguments")
% at(0)->str()).str(), exp.loc);
tenv.constrain(at(1), tenv.type(at(2)));
@@ -362,30 +368,30 @@ ASTPrimitive::compile(CEnv& cenv)
Value* a = LLVal(cenv.compile(at(1)));
Value* b = LLVal(cenv.compile(at(2)));
- if (OP_IS_A(arg.op, Instruction::BinaryOps)) {
- const Instruction::BinaryOps bo = (Instruction::BinaryOps)arg.op;
+ if (OP_IS_A(arg->op, Instruction::BinaryOps)) {
+ const Instruction::BinaryOps bo = (Instruction::BinaryOps)arg->op;
if (size() == 2)
return cenv.compile(at(1));
Value* val = cenv.engine.builder.CreateBinOp(bo, a, b);
for (size_t i = 3; i < size(); ++i)
val = cenv.engine.builder.CreateBinOp(bo, val, LLVal(cenv.compile(at(i))));
return val;
- } else if (arg.op == Instruction::ICmp) {
+ } else if (arg->op == Instruction::ICmp) {
bool isInt = cenv.tenv.type(at(1))->str() == "Int";
if (isInt) {
- return cenv.engine.builder.CreateICmp((CmpInst::Predicate)arg.arg, a, b);
+ return cenv.engine.builder.CreateICmp((CmpInst::Predicate)arg->arg, a, b);
} else {
// Translate to floating point operation
- switch (arg.arg) {
- case CmpInst::ICMP_EQ: arg.arg = CmpInst::FCMP_OEQ; break;
- case CmpInst::ICMP_NE: arg.arg = CmpInst::FCMP_ONE; break;
- case CmpInst::ICMP_SGT: arg.arg = CmpInst::FCMP_OGT; break;
- case CmpInst::ICMP_SGE: arg.arg = CmpInst::FCMP_OGE; break;
- case CmpInst::ICMP_SLT: arg.arg = CmpInst::FCMP_OLT; break;
- case CmpInst::ICMP_SLE: arg.arg = CmpInst::FCMP_OLE; break;
+ switch (arg->arg) {
+ case CmpInst::ICMP_EQ: arg->arg = CmpInst::FCMP_OEQ; break;
+ case CmpInst::ICMP_NE: arg->arg = CmpInst::FCMP_ONE; break;
+ case CmpInst::ICMP_SGT: arg->arg = CmpInst::FCMP_OGT; break;
+ case CmpInst::ICMP_SGE: arg->arg = CmpInst::FCMP_OGE; break;
+ case CmpInst::ICMP_SLT: arg->arg = CmpInst::FCMP_OLT; break;
+ case CmpInst::ICMP_SLE: arg->arg = CmpInst::FCMP_OLE; break;
default: throw Error("Unknown primitive", exp.loc);
}
- return cenv.engine.builder.CreateFCmp((CmpInst::Predicate)arg.arg, a, b);
+ return cenv.engine.builder.CreateFCmp((CmpInst::Predicate)arg->arg, a, b);
}
}
throw Error("Unknown primitive", exp.loc);
@@ -598,31 +604,39 @@ repl(CEnv& cenv)
int
main(int argc, char** argv)
{
-#define PRIM(O, A) PEnv::Parser(parseAST<ASTPrimitive>, CArg(Instruction:: O, A))
PEnv penv;
- penv.reg("fn", PEnv::Parser(parseFn));
- penv.reg("if", PEnv::Parser(parseAST<ASTIf>));
- penv.reg("def", PEnv::Parser(parseAST<ASTDefinition>));
- penv.reg("cons", PEnv::Parser(parseAST<ASTConsCall>));
- penv.reg("car", PEnv::Parser(parseAST<ASTCarCall>));
- penv.reg("cdr", PEnv::Parser(parseAST<ASTCdrCall>));
- 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));
+ penv.reg(true, "fn", PEnv::Handler(parseFn));
+ penv.reg(true, "if", PEnv::Handler(parseCall<ASTIf>));
+ penv.reg(true, "def", PEnv::Handler(parseCall<ASTDefinition>));
+ penv.reg(true, "cons", PEnv::Handler(parseCall<ASTConsCall>));
+ penv.reg(true, "car", PEnv::Handler(parseCall<ASTCarCall>));
+ penv.reg(true, "cdr", PEnv::Handler(parseCall<ASTCdrCall>));
+
+ bool trueVal = true;
+ bool falseVal = false;
+ penv.reg(false, "true", PEnv::Handler(parseLiteral<bool>, (CArg*)&trueVal));
+ penv.reg(false, "false", PEnv::Handler(parseLiteral<bool>, (CArg*)&falseVal));
+
+ map<string, CArg> prims;
+ prims.insert(make_pair("+", CArg(Instruction::Add)));
+ prims.insert(make_pair("-", CArg(Instruction::Sub)));
+ prims.insert(make_pair("*", CArg(Instruction::Mul)));
+ prims.insert(make_pair("/", CArg(Instruction::FDiv)));
+ prims.insert(make_pair("%", CArg(Instruction::FRem)));
+ prims.insert(make_pair("&", CArg(Instruction::And)));
+ prims.insert(make_pair("|", CArg(Instruction::Or)));
+ prims.insert(make_pair("^", CArg(Instruction::Xor)));
+ prims.insert(make_pair("=", CArg(Instruction::ICmp, CmpInst::ICMP_EQ)));
+ prims.insert(make_pair("!=", CArg(Instruction::ICmp, CmpInst::ICMP_NE)));
+ prims.insert(make_pair(">", CArg(Instruction::ICmp, CmpInst::ICMP_SGT)));
+ prims.insert(make_pair(">=", CArg(Instruction::ICmp, CmpInst::ICMP_SGE)));
+ prims.insert(make_pair("<", CArg(Instruction::ICmp, CmpInst::ICMP_SLT)));
+ prims.insert(make_pair("<=", CArg(Instruction::ICmp, CmpInst::ICMP_SLE)));
+ for (map<string,CArg>::iterator p = prims.begin(); p != prims.end(); ++p)
+ penv.reg(true, p->first, PEnv::Handler(parseCall<ASTPrimitive>, &p->second));
CEngine engine;
- CEnv cenv(penv, engine);
+ CEnv cenv(penv, engine);
cenv.tenv.def(penv.sym("Bool"), new AType(penv.sym("Bool"), Type::Int1Ty));
cenv.tenv.def(penv.sym("Int"), new AType(penv.sym("Int"), Type::Int32Ty));
generated by cgit v1.2.1 (git 2.18.0) at 2024-11-18 19:20:30 +0000