pipes.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          pipes.lisp
   6 ;;;; Purpose:       Pipes based on ideas from Norvig's PAIP book
   7 ;;;; Programmers:   Kevin M. Rosenberg and Peter Norvig
   8 ;;;; Date Started:  Apr 2000
   9 ;;;;
  10 ;;;; $Id: pipes.lisp,v 1.2 2002/11/07 20:26:13 kevin Exp $
  11 ;;;;
  12 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg and
  13 ;;;; Copyright (c) 1998-2002 by Peter Norvig.
  14 ;;;;
  15 ;;;; KMRCL users are granted the rights to distribute and use this software
  16 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  17 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  18 ;;;; *************************************************************************
  19
  20 (in-package :pipes)
  21
  22
  23 (defconstant +empty-pipe+ nil)
  24
  25 (defmacro make-pipe (head tail)
  26   "Create a pipe by evaluating head and delaying tail."
  27   `(cons ,head #'(lambda () ,tail)))
  28
  29 (defun pipe-tail (pipe)
  30   "Return tail of pipe or list, and destructively update
  31    the tail if it is a function."
  32   (if (functionp (rest pipe))
  33     (setf (rest pipe) (funcall (rest pipe)))
  34     (rest pipe)))
  35
  36 (defun pipe-head (pipe) (first pipe))
  37
  38 (defun pipe-elt (pipe i)
  39   "The i-th element of pipe, 0-based."
  40   (if (= i 0)
  41       (pipe-head pipe)
  42     (pipe-elt (pipe-tail pipe) (- i 1))))
  43
  44
  45 (defun pipe-enumerate (pipe &key count key (result pipe))
  46   "Go through all (or count) elements of pipe,
  47    possibly applying the KEY function. (Try PRINT.)"
  48   ;; Returns RESULT, which defaults to the pipe itself.
  49   (if (or (eq pipe +empty-pipe+) (eql count 0))
  50     result
  51     (progn
  52       (unless (null key) (funcall key (pipe-head pipe)))
  53       (pipe-enumerate (pipe-tail pipe)
  54                  :count (if count (1- count))
  55                  :key key :result result))))
  56
  57 (defun pipe-values (pipe &optional count)
  58   "Simple wrapper to return values of a pipe"
  59   (pipe-enumerate pipe :count count))
  60
  61 (defun pipe-force (pipe)
  62   "Force the enumeration of all of the pipe. Never returns
  63 if the pipe is infinite in length."
  64   (pipe-enumerate pipe))
  65
  66 (defun pipe-filter (predicate pipe)
  67   "Keep only items in pipe satisfying predicate."
  68   (if (eq pipe +empty-pipe+)
  69       +empty-pipe+
  70     (let ((head (pipe-head pipe))
  71           (tail (pipe-tail pipe)))
  72       (if (funcall predicate head)
  73           (make-pipe head (pipe-filter predicate tail))
  74         (pipe-filter predicate tail)))))
  75
  76
  77 (defun pipe-map (fn pipe)
  78   "Map fn over pipe, delaying all but the first fn call."
  79   (if (eq pipe +empty-pipe+)
  80       +empty-pipe+
  81     (make-pipe (funcall fn (pipe-head pipe))
  82                (pipe-map fn (pipe-tail pipe)))))
  83
  84
  85 (defun pipe-map-filtering (fn pipe &optional filter-pred)
  86   "Map fn over pipe, delaying all but the first fn call,
  87    while filtering results."
  88   (if (eq pipe +empty-pipe+)
  89       +empty-pipe+
  90     (let* ((head (pipe-head pipe))
  91            (tail (pipe-tail pipe))
  92            (result (funcall fn head)))
  93       (if (or (and filter-pred (funcall filter-pred result))
  94               result)
  95           (make-pipe result (pipe-map-filtering fn tail filter-pred))
  96         (pipe-map-filtering fn tail filter-pred)))))
  97
  98
  99 (defun pipe-append (x y)
 100   "Return a pipe that appends the elements of x and y."
 101   (if (eq x +empty-pipe+)
 102       y
 103     (make-pipe (pipe-head x)
 104                (pipe-append (pipe-tail x) y))))
 105
 106
 107 (defun pipe-mappend (fn pipe)
 108   "Lazily map fn over pipe, appending results."
 109   (if (eq pipe +empty-pipe+)
 110       +empty-pipe+
 111     (let ((x (funcall fn (pipe-head pipe))))
 112       (make-pipe (pipe-head x)
 113                  (pipe-append (pipe-tail x)
 114                               (pipe-mappend fn (pipe-tail pipe)))))))
 115
 116 (defun pipe-mappend-filtering (fn pipe &optional filter-pred)
 117   "Map fn over pipe, delaying all but the first fn call,
 118    appending results while filtering."
 119   (if (eq pipe +empty-pipe+)
 120       +empty-pipe+
 121     (let* ((head (pipe-head pipe))
 122            (tail (pipe-tail pipe))
 123            (result (funcall fn head)))
 124       (if (or (and filter-pred (funcall filter-pred result))
 125               result)
 126           (make-pipe (pipe-head result)
 127                      (pipe-append (pipe-tail result)
 128                                   (pipe-mappend-filtering fn tail filter-pred)))
 129         (pipe-mappend-filtering fn tail filter-pred)))))