Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
C
Cabal
Manage
Activity
Members
Code
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
Analyze
Contributor analytics
CI/CD analytics
Repository analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Glasgow Haskell Compiler
Packages
Cabal
Commits
e0cd3027
Commit
e0cd3027
authored
9 years ago
by
kristenk
Browse files
Options
Downloads
Patches
Plain Diff
Refactor 'Explore.backjumpInfo' after code review
parent
2854bcb3
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
cabal-install/Distribution/Client/Dependency/Modular/Explore.hs
+5
-11
5 additions, 11 deletions
...install/Distribution/Client/Dependency/Modular/Explore.hs
with
5 additions
and
11 deletions
cabal-install/Distribution/Client/Dependency/Modular/Explore.hs
+
5
−
11
View file @
e0cd3027
...
...
@@ -32,17 +32,20 @@ import qualified Distribution.Client.Dependency.Types as T
-- return it immediately. If all children contain conflict sets, we can
-- take the union as the combined conflict set.
backjump
::
F
.
Foldable
t
=>
Var
QPN
->
t
(
ConflictSetLog
a
)
->
ConflictSetLog
a
backjump
var
xs
=
F
.
foldr
combine
b
ackjump
Info
xs
S
.
empty
backjump
var
xs
=
F
.
foldr
combine
logB
ackjump
xs
S
.
empty
where
combine
::
ConflictSetLog
a
->
(
ConflictSet
QPN
->
ConflictSetLog
a
)
->
ConflictSet
QPN
->
ConflictSetLog
a
combine
(
T
.
Done
x
)
_
_
=
T
.
Done
x
combine
(
T
.
Fail
cs
)
f
csAcc
|
not
(
simplifyVar
var
`
S
.
member
`
cs
)
=
b
ackjump
Info
cs
|
not
(
simplifyVar
var
`
S
.
member
`
cs
)
=
logB
ackjump
cs
|
otherwise
=
f
(
csAcc
`
S
.
union
`
cs
)
combine
(
T
.
Step
m
ms
)
f
cs
=
T
.
Step
m
(
combine
ms
f
cs
)
logBackjump
::
ConflictSet
QPN
->
ConflictSetLog
a
logBackjump
cs
=
failWith
(
Failure
cs
Backjump
)
cs
type
ConflictSetLog
=
T
.
Progress
Message
(
ConflictSet
QPN
)
-- | A tree traversal that simultaneously propagates conflict sets up
...
...
@@ -77,15 +80,6 @@ exploreLog = cata go
(
failWith
(
Failure
S
.
empty
EmptyGoalChoice
)
S
.
empty
)
-- empty goal choice is an internal error
(
\
k
v
_xs
->
continueWith
(
Next
(
close
k
))
(
v
a
))
-- commit to the first goal choice
-- | Add in information about pruned trees.
--
-- TODO: This isn't quite optimal, because we do not merely report the shape of the
-- tree, but rather make assumptions about where that shape originated from. It'd be
-- better if the pruning itself would leave information that we could pick up at this
-- point.
backjumpInfo
::
ConflictSet
QPN
->
ConflictSetLog
a
backjumpInfo
cs
=
failWith
(
Failure
cs
Backjump
)
cs
-- | Interface.
backjumpAndExplore
::
Tree
a
->
Log
Message
(
Assignment
,
RevDepMap
)
backjumpAndExplore
t
=
toLog
$
exploreLog
t
(
A
M
.
empty
M
.
empty
M
.
empty
)
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment