Add -T option to type-check and pretty-print with type annotations.

Rename -p to -P (all 'stage' options, i.e. -P -T -S are uppercase for consistency).
Clean up main program.
Decent pretty printing.


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

4 files changed, 184 insertions, 182 deletions

diff --git a/src/pprint.cpp b/src/pprint.cpp
index 28df1cc..7a463cc 100644
--- a/src/pprint.cpp
+++ b/src/pprint.cpp
@@ -22,7 +22,41 @@
 #include "resp.hpp"
 
 ostream&
-operator<<(ostream& out, const AST* ast)
+print_to(ostream& out, const AST* ast, unsigned indent, CEnv* cenv, bool types);
+
+static void
+newline(ostream& out, unsigned indent)
+{
+	out << endl;
+	for (unsigned i = 0; i < indent; ++i)
+		out << " ";
+}
+
+void
+print_tuple(ostream& out, const ATuple* tup, ATuple::const_iterator i,
+            unsigned indent, bool newlines, CEnv* cenv, bool types, bool elem_types)
+{
+	for (; i != tup->end(); ) {
+		ATuple::const_iterator next = i;
+		++next;
+		
+		print_to(out, *i, newlines ? indent + 2 : indent, cenv, types);
+		if (elem_types)
+			out << " :" << cenv->tsubst.apply(cenv->tenv.var(*i));
+
+		if (next != tup->end()) {
+			if (newlines)
+				newline(out, indent + 2);
+			else
+				out << " ";
+		}
+		
+		i = next;
+	}
+}
+	
+ostream&
+print_to(ostream& out, const AST* ast, unsigned indent, CEnv* cenv, bool types)
 {
 	const ALexeme* lexeme = ast->to<const ALexeme*>();
 	if (lexeme)
@@ -62,122 +96,76 @@ operator<<(ostream& out, const AST* ast)
 	const ATuple* tup = ast->to<const ATuple*>();
 	if (tup) {
 		out << "(";
-		for (ATuple::const_iterator i = tup->begin(); i != tup->end(); ) {
-			ATuple::const_iterator next = i;
-			++next;
-			out << (*i) << ((next != tup->end()) ? " " : "");
-			i = next;
+		ATuple::const_iterator i = tup->begin();
+		const ASymbol* head = (i == tup->end()) ? NULL : (*i)->to<const ASymbol*>();
+		if (head) {
+			if (head == cenv->penv.sym("def")) {
+				out << (*i++) << " ";
+
+				// Print symbol (possibly with type annotation)
+				const AST* sym = *i++;
+				out << sym;
+				if (types)
+					out << " :" << cenv->tsubst.apply(cenv->tenv.var(sym));
+
+				// Print value on following lines, indented
+				newline(out, indent + 2);
+				print_tuple(out, tup, i, indent, true, cenv, types, false);
+				return out << ")";
+				
+			} else if (head == cenv->penv.sym("fn")) {
+				out << (*i++) << " ";
+				const ATuple* pat = (*i++)->as<const ATuple*>();
+
+				// Print prototype (possibly with parameter type annotations)
+				out << "(";
+				print_tuple(out, pat, pat->begin(), indent, false, cenv, types, types);
+				out << ")";
+
+				// Print body expression(s) on following lines, indented
+				newline(out, indent + 2);
+				print_tuple(out, tup, i, indent + 2, true, cenv, types, false);
+				return out << ")";
+
+			} else if (head == cenv->penv.sym("if")) {
+				out << (*i++) << " ";
+
+				// Print each condition and consequent pair separated by blank lines
+				for (; i != tup->end(); ) {
+					ATuple::const_iterator next = i;
+					++next;
+		
+					print_to(out, *i, indent + 2, cenv, types);
+					if (next != tup->end()) {
+						newline(out, indent + 2);
+						print_to(out, *next++, indent + 2, cenv, types);
+						newline(out, 0);
+						newline(out, indent + 2);
+					}
+
+					i = next;
+				}
+			}
 		}
+
+		// Print plain tuple
+		print_tuple(out, tup, i, indent + 1, false, cenv, types, false);
 		return out << ")";
 	}
 
 	return out << "?";
 }
 
-enum TupleStyle {
-	STYLE_ONE_LINE, // Entire tuple printed on one line
-	STYLE_ALIGN, // Align all elements aligned after opening '('
-	STYLE_CALL // Call with all arguments aligned after head
-};
-
-static bool
-can_one_line(const AST* ast, const unsigned max_width, unsigned& width, unsigned& depth)
-{
-	static const unsigned MAX_DEPTH = 3;
-
-	ostringstream ss;
-	ss << ast;
-	if ((width += ss.str().length()) >= max_width)
-		return false;
-
-	const ATuple* tup = ast->to<const ATuple*>();
-	if (tup) {
-		if (++depth >= MAX_DEPTH)
-			return false;
-
-		for (ATuple::const_iterator i = tup->begin(); i != tup->end(); ++i) {
-			ostringstream ss;
-			ss << *i;
-			width += ss.str().length();
-			if (!can_one_line(*i, max_width, width, depth))
-				return false;
-		}
-	}
-
-	return true;
-}
-	
-static TupleStyle
-tuple_style(const ATuple* tup, const unsigned max_width, unsigned& indent)
-{
-	unsigned depth = 0;
-	unsigned width = indent;
-	if (can_one_line(tup, max_width, width, depth))
-		return STYLE_ONE_LINE;
-
-	if (tup->to<const ADef*>() || tup->to<const AFn*>()) {
-		indent += 2;
-		return STYLE_CALL;
-	}
-	
-	if (tup->to<const ACall*>()) {
-		indent += tup->head()->str().length() + 1;
-		return STYLE_CALL;
-	}
-
-	return STYLE_ALIGN;
-}
-
-static void
-newline(ostream& out, unsigned indent)
-{
-	out << endl;
-	for (unsigned i = 0; i < indent; ++i)
-		out << " ";
-}
-	
-void
-pprint_internal(ostream& out, const AST* ast, unsigned indent)
+ostream&
+operator<<(ostream& out, const AST* ast)
 {
-	const ATuple* tup = ast->to<const ATuple*>();
-	if (tup) {
-		out << "(";
-		unsigned               child_indent = indent + 1;
-		ATuple::const_iterator i            = tup->begin();
-		if (i != tup->end()) {
-			const TupleStyle style = tuple_style(tup, 80, child_indent);
-			pprint_internal(out, *i++, indent + 1); // Print head
-			switch (style) {
-			case STYLE_ONE_LINE:
-				while (i != tup->end())
-					out << " " << *i++;
-				break;
-			case STYLE_ALIGN:
-				while (i != tup->end()) {
-					newline(out, indent + 1);
-					pprint_internal(out, *i++, child_indent);
-				}
-				break;
-			case STYLE_CALL:
-				out << " ";
-				pprint_internal(out, *i, child_indent); // Print first argument
-				while (++i != tup->end()) {
-					newline(out, child_indent);
-					pprint_internal(out, *i, child_indent);
-				}
-				break;
-			}
-		}
-		out << ")";
-	} else {
-		out << ast;
-	}
+	return print_to(out, ast, 0, NULL, false);
 }
 
 /// Pretty-print @a ast to @a out
 void
-pprint(ostream& out, const AST* ast)
+pprint(ostream& out, const AST* ast, CEnv* cenv, bool types)
 {
-	pprint_internal(out, ast, 0);
+	print_to(out, ast, 0, cenv, types);
 	out << endl;
 }
diff --git a/src/repl.cpp b/src/repl.cpp
index 0264c18..c2a50f5 100644
--- a/src/repl.cpp
+++ b/src/repl.cpp
@@ -44,6 +44,8 @@ readParseType(CEnv& cenv, Cursor& cursor, istream& is, AST*& exp, AST*& ast)
 	Constraints c(cenv.tsubst);
 	ast->constrain(cenv.tenv, c); // Constrain types
 
+	//cout << "(CONSTRAINTS " << endl << c << ")" << endl;
+	
 	const Subst subst = unify(c); // Solve type constraints
 	for (Subst::const_iterator i = subst.begin(); i != subst.end(); ++i) {
 		if (!cenv.tsubst.contains(i->first)) { // Substitution's LHS is a new variable
@@ -53,8 +55,8 @@ readParseType(CEnv& cenv, Cursor& cursor, istream& is, AST*& exp, AST*& ast)
 		}
 	}
 
-	//cout << "**** SUBST\n" << subst << "********" << endl;
-	//cout << "**** CENV.SUBST\n" << cenv.tsubst << "********" << endl;
+	//cout << "(SUBST " << endl << subst << ")" << endl;
+	//cout << "(TSUBST " << endl << cenv.tsubst << ")" << endl;
 	//cenv.tsubst = Subst::compose(cenv.tsubst, subst);
 
 	Object::pool.addRoot(ast); // Make parsed expression a GC root so it is not deleted
@@ -77,18 +79,21 @@ callPrintCollect(CEnv& cenv, CFunc f, AST* result, const AType* resultT, bool ex
 
 /// Compile and evaluate code from @a is
 int
-eval(CEnv& cenv, const string& name, istream& is, bool execute)
+eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute)
 {
-	AST*         exp  = NULL;
-	AST*         ast  = NULL;
+	AST*       exp = NULL;
+	AST*       ast = NULL;
 	list<AST*> parsed;
-	Cursor cursor(name);
 	try {
 		while (readParseType(cenv, cursor, is, exp, ast))
 			parsed.push_back(ast);
 
-		/*for (list<AST*>::const_iterator i = parsed.begin(); i != parsed.end(); ++i)
-			pprint(cout, (*i)->cps(cenv.tenv, cenv.penv.sym("halt")));*/
+		
+		if (cenv.args.find("-T") != cenv.args.end()) {
+			for (list<AST*>::const_iterator i = parsed.begin(); i != parsed.end(); ++i)
+				pprint(cout, (*i), &cenv, true);
+			return 0;
+		}
 
 		CVal  val = NULL;
 		CFunc f   = NULL;
diff --git a/src/resp.cpp b/src/resp.cpp
index 1f2c5c3..4da92e3 100644
--- a/src/resp.cpp
+++ b/src/resp.cpp
@@ -35,15 +35,16 @@ print_usage(char* name, bool error)
 	os << "Usage: " << name << " [OPTION]... [FILE]..."  << endl;
 	os << "Evaluate and/or compile Resp code"           << endl;
 	os << endl;
-	os << "  -h               Display this help and exit"                << endl;
-	os << "  -r               Enter REPL after evaluating files"         << endl;
-	os << "  -p               Pretty-print input only"                   << endl;
-	os << "  -b BACKEND       Use backend (llvm or c)"                   << endl;
-	os << "  -g               Debug (disable optimisation)"              << endl;
-	os << "  -d               Dump generated code during compilation"    << endl;
-	os << "  -S               Stop after compilation (output assembler)" << endl;
-	os << "  -e EXPRESSION    Evaluate EXPRESSION"                       << endl;
-	os << "  -o FILE          Compile output to FILE (don't run)"        << endl;
+	os << "  -h               Display this help and exit"                 << endl;
+	os << "  -r               Enter REPL after evaluating files"          << endl;
+	os << "  -b BACKEND       Use backend (llvm or c)"                    << endl;
+	os << "  -g               Debug (disable optimisation)"               << endl;
+	os << "  -d               Dump generated code during compilation"     << endl;
+	os << "  -P               Parse and pretty-print only"                << endl;
+	os << "  -T               Type check and annotate only"               << endl;
+	os << "  -S               Compile to assembly only (do not evaluate)" << endl;
+	os << "  -e EXPRESSION    Evaluate EXPRESSION"                        << endl;
+	os << "  -o FILE          Compile output to FILE (don't run)"         << endl;
 	return error ? 1 : 0;
 }
 
@@ -59,10 +60,11 @@ main(int argc, char** argv)
 		} else if (argv[i][0] != '-') {
 			files.push_back(argv[i]);
 		} else if (!strncmp(argv[i], "-r", 3)
-				|| !strncmp(argv[i], "-p", 3)
-				|| !strncmp(argv[i], "-g", 3)
-				|| !strncmp(argv[i], "-d", 3)
-				|| !strncmp(argv[i], "-S", 3)) {
+		           || !strncmp(argv[i], "-g", 3)
+		           || !strncmp(argv[i], "-d", 3)
+		           || !strncmp(argv[i], "-P", 3)
+		           || !strncmp(argv[i], "-T", 3)
+		           || !strncmp(argv[i], "-S", 3)) {
 			args.insert(make_pair(argv[i], ""));
 		} else if (i == argc-1 || argv[i+1][0] == '-') {
 			return print_usage(argv[0], true);
@@ -99,58 +101,67 @@ main(int argc, char** argv)
 	int ret = 0;
 
 	a = args.find("-o");
-	bool batch = a != args.end();
-	const string output = (a != args.end()) ? a->second : "";
-
-	if (args.find("-p") != args.end()) {
-		ifstream is(files.front().c_str());
-		if (is.good()) {
-			Cursor loc;
-			AST* exp = readExpression(loc, is);
-			AST* ast = penv.parse(exp);
-			pprint(cout, ast);
-		}
-		delete cenv;
-		return 0;
-	}
-
-	a = args.find("-e");
-	if (a != args.end()) {
-		istringstream is(a->second);
-		ret = eval(*cenv, "(command line)", is, !batch);
-	}
-
-	for (list<string>::iterator f = files.begin(); f != files.end(); ++f) {
-		ifstream is(f->c_str());
-		if (is.good()) {
-			ret = ret | eval(*cenv, *f, is, !batch);
-		} else {
-			cerr << argv[0] << ": " << *f << ": " << strerror(errno) << endl;
-			++ret;
-		}
-		is.close();
-	}
-
-	if (args.find("-r") != args.end() || (files.empty() && args.find("-e") == args.end()))
-		ret = repl(*cenv);
+	const bool batch  = (a != args.end());
+	string     output = batch ? a->second : "";
 
-	if (cenv->args.find("-S") != cenv->args.end() || cenv->args.find("-d") != cenv->args.end()) {
+	if (args.find("-P") != args.end()) { // Pretty-print input
 		ofstream fs;
 		if (output != "")
 			fs.open(output.c_str());
 
-		ostream& os = (output != "") ? fs : cout;
-
-		if (os.good()) {
-			cenv->engine()->writeModule(*cenv, os);
-		} else {
-			cerr << argv[0] << ": " << a->second << ": " << strerror(errno) << endl;
-			++ret;
+		ostream& os = (output == "") ? std::cout : fs;
+		for (list<string>::iterator f = files.begin(); f != files.end(); ++f) {
+			ifstream is(f->c_str());
+			try {
+				while (is.good() && !is.eof()) {
+					Cursor loc(*f);
+					AST* exp = readExpression(loc, is);
+					AST* ast = penv.parse(exp);
+					pprint(os, ast, cenv, false);
+					is.ignore(std::numeric_limits<std::streamsize>::max(), '\n'); // Skip newlines
+				}
+			} catch (Error e) {
+			}
+			is.close();
+		}
+		ret = 0;
+		
+	} else if (args.find("-e") != args.end()) { // Evaluate argument as expression
+		if (files.size() > 0) {
+			std::cerr << "Illegal options: both -e and files given" << std::endl;
+			delete cenv;
+			delete engine;
+			return print_usage(argv[0], true);
+		}
+		
+		std::istringstream is(a->second);
+		Cursor cursor("(command line)");
+		ret = eval(*cenv, cursor, is, !batch);
+		
+	} else if (files.size() == 0) { // Neither -e nor files given, run repl
+		ret = repl(*cenv);
+		
+	} else { // Evalute (or just type check if -T, or just compile if -S all files
+		for (list<string>::iterator f = files.begin(); f != files.end(); ++f) {
+			const string& filename = *f;
+			if (!batch)
+				output = filename + ".out";
+		
+			ifstream is(f->c_str());
+			if (is.good()) {
+				Cursor cursor(*f);
+				ret = ret | eval(*cenv, cursor, is, !batch);
+			} else {
+				cerr << argv[0] << ": " << *f << ": " << strerror(errno) << endl;
+				++ret;
+			}
+			is.close();
 		}
-		if (output != "")
-			fs.close();
 	}
 
+	if (args.find("-r") != args.end()) // Run REPL after evaluations
+		ret = repl(*cenv);
+
 	delete cenv;
 	delete engine;
 
diff --git a/src/resp.hpp b/src/resp.hpp
index a972d48..3f73f2f 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -647,10 +647,6 @@ struct TEnv : public Env<const ASymbol*, const AType*> {
 		if (!ast)
 			return new AType(Cursor(), varID++);
 
-		const ASymbol* sym = ast->to<const ASymbol*>();
-		if (sym)
-			return *ref(sym);
-
 		Vars::iterator v = vars.find(ast);
 		if (v != vars.end())
 			return v->second;
@@ -730,18 +726,20 @@ struct CEnv {
 	void    lock(const AST* ast) {
 		Object::pool.addRoot(ast);
 		if (type(ast))
-				Object::pool.addRoot(type(ast));
+			Object::pool.addRoot(type(ast));
 	}
 	const AType* type(const AST* ast, const Subst& subst = Subst()) const {
+		const AType*   ret = NULL;
 		const ASymbol* sym = ast->to<const ASymbol*>();
 		if (sym) {
 			const AType** rec = tenv.ref(sym);
-			return rec ? *rec : NULL;
-		}
-		const AType* var = tenv.vars[ast];
-		if (var) {
-			return tsubst.apply(subst.apply(var))->to<const AType*>();
+			if (rec)
+				ret = *rec;
 		}
+		if (!ret)
+			ret = tenv.vars[ast];
+		if (ret)
+			return tsubst.apply(subst.apply(ret))->to<const AType*>();
 		return NULL;
 	}
 	void def(const ASymbol* sym, const AST* c, const AType* t, CVal v) {
@@ -814,9 +812,9 @@ private:
  * EVAL/REPL/MAIN                                                          *
  ***************************************************************************/
 
-void pprint(std::ostream& out, const AST* ast);
+void pprint(std::ostream& out, const AST* ast, CEnv* cenv, bool types);
 void initLang(PEnv& penv, TEnv& tenv);
-int  eval(CEnv& cenv, const string& name, istream& is, bool execute);
+int  eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute);
 int  repl(CEnv& cenv);
 
 #endif // RESP_HPP