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.1 2002/11/02 17:49:10 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 eval'ing 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   ;; pipes should never contain functions as values
  33   (if (functionp (rest pipe))
  34     (setf (rest pipe) (funcall (rest pipe)))
  35     (rest pipe)))
  36
  37 (defun pipe-head (pipe) (first pipe))
  38
  39 (defun pipe-elt (pipe n)
  40   "nth element of pipe, 0 based."
  41   (if (= n 0) (pipe-head pipe)
  42      (pipe-elt (pipe-tail pipe) (- n 1))))
  43
  44
  45 (defun enumerate (pipe &key count key (result pipe))
  46   "go through all or count elements of pipe,
  47    possibly applying the key function. "
  48   (if (or (eq pipe +empty-pipe+) (eql count 0))
  49     result
  50     (progn
  51       (unless (null key) (funcall key (pipe-head pipe)))
  52       (enumerate (pipe-tail pipe)
  53                  :count (if count (1- count))
  54                  :key key
  55                  :result result))))
  56
  57 (defun pipe-display (pipe &optional count)
  58   (enumerate pipe :count count))
  59
  60 (defun pipe-force (pipe)
  61   (enumerate pipe))
  62
  63 (defun pipe-filter (predicate pipe)
  64   "keep only items in (non-null) pipe satisfying predicate"
  65      (if (eq pipe +empty-pipe+)
  66       +empty-pipe+
  67       (let ((head (pipe-head pipe))
  68             (tail (pipe-tail pipe)))
  69       (if (funcall predicate head)
  70         (make-pipe head (pipe-filter predicate tail))
  71         (pipe-filter predicate tail)))))
  72
  73
  74 (defun pipe-map (fn pipe)
  75   "Map fn over pipe, delaying all but the first fn call,
  76    collecting res<ults"
  77   (if (eq pipe +empty-pipe+)
  78     +empty-pipe+
  79     (make-pipe (funcall fn (pipe-head pipe))
  80                (pipe-map fn (pipe-tail pipe)))))
  81
  82
  83 (defun pipe-map-filtering (fn pipe &optional filter-test)
  84   "Map fn over pipe, delaying all but the first fn call,
  85    collecting results"
  86   (if (eq pipe +empty-pipe+)
  87     +empty-pipe+
  88     (let* ((head (pipe-head pipe))
  89            (tail (pipe-tail pipe))
  90            (result (funcall fn head)))
  91       (if (or (and filter-test (funcall filter-test result))
  92               result)
  93         (make-pipe result (pipe-map-filtering fn tail filter-test))
  94         (pipe-map-filtering fn tail filter-test)))))
  95
  96
  97 (defun pipe-append (pipex pipey)
  98   "return a pipe that appends two pipes"
  99   (if (eq pipex +empty-pipe+)
 100     pipey
 101     (make-pipe (pipe-head pipex)
 102                (pipe-append (pipe-tail pipex) pipey))))
 103
 104 (defun pipe-mappend (fn pipe)
 105   "lazily map fn over pipe, appending results"
 106   (if (eq pipe +empty-pipe+)
 107     +empty-pipe+
 108     (let ((x (funcall fn (pipe-head pipe))))
 109       (make-pipe (pipe-head x)
 110                  (pipe-append (pipe-tail x)
 111                                (pipe-mappend fn (pipe-tail pipe)))))))
 112
 113 (defun pipe-mappend-filtering (fn pipe &optional filter-test)
 114   "Map fn over pipe, delaying all but the first fn call,
 115    appending results, filtering along the way"
 116   (if (eq pipe +empty-pipe+)
 117     +empty-pipe+
 118     (let* ((head (pipe-head pipe))
 119            (tail (pipe-tail pipe))
 120            (result (funcall fn head)))
 121       (if (or (and filter-test (funcall filter-test result))
 122               result)
 123         (make-pipe (pipe-head result)
 124                    (pipe-append (pipe-tail result)
 125                                  (pipe-mappend-filtering fn tail filter-test)))
 126         (pipe-mappend-filtering fn tail filter-test)))))