op/do: clean up documentation-implementation problem.

It was reported by astute user vapnik spaknik that the
documentation says thing about the do operator which are
not actually true in the implementation.  I've decided that
one of them should be true, and so both implementation
and documentation are changing.

The documentation claims that (do set x) will produce
a function that can be called with one argument; that
argument will be assigned to x. That doesn't work, but this
commit will make it work.

The documentation has this example transformation:

  (do + foo) -> (lambda rest (+ foo . rest))

that cannot be made to work because do works with macros
and special operators to which arguments can't be dynamically
applied. This patch will not make the above work; instead
the example is corrected.

How do is going to work inow is that (do sym ...) syntax in
which no implicit variables appear will be equialent
to (do sym ... @1). The generated variadic function has one
required argument which is implicitly added to the syntax.
Obviously, that only works if that positon of the syntax
is an evaluated form or place.

Values of the -C option equal to 225 or less will restore
the old do behavior.

* share/txr/stdlib/op.tl (sys:op-expand): Support the new
style of do, subject to backward compatibility. A hack is
required here. We cannot discover the @1, @2 .. variables
in the syntax until we fully expand it. But that code walk
requires the syntax to be valid. For instance if (do set x) is
specified, with the expectation that it is equivalent to
(do set x @1), we cannot process that by code walking (set x).
(set x) is invalid syntax. What we do is to *try* expanding
it as (set x). If that doesn't work, we add a dummy gensym
to the form to produce (set x #:gNNNN) and try expanding that.
In that case, rather than adding @1 to the form, we replace
the dummy gensym with @1. The algorithm is careful not to
accidentally conceal real syntax errors in the form.
If the form without the dummy gensym fails to expand, and
the one with the dummy gensym expands fine but contains
references to implicit parameters (@1, @2, ...  @rest),
we expand it again without the gensym and allow the error
to propagate. Other aspects of this change are fairly trivial.
Because the do logic possibly introduces a @1 that doesn't
exist, near the end of this function we have to bind another
metas variable which has an up-to-date copy of the gens slot.
(op-ignerr): New macro; we can't use ignerr because that
will create a bootstrapping cycle; ignerr expands to catch,
and the catch macro uses do. Wrapping this in eval-only,
since we don't need an op-ignerr macro in the compiled image.

* txr.1: Documentation revised and updated. Differences
between do and op put clarified and put into point form.
Bad do examples corrected. Syntax of do now shown as having
a required parameter that is an operator.  Compat notes added.

2 files changed, 143 insertions, 65 deletions

diff --git a/share/txr/stdlib/op.tl b/share/txr/stdlib/op.tl
index e9b19b45..ca09e49a 100644
--- a/share/txr/stdlib/op.tl
+++ b/share/txr/stdlib/op.tl
@@ -90,14 +90,30 @@
                   ,op-args)))
     (expand code e)))
 
+(eval-only
+  (defmacro op-ignerr (x)
+    ^(sys:catch (error) ,x () (error (. args)))))
+
 (defun sys:op-expand (f e args)
   (unless args
     ['compile-error f "arguments required"])
-  (let* ((ctx (make-struct 'sys:op-ctx ^(form ,f)))
+  (let* ((compat (and (plusp sys:compat) (<= sys:compat 255)))
+         (ctx (make-struct 'sys:op-ctx ^(form ,f)))
+         (do-gen)
          (sys:*op-ctx* ctx)
          (sym (car f))
          (syntax-0 (if (eq sym 'do) args ^[,*args]))
-         (syntax-1 (sys:op-alpha-rename f e syntax-0 nil))
+         (syntax-1 (if (or (null syntax-0) (neq sym 'do) compat)
+                     (sys:op-alpha-rename f e syntax-0 nil)
+                     (or (op-ignerr (sys:op-alpha-rename f e syntax-0 nil))
+                         (let ((syn (sys:op-alpha-rename
+                                      f e (append syntax-0
+                                                  (list (sys:setq do-gen
+                                                                  (gensym))))
+                                      nil)))
+                           (when (slot ctx 'gens)
+                             (sys:op-alpha-rename f e syntax-0 nil))
+                           syn))))
          (syntax-2 (sys:op-alpha-rename f e syntax-1 t))
          (metas (slot ctx 'gens))
          (rec (slot ctx 'rec))
@@ -111,19 +127,28 @@
                                                        fargs)))
                                  ^[sys:apply ,(car (cdr syntax-2))
                                              (append ,rest-sym (list ,*fargs-l1))]))
-                              ((or metas (eq sym 'do))
-                               syntax-2)
+                              (metas syntax-2)
+                              ((eq sym 'do)
+                               (cond
+                                 (compat syntax-2)
+                                 (do-gen
+                                   (let ((arg1 (sys:ensure-op-arg ctx 1)))
+                                     ^(symacrolet ((,do-gen ,arg1))
+                                        ,syntax-2)))
+                                 (t (let ((arg1 (sys:ensure-op-arg ctx 1)))
+                                      (append syntax-2 (list arg1))))))
                               (t (append syntax-2 rest-sym))))))
-    (cond
-      (recvar ^(sys:lbind ((,rec (lambda (,*(cdr metas) . ,rest-sym)
-                                   (let ((,rec (fun ,rec)))
-                                     ,lambda-interior))))
-                 (fun ,rec)))
-      (rec ^(sys:lbind ((,rec (lambda (,*(cdr metas) . ,rest-sym)
-                                ,lambda-interior)))
-              (fun ,rec)))
-      (t ^(lambda (,*(cdr metas) . ,rest-sym)
-            ,lambda-interior)))))
+    (let ((metas (slot ctx 'gens)))
+      (cond
+        (recvar ^(sys:lbind ((,rec (lambda (,*(cdr metas) . ,rest-sym)
+                                     (let ((,rec (fun ,rec)))
+                                       ,lambda-interior))))
+                   (fun ,rec)))
+        (rec ^(sys:lbind ((,rec (lambda (,*(cdr metas) . ,rest-sym)
+                                  ,lambda-interior)))
+                (fun ,rec)))
+        (t ^(lambda (,*(cdr metas) . ,rest-sym)
+              ,lambda-interior))))))
 
 (defmacro op (:form f :env e . args)
   (sys:op-expand f e args))
diff --git a/txr.1 b/txr.1
index 8e287d9b..b560472e 100644
--- a/txr.1
+++ b/txr.1
@@ -46006,23 +46006,21 @@ literals to be processed which specify functions other than these three.
 .coNP Macros @ op and @ do
 .synb
 .mets (op << form +)
-.mets (do << form +)
+.mets (do < oper << form *)
 .syne
 .desc
-The
-.code op
-and
-.code do
-macro operators are similar.
-
-Like the lambda operator, the
+Like the
+.code lambda
+operator, the
 .code op
-operator creates an anonymous function based on its syntax.
-The difference is that the arguments of the function are implicit, or
-optionally specified within the function body, rather than as a formal
-parameter list before the body.
+macro denotes an anonymous function.
+Unlike
+.codn lambda ,
+the arguments of the function are implicit, or
+optionally specified within the expression, rather than as a formal
+parameter list which precedes a body.
 
-Also, the
+The
 .meta form
 arguments of
 .code op
@@ -46031,39 +46029,9 @@ which means that argument evaluation follows Lisp-1 rules.  (See the
 .code dwim
 operator).
 
-The
-.code do
-operator is like the
+The argument forms of
 .code op
-operator with the following difference:
-the
-.meta form
-arguments of
-.code do
-are not implicitly treated as DWIM expressions,
-but as ordinary expressions. In particular, this means that operator
-syntax is permitted. Note that the syntax
-.code "(op @1)"
-makes sense, since
-the argument can be a function, which will be invoked, but
-.code "(do @1)"
-doesn't
-make sense because it will produce a Lisp-2 form like
-.code "(#:arg1 ...)"
-referring
-to nonexistent function
-.codn #:arg1 .
-Because it accepts operators,
-.code do
-can be used with imperative constructs
-which are not functions, like set: like set: for instance
-.code "(do set x)"
-produces
-an anonymous function which, if called with one argument, stores that argument
-into
-.codn x .
-
-The argument forms are arbitrary expressions, within which special
+are arbitrary expressions, within which special
 conventions is permitted regarding the use of certain implicit variables:
 .RS
 .meIP >> @ num
@@ -46156,11 +46124,71 @@ denotes a function which takes any number of arguments, and ignores
 all but the first one, which is passed to
 .codn foo .
 
-The actions of
+The
+.code do
+operator is similar to
 .code op
-be understood by these examples, which show
-how
+op, with the following three differences:
+.RS
+.IP 1.
+The first argument of
+.codn do ,
+namely
+.metn oper ,
+is an operator. This argument is not processed for the presence of
+implicit variables. Thus for instance
+.code "(do @1 ...)"
+is invalid. By contrast,
+.code "(op @1 ...)"
+is possible and make sense under the right circumstances.
+The
+.meta oper
+argument may be the name of a macro or special operator, whereas
 .code op
+doesn't support the invocation of macros or special operators.
+For instance
+.code "(do let ((x @1)) (+ x 1))"
+is possible.
+.IP 2.
+The
+.meta form
+arguments of
+.code do
+are not implicitly treated as DWIM expressions,
+but as ordinary expressions.
+.IP 3.
+When
+.code do
+syntax doesn't contain any references to implicit variables (metanumbers or
+.codn @rest )
+then a variadic function is generated which requires one argument.
+That argument is added to the form. Thus for instance
+.code "(do set x)"
+effectively serves as a shorthand for
+.codn "(do set x @1)" .
+The corresponding defaulting behavior in
+.code op
+is that a variadic function is generated which requires no arguments.
+All of the available arguments are applied. Thus
+.code "(op f x)"
+is effectively a shorthand for
+.codn "(op f x . @rest)" .
+.RE
+.IP
+Because it accepts operators,
+.code do
+can be used with imperative constructs
+which are not functions, like set: like set: for instance
+.code "(do set x)"
+produces an anonymous function which, if called with one argument, stores that
+argument into
+.codn x .
+
+The actions of
+.code op
+and
+.code do
+be understood by these examples, which convey how the syntax is
 is rewritten to lambda.  However, note that the real translator
 uses generated symbols for the arguments, which are not equal to any
 symbols in the program.
@@ -46185,16 +46213,16 @@ symbols in the program.
 
   (op foo @rest @1) -> (lambda (arg1 . rest) [foo rest arg1])
 
-  (do + foo) -> (lambda rest (+ foo . rest))
+  (do + foo) -> (lambda (arg1 . rest) (+ foo arg1))
 
-  (do @1 @2) -> (lambda (arg1 arg2 . rest) (arg1 arg2))
+  (do @1 @2) -> (lambda (arg1 arg2 . rest) (@1 arg2)) ;; invalid!
 
   (do foo @rest @1) -> (lambda (arg1 . rest) (foo rest arg1))
 .brev
 
 Note that if argument
 .meta @n
-appears, it is not necessary
+appears in the syntax, it is not necessary
 for arguments
 .meta @1
 through
@@ -70580,6 +70608,31 @@ 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 225
+After \*(TX 225, the behavior of the
+.code do
+operator was adjusted. Previously, a form like
+.code "(do set x)"
+which contains no variable references like
+.codn @1 ,
+.code @2
+or
+.codn @rest ,
+generated a function similar to
+.codn "(lambda (. rest) (set x))" .
+This was contrary to documentation, which states that
+.code "(do set x)"
+should produce a variadic function which has one required argument,
+and which assigns that argument to the variable
+.code x
+when invoked. The current implementation is that
+.code "(do set x)"
+is equivalent to
+.code "(do set x @1)"
+which produces the documented behavior. If 225 or lower compatibility is
+selected, then the old behavior of
+.code do
+takes effect.
 .IP 224
 After \*(TX 224, the treatment of certain special structure functions
 has changed. Selecting 224 compatibility or lower restores that behavior.