1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Pipes based on ideas from Norvig's PAIP book
7 ;;;; Programmers: Kevin M. Rosenberg and Peter Norvig
8 ;;;; Date Started: Apr 2000
12 ;;;; *************************************************************************
16 (defconstant +empty-pipe+ nil)
18 (defmacro make-pipe (head tail)
19 "Create a pipe by evaluating head and delaying tail."
20 `(cons ,head #'(lambda () ,tail)))
22 (defun pipe-tail (pipe)
23 "Return tail of pipe or list, and destructively update
24 the tail if it is a function."
25 (if (functionp (rest pipe))
26 (setf (rest pipe) (funcall (rest pipe)))
29 (defun pipe-head (pipe) (first pipe))
31 (defun pipe-elt (pipe i)
32 "The i-th element of pipe, 0-based."
35 (pipe-elt (pipe-tail pipe) (- i 1))))
38 (defun pipe-enumerate (pipe &key count key (result pipe))
39 "Go through all (or count) elements of pipe,
40 possibly applying the KEY function. (Try PRINT.)"
41 ;; Returns RESULT, which defaults to the pipe itself.
42 (if (or (eq pipe +empty-pipe+) (eql count 0))
45 (unless (null key) (funcall key (pipe-head pipe)))
46 (pipe-enumerate (pipe-tail pipe)
47 :count (if count (1- count))
48 :key key :result result))))
50 (defun pipe-values (pipe &optional count)
51 "Simple wrapper to return values of a pipe"
52 (pipe-enumerate pipe :count count))
54 (defun pipe-force (pipe)
55 "Force the enumeration of all of the pipe. Never returns
56 if the pipe is infinite in length."
57 (pipe-enumerate pipe))
59 (defun pipe-filter (predicate pipe)
60 "Keep only items in pipe satisfying predicate."
61 (if (eq pipe +empty-pipe+)
63 (let ((head (pipe-head pipe))
64 (tail (pipe-tail pipe)))
65 (if (funcall predicate head)
66 (make-pipe head (pipe-filter predicate tail))
67 (pipe-filter predicate tail)))))
70 (defun pipe-map (fn pipe)
71 "Map fn over pipe, delaying all but the first fn call."
72 (if (eq pipe +empty-pipe+)
74 (make-pipe (funcall fn (pipe-head pipe))
75 (pipe-map fn (pipe-tail pipe)))))
78 (defun pipe-map-filtering (fn pipe &optional filter-pred)
79 "Map fn over pipe, delaying all but the first fn call,
80 while filtering results."
81 (if (eq pipe +empty-pipe+)
83 (let* ((head (pipe-head pipe))
84 (tail (pipe-tail pipe))
85 (result (funcall fn head)))
86 (if (or (and filter-pred (funcall filter-pred result))
88 (make-pipe result (pipe-map-filtering fn tail filter-pred))
89 (pipe-map-filtering fn tail filter-pred)))))
92 (defun pipe-append (x y)
93 "Return a pipe that appends the elements of x and y."
94 (if (eq x +empty-pipe+)
96 (make-pipe (pipe-head x)
97 (pipe-append (pipe-tail x) y))))
100 (defun pipe-mappend (fn pipe)
101 "Lazily map fn over pipe, appending results."
102 (if (eq pipe +empty-pipe+)
104 (let ((x (funcall fn (pipe-head pipe))))
105 (make-pipe (pipe-head x)
106 (pipe-append (pipe-tail x)
107 (pipe-mappend fn (pipe-tail pipe)))))))
109 (defun pipe-mappend-filtering (fn pipe &optional filter-pred)
110 "Map fn over pipe, delaying all but the first fn call,
111 appending results while filtering."
112 (if (eq pipe +empty-pipe+)
114 (let* ((head (pipe-head pipe))
115 (tail (pipe-tail pipe))
116 (result (funcall fn head)))
117 (if (or (and filter-pred (funcall filter-pred result))
119 (make-pipe (pipe-head result)
120 (pipe-append (pipe-tail result)
121 (pipe-mappend-filtering fn tail filter-pred)))
122 (pipe-mappend-filtering fn tail filter-pred)))))