/usr/share/common-lisp/source/pipes/src.lisp is in cl-pipes 1.2.1-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | ;;;; -*- 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: src.lisp 8627 2004-02-06 14:19:48Z kevin $
;;;;
;;;; *************************************************************************
(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)))))
|