Source file opamSolverConfig.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
type t = {
cudf_file: string option;
solver: (module OpamCudfSolver.S) Lazy.t;
best_effort: bool;
solver_preferences_default: string option Lazy.t;
solver_preferences_upgrade: string option Lazy.t;
solver_preferences_fixup: string option Lazy.t;
solver_preferences_best_effort_prefix: string option Lazy.t;
solver_timeout: float option;
}
type 'a options_fun =
?cudf_file:string option ->
?solver:((module OpamCudfSolver.S) Lazy.t) ->
?best_effort:bool ->
?solver_preferences_default:string option Lazy.t ->
?solver_preferences_upgrade:string option Lazy.t ->
?solver_preferences_fixup:string option Lazy.t ->
?solver_preferences_best_effort_prefix:string option Lazy.t ->
?solver_timeout:float option ->
'a
let default =
let solver = lazy (
OpamCudfSolver.get_solver OpamCudfSolver.default_solver_selection
) in
{
cudf_file = None;
solver;
best_effort = false;
solver_preferences_default = lazy None;
solver_preferences_upgrade = lazy None;
solver_preferences_fixup = lazy None;
solver_preferences_best_effort_prefix = lazy None;
solver_timeout = Some 60.;
}
let setk k t
?cudf_file
?solver
?best_effort
?solver_preferences_default
?solver_preferences_upgrade
?solver_preferences_fixup
?solver_preferences_best_effort_prefix
?solver_timeout
=
let (+) x opt = match opt with Some x -> x | None -> x in
k {
cudf_file = t.cudf_file + cudf_file;
solver = t.solver + solver;
best_effort = t.best_effort + best_effort;
solver_preferences_default =
t.solver_preferences_default + solver_preferences_default;
solver_preferences_upgrade =
t.solver_preferences_upgrade + solver_preferences_upgrade;
solver_preferences_fixup =
t.solver_preferences_fixup + solver_preferences_fixup;
solver_preferences_best_effort_prefix =
t.solver_preferences_best_effort_prefix +
solver_preferences_best_effort_prefix;
solver_timeout =
t.solver_timeout + solver_timeout;
}
let set t = setk (fun x () -> x) t
let r = ref default
let update ?noop:_ = setk (fun cfg () -> r := cfg) !r
let with_auto_criteria config =
let criteria = lazy (
let module S = (val Lazy.force config.solver) in
S.default_criteria
) in
set config
~solver_preferences_default:
(lazy (match config.solver_preferences_default with
| lazy None -> Some (Lazy.force criteria).OpamCudfSolver.crit_default
| lazy some -> some))
~solver_preferences_upgrade:
(lazy (match config.solver_preferences_upgrade with
| lazy None -> Some (Lazy.force criteria).OpamCudfSolver.crit_upgrade
| lazy some -> some))
~solver_preferences_fixup:
(lazy (match config.solver_preferences_fixup with
| lazy None -> Some (Lazy.force criteria).OpamCudfSolver.crit_fixup
| lazy some -> some))
~solver_preferences_best_effort_prefix:
(lazy (match config.solver_preferences_best_effort_prefix with
| lazy None ->
(Lazy.force criteria).OpamCudfSolver.crit_best_effort_prefix
| lazy some -> some))
()
let initk k =
let open OpamStd.Config in
let open OpamStd.Option.Op in
let solver =
let open OpamCudfSolver in
match env_string "EXTERNALSOLVER" with
| Some "" -> lazy (get_solver ~internal:true default_solver_selection)
| Some s -> lazy (solver_of_string s)
| None ->
let internal = env_bool "USEINTERNALSOLVER" ++ env_bool "NOASPCUD" in
lazy (get_solver ?internal default_solver_selection)
in
let best_effort =
env_bool "BESTEFFORT" in
let criteria =
env_string "CRITERIA" >>| fun c -> lazy (Some c) in
let upgrade_criteria =
(env_string "UPGRADECRITERIA" >>| fun c -> lazy (Some c)) ++ criteria in
let fixup_criteria =
env_string "FIXUPCRITERIA" >>| fun c -> (lazy (Some c)) in
let best_effort_prefix_criteria =
env_string "BESTEFFORTPREFIXCRITERIA" >>| fun c -> (lazy (Some c)) in
let solver_timeout =
env_float "SOLVERTIMEOUT" >>| fun f -> if f <= 0. then None else Some f in
setk (setk (fun c -> r := with_auto_criteria c; k)) !r
~cudf_file:(env_string "CUDFFILE")
~solver
?best_effort
?solver_preferences_default:criteria
?solver_preferences_upgrade:upgrade_criteria
?solver_preferences_fixup:fixup_criteria
?solver_preferences_best_effort_prefix:best_effort_prefix_criteria
?solver_timeout
let init ?noop:_ = initk (fun () -> ())
let best_effort =
let r = lazy (
!r.best_effort &&
let crit = match Lazy.force !r.solver_preferences_default with
| Some c -> c
| None -> failwith "Solver criteria uninitialised"
in
let pfx = Lazy.force !r.solver_preferences_best_effort_prefix in
pfx <> None ||
OpamStd.String.contains ~sub:"opam-query" crit ||
(OpamConsole.warning
"Your solver configuration does not support --best-effort, the option \
was ignored (you need to specify variable OPAMBESTEFFORTCRITERIA, or \
set your criteria to maximise the count for cudf attribute \
'opam-query')";
false)
) in
fun () -> Lazy.force r
let criteria kind =
let crit = match kind with
| `Default -> !r.solver_preferences_default
| `Upgrade -> !r.solver_preferences_upgrade
| `Fixup -> !r.solver_preferences_fixup
in
let str =
match Lazy.force crit with
| Some c -> c
| None -> failwith "Solver criteria uninitialised"
in
if !r.best_effort then
match !r.solver_preferences_best_effort_prefix with
| lazy (Some pfx) -> pfx ^ str
| lazy None -> str
else str
let call_solver ~criteria cudf =
let module S = (val Lazy.force (!r.solver)) in
OpamConsole.log "SOLVER" "Calling solver %s with criteria %s"
(OpamCudfSolver.get_name (module S)) criteria;
S.call ~criteria ?timeout:(!r.solver_timeout) cudf