I was reading about Microsoft's new scriptable shell on ars, and saw
that it had the ability to pipe output from one expression to another,
like you would in a shell. Very syntactically convenient. Here it is
in CL:
(defmacro pipe (&body body)
(labels ((transform-forms (forms)
(if forms
(list 'multiple-value-call
(car forms)
(transform-forms (cdr forms)))
(car body))))
(transform-forms (reverse (cdr body)))))
(defun test (n)
(pipe (values 1 2)
(lambda (x y) (values (+ x y) (* n 2)))
(lambda (n m) ;note the shadowed n, the value is still piped in
(format t "~A ~A~%" n m))))
It appears to work, also:
CL-USER> (test 2)
3 4
NIL
Note that 3 and 4 were printed, and NIL is FORMAT's return value. This
is better than Monad's pipes in that an arbitrary number of values can
be simultaneously piped, and worse in that it needs all those lambdas.
I'm still a bit fresh to Lisp and trying to get it all down, so
comments would be appreciated. This is also my first c.l.l. post, so
I'm now officially de-lurked.
-David
David Christiansen wrote:
> I was reading about Microsoft's new scriptable shell on ars, and saw
> that it had the ability to pipe output from one expression to another,
> like you would in a shell. Very syntactically convenient. Here it is
> in CL:
>
> (defmacro pipe (&body body)
I did this a couple of years ago, but I called it FILTER.
It lets you write things like:
(filter 3 1+ (expt _ 2) list (cons 'a))
This means start with the value 3, apply the 1+ function to produce
4, and then raise it to the power of 2 to get 16. Turn it into
a list to get (16), and finally cons 'a onto that to get (a 4).
The _ symbol is a notation which is used to refer to the output of
the last filter, when it needs to be inserted in other than the
trailing argument position.
Special notations are supported to avoid writing lambda expression,
so that (expt _ 2) means roughly #'(lambda (_) (expt _ 2)).
Symbols are taken to be function names, so you don't have to
hash-quote.
Multiple values are handled, and there are special operators to
split lists and multiple values into sub-filters and then re-combine
the values.
A crude debugging mechanism is provided: use filter-trace
instead of filter to compile a filter which prints the output
of each stage.
Lastly, a FILTER-DECLARE macro is added to help you fine tune. With
FILTER-DECLARE you can assert that certain symbols are names of
functions from which a single value is to be taken only. Their return
value is passsed to the next function in the chain using FUNCALL.
Otherwise MULTIPLE-VALUE-CALL is used. If a function should
unexpectedly return two or more values, they become arguments to the
next function. FILTER-DECLARE also lets you assert that something is a
mapping function.
If a symbol names a registered mapping function, the macro processes
the special shorthand syntax within the form, e.g:
(mapcar (list _ 'foo))
where now _ does not refer to the output of the previous stage. Rather
the previous stage puts out a list, which is passed thorugh mapcar. The
_ is used to refer to the list element in your expression; if you omit
it, it becomes the implicit last argument.
(filter '((a 1) (b 2) (c 3)) (mapcar second))
should yield (1 2 3). Note how you don't have to hash-quote the SECOND,
which is the effect of MAPCAR being a registered mapper.
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *filter-single-value-funcs* '(quote list cons append mapcar
car cdr first rest reverse nreverse))
(defvar *filter-mapping-functions* '(mapcar mapcan find-if remove-if
count-if)))
(defun single-value-p (expr)
(member (first expr) *filter-single-value-funcs*))
(defun tree-find (needle haystack &key (test #'eql))
(dolist (item haystack)
(if (funcall test needle item)
(return item)
(when (consp item)
(let ((find (tree-find needle item :test test)))
(when find
(return find)))))))
(defun expand-filter-expr (expr input)
(cond
((null expr)
input)
((atom expr)
(if (or (atom input) (single-value-p input))
`(funcall (function ,expr) ,input)
`(multiple-value-call (function ,expr) ,input)))
((consp (first expr))
(cond
((= 1 (length (first expr)))
`(let ((,(first (first expr)) ,input) ,@(rest (first expr)))
,@(rest expr)))
((and (every #'symbolp (first expr))
(null (intersection '(&optional &rest &key &body &aux)
(first expr))))
(if (or (atom input) (single-value-p input))
`(let ((,(first (first expr)) ,input) ,@(rest (first expr)))
,@(rest expr))
`(multiple-value-bind ,(first expr) ,input ,@(rest expr))))
(t `(multiple-value-call (lambda ,(first expr)
,@(rest expr)) ,input))))
((eq 'lambda (first expr))
(expand-filter-expr (rest expr) input))
((eq 'function (first expr))
(expand-filter-expr (second expr) input))
((member (first expr) *filter-mapping-functions*)
(cond
((and (consp (second expr))
(eq (first (second expr)) 'function))
`(,(first expr) ,@(rest expr) ,input))
((symbolp (second expr))
`(,(first expr) #',(second expr) ,@(rest (rest expr)) ,input))
(t (let ((input-sym (gensym "INPUT-")))
`(,(first expr) (lambda (,input-sym)
,(expand-filter-expr (second expr) input-sym))
,input)))))
((eq 'split (first expr))
(let ((value-list-sym (gensym "VALUE-LIST-")))
`(multiple-value-call (lambda (&rest ,value-list-sym)
(values ,@(mapcar #'(lambda (filter-exprs)
`(filter (values-list ,value-list-sym)
,@filter-exprs))
(rest expr))))
,input)))
((eq 'value-separate (first expr))
(let ((value-list-sym (gensym "VALUE-LIST-")))
`(multiple-value-call (lambda (&rest ,value-list-sym)
(values ,@(mapcar #'(lambda (filter-exprs)
`(filter (pop ,value-list-sym)
,@filter-exprs))
(rest expr))))
,input)))
((eq 'list-separate (first expr))
(let ((value-list-sym (gensym "VALUE-LIST-")))
`(let ((,value-list-sym ,input))
(list* ,@(mapcar #'(lambda (filter-exprs)
`(filter (pop ,value-list-sym)
,@filter-exprs))
(rest expr))
,value-list-sym))))
((tree-find '_ expr)
`(let ((_ ,input)) ,expr))
((> (length expr) 1)
`(,(first expr) ,@(rest expr) ,input))
(t (let ((input-sym (gensym "INPUT-")))
(if (or (atom input) (single-value-p input))
`(,(first expr) ,@(rest expr) ,input)
`(multiple-value-call (lambda (,input-sym)
(,(first expr) ,@(rest expr) ,input-sym))
,input))))))
(defun filter-declare-single-value (sym)
(push sym *filter-single-value-funcs*))
(defmacro filter (initial-expr &body filter-expr-list)
(if (null filter-expr-list)
initial-expr
`(filter ,(expand-filter-expr (first filter-expr-list)
initial-expr)
,@(rest filter-expr-list))))
(defun filter-chatter (&rest args)
(if (= (length args) 1)
(format t "filter trace: ~a~%"
(first args))
(format t "filter trace: ~{~a ~}~%"
args))
(values-list args))
(defmacro filter-trace (initial-expr &body filter-expr-list)
`(filter (multiple-value-call #'filter-chatter ,initial-expr)
,@(mapcan #'(lambda (filter-expr)
(list filter-expr '#'filter-chatter))
filter-expr-list)))
(defmacro filter-declare ((declaration-type &rest args))
(case declaration-type
((single-value)
(when (not (every #'symbolp args))
(error "FILTER-DECLARE: arguments to SINGLE-VALUE must be
symbols."))
`(setf *filter-single-value-funcs*
(append ',args *filter-single-value-funcs*)))
((mapping-function)
(when (not (every #'symbolp args))
(error "FILTER-DECLARE: arguments to MAPPING-FUNCTION must be
symbols."))
`(setf *filter-mapping-functions*
(append ',args *filter-mapping-functions*)))
(otherwise (error "FILTER-DECLARE: invalid declaration type ~a."
declaration-type))))
"David Christiansen" <·····@hampshire.edu> wrote in message
·····························@f14g2000cwb.googlegroups.com...
>I was reading about Microsoft's new scriptable shell on ars, and saw
> that it had the ability to pipe output from one expression to another,
> like you would in a shell. Very syntactically convenient. Here it is
> in CL:
>
> (defmacro pipe (&body body)
> (labels ((transform-forms (forms)
> (if forms
> (list 'multiple-value-call
> (car forms)
> (transform-forms (cdr forms)))
> (car body))))
> (transform-forms (reverse (cdr body)))))
>
(defmacro pipe (&optional transform &rest forms)
(dolist (form forms transform)
(setf transform `(multiple-value-call ,form ,transform))))
--
Geoff