NMAP a good idea if done correctly (blush)

[MURRAY%cs.umass.edu@RELAY.CS.NET]

I think the NMAP function is an excellent idea.  Mapping is generally
a good way to express things, and lends itself to parallelism.

However, I would call the proposed function MAP-INTO, and
have provided a definition below.  The definition provided
by Sasseen has the same Bug that most implementations
have with some sequence functions - they call LENGTH
on the arguments, which will never return for circular lists.

By having it be a macro instead of a function, it performs
NO consing, since the number of arguments are known,
and FUNCALL can be used.  However, it suffers the macro problem,
in that macros cannot be APPLYed.  
The right way to do it is to have it be a function that
has a compiler transform to expand calls at compile time.
Unfortunately, compiler transforms are not part of Common Lisp.

BTW: It took me 2 hours and 10 minutes to write and debug this macro.

 -- Kelly Murray


(defmacro MAP-INTO (into-seq function &rest arg-seqs)
  "MAP-INTO into-seq function &rest arg-seqs
Calls function on each element of the arg-seqs, storing results
in corresponding element of into-seq. Returns modified into-seq."
  (let* ((rs-sym (gensym "RS-SYM"))
         (seq-syms (mapcar
		     #'(lambda (ignore) (gensym "SEQ"))
		     arg-seqs))
         (consp-syms (mapcar
		       #'(lambda (ignore) (gensym "SEQ-CONSP"))
		       arg-seqs))
	 (rs-size (gensym "RS-SIZE"))
	 (rs-cons (gensym "RS-CONS"))
	 (seq-index (gensym "SEQ-INDEX"))
	 (max-sym (gensym "MAX-INDEX"))
	 (result-sym (gensym "RESULT"))
	 (fun-sym (gensym "FUN")))

    (cond
      ((null arg-seqs)	 ; No arguments?
       `(let* ((,rs-sym ,into-seq)
	       (,fun-sym ,function)
	       (,rs-cons (consp ,rs-sym)))
	  (when ,rs-sym	 ; Not NIL
	    (if ,rs-cons
		(do ((,rs-cons ,rs-sym (cdr ,rs-cons)))
		    ((endp ,rs-cons) ,rs-sym)
		  (setf (car ,rs-cons) (funcall ,fun-sym)))
		(dotimes (,rs-size (length ,rs-sym) ,rs-sym)
		  (setf (elt ,rs-sym ,rs-size) (funcall ,fun-sym))))
	    )))
      (:Else
		  
    ;; First Eval the arguments.
    `(let* ((,rs-sym ,into-seq)
	    (,fun-sym ,function)
	    ,@(mapcar #'(lambda(sym seq)(list sym seq))
		      seq-syms arg-seqs)
	    ; Determine result type
	    (,rs-cons (when (consp ,rs-sym) ,rs-sym))
	    (,rs-size (unless ,rs-cons (length ,rs-sym)))
	    ,@(mapcar #'(lambda(sym seq)(list sym `(consp ,seq)))	
		      consp-syms seq-syms)	; Consp variables
	    (,max-sym nil)
	    (,result-sym nil)
	    )
       ;; Determine maximum index for any argument vectors.
       ,@(mapcar
	   #'(lambda(sym consp)
	       `(unless ,consp
		  (if ,max-sym
		      (setq ,max-sym (min ,max-sym (length ,sym)))
		      (setq ,max-sym (length ,sym)))))
	   seq-syms
	   consp-syms)
       (or ,max-sym (setq ,max-sym -1)) ; = never true for conses
       (do ((,seq-index 0 (1+ ,seq-index)))
           ((or (= ,seq-index ,max-sym)	; Hit smaller 
		,@(mapcan
                   #'(lambda (sym)
		       `((not ,sym)))	; End of a List.
                    seq-syms))
	    ,rs-sym)			; Return the result sequence.
	 ;; Call the function.
	 (setq ,result-sym
	       (funcall ,fun-sym
			,@(mapcar #'(lambda(sym consp)
				      `(if ,consp (pop ,sym)
					   (elt ,sym ,seq-index)))
				  seq-syms
				  consp-syms)))
	 ;; Store the results
	 (cond
	   (,rs-cons			       
	    (setf (car ,rs-cons) ,result-sym)
	    (pop ,rs-cons))
	   ((< ,seq-index ,rs-size)
	    (setf (elt ,rs-sym ,seq-index) ,result-sym)))
	 ))))
    ))