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
10 ;;;; $Id: pipes.lisp,v 1.2 2002/11/07 20:26:13 kevin Exp $
12 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg and
13 ;;;; Copyright (c) 1998-2002 by Peter Norvig.
15 ;;;; KMRCL users are granted the rights to distribute and use this software
16 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
17 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
18 ;;;; *************************************************************************
23 (defconstant +empty-pipe+ nil)
25 (defmacro make-pipe (head tail)
26 "Create a pipe by evaluating head and delaying tail."
27 `(cons ,head #'(lambda () ,tail)))
29 (defun pipe-tail (pipe)
30 "Return tail of pipe or list, and destructively update
31 the tail if it is a function."
32 (if (functionp (rest pipe))
33 (setf (rest pipe) (funcall (rest pipe)))
36 (defun pipe-head (pipe) (first pipe))
38 (defun pipe-elt (pipe i)
39 "The i-th element of pipe, 0-based."
42 (pipe-elt (pipe-tail pipe) (- i 1))))
45 (defun pipe-enumerate (pipe &key count key (result pipe))
46 "Go through all (or count) elements of pipe,
47 possibly applying the KEY function. (Try PRINT.)"
48 ;; Returns RESULT, which defaults to the pipe itself.
49 (if (or (eq pipe +empty-pipe+) (eql count 0))
52 (unless (null key) (funcall key (pipe-head pipe)))
53 (pipe-enumerate (pipe-tail pipe)
54 :count (if count (1- count))
55 :key key :result result))))
57 (defun pipe-values (pipe &optional count)
58 "Simple wrapper to return values of a pipe"
59 (pipe-enumerate pipe :count count))
61 (defun pipe-force (pipe)
62 "Force the enumeration of all of the pipe. Never returns
63 if the pipe is infinite in length."
64 (pipe-enumerate pipe))
66 (defun pipe-filter (predicate pipe)
67 "Keep only items in pipe satisfying predicate."
68 (if (eq pipe +empty-pipe+)
70 (let ((head (pipe-head pipe))
71 (tail (pipe-tail pipe)))
72 (if (funcall predicate head)
73 (make-pipe head (pipe-filter predicate tail))
74 (pipe-filter predicate tail)))))
77 (defun pipe-map (fn pipe)
78 "Map fn over pipe, delaying all but the first fn call."
79 (if (eq pipe +empty-pipe+)
81 (make-pipe (funcall fn (pipe-head pipe))
82 (pipe-map fn (pipe-tail pipe)))))
85 (defun pipe-map-filtering (fn pipe &optional filter-pred)
86 "Map fn over pipe, delaying all but the first fn call,
87 while filtering results."
88 (if (eq pipe +empty-pipe+)
90 (let* ((head (pipe-head pipe))
91 (tail (pipe-tail pipe))
92 (result (funcall fn head)))
93 (if (or (and filter-pred (funcall filter-pred result))
95 (make-pipe result (pipe-map-filtering fn tail filter-pred))
96 (pipe-map-filtering fn tail filter-pred)))))
99 (defun pipe-append (x y)
100 "Return a pipe that appends the elements of x and y."
101 (if (eq x +empty-pipe+)
103 (make-pipe (pipe-head x)
104 (pipe-append (pipe-tail x) y))))
107 (defun pipe-mappend (fn pipe)
108 "Lazily map fn over pipe, appending results."
109 (if (eq pipe +empty-pipe+)
111 (let ((x (funcall fn (pipe-head pipe))))
112 (make-pipe (pipe-head x)
113 (pipe-append (pipe-tail x)
114 (pipe-mappend fn (pipe-tail pipe)))))))
116 (defun pipe-mappend-filtering (fn pipe &optional filter-pred)
117 "Map fn over pipe, delaying all but the first fn call,
118 appending results while filtering."
119 (if (eq pipe +empty-pipe+)
121 (let* ((head (pipe-head pipe))
122 (tail (pipe-tail pipe))
123 (result (funcall fn head)))
124 (if (or (and filter-pred (funcall filter-pred result))
126 (make-pipe (pipe-head result)
127 (pipe-append (pipe-tail result)
128 (pipe-mappend-filtering fn tail filter-pred)))
129 (pipe-mappend-filtering fn tail filter-pred)))))