;;; mapcar.el -- multi-list mapcar + related functions

;;; Copyright (C) 1992 Jamie Zawinkski <jwz@lucid.com>
;;; Copyright (C) 1993 Noah S. Friedman <friedman@prep.ai.mit.edu>

;;; Authors: Jamie Zawinkski, Noah Friedman
;;; Maintainer: friedman@prep.ai.mit.edu

;;; $Id: mapcar.el,v 1.2 2015/01/03 05:09:36 friedman Exp $

;;; 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; if not, you can either send email to this
;;; program's author (see below) or write to: The Free Software Foundation,
;;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.


;; save the builtin mapcar function, since for the one-arg case, it's faster.
(and (subrp (symbol-function 'mapcar))
     (fset 'mapcar-1 (symbol-function 'mapcar)))

(defun mapcar (function &rest lists)
  "Given a FUNCTION of R arguments and R lists (x1 ... xN) ... (z1 ... zN),
MAPCAR returns the list (e1 ... eN) where eI is the value of FUNCTION when
applied to the arguments xI,...,zI: eI is the value of (FUNCTION xI ... zI).
The lists need not have the same length - the length of the return list
is the length of the shortest of the R lists, even if some of the lists
are cyclic.  See also `mapc', `mapcan' and `mapcon'."
  (if (not (cdr lists))
      (mapcar-1 function (car lists))    ; for one arg, do it all in C.
    (let (restarg result tail tmp1 tmp2)
      (while lists
	(if result                      ; subsequent times around
	    (progn
	      (setq tmp1 restarg tmp2 lists)
	      ;; alter the list passed as the last arg to apply to correspond
	      ;; to this iteration
	      (while tmp1
		(setcar tmp1 (car (car tmp2)))
		(setq tmp1 (cdr tmp1) tmp2 (cdr tmp2)))
	      (nconc tail (setq tail (cons (apply function restarg) nil))))
	  (setq result                  ; first time around
		(setq tail
		      (list (apply function
				   ;; mapcar-1 is faster than a while loop.
				   (setq restarg (mapcar-1 'car lists)))))))
	;; pop an element of each sub-list; this modifies only the conses
	;;in `lists', not the lists pointed to.
	(setq tmp1 lists)
	(while tmp1
	  (setcar tmp1 (cdr (car tmp1)))
	  (or (car tmp1) (setq tmp1 (setq lists nil)))
	  (setq tmp1 (cdr tmp1))))
      result)))

(defun mapcan (function &rest lists)
  "Given a FUNCTION of R arguments and R lists (x1 ... xN) ... (z1 ... zN),
MAPCAN returns the list obtained by NCONCing the lists which are the values
of (FUNCTION x1 ... z1) ... (FUNCTION xN ... zN).  The lists need not have
the same length - mapcan terminates when the end of the shortest list is
reached.  See also `mapcar', `mapc' and `mapcon'."
  (let (restarg result tail tmp1 tmp2)
    (while lists
      (if restarg
	  (progn
	    (setq tmp1 restarg tmp2 lists)
	    (while tmp1
	      (setcar tmp1 (car (car tmp2)))
	      (setq tmp1 (cdr tmp1) tmp2 (cdr tmp2)))
	    (setq tmp1 (apply function restarg))
	    (or (consp tmp1)
		(error "non-null atom intermediate result %s in mapcan." tmp1))
	    (nconc tail tmp1)
	    (setq tail tmp1))
	(setq result
	      (setq tail
		    (apply function
			   (setq restarg (mapcar-1 'car lists))))))
      (setq tmp1 lists)
      (while tmp1
	(setcar tmp1 (cdr (car tmp1)))
	(or (car tmp1) (setq tmp1 (setq lists nil)))
	(setq tmp1 (cdr tmp1))))
    result))

(defun mapcon (function &rest lists)
  "Given a FUNCTION of R arguments and R lists (x1 ... xN) ... (z1 ... zN),
MAPCON returns the list obtained by NCONCing the lists which are the values
of (FUNCTION (x1...xN) ... (z1...zN)) ... (FUNCTION (xN) ... (zN)).  The
lists need not have the same length - mapcon terminates when the end of the
shortest list is reached.  See also `mapcar', `mapcan' and `mapc'."
  (let (result tail tmp)
    (while lists
      (setq tmp (apply function lists))
      (or (consp tmp)
	  (error "non-null atom intermediate result %s in mapcon." tmp))
      (if tail
	  (progn
	    (nconc tail tmp)
	    (setq tail tmp))
	(setq result (setq tail tmp)))
      (setq tmp lists)
      (while tmp
	(setcar tmp (cdr (car tmp)))
	(or (car tmp) (setq tmp (setq lists nil)))
	(setq tmp (cdr tmp))))
    result))

(defun mapc (function &rest lists)
  "Given a FUNCTION of R arguments and R lists (x1 ... xN) ... (z1 ... zN),
MAP applies FUNCTION successively to (x1 ... z1),...,(xN ... zN) ignoring the
values returned.  MAPC returns the first of the lists, and is thus only useful
when called for effect.  The lists need not have the same length - mapc
terminates when the end of the shortest list is reached.  See also `mapcar',
`mapcan' and `mapcon'."
  (let ((result (car lists))
	restarg tmp1 tmp2)
    (while lists
      (if restarg
	  (progn
	    (setq tmp1 restarg tmp2 lists)
	    (while tmp1
	      (setcar tmp1 (car (car tmp2)))
	      (setq tmp1 (cdr tmp1) tmp2 (cdr tmp2)))
	    (apply function restarg))
	(apply function (setq restarg (mapcar-1 'car lists))))
      (setq tmp1 lists)
      (while tmp1
	(setcar tmp1 (cdr (car tmp1)))
	(or (car tmp1) (setq tmp1 (setq lists nil)))
	(setq tmp1 (cdr tmp1))))
    result))

(provide 'mapcar)

;; End of file mapcar.el