New variant of op: lop.

* lisplib.c (op_set_entries): Add lop to auto-load list.

* share/txr/stdlib/op.tl (sys:op-expand): Recognize lop
and implement its transformation.
(lop) New macro.

* txr.1: Documented.

1 files changed, 16 insertions, 5 deletions

diff --git a/share/txr/stdlib/op.tl b/share/txr/stdlib/op.tl
index 78658658..e9ea8415 100644
--- a/share/txr/stdlib/op.tl
+++ b/share/txr/stdlib/op.tl
@@ -80,15 +80,26 @@
          (syntax-0 (if (eq sym 'do) ^(,*args) ^[,*args]))
          (syntax-1 (sys:op-alpha-rename f e syntax-0 nil))
          (syntax-2 (sys:op-alpha-rename f e syntax-1 t))
-         (have-metas (slot ctx 'gens))
+         (metas (slot ctx 'gens))
          (rest-sym (sys:ensure-op-arg ctx 0)))
-    ^(lambda (,*(cdr (slot ctx 'gens)) . ,rest-sym)
-       ,(if (or have-metas (eq sym 'do))
-          syntax-2
-          (append syntax-2 rest-sym)))))
+    ^(lambda (,*(cdr metas) . ,rest-sym)
+       ,(let ((fargs (cdr (cdr syntax-2))))
+          (cond
+            ((and (eq sym 'lop) fargs)
+             (let ((fargs-l1 (mapcar (lambda (farg)
+                                       ^(sys:l1-val ,farg))
+                                     fargs)))
+               ^[sys:apply ,(car (cdr syntax-2))
+                           (append ,rest-sym (list ,*fargs-l1))]))
+            ((or metas (eq sym 'do))
+             syntax-2)
+            (t (append syntax-2 rest-sym)))))))
 
 (defmacro op (:form f :env e . args)
   (sys:op-expand f e args))
 
 (defmacro do (:form f :env e . args)
   (sys:op-expand f e args))
+
+(defmacro lop (:form f :env e . args)
+  (sys:op-expand f e args))