diff options
| -rw-r--r-- | lisplib.c | 2 | ||||
| -rw-r--r-- | share/txr/stdlib/op.tl | 21 | ||||
| -rw-r--r-- | txr.1 | 90 |
3 files changed, 107 insertions, 6 deletions
@@ -563,7 +563,7 @@ static val doloop_instantiate(val set_fun) static val op_set_entries(val dlt, val fun) { val name[] = { - lit("op"), lit("do"), + lit("op"), lit("do"), lit("lop"), nil }; set_dlt_entries(dlt, name, fun); 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)) @@ -40175,6 +40175,96 @@ from a quasiliteral within a nested (mapcar (op list @2 @1) '((1 2) (a b))) -> ((2 1) (b a)) .cble +.coNP Macro @ lop +.synb +.mets (lop << form +) +.syne +.desc +The +.code lop +macro is variant of +.code op +with special semantics. + +The +.meta form +arguments support the same notation as those of the +.code op +operator. + +If only one +.meta form +is given then +.code lop +is equivalent to +.codn op . + +If two or more +.meta form +arguments are present, then +.code lop +generates a variadic function which inserts all of its trailing +arguments between the first and second +.metn form -s. + +That is to say, trailing arguments coming into the anonymous function +become the left arguments of the function or function-like object +denoted by the first +.meta form +and the remaining +.metn form -s +give additional arguments. Hence the name +.codn lop , +which stands for "left-inserting +.codn op ". + +This left insertion of the trailing arguments takes place regardless of whether +.code @rest +occurs in any +.metn form . + +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. + +The +.code lop +macro's expansion can be understood via the following equivalences, +except that in the real implementation, the symbols +.code rest +and +.code arg1 +through +.code arg3 +are replaced with hygienic, unique symbols. + +.cblk + (lop f) <--> (op f) <--> (lambda (. rest) [f . rest]) + + (lop f x y) <--> (lambda (. rest) + [apply f (append rest [list x y])]) + + (lop f x @3 y) <--> (lambda (arg1 arg2 arg3 . rest) + [apply f + (append rest + [list x arg3 y])]) +.cble + +.TP* Examples: + +.cblk + (mapcar (lop list 3) '(a b c)) --> ((a 3) (b 3) (c 3)) + + (mapcar (lop list @1) '(a b c)) --> ((a) (b) (c)) + + (mapcar (lop list @1) '(a b c) '(d e f)) + --> ((d a) (e b) (f c)) + +.cble + .coNP Macros @, ap @, ip @ ado and @ ido. .synb .mets (ap << form +) |