From 4c5b04a6cac0d43e83aa2dc4f800eab42e908486 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 20 Feb 2014 22:16:35 -0800
Subject: * eval.c (macro_form_p, macroexpand_1, macroexpand): New static
 functions. (eval_init): Registered new functions.

* txr.1: Documented.
---
 ChangeLog |  8 ++++++++
 eval.c    | 42 ++++++++++++++++++++++++++++++++++++++++++
 txr.1     | 40 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 90 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index eca751b1..18b958ca 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2014-02-20  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (macro_form_p, macroexpand_1, macroexpand): New static
+	functions.
+	(eval_init): Registered new functions.
+
+	* txr.1: Documented.
+
 2014-02-20  Kaz Kylheku  <kaz@kylheku.com>
 
 	* parser.y (unquotes_occur): Bugfix: we should not terminate
diff --git a/eval.c b/eval.c
index a1b2365a..7ab1fd63 100644
--- a/eval.c
+++ b/eval.c
@@ -2209,6 +2209,43 @@ tail:
   }
 }
 
+static val macro_form_p(val form)
+{
+  if (!consp(form))
+    return nil;
+  if (!gethash(top_mb, car(form)))
+    return nil;
+  return t;
+}
+
+static val macroexpand_1(val form, val mac_env)
+{
+  val macro;
+
+  mac_env = default_arg(mac_env, make_env(nil, nil, nil));
+
+  if (atom(form)) {
+    return form;
+  } else if ((macro = gethash(top_mb, car(form)))) {
+    val mac_expand = expand_macro(form, macro, mac_env);
+    if (mac_expand == form)
+      return form;
+    rlcp_tree(mac_expand, form);
+    return mac_expand;
+  }
+  return form;
+}
+
+static val macroexpand(val form, val mac_env)
+{
+  for (;;) {
+    val mac_expand = macroexpand_1(form, mac_env);
+    if (mac_expand == form)
+      return form;
+    form = mac_expand;
+  }
+}
+
 val mapcarv(val fun, val list_of_lists)
 {
   if (!cdr(list_of_lists)) {
@@ -2895,6 +2932,11 @@ void eval_init(void)
   reg_fun(intern(lit("lisp-parse"), user_package), func_n2o(lisp_parse, 0));
   reg_fun(intern(lit("read"), user_package), func_n2o(lisp_parse, 0));
   reg_fun(intern(lit("expand"), system_package), func_n1(expand));
+  reg_fun(intern(lit("macro-form-p"), user_package), func_n1(macro_form_p));
+  reg_fun(intern(lit("macroexpand-1"), user_package),
+          func_n2o(macroexpand_1, 1));
+  reg_fun(intern(lit("macroexpand"), user_package),
+          func_n2o(macroexpand, 1));
   reg_fun(intern(lit("chain"), user_package), func_n0v(chainv));
   reg_fun(intern(lit("andf"), user_package), func_n0v(andv));
   reg_fun(intern(lit("orf"), user_package), func_n0v(orv));
diff --git a/txr.1 b/txr.1
index 90d45953..e5a4ed99 100644
--- a/txr.1
+++ b/txr.1
@@ -12736,6 +12736,46 @@ Examples:
           (let ((,var (car i)))
             ,*body))))
 
+.SS Function macro-form-p
+
+.TP
+Syntax:
+
+  (macro-form-p <obj>)
+
+.TP
+Description:
+
+The macro-form-p function returns t if <obj> represents the syntax of
+a form which is a macro form. Otherwise it returns nil.
+
+A macro form will transform under macroexpand-1 or macroexpand; an object
+which isn't a macro form will not undergo expansion.
+
+.SS Functions macroexpand-1 and macroexpand
+
+.TP
+Syntax:
+
+  (macroexpand-1 <obj>)
+  (macroexpand <obj>)
+
+.TP
+Description:
+
+If <obj> is a macro form (an object for which macro-form-p returns t),
+these functions expand the macro form and return the expanded form.
+Otherwise, they return <obj>.
+
+macroexpand-1 performs a single expansion, expanding just the macro
+that is referenced by the symbol in the first position of <obj>,
+and returns the expansion. That expansion may itself be a macro form.
+
+macroexpand performs an expansion, like macroexpand-1. If the result is
+a macro form, then it expands that form, and keeps repeating this process
+until the expansion yields a non-macro-form. That non-macro-form is then
+returned.
+
 .SS Operator tree-bind
 
 .TP
-- 
cgit v1.2.3