Pipes's Copyright Statement
---------------------------
-Copyright (c) 2000-2002 Kevin Rosenberg
+Copyright (c) 2000-2003 Kevin Rosenberg
Copyright (c) 1998-2002 Peter Norvig
All rights reserved.
+cl-pipes (1.1-1) unstable; urgency=low
+
+ * Fix bug in examples file. Add ln2 examples to run-examples
+ * Rename pipes.lisp to src.lisp
+ * Update standards-version to 3.5.9.0 (no changes needed)
+ * Expand long description
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Fri, 14 Mar 2003 13:57:08 -0700
+
cl-pipes (1.0-2) unstable; urgency=low
* Remove 'load-compiled-op from .asd file
Priority: optional
Maintainer: Kevin M. Rosenberg <kmr@debian.org>
Build-Depends-Indep: debhelper (>= 4.0.0)
-Standards-Version: 3.5.8.0
+Standards-Version: 3.5.9.0
Package: cl-pipes
Architecture: all
Depends: ${shlibs:Depends}, common-lisp-controller (>= 3.47)
Description: Common Lisp library for pipes or streams
This package has functions for manipulating pipes, also called streams.
-
+ This package is adapted from an implementation in Peter Norvig's
+ Paradigms of Artificial Intelligence Programming.
Pipes's Copyright Statement
---------------------------
-Copyright (c) 2000-2002 Kevin Rosenberg
+Copyright (c) 2000-2003 Kevin Rosenberg
Copyright (c) 1998-2002 Peter Norvig
All rights reserved.
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: pipes-examples.lisp
-;;;; Purpose: Pipe examples
-;;;; Programmer: Kevin M. Rosenberg
-;;;; Date Started: Apr 2000
-;;;;
-;;;; $Id: pipes-example.lisp,v 1.2 2002/11/07 20:26:13 kevin Exp $
-;;;;
-;;;; This file, part of pipes, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; *************************************************************************
-
-(in-package #:pipes-user)
-
-
-(defun integers (&optional (start 0) end)
- (if (or (null end) (<= start end))
- (make-pipe start (integers (+ start 1) end))
- nil))
-
-(defun fibgen (a b)
- (make-pipe a (fibgen b (+ a b))))
-
-(defun fibs ()
- (fibgen 0 1))
-
-
-(defun divisible? (x y)
- (zerop (rem x y)))
-
-(defun no-sevens ()
- (pipe-filter #'(lambda (x) (not (divisible? x 7))) (integers)))
-
-
-(defun sieve (stream)
- (make-pipe
- (pipe-head stream)
- (sieve (pipe-filter
- #'(lambda (x)
- (not (divisible? x (pipe-head stream))))
- (pipe-tail stream)))))
-
-(defun primes ()
- (sieve (integers 2)))
-
-
-;; Pi
-
-(defun scale-pipe (factor pipe)
- (pipe-map #'(lambda (x) (* x factor)) pipe))
-
-(defun sum-pipe (sum s)
- (make-pipe sum
- (sum-pipe (+ sum (pipe-head s))
- (pipe-tail s))))
-
-(defun partial-sums (s)
- (make-pipe (pipe-head s) (sum-pipe 0 s)))
-
-(defun pi-summands (n)
- (make-pipe (/ 1d0 n)
- (pipe-map #'- (pi-summands (+ n 2)))))
-
-(defun pi-stream ()
- (scale-pipe 4d0 (partial-sums (pi-summands 1))))
-
-(defun square (x)
- (* x x))
-
-(defun euler-transform (s)
- (let ((s0 (pipe-elt s 0))
- (s1 (pipe-elt s 1))
- (s2 (pipe-elt s 2)))
- (if (and s0 s1 s2)
- (if (eql s1 s2) ;;; series has converged
- +empty-pipe+
- (make-pipe (- s2 (/ (square (- s2 s1))
- (+ s0 (* -2 s1) s2)))
- (euler-transform (pipe-tail s))))
- +empty-pipe+)))
-
-
-(defun ln2-summands (n)
- (pipe-map (/ 1d0 n)
- (pipe-map #'- (ln2-summands (1+ n)))))
-
-(defun ln2-stream ()
- (partial-sums (ln2-summands 1)))
-
-(defun make-tableau (transform s)
- (make-pipe s
- (make-tableau transform
- (funcall transform s))))
-
-(defun accelerated-sequence (transform s)
- (pipe-map #'pipe-head
- (make-tableau transform s)))
-
-
-(defun run-examples ()
- (let ((*print-length* 20))
- (format t "~&pi-stream: ~S"
- (pipe-values (pi-stream) 10))
- (format t "~&euler-transform: ~S"
- (pipe-values (euler-transform (pi-stream)) 10))
- (format t "~&accelerate-sequence: ~S"
- (pipe-values
- (accelerated-sequence #'euler-transform (pi-stream)) 10))))
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-\r
+;;;; *************************************************************************\r
+;;;; FILE IDENTIFICATION\r
+;;;;\r
+;;;; Name: pipes-examples.lisp\r
+;;;; Purpose: Pipe examples\r
+;;;; Programmer: Kevin M. Rosenberg\r
+;;;; Date Started: Apr 2000\r
+;;;;\r
+;;;; $Id: pipes-example.lisp,v 1.3 2003/03/15 00:48:56 kevin Exp $\r
+;;;;\r
+;;;; This file, part of pipes, is Copyright (c) 2002 by Kevin M. Rosenberg\r
+;;;;\r
+;;;; *************************************************************************\r
+\r
+(in-package #:pipes-user)\r
+\r
+\r
+(defun integers (&optional (start 0) end)\r
+ (if (or (null end) (<= start end))\r
+ (make-pipe start (integers (+ start 1) end))\r
+ nil))\r
+\r
+(defun fibgen (a b)\r
+ (make-pipe a (fibgen b (+ a b))))\r
+\r
+(defun fibs ()\r
+ (fibgen 0 1))\r
+\r
+\r
+(defun divisible? (x y) \r
+ (zerop (rem x y)))\r
+\r
+(defun no-sevens ()\r
+ (pipe-filter #'(lambda (x) (not (divisible? x 7))) (integers)))\r
+\r
+\r
+(defun sieve (stream)\r
+ (make-pipe\r
+ (pipe-head stream)\r
+ (sieve (pipe-filter\r
+ #'(lambda (x)\r
+ (not (divisible? x (pipe-head stream))))\r
+ (pipe-tail stream)))))\r
+\r
+(defun primes ()\r
+ (sieve (integers 2)))\r
+\r
+\r
+;; Pi\r
+\r
+(defun scale-pipe (factor pipe)\r
+ (pipe-map #'(lambda (x) (* x factor)) pipe))\r
+\r
+(defun sum-pipe (sum s)\r
+ (make-pipe sum\r
+ (sum-pipe (+ sum (pipe-head s))\r
+ (pipe-tail s))))\r
+\r
+(defun partial-sums (s)\r
+ (make-pipe (pipe-head s) (sum-pipe 0 s)))\r
+\r
+(defun pi-summands (n)\r
+ (make-pipe (/ 1d0 n)\r
+ (pipe-map #'- (pi-summands (+ n 2)))))\r
+\r
+(defun pi-stream ()\r
+ (scale-pipe 4d0 (partial-sums (pi-summands 1))))\r
+\r
+(defun square (x)\r
+ (* x x))\r
+\r
+(defun euler-transform (s)\r
+ (let ((s0 (pipe-elt s 0))\r
+ (s1 (pipe-elt s 1)) \r
+ (s2 (pipe-elt s 2)))\r
+ (if (and s0 s1 s2)\r
+ (if (eql s1 s2) ;;; series has converged \r
+ +empty-pipe+\r
+ (make-pipe (- s2 (/ (square (- s2 s1))\r
+ (+ s0 (* -2 s1) s2)))\r
+ (euler-transform (pipe-tail s))))\r
+ +empty-pipe+)))\r
+\r
+\r
+(defun ln2-summands (n)\r
+ (make-pipe (/ 1d0 n)\r
+ (pipe-map #'- (ln2-summands (1+ n)))))\r
+\r
+(defun ln2-stream ()\r
+ (partial-sums (ln2-summands 1)))\r
+\r
+(defun make-tableau (transform s)\r
+ (make-pipe s\r
+ (make-tableau transform\r
+ (funcall transform s))))\r
+\r
+(defun accelerated-sequence (transform s)\r
+ (pipe-map #'pipe-head\r
+ (make-tableau transform s)))\r
+\r
+\r
+(defun run-examples ()\r
+ (let ((*print-length* 20))\r
+ (format t "~&pi-stream:~& ~S"\r
+ (pipe-values (pi-stream) 10))\r
+ (format t "~& pi-stream euler-transform:~& ~S"\r
+ (pipe-values (euler-transform (pi-stream)) 10))\r
+ (format t "~& pi-stream accelerate-sequence:~& ~S"\r
+ (pipe-values\r
+ (accelerated-sequence #'euler-transform (pi-stream)) 10)))\r
+ (format t "~&ln2-stream:~& ~S"\r
+ (pipe-values (ln2-stream) 10))\r
+ (format t "~& ln2-stream euler-transform:~& ~S"\r
+ (pipe-values (euler-transform (ln2-stream)) 10))\r
+ (format t "~& ln2-stream accelerate-sequence:~& ~S"\r
+ (pipe-values\r
+ (accelerated-sequence #'euler-transform (ln2-stream)) 10)))\r
+\r
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: pipes.asd,v 1.2 2002/11/08 16:51:40 kevin Exp $
+;;;; $Id: pipes.asd,v 1.3 2003/03/15 00:48:56 kevin Exp $
;;;;
;;;; This file, part of PIPES, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; *************************************************************************
(pushnew :pipes cl:*features*))
:components
((:file "package")
- (:file "pipes" :depends-on ("package"))))
+ (:file "src" :depends-on ("package"))))
+++ /dev/null
-;;;; -*- 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: pipes.lisp,v 1.3 2002/11/08 16:51:40 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)))))
--- /dev/null
+;;;; -*- 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)))))
projects / pipes.git / commitdiff