matcher: add :match parameter macro.

With this, we can do matching anywhere we are able to specify
a function parameter list and a body, and we can specify
ordinary arguments, which are inserted to the left of the
implicit match. Plus, it specialy integrates with :key.

* lisplib.c (match_set_entries): Autoload on :match.

* share/txr/stdlib/match.tl (:match): New parameter macro.

* txr.1: Documented.

3 files changed, 252 insertions, 4 deletions

diff --git a/lisplib.c b/lisplib.c
index c0d6ded0..79c7087b 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -878,6 +878,12 @@ static val match_set_entries(val dlt, val fun)
     lit("lambda-match"), lit("defun-match"),
     nil
   };
+  val match_k = intern(lit("match"), keyword_package);
+
+  if (fun)
+    sethash(dlt, match_k, fun);
+  else
+    remhash(dlt, match_k);
 
   set_dlt_entries(dlt, name, fun);
   intern_only(name_noload);
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index e2a55256..8932cc71 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -678,6 +678,19 @@
   (tree-bind (lambda args . body) (expand-lambda-match clauses)
     ^(defun ,name ,args . ,body)))
 
+(define-param-expander :match (params clauses menv form)
+  (unless (proper-list-p params)
+    (compile-error form "~s is incompatible with dotted parameter lists" :match))
+  (when (find : params)
+    (compile-error form "~s is incompatible with optional parameters" :match))
+  (tree-bind (lambda lparams . body) (expand-lambda-match clauses)
+    (let ((dashdash (member '-- params)))
+      (cons (append (ldiff params dashdash)
+                    (butlastn 0 lparams)
+                    dashdash
+                    (nthlast 0 lparams))
+            body))))
+
 (defun non-triv-pat-p (syntax) t)
 
 (defun non-triv-pat-p (syntax)
diff --git a/txr.1 b/txr.1
index 0305ef39..775f02c6 100644
--- a/txr.1
+++ b/txr.1
@@ -36974,11 +36974,17 @@ final parameter list and its accompanying body are then
 taken in place of the original parameter list and
 body.
 
-\*(TL provides a built-in parameter list macro bound to the symbol
+\*(TL provides a two built-in parameter list macros.
+The
 .code :key
-which endows a function keyword parameters. The implementation is
-written entirely using this parameter list macro mechanism, by means
-of the
+parameter macro endows a function keyword parameters.
+The
+.code :match
+parameter macro allows a function to be expressed using pattern matching,
+which requires the body to consist of pattern-matching clauses.
+
+The implementation of both of these macros is written entirely using this
+parameter list macro mechanism, by means of the public
 .code define-param-expander
 macro.
 
@@ -40950,6 +40956,19 @@ can be obtained with the
 operator, using the pattern:
 .codn "(do match @1 ...)" .
 
+Note: the parameter macro
+.code :match
+can also define a
+.code lambda
+with pattern matching. Any
+.code "(lambda-match clauses ...)"
+form can be written as
+.codn "(lambda (:match) clauses ...)" .
+The parameter macro offers the additional ability of defining
+named arguments which are inserted before the implicit arguments
+generated from the clauses, and combining with other parameter
+macros.
+
 .TP* Examples:
 
 .verb
@@ -41007,6 +41026,21 @@ clauses of
 have exactly the same syntax and semantics as those of
 .codn lambda-match .
 
+Note: instead of
+.codn defun-match ,
+the parameter macro
+.code :match
+may be used. The following equivalence holds:
+
+.verb
+  (defun name (:match) ...)  <-->  (defun-match ...)
+.brev
+
+The parameter macro offers the additional ability of defining
+named arguments which are inserted before the implicit arguments
+generated from the clauses, and combining with other parameter
+macros.
+
 .TP* Examples:
 
 .verb
@@ -41034,6 +41068,201 @@ have exactly the same syntax and semantics as those of
   (ack 2 2) -> 7
 .brev
 
+.coNP Parameter list macro @ :match
+.synb
+.mets (:match << left-param * [-- << extra-param *]) << clause *
+.syne
+.desc
+Parameter list macro
+.code :match
+allows any function to be expressed in the style of
+.codn lambda-match ,
+with extra features.
+
+The
+.code :match
+macro expects the body of the function to consists of
+.code lambda-match
+clauses, which are semantically treated in exactly the same manner as
+under
+.codn lambda-match .
+
+The following restrictions apply. The parameter list may not include
+optional parameters delimited by
+.code :
+(colon symbol). The parameter list may not be dotted.
+
+The macro produces a function which the
+.meta left-param
+parameters, if any, are inserted to the left of the implicit parameters
+generated by the
+.code lambda-mach
+transformation.
+
+Furthermore, the
+.code :match
+parameter macro supports integration with the
+.code :key
+parameter macro, or any other macro which uses a compatible
+.code --
+convention for delimiting special arguments.
+If the parameter list includes the symbol
+.code --
+then that portion of the parameter list is set aside and not included in the
+.code lambda-match
+transformation. Then, that list is integrated into the resulting lambda.
+
+A complete transformation can be described by the following diagram:
+
+.verb
+  (lambda (:match a b c ... -- s t u ...) clauses ...)
+
+  -->
+
+  (lambda (a b c ... m n p ... -- s t u ... . z) body ...)
+.brev
+
+In this diagram,
+.code "a b c ..."
+denote the
+.meta left-param
+parameters.
+The
+.code "m n p ..."
+symbols denote the fixed parameters generated by the
+.code lambda-match
+transformation from the semantic analysis of
+.metn clauses .
+The
+.code "s t u ..."
+symbols denote the original
+.meta extra-param
+parameters. Finally,
+.code z
+denotes the dotted parameter generated by the
+.code lambda-match
+transform. If the transform produces no dotted parameter, then this is
+.codn nil .
+The dotted parameter is thus separated from the
+.code "m n p ..."
+group to which it belongs.
+
+When no
+.code --
+and
+.meta extra-params
+are present, the transformation reduces to:
+
+.verb
+  (lambda (:match a b c ...) clauses ...)
+
+  -->
+
+  (lambda (a b c ... m n p ... . z) body ...)
+.brev
+
+Note: these requirements harmonize with the
+.code :key
+parameter macro. If that is present to the left of
+.code :match
+it removes the
+.code --
+and the
+.code "s t u ..."
+keyword parameters, reuniting the
+.code z
+parameter with the
+.code "m n p"
+group. Furthermore, the
+.code :key
+macro generates code which refers to the existing
+.code z
+dotted parameter as the source for the keyword parameters, unless
+.code z
+is
+.codn nil ,
+in which case it inserts its own generated symbol.
+
+.TP* Examples:
+
+.verb
+  ;; Match-style cond-like macro with unreachability diagnosis.
+  ;; Demonstrates usefulness of :match, which allows the :form
+  ;; parameter to be promoted through to the macro definition.
+
+  (defmacro my-cond (:match :form f)
+    (() nil)
+    (((@(and @(constantp) @[eval test val])) . @rest)
+      (when (and val rest)
+        (compile-error f "unreachable code after ~s" test))
+      test)
+    (((@(and @(constantp) @[eval test val]) . @forms) . @rest)
+      (when (and val rest)
+        (compile-error f "unreachable code after ~s" test))
+      ^(progn ,*forms))
+    (((@test) . @rest)
+      ^(or ,test (my-cond ,*rest)))
+    (((@test . @forms) . @rest)
+      ^(if ,test (progn ,*forms)
+         (my-cond ,*rest)))
+    ((@else . @rest) (compile-error f "bad syntax")))
+
+  (my-cond (3)) --> 3
+  (my-cond (3 4)) --> 4
+  (my-cond (3 4) (5)) --> ;; my-cond: unreachable code after 3
+  (my-cond 42) --> ;; my-cond: bad syntax
+.brev
+
+.verb
+  ;; Keyword parameter example.
+
+  (defstruct simple-widget ()
+    name)
+
+  (defstruct widget (simple-widget)
+    frobosity
+    luminance)
+
+  (defstruct simple-point-widget (simple-widget)
+    (:static width 0)
+    (:static height 0))
+
+  (defstruct point-widget (widget)
+    (:static width 0)
+    (:static height 0))
+
+  (defstruct general-widget (widget)
+    width
+    height)
+
+  ;; Note that in clauses with no . @rest parameter, there
+  ;; is a mismatch if keyword arguments are present. The (0 0)
+  ;; clause exploits this to match only when keywords are absent.
+
+  (defun make-widget (:key :match name -- frob lum)
+    ((0 0) (new simple-point-widget name name))
+    ((0 0 . @rest) (new point-widget name name
+                                     frobosity frob
+                                     luminance lum))
+    ((@x @y . @rest) (new general-widget name name
+                                         width x
+                                         height x
+                                         frobosity frob
+                                         luminance lum)))
+
+  (make-widget "abc" 0 0) --> #S(simple-point-widget name "abc")
+
+  (make-widget "abc" 0 0 :frob 42)
+  --> #S(point-widget name "abc" frobosity 42 luminance nil)
+
+  (make-widget "abc" 0 0 :lum 9)
+  --> #S(point-widget name "abc" frobosity nil luminance 9)
+
+  (make-widget "abc" 0 1 :lum 9)
+  --> #S(general-widget name "abc" frobosity nil luminance 9
+                        width 0 height 0)
+.brev
+
 .SS* Quasiquote Operator Syntax
 .coNP Macro @ qquote
 .synb