summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--autoload.c2
-rw-r--r--stdlib/op.tl12
-rw-r--r--tests/012/op.tl13
-rw-r--r--txr.142
4 files changed, 66 insertions, 3 deletions
diff --git a/autoload.c b/autoload.c
index bf5e7602..9808c141 100644
--- a/autoload.c
+++ b/autoload.c
@@ -713,7 +713,7 @@ static val op_set_entries(val fun)
{
val name[] = {
lit("op"), lit("do"), lit("lop"), lit("ldo"), lit("ap"), lit("ip"),
- lit("ado"), lit("ido"), lit("ret"), lit("aret"),
+ lit("lop1"), lit("ado"), lit("ido"), lit("ret"), lit("aret"),
lit("opip"), lit("oand"), lit("lopip"), lit("loand"),
lit("opf"), lit("lopf"), lit("flow"), lit("lflow"), lit("tap"),
nil
diff --git a/stdlib/op.tl b/stdlib/op.tl
index a3a0135e..b443a2d2 100644
--- a/stdlib/op.tl
+++ b/stdlib/op.tl
@@ -172,6 +172,13 @@
;; no cadr here to avoid circular autoload
^[sys:apply ,(car (cdr syntax-2))
(append ,rest-sym (list ,*fargs-l1))]))
+ ((and (eq sym 'lop1) fargs)
+ (let ((fargs-l1 (mapcar (lambda (farg)
+ ^(sys:l1-val ,farg))
+ fargs))
+ (arg1 (sys:ensure-op-arg ctx 1)))
+ ;; no cadr here to avoid circular autoload
+ ^[,(car (cdr syntax-2)) ,arg1 ,*fargs-l1]))
(metas syntax-2)
((eq sym 'do)
(let ((arg1 (sys:ensure-op-arg ctx 1)))
@@ -199,6 +206,9 @@
(defmacro lop (:form f :env e . args)
(sys:op-expand f e args))
+(defmacro lop1 (:form f :env e . args)
+ (sys:op-expand f e args))
+
(defmacro ldo (op . args)
^(do ,op @1 ,*args))
@@ -243,7 +253,7 @@
(cons c (sys:opip-expand e opsym dosym rest))
(let ((sym (car c)))
(cond
- ((memq sym '(dwim uref qref op do lop ldo ap ip ado ido ret aret))
+ ((memq sym '(dwim uref qref op do lop lop1 ldo ap ip ado ido ret aret))
(cons c (sys:opip-expand e opsym dosym rest)))
((sys:opip-single-let-p c)
(tree-bind (t sym) c
diff --git a/tests/012/op.tl b/tests/012/op.tl
index 34f7ef39..6bda45a0 100644
--- a/tests/012/op.tl
+++ b/tests/012/op.tl
@@ -52,6 +52,19 @@
(fi (lop list @42 @rest)) (42 t)
(fi (lop list @1 @3 @rest @2)) (3 t))
+'(mtest
+ (fi (lop1)) :error
+ (fi (lop1 list)) (0 t)
+ (fi (lop1 list @1)) (1 t)
+ (fi (lop1 list @2)) (2 t)
+ (fi (lop1 list @42)) (42 t)
+ (fi (lop1 list @rest)) (0 t)
+ (fi (lop1 list @1 @rest)) (1 t)
+ (fi (lop1 list @2 @rest)) (2 t)
+ (fi (lop1 list @42 @rest)) (42 t)
+ (fi (lop1 list @1 @3 @rest @2)) (3 t))
+
+
(mtest
[(do quote x) 3] :error
[(do quote @1) 3] :error
diff --git a/txr.1 b/txr.1
index 0f353b97..85116591 100644
--- a/txr.1
+++ b/txr.1
@@ -60438,7 +60438,7 @@ is equivalent to
Likewise, if any meta-number arguments or
.code @rest
-are represent,
+are present,
.code lop
is equivalent to
.codn op .
@@ -60534,6 +60534,45 @@ equivalence above is instead:
.brev
+.coNP Macro @ lop1
+.synb
+.mets (lop1 << form +)
+.syne
+.desc
+The
+.code lop1
+macro is variant of
+.codn lop .
+
+The
+.code lop1
+macro is equivalent to
+.code op
+under all the same conditions as
+.codn lop .
+
+If two or more
+.metn form s
+are specified, and none of the forms mention any
+meta-number arguments or
+.codn @rest ,
+then
+.code lop1
+produces a function of one parameter, which
+inserts the argument value into the leftmost position
+of the function being applied.
+
+In contrast, under the same conditions, the
+.code lop
+macro produces a variadic function which inserts
+all of its arguments into that position.
+
+Note:
+.code lop1
+provides a useful optimization in situations when it is known that the
+resulting function will be called with exactly one argument. It eliminates
+argument list splicing logic.
+
.coNP Macro @ ldo
.synb
.mets (ldo < oper << form *)
@@ -60721,6 +60760,7 @@ notation denotes the following transformation applied to each argument:
(op ...) -> (op ...)
(do ...) -> (do ...)
(lop ...) -> (lop ...)
+ (lop1 ...) -> (lop1 ...)
(ldo ...) -> (ldo ...)
(ap ...) -> (ap ...)
(ip ...) -> (ip ...)