From b7d76c8f62b539f48a6d6454dcac21c8be47d2c5 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Tue, 30 Nov 1999 01:47:53 +0000 Subject: [PATCH] (last, mapc): New compiler macros for emulating cl functions. --- lisp/dgnushack.el | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) 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). -- 1.7.10.4