From 50ee2fff4dbb46612d3c4308f6e705ae5b4a9958 Mon Sep 17 00:00:00 2001
From: Doug Evans <xdje42@gmail.com>
Date: Thu, 20 Aug 2009 05:33:14 +0000
Subject: [PATCH] 	New builtin .pmacro?. 	* pmacros.scm
 (-pmacro-builtin-pmacro?): New function. 	(pmacros-init!): Add .pmacro?.
 	* doc/pmacros.text: Document .pmacro?. 	* testsuite/pmacros-1.test:
 Test .pmacro?.

---
 ChangeLog                |  6 ++++++
 doc/pmacros.texi         | 28 ++++++++++++++++++++++++++++
 pmacros.scm              |  8 ++++++++
 testsuite/pmacros-1.test | 10 ++++++++++
 4 files changed, 52 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index 52c792c..650cdaf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2009-08-19  Doug Evans  <dje@sebabeach.org>
 
+	New builtin .pmacro?.
+	* pmacros.scm (-pmacro-builtin-pmacro?): New function.
+	(pmacros-init!): Add .pmacro?.
+	* doc/pmacros.text: Document .pmacro?.
+	* testsuite/pmacros-1.test: Test .pmacro?.
+
 	* pmacros.scm (scan-list1): Reorganize tracing so that the tracing
 	of a pmacro begins before its arguments are evaluated, improves
 	readability.
diff --git a/doc/pmacros.texi b/doc/pmacros.texi
index d7bb923..12a5586 100644
--- a/doc/pmacros.texi
+++ b/doc/pmacros.texi
@@ -837,6 +837,7 @@ Pmacros for working with pmacros.
 * Passing pmacros as arguments::     Passing a pmacro to another pmacro
 * Defining a block of locals::       The @code{.let}, @code{.let*} builtins
 * A block of statements::            The @code{.begin} builtin
+* Testing if something is a pmacro:: The @code{.pmacro?} builtin
 @end menu
 
 @node Re-evaluating an expression
@@ -1057,6 +1058,33 @@ Syntax: @samp{(.begin [expr1 [expr2 ...]])}
 Each expression is evaluated in turn and the result is the result
 of the last expression.
 
+@node Testing if something is a pmacro
+@subsection Testing if something is a pmacro
+@cindex .pmacro?
+
+Sometimes one wishes to know if an argument is a pmacro or not.
+This is useful when one is writing a pmacro that has a parameter
+that is either a pmacro or is not (e.g., it could be an rtl function
+instead).  When the parameter is a pmacro one might like to @samp{.apply}
+it to another argument, and if not one might like to simply construct
+a list of it and the other argument.
+
+Syntax: @samp{(.pmacro? arg)}
+
+Example:
+
+@smallexample
+(define-pmacro (compare a b) (if (eq a b) 1 0))
+(define-pmacro (maybe-apply fun args)
+  (.if (.pmacro? fun)
+       (.apply fun args)
+       (.splice fun (.unsplice args))))
+(define-pmacro (gen-semantics semfun args)
+  (set dest (maybe-apply semfun args)))
+(gen-semantics add (op1 op2))) ;; ==> (set dest (add op1 op2))
+(gen-semantics compare (op1 op2))) ;; ==> (set dest (if (eq op1 op2) 1 0))
+@end smallexample
+
 @node Debugging utilities
 @section Debugging utilities
 
diff --git a/pmacros.scm b/pmacros.scm
index a45d867..c90bdd2 100644
--- a/pmacros.scm
+++ b/pmacros.scm
@@ -71,6 +71,7 @@
 ; (.exec expr)                        - execute expr immediately
 ; (.apply pmacro-name arg)
 ; (.pmacro (arg-list) expansion)      - akin go lambda in Scheme
+; (.pmacro? arg)
 ; (.let (var-list) expr1 . expr-rest) - akin to let in Scheme
 ; (.let* (var-list) expr1 . expr-rest) - akin to let* in Scheme
 ; (.if expr then [else])
@@ -856,6 +857,12 @@
 		(-pmacro-build-lambda loc env params expansion) "")
 )
 
+; (.pmacro? arg)
+
+(define (-pmacro-builtin-pmacro? arg)
+  (-pmacro? arg)
+)
+
 ; (.let (var-list) expr1 . expr-rest)
 ; NOTE: syntactic form
 
@@ -1330,6 +1337,7 @@
 	  (list '.exec '(expr) #f -pmacro-builtin-exec "execute expr immediately")
 	  (list '.apply '(pmacro arg-list) #f -pmacro-builtin-apply "apply a pmacro to a list of arguments")
 	  (list '.pmacro '(params expansion) #t -pmacro-builtin-pmacro "create a pmacro on-the-fly")
+	  (list '.pmacro? '(arg) #f -pmacro-builtin-pmacro? "return true if arg is a pmacro")
 	  (list '.let '(locals expr1 . rest) #t -pmacro-builtin-let "create a binding context, let-style")
 	  (list '.let* '(locals expr1 . rest) #t -pmacro-builtin-let* "create a binding context, let*-style")
 	  (list '.if '(expr then . else) #t -pmacro-builtin-if "if expr is true, process then, else else")
diff --git a/testsuite/pmacros-1.test b/testsuite/pmacros-1.test
index 12f4569..e6deaf2 100644
--- a/testsuite/pmacros-1.test
+++ b/testsuite/pmacros-1.test
@@ -100,6 +100,16 @@ cat > ${cpu_file} <<EOF
 (print-match "ABC")
 (print-expr (.apply .upcase (abc)))
 
+(test-name ".pmacro?")
+(print-match "#t")
+(print-expr (.pmacro? .pmacro?))
+(print-match "#t")
+(print-expr (.pmacro? test-name))
+(print-match "#t")
+(print-expr (.pmacro? (.pmacro (a) (add a 1))))
+(print-match "#f")
+(print-expr (.pmacro? 42))
+
 (test-name ".eval")
 (print-match "(explicitly-undefined 42)")
 (define-pmacro (eval-test1 a) (explicitly-undefined a))
-- 
2.43.5