;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          pipes.lisp
;;;; Purpose:       Pipes based on ideas from Norvig's PAIP book
;;;; Programmers:   Kevin M. Rosenberg and Peter Norvig
;;;; Date Started:  Apr 2000
;;;;
;;;; $Id$
;;;;
;;;; *************************************************************************

(in-package #:pipes)

(defconstant +empty-pipe+ nil)

(defmacro make-pipe (head tail)
  "Create a pipe by evaluating 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."
  (if (functionp (rest pipe))
    (setf (rest pipe) (funcall (rest pipe)))
    (rest pipe)))

(defun pipe-head (pipe) (first pipe))

(defun pipe-elt (pipe i)
  "The i-th element of pipe, 0-based."
  (if (= i 0)
      (pipe-head pipe)
    (pipe-elt (pipe-tail pipe) (- i 1))))


(defun pipe-enumerate (pipe &key count key (result pipe))
  "Go through all (or count) elements of pipe,
   possibly applying the KEY function. (Try PRINT.)"
  ;; Returns RESULT, which defaults to the pipe itself.
  (if (or (eq pipe +empty-pipe+) (eql count 0))
    result
    (progn
      (unless (null key) (funcall key (pipe-head pipe)))
      (pipe-enumerate (pipe-tail pipe)
                 :count (if count (1- count))
                 :key key :result result))))

(defun pipe-values (pipe &optional count)
  "Simple wrapper to return values of a pipe"
  (pipe-enumerate pipe :count count))

(defun pipe-force (pipe)
  "Force the enumeration of all of the pipe. Never returns
if the pipe is infinite in length."
  (pipe-enumerate pipe))

(defun pipe-filter (predicate pipe)
  "Keep only items in 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."
  (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-pred)
  "Map fn over pipe, delaying all but the first fn call,
   while filtering 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-pred (funcall filter-pred result))
              result)
          (make-pipe result (pipe-map-filtering fn tail filter-pred))
        (pipe-map-filtering fn tail filter-pred)))))


(defun pipe-append (x y)
  "Return a pipe that appends the elements of x and y."
  (if (eq x +empty-pipe+)
      y
    (make-pipe (pipe-head x)
               (pipe-append (pipe-tail x) y))))


(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-pred)
  "Map fn over pipe, delaying all but the first fn call,
   appending results while filtering."
  (if (eq pipe +empty-pipe+)
      +empty-pipe+
    (let* ((head (pipe-head pipe))
           (tail (pipe-tail pipe))
           (result (funcall fn head)))
      (if (or (and filter-pred (funcall filter-pred result))
              result)
          (make-pipe (pipe-head result)
                     (pipe-append (pipe-tail result)
                                  (pipe-mappend-filtering fn tail filter-pred)))
        (pipe-mappend-filtering fn tail filter-pred)))))