matcher: rearrange match order of @(with).

The @(with side-pat expr main-pat) syntax becomes
@(with main-pat side-pat expr), which is more useful.
Also, the main-pat can be omitted.

* share/txr/stdlib/match.tl (compile-with-match): Recognize
two forms of the syntax: two argument form with main-pat
omitted and the full form. In the full form, main-pat is
on the left now and processed first, so we have to rearrange
the compilation and integration order.

* tests/011/patmatch.tl: Existing tests updated. Two-argument
test added.

* txr.1: Updated.

3 files changed, 49 insertions, 28 deletions

diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index 38d0b821..e269ecc1 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -331,22 +331,26 @@
                                pat-match.guard-chain)))))
 
 (defun compile-with-match (exp obj-var var-list)
-  (mac-param-bind *match-form* (op side-pat-var side-expr main-pat) exp
-    (let* ((side-var (gensym))
-           (side-pat (if (or (null side-pat-var) (bindable side-pat-var))
-                       ^(sys:var ,side-pat-var)
-                       side-pat-var))
-           (side-match (compile-match side-pat side-var var-list))
-           (main-match (compile-match main-pat obj-var var-list))
-           (guard (new match-guard
-                      pure-temps (list side-var)
-                      pure-temp-exprs (list side-expr))))
-      (new compiled-match
-           pattern exp
-           obj-var obj-var
-           guard-chain (append (list guard)
-                               side-match.guard-chain
-                               main-match.guard-chain)))))
+  (tree-case exp
+    ((op main-pat side-pat-var side-expr)
+       (let* ((side-var (gensym))
+              (side-pat (if (or (null side-pat-var) (bindable side-pat-var))
+                          ^(sys:var ,side-pat-var)
+                          side-pat-var))
+              (main-match (compile-match main-pat obj-var var-list))
+              (side-match (compile-match side-pat side-var var-list))
+              (guard (new match-guard
+                          pure-temps (list side-var)
+                          pure-temp-exprs (list side-expr))))
+         (new compiled-match
+              pattern exp
+              obj-var obj-var
+              guard-chain (append main-match.guard-chain
+                                  (list guard)
+                                  side-match.guard-chain))))
+    ((op side-pat-var side-expr)
+       (compile-with-match ^(,op @nil ,side-pat-var ,side-expr) obj-var var-list))
+    (x (compile-error *match-form* "bad syntax: ~s" exp))))
 
 (defun compile-loop-match (exp obj-var var-list)
   (mac-param-bind *match-form* (op match) exp
diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl
index 5dd735b9..fe82d28c 100644
--- a/tests/011/patmatch.tl
+++ b/tests/011/patmatch.tl
@@ -120,14 +120,19 @@
 
 (test (when-match (@a @(as a @(or x @a))) '(#1=(1 2 #1# 3) #1#) :yes) :yes)
 
-(test (when-match (@(with x 42 @a) @b @c) '(1 2 3) (list a b c x))
+(test (when-match (@(with @a x 42) @b @c) '(1 2 3) (list a b c x))
       (1 2 3 42))
 
 (test (let ((o 3))
-        (when-match (@(evenp x) @(with @(oddp y) o @z)) '(4 6)
+        (when-match (@(evenp x) @(with @z @(oddp y) o)) '(4 6)
           (list x y z)))
       (4 3 6))
 
+(test (let ((o 3))
+        (when-match (@(evenp x) @(with @(oddp y) o)) '(4 6)
+          (list x y)))
+      (4 3))
+
 (defstruct node ()
   left right)
 
diff --git a/txr.1 b/txr.1
index 9aa0dbb1..74359b7c 100644
--- a/txr.1
+++ b/txr.1
@@ -40288,12 +40288,12 @@ as its value.
 
 .coNP Pattern operator @ with
 .synb
-.mets @(with >> [ side-pattern | << name ] < expr << main-pattern )
+.mets @(with <> [ main-pattern ] >> { side-pattern | << name } << expr )
 .syne
 .desc
 The
 .code with
-pattern operator matches the
+pattern operator matches the optional
 .meta main-pattern
 against a corresponding object, while matching a
 .meta side-pattern
@@ -40303,15 +40303,27 @@ against the value of the expression
 .meta expr
 which is embedded in the syntax.
 
+First, if
+.meta main-pattern
+is present in the syntax,
+it is matched its corresponding object. This match must
+succeed, or else the
+.code with
+operator fails to match.
 
-First,
+Next,
 .meta expr
-is evaluated in the scope of earlier pattern variables. It is unspecified
-whether later pattern variables are visible. The matching of
+is evaluated in the scope of earlier pattern variables, including any
+which that emanate from
+.metn main-pattern .
+It is unspecified
+whether later pattern variables are visible.
+
+Finally,
 .meta side-pattern
-follows, and if that succeeds, then the matching of
-.meta main-pattern
-against the corresponding object takes place.
+is matched against the value of
+.metn expr .
+If that succeeds, then the operator has successfully matched.
 
 If a
 .meta name
@@ -40323,11 +40335,11 @@ it must be a bindable symbol or else
 .TP* Examples:
 
 .verb
-  (when-match (@(with x 42 @a) @b @c) '(1 2 3) (list a b c x))
+  (when-match (@(with @a x 42) @b @c) '(1 2 3) (list a b c x))
   --> (1 2 3 42)
 
   (let ((o 3))
-    (when-match (@(evenp x) @(with @(oddp y) o @z)) '(4 6)
+    (when-match (@(evenp x) @(with @z @(oddp y) o)) '(4 6)
       (list x y z)))
   --> (4 3 6)
 .brev