r4200: *** empty log message ***

[pipes.git] / src.lisp

diff --git a/src.lisp b/src.lisp
new file mode 100644 (file)
index 0000000..61f852b
--- /dev/null
+++ b/src.lisp
@@ -0,0 +1,125 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          pipes.lisp
+;;;; Purpose:       Pipes based on ideas from Norvig's PAIP book
+;;;; Programmers:   Kevin M. Rosenberg and Peter Norvig
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; $Id: src.lisp,v 1.1 2003/03/15 00:48:56 kevin Exp $
+;;;;
+;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg and
+;;;; Copyright (c) 1998-2002 by Peter Norvig. 
+;;;; *************************************************************************
+
+(in-package :pipes)
+
+
+(defconstant +empty-pipe+ nil)
+
+(defmacro make-pipe (head tail)
+  "Create a pipe by evaluating head and delaying tail."
+  `(cons ,head #'(lambda () ,tail)))
+
+(defun pipe-tail (pipe)
+  "Return tail of pipe or list, and destructively update 
+   the tail if it is a function."
+  (if (functionp (rest pipe))
+    (setf (rest pipe) (funcall (rest pipe)))
+    (rest pipe)))
+
+(defun pipe-head (pipe) (first pipe))
+
+(defun pipe-elt (pipe i)
+  "The i-th element of pipe, 0-based."
+  (if (= i 0)
+      (pipe-head pipe)
+    (pipe-elt (pipe-tail pipe) (- i 1))))
+
+
+(defun pipe-enumerate (pipe &key count key (result pipe))
+  "Go through all (or count) elements of pipe,
+   possibly applying the KEY function. (Try PRINT.)"
+  ;; Returns RESULT, which defaults to the pipe itself. 
+  (if (or (eq pipe +empty-pipe+) (eql count 0))
+    result
+    (progn
+      (unless (null key) (funcall key (pipe-head pipe)))
+      (pipe-enumerate (pipe-tail pipe)
+                 :count (if count (1- count))
+                 :key key :result result))))
+
+(defun pipe-values (pipe &optional count)
+  "Simple wrapper to return values of a pipe"
+  (pipe-enumerate pipe :count count))
+
+(defun pipe-force (pipe)
+  "Force the enumeration of all of the pipe. Never returns
+if the pipe is infinite in length."
+  (pipe-enumerate pipe))
+
+(defun pipe-filter (predicate pipe)
+  "Keep only items in pipe satisfying predicate."
+  (if (eq pipe +empty-pipe+)
+      +empty-pipe+
+    (let ((head (pipe-head pipe))
+         (tail (pipe-tail pipe)))
+      (if (funcall predicate head)
+         (make-pipe head (pipe-filter predicate tail))
+        (pipe-filter predicate tail)))))
+               
+
+(defun pipe-map (fn pipe)
+  "Map fn over pipe, delaying all but the first fn call."
+  (if (eq pipe +empty-pipe+)
+      +empty-pipe+
+    (make-pipe (funcall fn (pipe-head pipe))
+               (pipe-map fn (pipe-tail pipe)))))
+
+
+(defun pipe-map-filtering (fn pipe &optional filter-pred)
+  "Map fn over pipe, delaying all but the first fn call,
+   while filtering results."
+  (if (eq pipe +empty-pipe+)
+      +empty-pipe+
+    (let* ((head (pipe-head pipe))
+           (tail (pipe-tail pipe))
+           (result (funcall fn head)))
+      (if (or (and filter-pred (funcall filter-pred result))
+              result)
+         (make-pipe result (pipe-map-filtering fn tail filter-pred))
+        (pipe-map-filtering fn tail filter-pred)))))
+
+      
+(defun pipe-append (x y)
+  "Return a pipe that appends the elements of x and y."
+  (if (eq x +empty-pipe+)
+      y
+    (make-pipe (pipe-head x)
+               (pipe-append (pipe-tail x) y))))
+
+
+(defun pipe-mappend (fn pipe)
+  "Lazily map fn over pipe, appending results."
+  (if (eq pipe +empty-pipe+)
+      +empty-pipe+
+    (let ((x (funcall fn (pipe-head pipe))))
+      (make-pipe (pipe-head x)
+                 (pipe-append (pipe-tail x)
+                             (pipe-mappend fn (pipe-tail pipe)))))))
+
+(defun pipe-mappend-filtering (fn pipe &optional filter-pred)
+  "Map fn over pipe, delaying all but the first fn call,
+   appending results while filtering."
+  (if (eq pipe +empty-pipe+)
+      +empty-pipe+
+    (let* ((head (pipe-head pipe))
+           (tail (pipe-tail pipe))
+           (result (funcall fn head)))
+      (if (or (and filter-pred (funcall filter-pred result))
+              result)
+         (make-pipe (pipe-head result)
+                    (pipe-append (pipe-tail result)
+                                 (pipe-mappend-filtering fn tail filter-pred)))
+        (pipe-mappend-filtering fn tail filter-pred)))))