Primitive internal macro system (for implementing sugar).

(def (f x) ...) sugar.


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

1 files changed, 49 insertions, 0 deletions

diff --git a/tuplr.cpp b/tuplr.cpp
index 6e0571e..c13b9bc 100644
--- a/tuplr.cpp
+++ b/tuplr.cpp
@@ -28,6 +28,24 @@ using boost::format;
 
 Funcs AConsCall::funcs;
 
+template<typename Atom>
+ostream&
+operator<<(ostream& out, const Exp<Atom>& exp)
+{
+	switch (exp.type) {
+	case Exp<Atom>::ATOM:
+		out << exp.atom;
+		break;
+	case Exp<Atom>::LIST:
+		out << "(";
+		for (size_t i = 0; i != exp.size(); ++i)
+			out << exp.at(i) << ((i != exp.size() - 1) ? " " : "");
+		out << ")";
+		break;
+	}
+	return out;
+}
+
 /***************************************************************************
  * Lexer                                                                   *
  ***************************************************************************/
@@ -103,6 +121,34 @@ readExpression(Cursor& cur, istream& in)
 
 
 /***************************************************************************
+ * Macro Functions                                                         *
+ ***************************************************************************/
+
+inline SExp
+macDef(PEnv& penv, const SExp& exp)
+{
+	if (exp.size() != 3) throw Error("`def' requires exactly 2 arguments", exp.loc);
+	if (exp.at(1).type == SExp::ATOM) {
+		return exp;
+	} else {
+		// (def (f x) y) => (def f (fn (x) y))
+		SExp argsExp(exp.loc);
+		for (size_t i = 1; i < exp.at(1).size(); ++i)
+			argsExp.push_back(exp.at(1).at(i));
+		SExp fnExp(exp.at(2).loc);
+		fnExp.push_back(SExp(exp.at(2).loc, "fn"));
+		fnExp.push_back(argsExp);
+		fnExp.push_back(exp.at(2));
+		SExp ret(exp.loc);
+		ret.push_back(exp.at(0));
+		ret.push_back(exp.at(1).at(0));
+		ret.push_back(fnExp);
+		return ret;
+	}
+}
+
+
+/***************************************************************************
  * Parser Functions                                                        *
  ***************************************************************************/
 
@@ -153,6 +199,9 @@ initLang(PEnv& penv, TEnv& tenv)
 	penv.reg(false, "#t", PEnv::Handler(parseLiteral<bool>, &trueVal));
 	penv.reg(false, "#f", PEnv::Handler(parseLiteral<bool>, &falseVal));
 
+	// Macros
+	penv.defmac("def",  macDef);
+
 	// Special forms
 	penv.reg(true, "fn",   PEnv::Handler(parseFn));
 	penv.reg(true, "if",   PEnv::Handler(parseCall<AIf>));