Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
A
alexandria
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
3
Issues
3
List
Boards
Labels
Milestones
Merge Requests
3
Merge Requests
3
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
alexandria
alexandria
Commits
fab0e59c
Commit
fab0e59c
authored
Jan 25, 2020
by
Philipp Marek
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fixed issue 13, WHICHEVER and singleargument calls.
parent
fc2a2f5c
Changes
2
Hide whitespace changes
Inline
Sidebyside
Showing
2 changed files
with
30 additions
and
16 deletions
+30
16
controlflow.lisp
controlflow.lisp
+21
16
tests.lisp
tests.lisp
+9
0
No files found.
controlflow.lisp
View file @
fab0e59c
...
@@ 50,22 +50,27 @@ returns the values of T or OTHERWISE if no keys match."
...
@@ 50,22 +50,27 @@ returns the values of T or OTHERWISE if no keys match."
(
defmacro
whichever
(
&rest
possibilities
&environment
env
)
(
defmacro
whichever
(
&rest
possibilities
&environment
env
)
"Evaluates exactly one of POSSIBILITIES, chosen at random."
"Evaluates exactly one of POSSIBILITIES, chosen at random."
(
setf
possibilities
(
mapcar
(
lambda
(
p
)
(
macroexpand
p
env
))
possibilities
))
(
setf
possibilities
(
mapcar
(
lambda
(
p
)
(
macroexpand
p
env
))
possibilities
))
(
if
(
every
(
lambda
(
p
)
(
constantp
p
))
possibilities
)
(
let
((
length
(
length
possibilities
)))
`
(
svref
(
loadtimevalue
(
vector
,@
possibilities
))
(
random
,
(
length
possibilities
)))
(
cond
(
labels
((
expand
(
possibilities
position
randomnumber
)
((
=
1
length
)
(
if
(
null
(
cdr
possibilities
))
(
first
possibilities
))
(
car
possibilities
)
((
every
#'
constantp
possibilities
)
(
let*
((
length
(
length
possibilities
))
`
(
svref
(
loadtimevalue
(
vector
,@
possibilities
))
(
half
(
truncate
length
2
))
(
random
,
length
)))
(
secondhalf
(
nthcdr
half
possibilities
))
(
T
(
firsthalf
(
butlast
possibilities
(

length
half
))))
(
labels
((
expand
(
possibilities
position
randomnumber
)
`
(
if
(
<
,
randomnumber
,
(
+
position
half
))
(
if
(
null
(
cdr
possibilities
))
,
(
expand
firsthalf
position
randomnumber
)
(
car
possibilities
)
,
(
expand
secondhalf
(
+
position
half
)
randomnumber
))))))
(
let*
((
length
(
length
possibilities
))
(
withgensyms
(
randomnumber
)
(
half
(
truncate
length
2
))
(
let
((
length
(
length
possibilities
)))
(
secondhalf
(
nthcdr
half
possibilities
))
`
(
let
((
,
randomnumber
(
random
,
length
)))
(
firsthalf
(
butlast
possibilities
(

length
half
))))
,
(
expand
possibilities
0
randomnumber
)))))))
`
(
if
(
<
,
randomnumber
,
(
+
position
half
))
,
(
expand
firsthalf
position
randomnumber
)
,
(
expand
secondhalf
(
+
position
half
)
randomnumber
))))))
(
withgensyms
(
randomnumber
)
`
(
let
((
,
randomnumber
(
random
,
length
)))
,
(
expand
possibilities
0
randomnumber
))))))))
(
defmacro
xor
(
&rest
datums
)
(
defmacro
xor
(
&rest
datums
)
"Evaluates its arguments one at a time, from left to right. If more than one
"Evaluates its arguments one at a time, from left to right. If more than one
...
...
tests.lisp
View file @
fab0e59c
...
@@ 188,6 +188,15 @@
...
@@ 188,6 +188,15 @@
(
and
(
member
x
'
(
1
2
3
))
t
))
(
and
(
member
x
'
(
1
2
3
))
t
))
t
)
t
)
;; https://gitlab.commonlisp.net/alexandria/alexandria/issues/13
(
deftest
whichever.3
(
multiplevaluebind
(
code
warnings?
)
(
compile
nil
`
(
lambda
(
x
)
(
whichever
(
1+
x
))))
(
and
(
not
warnings?
)
(
=
6
(
funcall
code
5
))))
t
)
(
deftest
xor.1
(
deftest
xor.1
(
xor
nil
nil
1
nil
)
(
xor
nil
nil
1
nil
)
1
1
...
...
Philipp Marek
@pmarek
mentioned in issue
#13 (closed)
·
Jan 25, 2020
mentioned in issue
#13 (closed)
mentioned in issue #13
Toggle commit list
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