Commit 4dc1f739 authored by ram's avatar ram
Browse files

Wrote MAP-INTO.

parent 395d99e3
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.12 1992/05/15 19:25:14 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.13 1993/08/17 20:48:00 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -29,6 +29,7 @@
substitute substitute-if substitute-if-not nsubstitute nsubstitute-if
nsubstitute-if-not find find-if find-if-not position position-if
position-if-not count count-if count-if-not mismatch search
map-into
identity)) ; Yep, thet's whar it is.
......@@ -644,6 +645,26 @@
(apply #'map (result-type-or-lose output-type-spec t)
function sequences)))))
(defun map-into (result-sequence function &rest sequences)
(let* ((fp-result
(and (arrayp result-sequence)
(array-has-fill-pointer-p result-sequence)))
(len (apply #'min
(if fp-result
(array-dimension result-sequence 0)
(length result-sequence))
(mapcar #'length sequences))))
(when fp-result
(setf (fill-pointer result-sequence) len))
(dotimes (index len)
(setf (elt result-sequence index)
(apply function
(mapcar #'(lambda (seq) (elt seq index))
sequences)))))
result-sequence)
;;; Quantifiers:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment