cgit.sxemacs.org Git - packages/blob - xemacs-packages/tm/tl-seq.el

   1 ;;; tl-seq.el --- sequence functions
   2
   3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Version:
   7 ;;      $Id: tl-seq.el,v 1.1.1.1 1998-01-14 06:27:57 steve Exp $
   8 ;; Keywords: sequence
   9
  10 ;; This file is part of tl (Tiny Library).
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with This program; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Code:
  28
  29 (require 'file-detect)
  30
  31 (cond ((file-installed-p "cl-seq.elc")
  32        (require 'cl)
  33        )
  34       (t
  35        (defun find-if (pred seq)
  36          "Return the first element of sequence SEQ satisfying PRED.
  37 \[tl-seq.el]"
  38          (let ((i 0)(len (length seq)) element)
  39            (catch 'tag
  40              (while (< i len)
  41                (if (funcall pred (setq element (elt seq i)))
  42                    (throw 'tag element)
  43                  )
  44                (setq i (+ i 1))
  45                ))
  46            ))
  47
  48        (defun find (item seq)
  49          "Return the first element which is found in sequence SEQ as item.
  50 \[tl-seq.el]"
  51          (find-if (function
  52                    (lambda (elt)
  53                      (eq elt item)
  54                      ))
  55                   seq))
  56        ))
  57
  58 (defun foldr (func a seq)
  59   "Return (func (func (func (... (func a Sn) ...) S2) S1) S0)
  60 when func's argument is 2 and seq is a sequence whose
  61 elements = S0 S1 S2 ... Sn. [tl-seq.el]"
  62   (let ((i (length seq)))
  63     (while (> i 0)
  64       (setq i (1- i))
  65       (setq a (funcall func a (elt seq i)))
  66       )
  67     a))
  68
  69 (defun foldl (func a seq)
  70   "Return (... (func (func (func a S0) S1) S2) ...)
  71 when func's argument is 2 and seq is a sequence whose
  72 elements = S0 S1 S2 .... [tl-seq.el]"
  73   (let ((len (length seq))
  74         (i 0))
  75     (while (< i len)
  76       (setq a (funcall func a (elt seq i)))
  77       (setq i (1+ i))
  78       )
  79     a))
  80
  81 (defun pack-sequence (seq size)
  82   (let ((len (length seq)) (p 0) obj
  83         unit (i 0)
  84         dest)
  85     (while (< p len)
  86       (setq obj (elt seq p))
  87       (setq unit (cons obj unit))
  88       (setq i (1+ i))
  89       (if (= i size)
  90           (progn
  91             (setq dest (cons (reverse unit) dest))
  92             (setq unit nil)
  93             (setq i 0)
  94             ))
  95       (setq p (1+ p))
  96       )
  97     (if unit
  98         (setq dest (cons (reverse unit) dest))
  99       )
 100     (reverse dest)
 101     ))
 102
 103
 104 ;;; @ end
 105 ;;;
 106
 107 (provide 'tl-seq)
 108
 109 ;;; tl-seq.el ends here