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
Knut Olav Bøhmer
alexandria
Commits
f20785f0
Commit
f20785f0
authored
Mar 06, 2011
by
Nikodemus Siivola
Browse files
more error-checking in RANDOM-ELT
Check for empty sequences and invalid bounding index designators.
parent
c9e15432
Changes
1
Hide whitespace changes
Inline
Side-by-side
sequences.lisp
View file @
f20785f0
...
...
@@ -104,13 +104,28 @@ error if SEQUENCE is not a proper sequence."
(
defun
random-elt
(
sequence
&key
(
start
0
)
end
)
"Returns a random element from SEQUENCE bounded by START and END. Signals an
error if the SEQUENCE is not a proper sequence."
error if the SEQUENCE is not a proper non-empty sequence, or if END and START
are not proper bounding index designators for SEQUENCE."
(
declare
(
sequence
sequence
)
(
fixnum
start
)
(
type
(
or
fixnum
null
)
end
))
(
let
((
i
(
+
start
(
random
(
-
(
or
end
(
if
(
listp
sequence
)
(
proper-list-length
sequence
)
(
length
sequence
)))
start
)))))
(
elt
sequence
i
)))
(
let*
((
size
(
if
(
listp
sequence
)
(
proper-list-length
sequence
)
(
length
sequence
)))
(
end2
(
or
end
size
)))
(
cond
((
zerop
size
)
(
error
'type-error
:datum
sequence
:expected-type
`
(
and
sequence
(
not
(
satisfies
emptyp
)))))
((
not
(
and
(
<=
0
start
)
(
<
start
end2
)
(
<=
end2
size
)))
(
error
'simple-type-error
:datum
(
cons
start
end
)
:expected-type
`
(
cons
(
integer
0
(
,
end2
))
(
or
null
(
integer
(
,
start
)
,
size
)))
:format-control
"~@<~S and ~S are not valid bounding index designators for ~
a sequence of length ~S.~:@>"
:format-arguments
(
list
start
end
size
)))
(
t
(
let
((
index
(
+
start
(
random
(
-
end2
start
)))))
(
elt
sequence
index
))))))
(
declaim
(
inline
remove/swapped-arguments
))
(
defun
remove/swapped-arguments
(
sequence
item
&rest
keyword-arguments
)
...
...
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