From: yamaoka <yamaoka>
Date: Tue, 30 Nov 1999 01:47:53 +0000 (+0000)
Subject: (last, mapc): New compiler macros for emulating cl functions.
X-Git-Tag: t-gnus-6_13_3-07~12
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=b7d76c8f62b539f48a6d6454dcac21c8be47d2c5;p=elisp%2Fgnus.git-

(last, mapc): New compiler macros for emulating cl functions.
---

diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el
index 24d24c3..da5e2c2 100644
--- a/lisp/dgnushack.el
+++ b/lisp/dgnushack.el
@@ -49,6 +49,48 @@
 (fset 'facep 'ignore)
 
 (require 'cl)
+
+;; cl functions.
+(define-compiler-macro mapc (&whole form fn seq &rest rest)
+  (if (and (fboundp 'mapc)
+	   (subrp (symbol-function 'mapc)))
+      form
+    (if rest
+	`(let* ((fn ,fn)
+		(seq ,seq)
+		(args (cons seq ,rest))
+		(m (apply (function min) (mapcar (function length) args)))
+		(n 0))
+	   (while (< n m)
+	     (apply fn (mapcar (function (lambda (arg) (nth n arg))) args))
+	     (setq n (1+ n)))
+	   seq)
+      `(let ((seq ,seq))
+	 (mapcar ,fn seq)
+	 seq))))
+
+(define-compiler-macro last (&whole form x &optional n)
+  (if (and (fboundp 'last)
+	   (subrp (symbol-function 'last)))
+      form
+    (if n
+	`(let* ((x ,x)
+		(n ,n)
+		(m 0)
+		(p x))
+	   (while (consp p)
+	     (incf m)
+	     (pop p))
+	   (if (<= n 0)
+	       p
+	     (if (< n m)
+		 (nthcdr (- m n) x)
+	       x)))
+      `(let ((x ,x))
+	 (while (consp (cdr x))
+	   (pop x))
+	 x))))
+
 (require 'bytecomp)
 
 ;; Attempt to pickup the additional load-path(s).