3 ms·
There's also this macro I wrote that I couldn't live without, I call it fmask. Problem: I always hated that (loop for element in list collect (my-fun element))
by Hexstream 17y ago
There's also this macro I wrote that I couldn't live without, I call it fmask.
Problem: I always hated that (loop for element in list collect (my-fun element)) translates trivially to (mapcar #'my-fun list) but (loop for element in list collect (my-fun element my-constant)) doesn't. You'd either have to stick with the loop version or use something ugly and inefficient like (mapcar #'my-fun list (make-list (length list) :initial-element my-constant)) or write out the lambda: (mapcar (lambda (element) (my-fun element my-constant)) list) (my-constant could actually be an arbitrary form).
None of these solutions appealed to me. So I wrote fmask. With it, the example is simply rewritten as (mapcar (fmask #'my-fun ? (? my-constant)) list)
Another example:
(mapcar (fmask #'list ? (? (1+ (length ?))))
'(3 8 2) '(("some" "items") "A string" (nil "test")))
=>((3 3) (8 9) (2 3))
Here's the implementation:
(defmacro fmask (function unknown (&rest args))
(check-type unknown symbol)
(macrolet ((autotraverse-let (bindings &body body)
(let ((gensyms (iter (repeat (length bindings))
(collect (gensym "TRAVERSED")))))
`(let (,@(iter (for (nil value) in bindings)
(for gensym in gensyms)
(collect `(,gensym ,value))))
(symbol-macrolet (,@(iter (for (var nil) in bindings)
(for gensym in gensyms)
(collect `(,var (prog1 (car ,gensym)
(setf ,gensym (cdr ,gensym)))))))
,@body)))))
(labels ((unknownp (arg)
(etypecase arg
(atom (eq arg unknown))
(cons (some #'unknownp arg))))
(literalp (arg)
(or (typep arg '(or array keyword pathname number))
(and (consp arg)
(or (and (eq (first arg) 'function)
(cdr arg)
(not (cddr arg)))
(eq (first arg) 'quote))))))
(let ((unknowns (iter (repeat (count-if #'unknownp args))
(collect (gensym "UNKNOWN"))))
(knowns (iter (for arg in args)
(if (not (or (unknownp arg) (literalp arg)))
(collect (list (gensym "KNOWN") arg)))))
(known-function (and (consp function)
(eq (first function) 'function)
(symbolp (second function))
(second function))))
(autotraverse-let ((an-unknown unknowns)
(a-known (mapcar #'first knowns)))
(let* ((unknown-function (gensym "UNKNOWN-FUNCTION"))
(call-function (if known-function
(list known-function)
`(funcall ,unknown-function)))
(main (let ((inner `(lambda (,@unknowns)
(,@call-function
,@(iter (for arg in args)
(collect (if (unknownp arg)
(subst an-unknown
unknown
arg)
(if (literalp arg)
arg
a-known))))))))
(if knowns
`(let (,@knowns)
,inner)
inner))))
(if known-function
main
`(let ((,unknown-function ,function))
,main))))))))
- mahmud 17y agoPlease use Lisppaste to show gorgeous code :-) http://paste.lisp.org/new http://paste.lisp.org/new
- Hexstream 17y agoGood idea! fmask's implementation with syntax coloring: http://paste.lisp.org/display/81488 http://paste.lisp.org/display/81488 I also have a more extended example usage in an annotation at the bottom.
- TomSW 17y agoFor the simpler cases you can just use curry or rcurry, eg: (mapcar (rcurry #'parse-integer :junk-allowed t) '(" 1" "2xx" "3" "foo")) (1 2 3 NIL) ... whereas your more complex example doesn't strike me as an improvement over lambda + backquote: (mapcar (fmask #'list ? (? (1+ (length ?)))))) vs. (mapcar (lambda (n list) `(,n (1+ (length ,list)))) numbers lists) ... which might be longer than the fmask version but has the advantage of being immediately readable to any Lisp programmer, and of allowing arguments to be reused, or used in a different order than they appear. Doug Hoyte has a nice read macro called #`: (mapcar #2`(,a1 (1+ (length ,a2))) numbers lists)