diff options
| -rw-r--r-- | autoload.c | 2 | ||||
| -rw-r--r-- | stdlib/op.tl | 12 | ||||
| -rw-r--r-- | tests/012/op.tl | 13 | ||||
| -rw-r--r-- | txr.1 | 42 |
4 files changed, 66 insertions, 3 deletions
@@ -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 @@ -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 ...) |