From a7e747b45b0ff3f9e106182e6a357d0b261255a5 Mon Sep 17 00:00:00 2001 From: David Robillard Date: Sat, 7 Mar 2009 00:24:05 +0000 Subject: Fancy error reporting for type errors, among other things. git-svn-id: http://svn.drobilla.net/resp/tuplr@66 ad02d1e2-f140-0410-9f75-f8b11f17cedd --- llvm.cpp | 31 +++++++++++++++++------------- tuplr.cpp | 36 +++++++++++++++++------------------ tuplr.hpp | 64 ++++++++++++++++++++++++++++++++++---------------------------- typing.cpp | 34 +++++++++++++++++---------------- 4 files changed, 89 insertions(+), 76 deletions(-) diff --git a/llvm.cpp b/llvm.cpp index b981d7d..a0ec539 100644 --- a/llvm.cpp +++ b/llvm.cpp @@ -190,12 +190,17 @@ compileFunction(CEnv& cenv, const std::string& name, const Type* retT, const AST * AST Code Generation * ***************************************************************************/ +void +ASTSymbol::lift(CEnv& cenv) +{ + if (!cenv.code.ref(this)) + throw Error((string("undefined symbol `") + cppstr + "'").c_str(), loc); +} + CValue ASTSymbol::compile(CEnv& cenv) { - AST** c = cenv.code.ref(this); - if (!c) throw Error((string("undefined symbol `") + cppstr + "'").c_str(), loc); - return cenv.compile(*c); + return cenv.compile(*cenv.code.ref(this)); } void @@ -356,14 +361,14 @@ ASTPrimitive::compile(CEnv& cenv) // Binary arithmetic operations Instruction::BinaryOps op = (Instruction::BinaryOps)0; - if (n == "+") op = Instruction::Add; - if (n == "-") op = Instruction::Sub; - if (n == "*") op = Instruction::Mul; - if (n == "&") op = Instruction::And; - if (n == "|") op = Instruction::Or; - if (n == "^") op = Instruction::Xor; - if (n == "/") op = isInt ? Instruction::SDiv : Instruction::FDiv; - if (n == "%") op = isInt ? Instruction::SRem : Instruction::FRem; + if (n == "+") op = Instruction::Add; + if (n == "-") op = Instruction::Sub; + if (n == "*") op = Instruction::Mul; + if (n == "and") op = Instruction::And; + if (n == "or") op = Instruction::Or; + if (n == "xor") op = Instruction::Xor; + if (n == "/") op = isInt ? Instruction::SDiv : Instruction::FDiv; + if (n == "%") op = isInt ? Instruction::SRem : Instruction::FRem; if (op != 0) { Value* val = cenv.engine.builder.CreateBinOp(op, a, b); for (size_t i = 3; i < size(); ++i) @@ -394,8 +399,8 @@ ASTConsCall::functionType(CEnv& cenv) { ASTTuple* protTypes = new ASTTuple(cenv.tenv.type(at(1)), cenv.tenv.type(at(2)), NULL); AType* cellType = new AType(ASTTuple(cenv.penv.sym("Pair"), - cenv.tenv.type(at(1)), cenv.tenv.type(at(2)), NULL)); - return new AType(ASTTuple(cenv.penv.sym("Fn"), protTypes, cellType, NULL)); + cenv.tenv.type(at(1)), cenv.tenv.type(at(2)), NULL), Cursor()); + return new AType(ASTTuple(cenv.penv.sym("Fn"), protTypes, cellType, NULL), loc); } void diff --git a/tuplr.cpp b/tuplr.cpp index 0200a36..22632ef 100644 --- a/tuplr.cpp +++ b/tuplr.cpp @@ -101,14 +101,14 @@ void initLang(PEnv& penv, TEnv& tenv) { // Types - tenv.def(penv.sym("Bool"), new AType(penv.sym("Bool"))); - tenv.def(penv.sym("Int"), new AType(penv.sym("Int"))); - tenv.def(penv.sym("Float"), new AType(penv.sym("Float"))); + tenv.def(penv.sym("Bool"), new AType(penv.sym("Bool"), Cursor())); + tenv.def(penv.sym("Int"), new AType(penv.sym("Int"), Cursor())); + tenv.def(penv.sym("Float"), new AType(penv.sym("Float"), Cursor())); // Literals static bool trueVal = true; static bool falseVal = false; - penv.reg(false, "#t", PEnv::Handler(parseLiteral, &trueVal)); + penv.reg(false, "#t", PEnv::Handler(parseLiteral, &trueVal)); penv.reg(false, "#f", PEnv::Handler(parseLiteral, &falseVal)); // Special forms @@ -120,20 +120,20 @@ initLang(PEnv& penv, TEnv& tenv) penv.reg(true, "cdr", PEnv::Handler(parseCall)); // Numeric primitives - penv.reg(true, "+", PEnv::Handler(parseCall)); - penv.reg(true, "-", PEnv::Handler(parseCall)); - penv.reg(true, "*", PEnv::Handler(parseCall)); - penv.reg(true, "/", PEnv::Handler(parseCall)); - penv.reg(true, "%", PEnv::Handler(parseCall)); - penv.reg(true, "&", PEnv::Handler(parseCall)); - penv.reg(true, "|", PEnv::Handler(parseCall)); - penv.reg(true, "^", PEnv::Handler(parseCall)); - penv.reg(true, "=", PEnv::Handler(parseCall)); - penv.reg(true, "!=", PEnv::Handler(parseCall)); - penv.reg(true, ">", PEnv::Handler(parseCall)); - penv.reg(true, ">=", PEnv::Handler(parseCall)); - penv.reg(true, "<", PEnv::Handler(parseCall)); - penv.reg(true, "<=", PEnv::Handler(parseCall)); + penv.reg(true, "+", PEnv::Handler(parseCall)); + penv.reg(true, "-", PEnv::Handler(parseCall)); + penv.reg(true, "*", PEnv::Handler(parseCall)); + penv.reg(true, "/", PEnv::Handler(parseCall)); + penv.reg(true, "%", PEnv::Handler(parseCall)); + penv.reg(true, "and", PEnv::Handler(parseCall)); + penv.reg(true, "or", PEnv::Handler(parseCall)); + penv.reg(true, "xor", PEnv::Handler(parseCall)); + penv.reg(true, "=", PEnv::Handler(parseCall)); + penv.reg(true, "!=", PEnv::Handler(parseCall)); + penv.reg(true, ">", PEnv::Handler(parseCall)); + penv.reg(true, ">=", PEnv::Handler(parseCall)); + penv.reg(true, "<", PEnv::Handler(parseCall)); + penv.reg(true, "<=", PEnv::Handler(parseCall)); } diff --git a/tuplr.hpp b/tuplr.hpp index 489868a..985bf2f 100644 --- a/tuplr.hpp +++ b/tuplr.hpp @@ -32,16 +32,6 @@ using namespace std; using boost::format; -/*************************************************************************** - * Backend * - ***************************************************************************/ - -typedef void* CValue; ///< Compiled value (opaque) -typedef void* CFunction; ///< Compiled function (opaque) - -struct CEngine; ///< Backend data (opaque) - - /*************************************************************************** * Basic Utility Classes * ***************************************************************************/ @@ -51,6 +41,7 @@ extern std::ostream& out; struct Cursor { Cursor(const string& n="", unsigned l=1, unsigned c=0) : name(n), line(l), col(c) {} + operator bool() const { return !(line == 1 && col == 0); } string str() const { return (format("%1%:%2%:%3%") % name % line % col).str(); } string name; unsigned line; @@ -59,7 +50,7 @@ struct Cursor { struct Error { Error(const string& m, Cursor c=Cursor()) : msg(m), loc(c) {} - const string what() const throw() { return loc.str() + ": error: " + msg; } + const string what() const throw() { return (loc ? loc.str() + ": " : "") + "error: " + msg; } string msg; Cursor loc; }; @@ -85,6 +76,15 @@ typedef Exp SExp; ///< Textual S-Expression SExp readExpression(Cursor& cur, std::istream& in); +/*************************************************************************** + * Backend * + ***************************************************************************/ + +typedef void* CValue; ///< Compiled value (opaque) +typedef void* CFunction; ///< Compiled function (opaque) +struct CEngine; ///< Backend data (opaque) + + /*************************************************************************** * Abstract Syntax Tree * ***************************************************************************/ @@ -94,6 +94,7 @@ struct CEnv; ///< Compile-Time Environment /// Base class for all AST nodes struct AST { + AST(Cursor c=Cursor()) : loc(c) {} virtual ~AST() {} virtual string str() const = 0; virtual bool operator==(const AST& o) const = 0; @@ -101,12 +102,13 @@ struct AST { virtual void constrain(TEnv& tenv) const {} virtual void lift(CEnv& cenv) {} virtual CValue compile(CEnv& cenv) = 0; + Cursor loc; }; /// Literal value template struct ASTLiteral : public AST { - ASTLiteral(VT v) : val(v) {} + ASTLiteral(VT v, Cursor c) : AST(c), val(v) {} bool operator==(const AST& rhs) const { const ASTLiteral* r = dynamic_cast*>(&rhs); return (r && (val == r->val)); @@ -121,17 +123,17 @@ struct ASTLiteral : public AST { struct ASTSymbol : public AST { bool operator==(const AST& rhs) const { return this == &rhs; } string str() const { return cppstr; } + void lift(CEnv& cenv); CValue compile(CEnv& cenv); private: friend class PEnv; - ASTSymbol(const string& s, Cursor c=Cursor()) : loc(c), cppstr(s) {} - Cursor loc; + ASTSymbol(const string& s, Cursor c) : AST(c), cppstr(s) {} const string cppstr; }; /// Tuple (heterogeneous sequence of fixed length), e.g. "(a b c)" struct ASTTuple : public AST, public vector { - ASTTuple(const vector& t=vector()) : vector(t) {} + ASTTuple(const vector& t=vector(), Cursor c=Cursor()) : AST(c), vector(t) {} ASTTuple(size_t size) : vector(size) {} ASTTuple(AST* ast, ...) { push_back(ast); @@ -144,7 +146,7 @@ struct ASTTuple : public AST, public vector { string str() const { string ret = "("; for (size_t i = 0; i != size(); ++i) - ret += at(i)->str() + ((i != size() - 1) ? " " : ""); + ret += (at(i) ? at(i)->str() : "NULL") + ((i != size() - 1) ? " " : ""); return ret + ")"; } bool operator==(const AST& rhs) const { @@ -173,9 +175,9 @@ struct ASTTuple : public AST, public vector { /// Type Expression, e.g. "Int", "(Fn (Int Int) Float)" struct AType : public ASTTuple { - AType(unsigned i) : kind(VAR), id(i) {} - AType(ASTSymbol* s) : kind(PRIM), id(0) { push_back(s); } - AType(const ASTTuple& t) : ASTTuple(t), kind(EXPR), id(0) {} + AType(unsigned i, Cursor c) : kind(VAR), id(i) {} + AType(ASTSymbol* s, Cursor c) : kind(PRIM), id(0) { push_back(s); } + AType(const ASTTuple& t, Cursor c) : ASTTuple(t), kind(EXPR), id(0) {} string str() const { switch (kind) { case VAR: return (format("?%1%") % id).str(); @@ -243,7 +245,7 @@ private: /// Function call/application, e.g. "(func arg1 arg2)" struct ASTCall : public ASTTuple { - ASTCall(const SExp& e, const ASTTuple& t) : ASTTuple(t), exp(e) {} + ASTCall(const SExp& e, const ASTTuple& t) : ASTTuple(t, e.loc), exp(e) {} void constrain(TEnv& tenv) const; void lift(CEnv& cenv); CValue compile(CEnv& cenv); @@ -301,7 +303,7 @@ struct ASTCdrCall : public ASTCall { * Parser - S-Expressions (SExp) -> AST Nodes (AST) * ***************************************************************************/ -// Parse Time Environment (symbol table) +/// Parse Time Environment (symbol table) struct PEnv : private map { typedef AST* (*PF)(PEnv&, const SExp&, void*); // Parse Function struct Handler { Handler(PF f, void* a=0) : func(f), arg(a) {} PF func; void* arg; }; @@ -349,9 +351,9 @@ parseExpression(PEnv& penv, const SExp& exp) return new ASTCall(exp, pmap(penv, exp.list)); // Parse as regular call } else if (isdigit(exp.atom[0])) { if (exp.atom.find('.') == string::npos) - return new ASTLiteral(strtol(exp.atom.c_str(), NULL, 10)); + return new ASTLiteral(strtol(exp.atom.c_str(), NULL, 10), exp.loc); else - return new ASTLiteral(strtod(exp.atom.c_str(), NULL)); + return new ASTLiteral(strtod(exp.atom.c_str(), NULL), exp.loc); } else { const PEnv::Handler* handler = penv.handler(false, exp.atom); if (handler) // Dispatch to atom parse function @@ -371,7 +373,7 @@ template inline AST* parseLiteral(PEnv& penv, const SExp& exp, void* arg) { - return new ASTLiteral(*reinterpret_cast(arg)); + return new ASTLiteral(*reinterpret_cast(arg), exp.loc); } inline AST* @@ -379,7 +381,7 @@ parseFn(PEnv& penv, const SExp& exp, void* arg) { SExp::List::const_iterator a = exp.list.begin(); ++a; return new ASTClosure( - new ASTTuple(pmap(penv, (*a++).list)), + new ASTTuple(pmap(penv, a->list), (*a++).loc), parseExpression(penv, *a++)); } @@ -421,18 +423,22 @@ struct TSubst : public map { /// Type-Time Environment struct TEnv : public Env { TEnv(PEnv& p) : penv(p), varID(1) {} - typedef list< pair > Constraints; - AType* var() { return new AType(varID++); } + struct Constraint : public pair { + Constraint(AType* a, AType* b, Cursor c=Cursor()) : pair(a, b), loc(c) {} + Cursor loc; + }; + typedef list Constraints; + AType* var(Cursor c) { return new AType(varID++, c); } AType* type(const AST* ast) { AType** t = ref(ast); - return t ? *t : def(ast, var()); + return t ? *t : def(ast, var(ast->loc)); } AType* named(const string& name) { return *ref(penv.sym(name)); } void constrain(const AST* o, AType* t) { assert(!dynamic_cast(o)); - constraints.push_back(make_pair(type(o), t)); + constraints.push_back(Constraint(type(o), t, o->loc)); } void solve() { apply(unify(constraints)); } void apply(const TSubst& substs); diff --git a/typing.cpp b/typing.cpp index 071e582..389edf0 100644 --- a/typing.cpp +++ b/typing.cpp @@ -17,7 +17,6 @@ #include "tuplr.hpp" - /*************************************************************************** * AST Type Contraints * ***************************************************************************/ @@ -25,7 +24,7 @@ void ASTTuple::constrain(TEnv& tenv) const { - AType* t = new AType(ASTTuple()); + AType* t = new AType(ASTTuple(), loc); FOREACH(const_iterator, p, *this) { (*p)->constrain(tenv); t->push_back(tenv.type(*p)); @@ -41,7 +40,7 @@ ASTClosure::constrain(TEnv& tenv) const AType* protT = tenv.type(at(1)); AType* bodyT = tenv.type(at(2)); tenv.constrain(this, new AType(ASTTuple( - tenv.penv.sym("Fn"), protT, bodyT, 0))); + tenv.penv.sym("Fn"), protT, bodyT, 0), loc)); } void @@ -50,11 +49,11 @@ ASTCall::constrain(TEnv& tenv) const FOREACH(const_iterator, p, *this) (*p)->constrain(tenv); AType* retT = tenv.type(this); - AType* argsT = new AType(ASTTuple()); + AType* argsT = new AType(ASTTuple(), loc); for (size_t i = 1; i < size(); ++i) argsT->push_back(tenv.type(at(i))); tenv.constrain(at(0), new AType(ASTTuple( - tenv.penv.sym("Fn"), argsT, retT, NULL))); + tenv.penv.sym("Fn"), argsT, retT, NULL), loc)); } void @@ -91,7 +90,7 @@ ASTPrimitive::constrain(TEnv& tenv) const type = ARITHMETIC; else if (n == "%") type = BINARY; - else if (n == "&" || n == "|" || n == "^") + else if (n == "and" || n == "or" || n == "xor") type = BITWISE; else if (n == "=" || n == "!=" || n == ">" || n == ">=" || n == "<" || n == "<=") type = COMPARISON; @@ -106,13 +105,13 @@ ASTPrimitive::constrain(TEnv& tenv) const if (size() < 3) throw Error((format("`%1%' requires at least 2 arguments") % n).str(), exp.loc); for (size_t i = 1; i < size(); ++i) - tenv.constrain(this, tenv.type(at(i))); + tenv.constrain(at(i), tenv.type(this)); break; case BINARY: if (size() != 3) throw Error((format("`%1%' requires exactly 2 arguments") % n).str(), exp.loc); - tenv.constrain(this, tenv.type(at(1))); - tenv.constrain(this, tenv.type(at(2))); + tenv.constrain(at(1), tenv.type(this)); + tenv.constrain(at(2), tenv.type(this)); break; case BITWISE: if (size() != 3) @@ -127,13 +126,15 @@ ASTPrimitive::constrain(TEnv& tenv) const tenv.constrain(this, tenv.named("Bool")); tenv.constrain(at(1), tenv.type(at(2))); break; + default: + throw Error((format("unknown primitive `%1%'") % n).str(), exp.loc); } } void ASTConsCall::constrain(TEnv& tenv) const { - AType* t = new AType(ASTTuple(tenv.penv.sym("Pair"), 0)); + AType* t = new AType(ASTTuple(tenv.penv.sym("Pair"), 0), loc); for (size_t i = 1; i < size(); ++i) { at(i)->constrain(tenv); t->push_back(tenv.type(at(i))); @@ -145,8 +146,8 @@ void ASTCarCall::constrain(TEnv& tenv) const { at(1)->constrain(tenv); - AType* ct = tenv.var(); - AType* tt = new AType(ASTTuple(tenv.penv.sym("Pair"), ct, tenv.var(), 0)); + AType* ct = tenv.var(loc); + AType* tt = new AType(ASTTuple(tenv.penv.sym("Pair"), ct, tenv.var(at(2)->loc), 0), loc); tenv.constrain(at(1), tt); tenv.constrain(this, ct); } @@ -155,8 +156,8 @@ void ASTCdrCall::constrain(TEnv& tenv) const { at(1)->constrain(tenv); - AType* ct = tenv.var(); - AType* tt = new AType(ASTTuple(tenv.penv.sym("Pair"), tenv.var(), ct, 0)); + AType* ct = tenv.var(loc); + AType* tt = new AType(ASTTuple(tenv.penv.sym("Pair"), tenv.var(at(1)->loc), ct, 0), loc); tenv.constrain(at(1), tt); tenv.constrain(this, ct); } @@ -227,11 +228,12 @@ TEnv::unify(const Constraints& constraints) // TAPL 22.4 AType* si = dynamic_cast(s->at(i)); AType* ti = dynamic_cast(t->at(i)); if (si && ti) - cp.push_back(make_pair(si, ti)); + cp.push_back(Constraint(si, ti, si->loc)); } return unify(cp); } else { - throw Error("Type unification failed"); + throw Error((format("type is `%1%' but should be `%2%'") % s->str() % t->str()).str(), + constraints.begin()->loc); } } -- cgit v1.2.1