lop: don't insert args when metas present.

The lop macro is inconsistent from op in that it
inserts the trailing function arguments on the
left even if arguments are explicitly given in the
form via @1, @2, ... or @rest. This change makes
lop is equivalent to op in all situations when these
metas are given.

* stdlib/op.tl (compat-225, compat-298): New top-level
variables.
(op-expand): local variable compat replaced by references to
compat-225. If compat-298 is *not* in effect, then metas
are checked for first in the cond, preventing the lop
transformation from taking place.

* tests/012/op.tl: Test cases for lop, combinations of
do with lop and a few for op also.

* txr.1: Redocumented, added compat notes.

3 files changed, 114 insertions, 26 deletions

diff --git a/stdlib/op.tl b/stdlib/op.tl
index d1c1f3e7..a3a0135e 100644
--- a/stdlib/op.tl
+++ b/stdlib/op.tl
@@ -107,17 +107,20 @@
   (defmacro op-ignerr (x)
     ^(sys:catch (error) ,x () (error (. args) (ignore args)))))
 
+(defparml compat-225 (and (plusp sys:compat) (<= sys:compat 225)))
+
+(defparml compat-298 (and (plusp sys:compat) (<= sys:compat 298)))
+
 (defun sys:op-expand (f e args)
   (unless args
     ['compile-error f "arguments required"])
-  (let* ((compat (and (plusp sys:compat) (<= sys:compat 225)))
-         (ctx (make-struct 'sys:op-ctx ^(form ,f)))
+  (let* ((ctx (make-struct 'sys:op-ctx ^(form ,f)))
          (sys:*op-ctx* ctx)
          (sym (car f))
          (do-gen (if (eq sym 'do) (gensym)))
          (syntax-0 (if (eq sym 'do) args ^[,*args]))
-         (syntax-1 (if (or (null syntax-0) (neq sym 'do) compat)
-                     ;; Not do, or empty do syntax, or compat mode.
+         (syntax-1 (if (or (null syntax-0) (neq sym 'do) compat-225)
+                     ;; Not do, or empty do syntax, or compat 225 mode.
                      (sys:op-alpha-rename e syntax-0 nil)
                      ;; Try to expand args as-is, catching errors.
                      (let ((syn (op-ignerr (sys:op-alpha-rename e
@@ -161,6 +164,7 @@
          (lambda-interior (let ((fargs (tree-case syntax-2
                                          ((t t . fa) fa))))
                             (cond
+                              ((and metas (not compat-298)) syntax-2)
                               ((and (eq sym 'lop) fargs)
                                (let ((fargs-l1 (mapcar (lambda (farg)
                                                          ^(sys:l1-val ,farg))
diff --git a/tests/012/op.tl b/tests/012/op.tl
index 47f1f80d..34f7ef39 100644
--- a/tests/012/op.tl
+++ b/tests/012/op.tl
@@ -41,6 +41,18 @@
   (fi (do if @1 @3 @rest @2)) (3 t))
 
 (mtest
+  (fi (lop)) :error
+  (fi (lop list)) (0 t)
+  (fi (lop list @1)) (1 t)
+  (fi (lop list @2)) (2 t)
+  (fi (lop list @42)) (42 t)
+  (fi (lop list @rest)) (0 t)
+  (fi (lop list @1 @rest)) (1 t)
+  (fi (lop list @2 @rest)) (2 t)
+  (fi (lop list @42 @rest)) (42 t)
+  (fi (lop list @1 @3 @rest @2)) (3 t))
+
+(mtest
   [(do quote x) 3] :error
   [(do quote @1) 3] :error
   (do pop a) :error)
@@ -78,12 +90,22 @@
 (mtest
   [[(do op list)] 2] :error
   [[(do op list) 2]] (2)
+  [[(do op list 3) 2]] (3 2)
   [[(do op list @@1) 1] 2] (1 2)
   [[(do op list @1)] 2] :error
   [[(do op list @1) 1] 2] (2 1)
   [[(do op list @@1 @1) 1] 2] (1 2))
 
 (mtest
+  [[(do lop list)] 2] :error
+  [[(do lop list) 2]] (2)
+  [[(do lop list 3) 2]] (3 2)
+  [[(do lop list @@1) 1] 2] (2 1)
+  [[(do lop list @1)] 2] :error
+  [[(do lop list @1) 1] 2] (2 1)
+  [[(do lop list @@1 @1) 1] 2] (1 2))
+
+(mtest
   [[[[(do do do op list @1) 1] 2] 3] 4] (4 1 2 3)
   [[[[(do do do op list @@1) 1] 2] 3] 4] (3 1 2 4)
   [[[[(do do do op list @@@1) 1] 2] 3] 4] (2 1 3 4)
@@ -125,3 +147,25 @@
             (tap inc y @1))
           y))
   (13 23))
+
+(mtest
+  [(op list) 1 2 3] (1 2 3)
+  [(op list 0) 1 2 3] (0 1 2 3)
+  [(op list 0 4) 1 2 3] (0 4 1 2 3)
+  [(op list @1) 1 2 3] (1)
+  [(op list @2) 1 2 3] (2)
+  [(op list @3) 1 2 3] (3)
+  [(op list 0 @3) 1 2 3] (0 3)
+  [(op list 0 4 @3) 1 2 3] (0 4 3)
+  [(op list . @rest) 1 2 3] (1 2 3))
+
+(mtest
+  [(lop list) 1 2 3] (1 2 3)
+  [(lop list 0) 1 2 3] (1 2 3 0)
+  [(lop list 0 4) 1 2 3] (1 2 3 0 4)
+  [(lop list @1) 1 2 3] (1)
+  [(lop list @2) 1 2 3] (2)
+  [(lop list @3) 1 2 3] (3)
+  [(lop list 0 @3) 1 2 3] (0 3)
+  [(lop list 0 4 @3) 1 2 3] (0 4 3)
+  [(lop list . @rest) 1 2 3] (1 2 3))
diff --git a/txr.1 b/txr.1
index 3f6b2527..0f353b97 100644
--- a/txr.1
+++ b/txr.1
@@ -60417,7 +60417,9 @@ in which they are passed to
 .desc
 The
 .code lop
-macro is variant of
+macro, (\(dqleft-inserting
+.codn op \(dq),
+is variant of
 .code op
 with special semantics.
 
@@ -60434,13 +60436,32 @@ is given then
 is equivalent to
 .codn op .
 
-If two or more
-.meta form
-arguments are present, then
+Likewise, if any meta-number arguments or
+.code @rest
+are represent,
 .code lop
-generates a variadic function which inserts all of its trailing
-arguments between the first and second
-.metn form s.
+is equivalent to
+.codn op .
+
+The difference between
+.code op
+and
+.code lop
+lies in the implicit insertion of the 
+.code @rest
+arguments.
+
+In cases when
+.code op
+implicitly adds the resulting function's arguments to the right of the bound
+arguments given by the
+.metn form -s,
+the
+.code lop
+macro instead inserts the function's arguments into the left position,
+between the first and second
+.meta form
+arguments.
 
 That is to say, trailing arguments coming into the anonymous function
 become the left arguments of the function or function-like object
@@ -60448,22 +60469,16 @@ denoted by the first
 .meta form
 and the remaining
 .metn form s
-give additional arguments. Hence the name
-.codn lop ,
-which stands for \(dqleft-inserting
-.codn op \(dq.
-
-This left insertion of the trailing arguments takes place regardless of whether
-.code @rest
-occurs in any
-.metn form .
+give additional arguments.
 
-The
-.meta form
-syntax determines the number of required arguments of the
-generated function, according to the highest-valued meta-number. The trailing
-arguments which are inserted into the left position are any arguments in excess
-of the required arguments.
+Thus, whereas
+.code "(op - 1 2 3)"
+denotes a function similar to
+.codn "(lambda (. args) [- 1 2 3 . args])" ,
+the expression
+.code "(lop - 1 2 3)"
+denotes
+.codn "(lambda (. args) [apply - (append args [list 1 2 3])])" .
 
 The
 .code lop
@@ -60482,6 +60497,25 @@ are replaced with hygienic, unique symbols.
   (lop f x y)  <-->  (lambda (. rest)
                        [apply f (append rest [list x y])])
 
+  ;; same as (op f x @3 y)
+  (lop f x @3 y)  <-->  (lambda (arg1 arg2 arg3 . rest)
+                          [f x arg3 y])
+.brev
+
+Compatibility Note: until \*(TX 298, the implicit left insertion of the
+trailing arguments takes place regardless of whether
+.code @rest
+or any meta-number arguments occur in the form, meaning that
+.code lop
+forms which have those arguments are not equivalent to
+.codn op .
+This is affected by the compatibility option, and hence mentioned in the
+COMPATIBILITY section.  Under the old behavior, the previously given
+equivalence above is instead:
+
+.verb
+  ;; the trailing arguments after the fixed ones
+  ;; are inserted in the function's left position
   (lop f x @3 y)  <-->  (lambda (arg1 arg2 arg3 . rest)
                           [apply f
                                  (append rest
@@ -95122,6 +95156,12 @@ of these version values, the described behaviors are provided if
 is given an argument which is equal or lower. For instance
 .code "-C 103"
 selects the behaviors described below for version 105, but not those for 102.
+.IP 298
+Until \*(TX 298, the
+.code lop
+macro has a certain behavior which has changed. That behavior is restored
+with compatibility values of 298 or lower. More details are given in
+the description of that macro.
 .IP 294
 Until \*(TX 294, the
 .code pprint