From b6bc968944cde401be703371f75d3059cbccaae5 Mon Sep 17 00:00:00 2001 From: David Robillard Date: Thu, 5 Mar 2009 22:21:32 +0000 Subject: Less parser specialmagic cruft. git-svn-id: http://svn.drobilla.net/resp/tuplr@49 ad02d1e2-f140-0410-9f75-f8b11f17cedd --- fac.tpr | 5 ++-- tuplr.cpp | 85 +++++++++++++++++++++++---------------------------------------- 2 files changed, 34 insertions(+), 56 deletions(-) diff --git a/fac.tpr b/fac.tpr index 076a02c..77e4776 100644 --- a/fac.tpr +++ b/fac.tpr @@ -1,6 +1,7 @@ ; Factorial (def fac (fn (n) - (if (= 0 n) 1 - (* n (fac (- n 1)))))) + (if (= 0 n) 1 + (* n (fac (- n 1)))))) (fac 5) + diff --git a/tuplr.cpp b/tuplr.cpp index e3e439f..4403922 100644 --- a/tuplr.cpp +++ b/tuplr.cpp @@ -60,14 +60,14 @@ struct Error { Cursor loc; }; -template +template struct Exp { // ::= Atom | (Exp*) - Exp(Cursor c) : type(LIST), loc(c) {} - Exp(Cursor c, const A& a) : type(ATOM), loc(c), atom(a) {} - typedef std::vector< Exp > List; + Exp(Cursor c) : type(LIST), loc(c) {} + Exp(Cursor c, const Atom& a) : type(ATOM), loc(c), atom(a) {} + typedef std::vector< Exp > List; enum { ATOM, LIST } type; Cursor loc; - A atom; + Atom atom; List list; }; @@ -142,11 +142,13 @@ readExpression(Cursor& cur, std::istream& in) struct TEnv; ///< Type-Time Environment struct CEnv; ///< Compile-Time Environment +/// Constructor user data argument (LLVM opcode) +struct CArg { CArg(int o=0, int a=0) : op(o), arg(a) {} int op; int arg; }; + /// Base class for all AST nodes struct AST { virtual ~AST() {} virtual bool contains(AST* child) const { return false; } - virtual bool operator!=(const AST& o) const { return !operator==(o); } virtual bool operator==(const AST& o) const = 0; virtual string str() const = 0; virtual void constrain(TEnv& tenv) const {} @@ -321,7 +323,7 @@ struct ASTCall : public ASTTuple { /// Definition special form, e.g. "(def x 2)" struct ASTDefinition : public ASTCall { - ASTDefinition(const SExp& e, const ASTTuple& t) : ASTCall(e, t) {} + ASTDefinition(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {} void constrain(TEnv& tenv) const; void lift(CEnv& cenv); Value* compile(CEnv& cenv); @@ -329,14 +331,15 @@ struct ASTDefinition : public ASTCall { /// Conditional special form, e.g. "(if cond thenexp elseexp)" struct ASTIf : public ASTCall { - ASTIf(const SExp& e, const ASTTuple& t) : ASTCall(e, t) {} + ASTIf(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {} void constrain(TEnv& tenv) const; Value* compile(CEnv& cenv); }; /// Primitive (builtin arithmetic function), e.g. "(+ 2 3)" struct ASTPrimitive : public ASTCall { - ASTPrimitive(const SExp& e, const ASTTuple& t, int o, int a=0) : ASTCall(e, t), op(o), arg(a) {} + ASTPrimitive(const SExp& e, const ASTTuple& t, CArg ca=CArg()) + : ASTCall(e, t), op(ca.op), arg(ca.arg) {} void constrain(TEnv& tenv) const; Value* compile(CEnv& cenv); unsigned op; @@ -345,7 +348,7 @@ struct ASTPrimitive : public ASTCall { /// Cons special form, e.g. "(cons 1 2)" struct ASTConsCall : public ASTCall { - ASTConsCall(const SExp& e, const ASTTuple& t) : ASTCall(e, t) {} + ASTConsCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {} AType* functionType(CEnv& cenv); void constrain(TEnv& tenv) const; void lift(CEnv& cenv); @@ -357,14 +360,14 @@ Funcs ASTConsCall::funcs; /// Car special form, e.g. "(car p)" struct ASTCarCall : public ASTCall { - ASTCarCall(const SExp& e, const ASTTuple& t) : ASTCall(e, t) {} + ASTCarCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {} void constrain(TEnv& tenv) const; Value* compile(CEnv& cenv); }; /// Cdr special form, e.g. "(cdr p)" struct ASTCdrCall : public ASTCall { - ASTCdrCall(const SExp& e, const ASTTuple& t) : ASTCall(e, t) {} + ASTCdrCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {} void constrain(TEnv& tenv) const; Value* compile(CEnv& cenv); }; @@ -374,15 +377,10 @@ struct ASTCdrCall : public ASTCall { * Parser - S-Expressions (SExp) -> AST Nodes (AST) * ***************************************************************************/ -/// LLVM Operation -struct Op { Op(int o=0, int a=0) : op(o), arg(a) {} int op; int arg; }; - -typedef Op UD; // User Data argument for parse functions - // Parse Time Environment (symbol table) struct PEnv : private map { - typedef AST* (*PF)(PEnv&, const SExp&, UD); // Parse Function - struct Parser { Parser(PF f, UD d) : pf(f), ud(d) {} PF pf; UD ud; }; + 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 parsers; void reg(const string& s, const Parser& p) { parsers.insert(make_pair(sym(s)->str(), p)); @@ -420,7 +418,7 @@ parseExpression(PEnv& penv, const SExp& exp) if (exp.list.front().type == SExp::ATOM) { const PEnv::Parser* handler = penv.parser(exp.list.front().atom); if (handler) // Dispatch to parse function - return handler->pf(penv, exp, handler->ud); + return handler->func(penv, exp, handler->arg); } return new ASTCall(exp, pmap(penv, exp.list)); // Parse as regular call } else if (isdigit(exp.atom[0])) { @@ -436,22 +434,15 @@ parseExpression(PEnv& penv, const SExp& exp) return penv.sym(exp.atom, exp.loc); } -// Special forms - -static AST* -parseIf(PEnv& penv, const SExp& exp, UD) - { return new ASTIf(exp, pmap(penv, exp.list)); } - -static AST* -parseDef(PEnv& penv, const SExp& exp, UD) - { return new ASTDefinition(exp, pmap(penv, exp.list)); } - +template static AST* -parsePrim(PEnv& penv, const SExp& exp, UD data) - { return new ASTPrimitive(exp, pmap(penv, exp.list), data.op, data.arg); } +parseAST(PEnv& penv, const SExp& exp, CArg arg=CArg()) +{ + return new C(exp, pmap(penv, exp.list), arg); +} static AST* -parseFn(PEnv& penv, const SExp& exp, UD) +parseFn(PEnv& penv, const SExp& exp, CArg arg) { SExp::List::const_iterator a = exp.list.begin(); ++a; return new ASTClosure( @@ -459,18 +450,6 @@ parseFn(PEnv& penv, const SExp& exp, UD) parseExpression(penv, *a++)); } -static AST* -parseCons(PEnv& penv, const SExp& exp, UD) - { return new ASTConsCall(exp, pmap(penv, exp.list)); } - -static AST* -parseCar(PEnv& penv, const SExp& exp, UD) - { return new ASTCarCall(exp, pmap(penv, exp.list)); } - -static AST* -parseCdr(PEnv& penv, const SExp& exp, UD) - { return new ASTCdrCall(exp, pmap(penv, exp.list)); } - /*************************************************************************** * Generic Lexical Environment * @@ -700,8 +679,6 @@ TEnv::unify(const Constraints& constraints) // TAPL 22.4 AType* s = constraints.begin()->first; AType* t = constraints.begin()->second; Constraints cp = constraints; - //FOREACH(Constraints::const_iterator, c, cp) - // out << c->first->str() << " : " << c->second->str() << endl; cp.erase(cp.begin()); if (*s == *t) { @@ -1243,14 +1220,14 @@ repl(CEnv& cenv, ExecutionEngine* engine) int main(int argc, char** argv) { -#define PRIM(O, A) PEnv::Parser(parsePrim, Op(Instruction:: O, A)) +#define PRIM(O, A) PEnv::Parser(parseAST, CArg(Instruction:: O, A)) PEnv penv; - penv.reg("fn", PEnv::Parser(parseFn, Op())); - penv.reg("if", PEnv::Parser(parseIf, Op())); - penv.reg("def", PEnv::Parser(parseDef, Op())); - penv.reg("cons", PEnv::Parser(parseCons, Op())); - penv.reg("car", PEnv::Parser(parseCar, Op())); - penv.reg("cdr", PEnv::Parser(parseCdr, Op())); + penv.reg("fn", PEnv::Parser(parseFn)); + penv.reg("if", PEnv::Parser(parseAST)); + penv.reg("def", PEnv::Parser(parseAST)); + penv.reg("cons", PEnv::Parser(parseAST)); + penv.reg("car", PEnv::Parser(parseAST)); + penv.reg("cdr", PEnv::Parser(parseAST)); penv.reg("+", PRIM(Add, 0)); penv.reg("-", PRIM(Sub, 0)); penv.reg("*", PRIM(Mul, 0)); -- cgit v1.2.1