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