src.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$
  11 ;;;;
  12 ;;;; *************************************************************************
  13
  14 (in-package #:pipes)
  15
  16 (defconstant +empty-pipe+ nil)
  17
  18 (defmacro make-pipe (head tail)
  19   "Create a pipe by evaluating head and delaying tail."
  20   `(cons ,head #'(lambda () ,tail)))
  21
  22 (defun pipe-tail (pipe)
  23   "Return tail of pipe or list, and destructively update
  24    the tail if it is a function."
  25   (if (functionp (rest pipe))
  26     (setf (rest pipe) (funcall (rest pipe)))
  27     (rest pipe)))
  28
  29 (defun pipe-head (pipe) (first pipe))
  30
  31 (defun pipe-elt (pipe i)
  32   "The i-th element of pipe, 0-based."
  33   (if (= i 0)
  34       (pipe-head pipe)
  35     (pipe-elt (pipe-tail pipe) (- i 1))))
  36
  37
  38 (defun pipe-enumerate (pipe &key count key (result pipe))
  39   "Go through all (or count) elements of pipe,
  40    possibly applying the KEY function. (Try PRINT.)"
  41   ;; Returns RESULT, which defaults to the pipe itself.
  42   (if (or (eq pipe +empty-pipe+) (eql count 0))
  43     result
  44     (progn
  45       (unless (null key) (funcall key (pipe-head pipe)))
  46       (pipe-enumerate (pipe-tail pipe)
  47                  :count (if count (1- count))
  48                  :key key :result result))))
  49
  50 (defun pipe-values (pipe &optional count)
  51   "Simple wrapper to return values of a pipe"
  52   (pipe-enumerate pipe :count count))
  53
  54 (defun pipe-force (pipe)
  55   "Force the enumeration of all of the pipe. Never returns
  56 if the pipe is infinite in length."
  57   (pipe-enumerate pipe))
  58
  59 (defun pipe-filter (predicate pipe)
  60   "Keep only items in pipe satisfying predicate."
  61   (if (eq pipe +empty-pipe+)
  62       +empty-pipe+
  63     (let ((head (pipe-head pipe))
  64           (tail (pipe-tail pipe)))
  65       (if (funcall predicate head)
  66           (make-pipe head (pipe-filter predicate tail))
  67         (pipe-filter predicate tail)))))
  68
  69
  70 (defun pipe-map (fn pipe)
  71   "Map fn over pipe, delaying all but the first fn call."
  72   (if (eq pipe +empty-pipe+)
  73       +empty-pipe+
  74     (make-pipe (funcall fn (pipe-head pipe))
  75                (pipe-map fn (pipe-tail pipe)))))
  76
  77
  78 (defun pipe-map-filtering (fn pipe &optional filter-pred)
  79   "Map fn over pipe, delaying all but the first fn call,
  80    while filtering results."
  81   (if (eq pipe +empty-pipe+)
  82       +empty-pipe+
  83     (let* ((head (pipe-head pipe))
  84            (tail (pipe-tail pipe))
  85            (result (funcall fn head)))
  86       (if (or (and filter-pred (funcall filter-pred result))
  87               result)
  88           (make-pipe result (pipe-map-filtering fn tail filter-pred))
  89         (pipe-map-filtering fn tail filter-pred)))))
  90
  91
  92 (defun pipe-append (x y)
  93   "Return a pipe that appends the elements of x and y."
  94   (if (eq x +empty-pipe+)
  95       y
  96     (make-pipe (pipe-head x)
  97                (pipe-append (pipe-tail x) y))))
  98
  99
 100 (defun pipe-mappend (fn pipe)
 101   "Lazily map fn over pipe, appending results."
 102   (if (eq pipe +empty-pipe+)
 103       +empty-pipe+
 104     (let ((x (funcall fn (pipe-head pipe))))
 105       (make-pipe (pipe-head x)
 106                  (pipe-append (pipe-tail x)
 107                               (pipe-mappend fn (pipe-tail pipe)))))))
 108
 109 (defun pipe-mappend-filtering (fn pipe &optional filter-pred)
 110   "Map fn over pipe, delaying all but the first fn call,
 111    appending results while filtering."
 112   (if (eq pipe +empty-pipe+)
 113       +empty-pipe+
 114     (let* ((head (pipe-head pipe))
 115            (tail (pipe-tail pipe))
 116            (result (funcall fn head)))
 117       (if (or (and filter-pred (funcall filter-pred result))
 118               result)
 119           (make-pipe (pipe-head result)
 120                      (pipe-append (pipe-tail result)
 121                                   (pipe-mappend-filtering fn tail filter-pred)))
 122         (pipe-mappend-filtering fn tail filter-pred)))))