Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
4dc1f739
Commit
4dc1f739
authored
Aug 17, 1993
by
ram
Browse files
Wrote MAP-INTO.
parent
395d99e3
Changes
1
Hide whitespace changes
Inline
Side-by-side
code/seq.lisp
View file @
4dc1f739
...
...
@@ -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.1
2
199
2
/0
5
/1
5 19:25:14 wlott
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.1
3
199
3
/0
8
/1
7 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:
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment