From 108cf113175bc41454b5b028d78fe00e67c37d83 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sat, 2 Nov 2002 17:49:10 +0000 Subject: [PATCH] r3273: *** empty log message *** --- .cvsignore | 1 + COPYING | 30 +++++++++++ debian/README.Debian | 6 +++ debian/changelog | 6 +++ debian/control | 13 +++++ debian/copyright | 69 ++++++++++++++++++++++++ debian/postinst | 46 ++++++++++++++++ debian/prerm | 42 +++++++++++++++ debian/rules | 82 ++++++++++++++++++++++++++++ debian/upload.sh | 6 +++ package.lisp | 45 ++++++++++++++++ pipes-example.lisp | 113 ++++++++++++++++++++++++++++++++++++++ pipes.asd | 36 +++++++++++++ pipes.lisp | 126 +++++++++++++++++++++++++++++++++++++++++++ 14 files changed, 621 insertions(+) create mode 100644 .cvsignore create mode 100644 COPYING create mode 100644 debian/README.Debian create mode 100644 debian/changelog create mode 100644 debian/control create mode 100644 debian/copyright create mode 100755 debian/postinst create mode 100755 debian/prerm create mode 100755 debian/rules create mode 100755 debian/upload.sh create mode 100644 package.lisp create mode 100644 pipes-example.lisp create mode 100644 pipes.asd create mode 100644 pipes.lisp diff --git a/.cvsignore b/.cvsignore new file mode 100644 index 0000000..ca8d09f --- /dev/null +++ b/.cvsignore @@ -0,0 +1 @@ +.bin diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..1d7faa2 --- /dev/null +++ b/COPYING @@ -0,0 +1,30 @@ +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. diff --git a/debian/README.Debian b/debian/README.Debian new file mode 100644 index 0000000..8d01e55 --- /dev/null +++ b/debian/README.Debian @@ -0,0 +1,6 @@ +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. diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..7d24e51 --- /dev/null +++ b/debian/changelog @@ -0,0 +1,6 @@ +cl-pipes (1.0-1) unstable; urgency=low + + * Initial Release (closes: ) + + -- Kevin M. Rosenberg Sat, 5 Oct 2002 13:19:33 -0600 + diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..606361d --- /dev/null +++ b/debian/control @@ -0,0 +1,13 @@ +Source: cl-pipes +Section: devel +Priority: optional +Maintainer: Kevin M. Rosenberg +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. + diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..078105c --- /dev/null +++ b/debian/copyright @@ -0,0 +1,69 @@ +This package was debianized by Kevin M. Rosenberg 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. + diff --git a/debian/postinst b/debian/postinst new file mode 100755 index 0000000..71d66b8 --- /dev/null +++ b/debian/postinst @@ -0,0 +1,46 @@ +#! /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: +# * `configure' +# * `abort-upgrade' +# * `abort-remove' `in-favour' +# +# * `abort-deconfigure' `in-favour' +# `removing' +# +# 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 diff --git a/debian/prerm b/debian/prerm new file mode 100755 index 0000000..d6bed9e --- /dev/null +++ b/debian/prerm @@ -0,0 +1,42 @@ +#! /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: +# * `remove' +# * `upgrade' +# * `failed-upgrade' +# * `remove' `in-favour' +# * `deconfigure' `in-favour' +# `removing' +# +# 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 + + diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..a460680 --- /dev/null +++ b/debian/rules @@ -0,0 +1,82 @@ +#!/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 + diff --git a/debian/upload.sh b/debian/upload.sh new file mode 100755 index 0000000..cc04ae5 --- /dev/null +++ b/debian/upload.sh @@ -0,0 +1,6 @@ +#!/bin/bash -e + +dup pipes -Uftp.med-info.com -D/home/ftp/pipes -su $* + + + diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..2c9d6c9 --- /dev/null +++ b/package.lisp @@ -0,0 +1,45 @@ +;;;; -*- 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) + ) diff --git a/pipes-example.lisp b/pipes-example.lisp new file mode 100644 index 0000000..c5722ec --- /dev/null +++ b/pipes-example.lisp @@ -0,0 +1,113 @@ +;;;; -*- 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)))) diff --git a/pipes.asd b/pipes.asd new file mode 100644 index 0000000..da527cd --- /dev/null +++ b/pipes.asd @@ -0,0 +1,36 @@ +;;;; -*- 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*))) + diff --git a/pipes.lisp b/pipes.lisp new file mode 100644 index 0000000..9b6b4c7 --- /dev/null +++ b/pipes.lisp @@ -0,0 +1,126 @@ +;;;; -*- 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