--- /dev/null
+Pipes's Copyright Statement
+---------------------------
+
+Copyright (c) 2000-2002 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.
--- /dev/null
+Installing pipes into your CL implementation that uses
+Debian's Common Lisp Controller is easy. Just enter
+
+(require 'pipes)
+
+and a precompiled version of pipes should be loaded.
--- /dev/null
+cl-pipes (1.0-1) unstable; urgency=low
+
+ * Initial Release (closes: )
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Sat, 5 Oct 2002 13:19:33 -0600
+
--- /dev/null
+Source: cl-pipes
+Section: devel
+Priority: optional
+Maintainer: Kevin M. Rosenberg <kmr@debian.org>
+Build-Depends-Indep: debhelper (>= 4.0.0)
+Standards-Version: 3.5.7.1
+
+Package: cl-pipes
+Architecture: all
+Depends: ${shlibs:Depends}, common-lisp-controller
+Description: Common Lisp library for pipes or streams
+ This package has functions for manipulating pipes, also called streams.
+
--- /dev/null
+This package was debianized by Kevin M. Rosenberg <kmr@debian.org> on
+Nov 2, 2002.
+
+It was downloaded from ftp://ftp.b9.com/pipes/
+Upstream Authors: Kevin Rosenberg & Peter Norvig
+
+
+Pipes's Copyright Statement
+---------------------------
+
+Copyright (c) 2000-2002 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.
+
+
+Peter Norvig's Original Copyright
+---------------------------------
+
+Copyright (c) 1998-2002 by Peter Norvig.
+
+Permission is granted to anyone to use this software, in source or
+object code form, on any computer system, and to modify, compile,
+decompile, run, and redistribute it to anyone else, subject to the
+following restrictions:
+
+ 1. The author makes no warranty of any kind, either expressed or
+implied, about the suitability of this software for any purpose.
+
+ 2. The author accepts no liability of any kind for damages or other
+consequences of the use of this software, even if they arise from
+defects in the software.
+
+ 3. The origin of this software must not be misrepresented, either
+by explicit claim or by omission.
+
+ 4. Altered versions must be plainly marked as such, and must not be
+misrepresented as being the original software. Altered versions may be
+distributed in packages under other licenses (such as the GNU
+license).
+
+If you find this software useful, it would be nice if you let me
+(peter@norvig.com) know about it, and nicer still if you send me
+modifications that you are willing to share. However, you are not
+required to do so.
+
--- /dev/null
+#! /bin/sh
+# postinst script for cl-pipes
+#
+# see: dh_installdeb(1)
+
+set -e
+
+# package name according to lisp
+LISP_PKG=pipes
+
+# summary of how this script can be called:
+# * <postinst> `configure' <most-recently-configured-version>
+# * <old-postinst> `abort-upgrade' <new version>
+# * <conflictor's-postinst> `abort-remove' `in-favour' <package>
+# <new-version>
+# * <deconfigured's-postinst> `abort-deconfigure' `in-favour'
+# <failed-install-package> <version> `removing'
+# <conflicting-package> <version>
+# for details, see http://www.debian.org/doc/debian-policy/ or
+# the debian-policy package
+#
+# quoting from the policy:
+# Any necessary prompting should almost always be confined to the
+# post-installation script, and should be protected with a conditional
+# so that unnecessary prompting doesn't happen if a package's
+# installation fails and the `postinst' is called with `abort-upgrade',
+# `abort-remove' or `abort-deconfigure'.
+
+case "$1" in
+ configure)
+ /usr/sbin/register-common-lisp-source ${LISP_PKG}
+ ;;
+ abort-upgrade|abort-remove|abort-deconfigure)
+ ;;
+ *)
+ echo "postinst called with unknown argument \`$1'" >&2
+ exit 1
+ ;;
+esac
+
+# dh_installdeb will replace this with shell code automatically
+# generated by other debhelper scripts.
+
+#DEBHELPER#
+
+exit 0
--- /dev/null
+#! /bin/sh
+# prerm script for cl-pipes
+#
+# see: dh_installdeb(1)
+
+set -e
+
+# package name according to lisp
+LISP_PKG=pipes
+
+# summary of how this script can be called:
+# * <prerm> `remove'
+# * <old-prerm> `upgrade' <new-version>
+# * <new-prerm> `failed-upgrade' <old-version>
+# * <conflictor's-prerm> `remove' `in-favour' <package> <new-version>
+# * <deconfigured's-prerm> `deconfigure' `in-favour'
+# <package-being-installed> <version> `removing'
+# <conflicting-package> <version>
+# for details, see http://www.debian.org/doc/debian-policy/ or
+# the debian-policy package
+
+
+case "$1" in
+ remove|upgrade|deconfigure)
+ /usr/sbin/unregister-common-lisp-source ${LISP_PKG}
+ ;;
+ failed-upgrade)
+ ;;
+ *)
+ echo "prerm called with unknown argument \`$1'" >&2
+ exit 1
+ ;;
+esac
+
+# dh_installdeb will replace this with shell code automatically
+# generated by other debhelper scripts.
+
+#DEBHELPER#
+
+exit 0
+
+
--- /dev/null
+#!/usr/bin/make -f
+
+export DH_COMPAT=4
+
+pkg := pipes
+debpkg := cl-pipes
+
+
+clc-source := usr/share/common-lisp/source
+clc-systems := usr/share/common-lisp/systems
+clc-pipes := $(clc-source)/$(pkg)
+
+doc-dir := usr/share/doc/$(debpkg)
+
+
+configure: configure-stamp
+configure-stamp:
+ dh_testdir
+ # Add here commands to configure the package.
+
+ touch configure-stamp
+
+
+build: build-stamp
+
+build-stamp: configure-stamp
+ dh_testdir
+ # Add here commands to compile the package.
+ touch build-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+ rm -f build-stamp configure-stamp
+ # Add here commands to clean up after the build process.
+ rm -f debian/cl-pipes.postinst.* debian/cl-pipes.prerm.*
+ dh_clean
+
+install: build
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+ # Add here commands to install the package into debian/pipes.
+ dh_installdirs $(clc-systems) $(clc-pipes) $(doc-dir)
+ dh_install pipes.asd $(shell echo *.lisp) $(clc-pipes)
+ dh_link $(clc-pipes)/pipes.asd $(clc-systems)/pipes.asd
+
+# Build architecture-independent files here.
+binary-indep: build install
+ dh_testdir -i
+ dh_testroot -i
+# dh_installdebconf
+ dh_installdocs -i
+ dh_installexamples -i pipes-example.lisp
+# dh_installmenu
+# dh_installlogrotate
+# dh_installemacsen
+# dh_installpam
+# dh_installmime
+# dh_installinit
+# dh_installcron
+# dh_installman
+# dh_installinfo
+# dh_undocumented
+ dh_installchangelogs -i
+ dh_strip -i
+ dh_compress -i
+ dh_fixperms -i
+# dh_makeshlibs
+ dh_installdeb -i
+# dh_perl
+ dh_shlibdeps -i
+ dh_gencontrol -i
+ dh_md5sums -i
+ dh_builddeb -i
+
+# Build architecture-dependent files here.
+binary-arch: build install
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary install configure
+
--- /dev/null
+#!/bin/bash -e
+
+dup pipes -Uftp.med-info.com -D/home/ftp/pipes -su $*
+
+
+
--- /dev/null
+;;;; -*- 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,v 1.1 2002/11/02 17:49:10 kevin Exp $
+;;;;
+;;;; This file, part of pipes, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; Pipes users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+
+(in-package :cl-user)
+
+(defpackage #:pipes
+ (:use #:common-lisp)
+ (:export
+ #:+empty-pipe+
+ #:make-pipe
+ #:pipe-tail
+ #:pipe-head
+ #:pipe-elt
+ #:enumerate
+ #:pipe-display
+ #:pipe-force
+ #:pipe-filter
+ #:pipe-map
+ #:pipe-map-filtering
+ #:pipe-append
+ #:pipe-mappend
+ #:pipe-mappend-filtering
+ ))
+
+
+(defpackage #:pipes-user
+ (:use #:common-lisp #:pipes)
+ )
--- /dev/null
+;;;; -*- 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.1 2002/11/02 17:49:10 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)
+ "a pipe of integers from START to 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-display (pi-stream) 10))
+ (format t "~&euler-transform: ~S"
+ (pipe-display (euler-transform (pi-stream)) 10))
+ (format t "~&accelerate-sequence: ~S"
+ (pipe-display
+ (accelerated-sequence #'euler-transform (pi-stream)) 10))))
--- /dev/null
+;;;; -*- 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,v 1.1 2002/11/02 17:49:10 kevin Exp $
+;;;;
+;;;; This file, part of PIPES, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; PIPES users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+#+allegro (require :pxml)
+#+(and allegro common-lisp-controller) (c-l-c::clc-require :aserve)
+#+(and allegro (not common-lisp-controller)) (require :aserve)
+
+(in-package :asdf)
+
+(defsystem :pipes
+ :perform (load-op :after (op pipes)
+ (pushnew :pipes cl:*features*))
+ :components
+ ((:file "package")
+ (:file "pipes" :depends-on ("package"))))
+
+
+(when (ignore-errors (find-class 'load-compiled-op))
+ (defmethod perform :after ((op load-compiled-op) (c (eql (find-system :pipes))))
+ (pushnew :pipes cl:*features*)))
+
--- /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.1 2002/11/02 17:49:10 kevin Exp $
+;;;;
+;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg and
+;;;; Copyright (c) 1998-2002 by Peter Norvig.
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :pipes)
+
+
+(defconstant +empty-pipe+ nil)
+
+(defmacro make-pipe (head tail)
+ "create a pipe by eval'ing 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."
+ ;; pipes should never contain functions as values
+ (if (functionp (rest pipe))
+ (setf (rest pipe) (funcall (rest pipe)))
+ (rest pipe)))
+
+(defun pipe-head (pipe) (first pipe))
+
+(defun pipe-elt (pipe n)
+ "nth element of pipe, 0 based."
+ (if (= n 0) (pipe-head pipe)
+ (pipe-elt (pipe-tail pipe) (- n 1))))
+
+
+(defun enumerate (pipe &key count key (result pipe))
+ "go through all or count elements of pipe,
+ possibly applying the key function. "
+ (if (or (eq pipe +empty-pipe+) (eql count 0))
+ result
+ (progn
+ (unless (null key) (funcall key (pipe-head pipe)))
+ (enumerate (pipe-tail pipe)
+ :count (if count (1- count))
+ :key key
+ :result result))))
+
+(defun pipe-display (pipe &optional count)
+ (enumerate pipe :count count))
+
+(defun pipe-force (pipe)
+ (enumerate pipe))
+
+(defun pipe-filter (predicate pipe)
+ "keep only items in (non-null) 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,
+ collecting res<ults"
+ (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-test)
+ "Map fn over pipe, delaying all but the first fn call,
+ collecting 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-test (funcall filter-test result))
+ result)
+ (make-pipe result (pipe-map-filtering fn tail filter-test))
+ (pipe-map-filtering fn tail filter-test)))))
+
+
+(defun pipe-append (pipex pipey)
+ "return a pipe that appends two pipes"
+ (if (eq pipex +empty-pipe+)
+ pipey
+ (make-pipe (pipe-head pipex)
+ (pipe-append (pipe-tail pipex) pipey))))
+
+(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-test)
+ "Map fn over pipe, delaying all but the first fn call,
+ appending results, filtering along the way"
+ (if (eq pipe +empty-pipe+)
+ +empty-pipe+
+ (let* ((head (pipe-head pipe))
+ (tail (pipe-tail pipe))
+ (result (funcall fn head)))
+ (if (or (and filter-test (funcall filter-test result))
+ result)
+ (make-pipe (pipe-head result)
+ (pipe-append (pipe-tail result)
+ (pipe-mappend-filtering fn tail filter-test)))
+ (pipe-mappend-filtering fn tail filter-test)))))
projects / pipes.git / commitdiff