From 545b524bda45f2087ac92cf58f6eaa78499332cf Mon Sep 17 00:00:00 2001
From: David Robillard <d@drobilla.net>
Date: Thu, 18 Jun 2009 20:22:10 +0000
Subject: 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
---
 tuplr.cpp | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)

(limited to 'tuplr.cpp')

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                                                                   *
  ***************************************************************************/
@@ -102,6 +120,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>));
-- 
cgit v1.2.1