Adding a generic option manager for the dolmen state #951
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,117 @@ | ||
| (**************************************************************************) | ||
| (* *) | ||
| (* Alt-Ergo: The SMT Solver For Software Verification *) | ||
| (* Copyright (C) 2013-2023 --- OCamlPro SAS *) | ||
| (* *) | ||
| (* This file is distributed under the terms of OCamlPro *) | ||
| (* Non-Commercial Purpose License, version 1. *) | ||
| (* *) | ||
| (* As an exception, Alt-Ergo Club members at the Gold level can *) | ||
| (* use this file under the terms of the Apache Software License *) | ||
| (* version 2.0. *) | ||
| (* *) | ||
| (* --------------------------------------------------------------- *) | ||
| (* *) | ||
| (* The Alt-Ergo theorem prover *) | ||
| (* *) | ||
| (* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) | ||
| (* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) | ||
| (* *) | ||
| (* CNRS - INRIA - Universite Paris Sud *) | ||
| (* *) | ||
| (* Until 2013, some parts of this code were released under *) | ||
| (* the Apache Software License version 2.0. *) | ||
| (* *) | ||
| (* --------------------------------------------------------------- *) | ||
| (* *) | ||
| (* More details can be found in the directory licenses/ *) | ||
| (* *) | ||
| (**************************************************************************) | ||
|
|
||
| module O = Options | ||
| module State = D_loop.State | ||
| module Typer = D_loop.Typer | ||
|
|
||
| module type Input = sig | ||
| type k | ||
|
|
||
| type t | ||
|
|
||
| val get : unit -> k | ||
|
|
||
| val key : string | ||
|
|
||
| val on_update : k -> unit | ||
|
|
||
| val map : k -> t | ||
| end | ||
|
|
||
| module type S = sig | ||
| type k | ||
|
|
||
| type t | ||
|
|
||
| val set : k -> Typer.state -> Typer.state | ||
|
|
||
| val get : Typer.state -> t | ||
|
|
||
| val reset : Typer.state -> Typer.state | ||
| end | ||
|
|
||
| module Make(O:Input) : S with type k = O.k and type t = O.t = struct | ||
| type k = O.k | ||
| type t = O.t | ||
|
|
||
| let key = State.create_key ~pipe:"" O.key | ||
|
|
||
| let set opt st = | ||
| let st = State.set key (O.map opt) st in | ||
| O.on_update opt; | ||
| st | ||
|
|
||
| let get st = | ||
| try State.get key st with | ||
| | State.Key_not_found _ -> O.map (O.get ()) | ||
|
|
||
| let reset = set (O.get ()) | ||
| end | ||
|
|
||
| let create_opt | ||
| (type k) | ||
| (type t) | ||
| ?(on_update=ignore) | ||
bclement-ocp marked this conversation as resolved.
Show resolved
Hide resolved
|
||
| key | ||
| (get : unit -> k) | ||
| (map : (k -> t)) = | ||
| (module ( | ||
| Make ( | ||
| struct | ||
| type nonrec k = k | ||
| type nonrec t = t | ||
| let key = key | ||
| let get = get | ||
| let on_update = on_update | ||
| let map = map | ||
| end) | ||
| ) : S with type k = k and type t = t) | ||
|
There was a problem hiding this comment. I think we should either go through first-class module or through a (module struct
type nonrec k = k
type nonrec t = t
let key = State.create_key ~pipe:"" key
let set opt st = (* .. as in Make *)
let reset = set (get ())
let get st = (* .. as in Make *)
end : S with type k = k and type t = t)which would get rid of both the |
||
|
|
||
| module ProduceAssignment = | ||
| (val (create_opt "produce_assignment" (fun _ -> false)) Fun.id) | ||
|
|
||
| module Optimize = | ||
| (val (create_opt "optimize" O.get_optimize) Fun.id) | ||
|
|
||
| let msatsolver = | ||
| let map s = | ||
| let module SatCont = | ||
| (val (Sat_solver.get s) : Sat_solver_sig.SatContainer) in | ||
| let module TH = | ||
| (val | ||
| (if Options.get_no_theory() then (module Theory.Main_Empty : Theory.S) | ||
| else (module Theory.Main_Default : Theory.S)) : Theory.S ) in | ||
| s, | ||
| (module SatCont.Make(TH) : Sat_solver_sig.S) | ||
| in | ||
| (create_opt "sat_solver" O.get_sat_solver map) | ||
|
|
||
| module SatSolver = (val msatsolver) | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,56 @@ | ||
| (**************************************************************************) | ||
| (* *) | ||
| (* Alt-Ergo: The SMT Solver For Software Verification *) | ||
| (* Copyright (C) 2013-2023 --- OCamlPro SAS *) | ||
| (* *) | ||
| (* This file is distributed under the terms of OCamlPro *) | ||
| (* Non-Commercial Purpose License, version 1. *) | ||
| (* *) | ||
| (* As an exception, Alt-Ergo Club members at the Gold level can *) | ||
| (* use this file under the terms of the Apache Software License *) | ||
| (* version 2.0. *) | ||
| (* *) | ||
| (* --------------------------------------------------------------- *) | ||
| (* *) | ||
| (* The Alt-Ergo theorem prover *) | ||
| (* *) | ||
| (* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) | ||
| (* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) | ||
| (* *) | ||
| (* CNRS - INRIA - Universite Paris Sud *) | ||
| (* *) | ||
| (* Until 2013, some parts of this code were released under *) | ||
| (* the Apache Software License version 2.0. *) | ||
| (* *) | ||
| (* --------------------------------------------------------------- *) | ||
| (* *) | ||
| (* More details can be found in the directory licenses/ *) | ||
| (* *) | ||
| (**************************************************************************) | ||
|
|
||
| (** The Dolmen state option manager. Each module defined below is linked to | ||
| an option that can be set, fetched et reset independently from the | ||
| Options module, which is used as a static reference. *) | ||
|
|
||
| module type S = sig | ||
| (** The type of options. It should match the type in the module Options. *) | ||
| type k | ||
|
|
||
| (** The data saved in the state. May differ from the saved option. *) | ||
| type t | ||
|
|
||
| (** Sets the option on the dolmen state, with a transformation from k to t. *) | ||
| val set : k -> D_loop.Typer.state -> D_loop.Typer.state | ||
|
|
||
| (** Returns the option stored in the state. If it has not been registered, | ||
| fetches the default option in the module Options. *) | ||
| val get : D_loop.Typer.state -> t | ||
|
|
||
| (** Resets the option to its default value in Options. *) | ||
| val reset : D_loop.Typer.state -> D_loop.Typer.state | ||
| end | ||
|
|
||
| module ProduceAssignment : S with type k = bool and type t = bool | ||
| module Optimize : S with type k = bool and type t = bool | ||
| module SatSolver : S with type k = Util.sat_solver | ||
| and type t = Util.sat_solver * (module Sat_solver_sig.S) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
This one seems unused?
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
It is used in
setand, while there is no option settingon_updateyet, it will be useful for other options (like the steps limit that has to check a few things before setting the option).There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I am not sure how a function with type
k -> unitcan be very meaningfully used to perform checks. Is the idea to have it raise an exception? I worry this would start to make the control flow for setting options quite a bit more convoluted than it needs to be.