Fancy error reporting for type errors, among other things.

git-svn-id: http://svn.drobilla.net/resp/tuplr@66 ad02d1e2-f140-0410-9f75-f8b11f17cedd

1 files changed, 35 insertions, 29 deletions

diff --git a/tuplr.hpp b/tuplr.hpp
index 489868a..985bf2f 100644
--- a/tuplr.hpp
+++ b/tuplr.hpp
@@ -33,16 +33,6 @@ 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;
 };
@@ -86,6 +77,15 @@ 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<typename VT>
 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<VT>* r = dynamic_cast<const ASTLiteral<VT>*>(&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<AST*> {
-	ASTTuple(const vector<AST*>& t=vector<AST*>()) : vector<AST*>(t) {}
+	ASTTuple(const vector<AST*>& t=vector<AST*>(), Cursor c=Cursor()) : AST(c), vector<AST*>(t) {}
 	ASTTuple(size_t size) : vector<AST*>(size) {}
 	ASTTuple(AST* ast, ...) {
 		push_back(ast);
@@ -144,7 +146,7 @@ struct ASTTuple : public AST, public vector<AST*> {
 	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<AST*> {
 
 /// 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<const string, ASTSymbol*> {
 	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<int32_t>(strtol(exp.atom.c_str(), NULL, 10));
+			return new ASTLiteral<int32_t>(strtol(exp.atom.c_str(), NULL, 10), exp.loc);
 		else
-			return new ASTLiteral<float>(strtod(exp.atom.c_str(), NULL));
+			return new ASTLiteral<float>(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<typename T>
 inline AST*
 parseLiteral(PEnv& penv, const SExp& exp, void* arg)
 {
-	return new ASTLiteral<T>(*reinterpret_cast<T*>(arg));
+	return new ASTLiteral<T>(*reinterpret_cast<T*>(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<AType*, AType*> {
 /// Type-Time Environment
 struct TEnv : public Env<const AST*,AType*> {
 	TEnv(PEnv& p) : penv(p), varID(1) {}
-	typedef list< pair<AType*, AType*> > Constraints;
-	AType* var() { return new AType(varID++); }
+	struct Constraint : public pair<AType*,AType*> {
+		Constraint(AType* a, AType* b, Cursor c=Cursor()) : pair<AType*,AType*>(a, b), loc(c) {}
+		Cursor loc;
+	};
+	typedef list<Constraint> 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<const AType*>(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);