cl-pipes-1.2.1/0002750000175000017500000000000010010721240013461 5ustar kevinkevin00000000000000cl-pipes-1.2.1/COPYING0000640000175000017500000000275307634474170014553 0ustar kevinkevin00000000000000Pipes's Copyright Statement --------------------------- Copyright (c) 2000-2003 Kevin Rosenberg Copyright (c) 1998-2002 Peter Norvig All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the Authors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cl-pipes-1.2.1/pipes-example.lisp0000640000175000017500000000566407726550605017166 0ustar kevinkevin00000000000000;;;; -*- 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 7061 2003-09-07 06:34:45Z kevin $ ;;;; ;;;; 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) (make-pipe (/ 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 "~& pi-stream euler-transform:~& ~S" (pipe-values (euler-transform (pi-stream)) 10)) (format t "~& pi-stream accelerate-sequence:~& ~S" (pipe-values (accelerated-sequence #'euler-transform (pi-stream)) 10))) (format t "~&ln2-stream:~& ~S" (pipe-values (ln2-stream) 10)) (format t "~& ln2-stream euler-transform:~& ~S" (pipe-values (euler-transform (ln2-stream)) 10)) (format t "~& ln2-stream accelerate-sequence:~& ~S" (pipe-values (accelerated-sequence #'euler-transform (ln2-stream)) 10))) cl-pipes-1.2.1/package.lisp0000644000175000017500000000154410010721213015754 0ustar kevinkevin00000000000000;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: package.lisp ;;;; Purpose: Package definition for pipes package ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; ;;;; $Id: package.lisp 8627 2004-02-06 14:19:48Z kevin $ ;;;; ;;;; ************************************************************************* (in-package #:cl-user) (defpackage #:pipes (:use #:common-lisp) (:export #:+empty-pipe+ #:make-pipe #:pipe-tail #:pipe-head #:pipe-elt #:pipe-enumerate #:pipe-values #:pipe-force #:pipe-filter #:pipe-map #:pipe-map-filtering #:pipe-append #:pipe-mappend #:pipe-mappend-filtering )) (defpackage #:pipes-user (:use #:common-lisp #:pipes) ) cl-pipes-1.2.1/pipes.asd0000644000175000017500000000120610010721213015274 0ustar kevinkevin00000000000000;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: pipes.asd ;;;; Purpose: ASDF system definition for PIPES package ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; ;;;; $Id: pipes.asd 8627 2004-02-06 14:19:48Z kevin $ ;;;; ************************************************************************* (defpackage #:pipes-system (:use #:cl #:asdf)) (in-package :pipes-system) (defsystem pipes :components ((:file "package") (:file "src" :depends-on ("package")))) cl-pipes-1.2.1/src.lisp0000644000175000017500000000756510010721213015161 0ustar kevinkevin00000000000000;;;; -*- 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 8627 2004-02-06 14:19:48Z kevin $ ;;;; ;;;; ************************************************************************* (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)))))