X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=pipes.lisp;fp=pipes.lisp;h=0000000000000000000000000000000000000000;hb=2fe4af4d562f6d76038e85d68e5808a35d6fe2c5;hp=5b80bb844fd8d8e8952c80c46e73e52246088e06;hpb=1e45868ec74faab1998701ddb084f1117146a0b3;p=kmrcl.git

diff --git a/pipes.lisp b/pipes.lisp
deleted file mode 100644
index 5b80bb8..0000000
--- a/pipes.lisp
+++ /dev/null
@@ -1,229 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          pipes.lisp
-;;;; Purpose:       Pipes based on ideas from Norvig's PAIP book
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Apr 2000
-;;;;
-;;;; $Id: pipes.lisp,v 1.3 2002/10/10 16:23:48 kevin Exp $
-;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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 :kmrcl)
-
-(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."
-  ;; This assumes that pipes will 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 i)
-  "ith element of pipe, 0 based."
-  (if (= i 0) (pipe-head pipe)
-     (pipe-elt (pipe-tail pipe) (- i 1))))
-
-(defconstant +empty-pipe+ nil)
-
-(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))
-
-;;; incorrect version-- as in Norvig.
-;(defun filter-pipe (predicate pipe)
-;  "keep only items in (non-null) pipe satisfying predicate"
-;  (if (funcall predicate (head pipe))
-;    (make-pipe (head pipe) (filter-pipe predicate (tail pipe)))
-;    (pipe-filter predicate (tail 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)))))
-
-
-
-#||
-;; Applications
-
-(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)))
-
-
- (pipe-display (pi-stream) 10)
- (pipe-display (euler-transform (pi-stream)) 10)
- (pipe-display (accelerated-sequence #'euler-transform (pi-stream)) 10)
-
-||#
-