diff lisp/tl/tl-seq.el @ 4:b82b59fe008d r19-15b3

Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents
children 4b173ad71786
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/tl/tl-seq.el	Mon Aug 13 08:46:56 2007 +0200
@@ -0,0 +1,109 @@
+;;; tl-seq.el --- sequence functions
+
+;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Version:
+;;	$Id: tl-seq.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $
+;; Keywords: sequence
+
+;; This file is part of tl (Tiny Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with This program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'file-detect)
+
+(cond ((file-installed-p "cl-seq.elc")
+       (require 'cl)
+       )
+      (t
+       (defun find-if (pred seq)
+	 "Return the first element of sequence SEQ satisfying PRED.
+\[tl-seq.el]"
+	 (let ((i 0)(len (length seq)) element)
+	   (catch 'tag
+	     (while (< i len)
+	       (if (funcall pred (setq element (elt seq i)))
+		   (throw 'tag element)
+		 )
+	       (setq i (+ i 1))
+	       ))
+	   ))
+       
+       (defun find (item seq)
+	 "Return the first element which is found in sequence SEQ as item.
+\[tl-seq.el]"
+	 (find-if (function
+		   (lambda (elt)
+		     (eq elt item)
+		     ))
+		  seq))
+       ))
+
+(defun foldr (func a seq)
+  "Return (func (func (func (... (func a Sn) ...) S2) S1) S0)
+when func's argument is 2 and seq is a sequence whose
+elements = S0 S1 S2 ... Sn. [tl-seq.el]"
+  (let ((i (length seq)))
+    (while (> i 0)
+      (setq i (1- i))
+      (setq a (funcall func a (elt seq i)))
+      )
+    a))
+
+(defun foldl (func a seq)
+  "Return (... (func (func (func a S0) S1) S2) ...)
+when func's argument is 2 and seq is a sequence whose
+elements = S0 S1 S2 .... [tl-seq.el]"
+  (let ((len (length seq))
+	(i 0))
+    (while (< i len)
+      (setq a (funcall func a (elt seq i)))
+      (setq i (1+ i))
+      )
+    a))
+
+(defun pack-sequence (seq size)
+  (let ((len (length seq)) (p 0) obj
+	unit (i 0)
+	dest)
+    (while (< p len)
+      (setq obj (elt seq p))
+      (setq unit (cons obj unit))
+      (setq i (1+ i))
+      (if (= i size)
+	  (progn
+	    (setq dest (cons (reverse unit) dest))
+	    (setq unit nil)
+	    (setq i 0)
+	    ))
+      (setq p (1+ p))
+      )
+    (if unit
+	(setq dest (cons (reverse unit) dest))
+      )
+    (reverse dest)
+    ))
+
+
+;;; @ end
+;;;
+
+(provide 'tl-seq)
+
+;;; tl-seq.el ends here