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
Momchil Ivanov
alexandria
Commits
7ff1807a
Commit
7ff1807a
authored
Apr 10, 2008
by
Attila Lendvai
Browse files
Added length
parent
3aa4b145
Changes
3
Hide whitespace changes
Inline
Side-by-side
package.lisp
View file @
7ff1807a
...
...
@@ -99,6 +99,7 @@
#:removef
#:rotate
#:sequence-of-length-p
#:length=
#:shuffle
#:starts-with
#:starts-with-subseq
...
...
sequences.lisp
View file @
7ff1807a
...
...
@@ -118,6 +118,60 @@ is not a sequence"
(
list
(
null
sequence
))
(
sequence
(
zerop
(
length
sequence
)))))
(
defun
length=
(
&rest
sequences
)
"Takes any number of sequences or integers in any order. Returns true iff
the length of all the sequences and the integers are equal. Hint: there's a
compiler macro that expands into more efficient code if the first argument
is a literal integer."
(
declare
(
dynamic-extent
sequences
)
(
inline
sequence-of-length-p
)
(
optimize
speed
))
(
unless
(
cdr
sequences
)
(
error
"You must call LENGTH= with at least two arguments"
))
;; There's room for optimization here: multiple list arguments could be
;; traversed in parallel.
(
let*
((
first
(
pop
sequences
))
(
current
(
if
(
integerp
first
)
first
(
length
first
))))
(
declare
(
type
array-index
current
))
(
dolist
(
el
sequences
)
(
if
(
integerp
el
)
(
unless
(
=
el
current
)
(
return-from
length=
nil
))
(
unless
(
sequence-of-length-p
el
current
)
(
return-from
length=
nil
)))))
t
)
(
define-compiler-macro
length=
(
&whole
form
length
&rest
sequences
)
(
cond
((
zerop
(
length
sequences
))
form
)
(
t
(
let
((
optimizedp
(
integerp
length
)))
(
with-unique-names
(
tmp
current
)
(
declare
(
ignorable
current
))
`
(
locally
(
declare
(
inline
sequence-of-length-p
))
(
let
((
,
tmp
)
,@
(
unless
optimizedp
`
((
,
current
,
length
))))
,@
(
unless
optimizedp
`
((
unless
(
integerp
,
current
)
(
setf
,
current
(
length
,
current
)))))
(
and
,@
(
loop
:for
sequence
:in
sequences
:collect
`
(
progn
(
setf
,
tmp
,
sequence
)
(
if
(
integerp
,
tmp
)
(
=
,
tmp
,
(
if
optimizedp
length
current
))
(
sequence-of-length-p
,
tmp
,
(
if
optimizedp
length
current
)))))))))))))
(
defun
sequence-of-length-p
(
sequence
length
)
"Return true if SEQUENCE is a sequence of length LENGTH. Signals an error if
SEQUENCE is not a sequence. Returns FALSE for circular lists."
...
...
tests.lisp
View file @
7ff1807a
...
...
@@ -1025,6 +1025,44 @@
4
))
(
t
t
t
t
t
t
nil
nil
nil
nil
))
(
deftest
length=.1
(
mapcar
#'
length=
(
list
nil
#(
)
(
list
1
)
(
vector
1
)
(
list
1
2
)
(
vector
1
2
)
(
list
1
2
)
(
vector
1
2
)
(
list
1
2
)
(
vector
1
2
))
(
list
0
0
1
1
2
2
1
1
4
4
))
(
t
t
t
t
t
t
nil
nil
nil
nil
))
(
deftest
length=.2
;; test the compiler macro
(
macrolet
((
x
(
&rest
args
)
(
funcall
(
compile
nil
`
(
lambda
()
(
length=
,@
args
))))))
(
list
(
x
2
'
(
1
2
))
(
x
'
(
1
2
)
'
(
3
4
))
(
x
'
(
1
2
)
2
)
(
x
'
(
1
2
)
2
'
(
3
4
))
(
x
1
2
3
)))
(
t
t
t
t
nil
))
(
deftest
copy-sequence.1
(
let
((
l
(
list
1
2
3
))
(
v
(
vector
#\a
#\b
#\c
)))
...
...
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