From 3613cdc6b72d14cc45c063c1127287da8b4baa82 Mon Sep 17 00:00:00 2001 From: Antoine Pouille Date: Wed, 25 Sep 2024 17:29:33 +0200 Subject: [PATCH] Ocamlformat the whole repo --- .../abstract_domains/mvbdu/boolean_mvbdu.ml | 9 +- .../abstract_domains/mvbdu/boolean_mvbdu.mli | 6 +- .../abstract_domains/mvbdu/list_algebra.mli | 27 +- .../abstract_domains/mvbdu/memo_sig.ml | 23 +- .../abstract_domains/mvbdu/memo_sig.mli | 23 +- .../abstract_domains/mvbdu/mvbdu_algebra.ml | 4 +- .../abstract_domains/mvbdu/mvbdu_algebra.mli | 6 +- .../abstract_domains/mvbdu/mvbdu_wrapper.ml | 3 +- .../abstract_domains/mvbdu/mvbdu_wrapper.mli | 3 +- .../numerical_domains/mat_inter.ml | 3 +- .../numerical_domains/mat_inter.mli | 3 +- .../numerical_domains/matrices.ml | 9 +- .../counting_engine.ml | 142 +++-- .../counting_test.ml | 9 +- core/KaSa_rep/frontend/ckappa_sig.mli | 3 +- core/KaSa_rep/frontend/dune | 2 +- core/KaSa_rep/frontend/list_tokens.mli | 6 +- core/KaSa_rep/frontend/prepreprocess.ml | 3 +- core/KaSa_rep/frontend/prepreprocess.mli | 11 +- core/KaSa_rep/frontend/preprocess.mli | 18 +- core/KaSa_rep/frontend/print_ckappa.ml | 6 +- core/KaSa_rep/frontend/print_handler.ml | 8 +- .../more_datastructures/dictionary.ml | 9 +- .../more_datastructures/dictionary.mli | 9 +- .../more_datastructures/map_wrapper.ml | 4 +- .../more_datastructures/map_wrapper.mli | 4 +- .../polymer_detection/contact_map_scc.mli | 3 +- .../reachability_analysis/agents_domain.ml | 3 +- .../reachability_analysis/communication.ml | 3 +- .../reachability_analysis/communication.mli | 14 +- .../reachability_analysis/composite_domain.ml | 4 +- .../composite_domain.mli | 4 +- .../reachability_analysis/counters_domain.ml | 4 +- .../reachability_analysis/parallel_bonds.ml | 4 +- .../site_across_bonds_domain.ml | 4 +- .../translation_in_natural_language.mli | 3 +- .../reachability_analysis/views_domain.ml | 3 +- .../remanent_state/remanent_state.mli | 4 +- .../KaSa_rep/sanity_test/sanity_test.expected | 4 +- core/api/kappa_facade.ml | 7 +- core/cflow/causal.mli | 16 +- core/cflow/cflow_handler.ml | 44 +- core/cflow/cflow_handler.mli | 24 +- core/cflow/dag.ml | 4 +- core/cflow/utilities.ml | 4 +- core/cli/cli_init.ml | 8 +- core/cli/cli_init.mli | 2 +- core/cli/dune | 3 +- core/dataStructures/setMap.ml | 50 +- core/dataStructures/setMap.mli | 50 +- core/dataStructures/tools.ml | 5 +- core/dataStructures/tools.mli | 3 +- core/error_handlers/exception.ml | 43 +- core/error_handlers/exception.mli | 10 +- core/grammar/counters_compiler.ml | 205 +++--- core/grammar/counters_compiler.mli | 3 +- core/grammar/eval.ml | 6 +- core/grammar/eval.mli | 2 +- core/grammar/evaluator.ml | 7 +- core/grammar/lKappa_compiler.ml | 582 ++++++++++-------- .../parameters/exception_without_parameter.ml | 1 + .../exception_without_parameter.mli | 2 +- core/parameters/remanent_parameters_sig.ml | 3 +- core/symmetries/kade_backend.ml | 24 +- core/symmetries/kade_backend.mli | 2 +- core/symmetries/lKappa_group_action.ml | 20 +- core/symmetries/pattern_group_action.ml | 5 +- core/symmetries/patterns_extra.ml | 61 +- core/symmetries/symmetries.ml | 27 +- core/symmetries/symmetries.mli | 4 +- core/symmetries/symmetry_interface.ml | 8 +- core/term/kappa_printer.ml | 3 +- core/term/lKappa.ml | 77 ++- core/term/lKappa.mli | 3 +- core/term/pattern.ml | 125 ++-- core/term/pattern.mli | 12 +- core/term/pattern_compiler.ml | 10 +- core/term/raw_mixture.ml | 41 +- core/term/raw_mixture.mli | 2 +- core/utils/utils.ml | 1 - core/utils/utils.mli | 1 - gui/dune | 13 +- gui/lib/dune | 24 +- gui/lib/html_utility.mli | 3 +- gui/lib_no_jsoo/dune | 16 +- gui/state/dune | 2 +- gui/state/state_simulation.ml | 7 +- gui/ui/dune | 7 +- gui/ui/panel_projects.ml | 3 +- .../tab_editor/editor_controller.ml | 3 +- .../panel_tabs/tab_editor/editor_menu_file.ml | 3 +- .../panel_tabs/tab_editor/subtab_polymers.ml | 3 +- tests/integration/Makefile | 1 - .../compiler/site_mismatch/output/LOG.ref | 2 +- 94 files changed, 1208 insertions(+), 799 deletions(-) diff --git a/core/KaSa_rep/abstract_domains/mvbdu/boolean_mvbdu.ml b/core/KaSa_rep/abstract_domains/mvbdu/boolean_mvbdu.ml index 302e33229..f480a4cf4 100644 --- a/core/KaSa_rep/abstract_domains/mvbdu/boolean_mvbdu.ml +++ b/core/KaSa_rep/abstract_domains/mvbdu/boolean_mvbdu.ml @@ -147,7 +147,8 @@ type unary_memoized_fun = variables_list_dic, Exception.exceptions_caught_and_uncaught -> bool -> - Exception.exceptions_caught_and_uncaught * (bool Mvbdu_sig.mvbdu, bool) Mvbdu_sig.premvbdu, + Exception.exceptions_caught_and_uncaught + * (bool Mvbdu_sig.mvbdu, bool) Mvbdu_sig.premvbdu, memo_tables, memo_tables, int ) @@ -1392,7 +1393,8 @@ let rec extensional_description_of_mvbdu parameters handler error mvbdu = }, output ) ) -let print_boolean_mvbdu parameters (error : Exception.exceptions_caught_and_uncaught) = +let print_boolean_mvbdu parameters + (error : Exception.exceptions_caught_and_uncaught) = Mvbdu_core.print_mvbdu error (fun error parameters a -> let _ = @@ -1518,7 +1520,8 @@ let print_gen log parameters error (title, print_hash, l) = print_hash (Remanent_parameters.update_prefix parameters pref) error x) error l -let print_memo (error : Exception.exceptions_caught_and_uncaught) handler parameters = +let print_memo (error : Exception.exceptions_caught_and_uncaught) handler + parameters = let error, l1, l2, l3, l4, l5, l6, l7, l8, l9 = split_memo error handler in let () = Loggers.fprintf diff --git a/core/KaSa_rep/abstract_domains/mvbdu/boolean_mvbdu.mli b/core/KaSa_rep/abstract_domains/mvbdu/boolean_mvbdu.mli index 420ccca80..50373b401 100644 --- a/core/KaSa_rep/abstract_domains/mvbdu/boolean_mvbdu.mli +++ b/core/KaSa_rep/abstract_domains/mvbdu/boolean_mvbdu.mli @@ -114,7 +114,8 @@ val extensional_description_of_mvbdu : handler -> Exception_without_parameter.exceptions_caught_and_uncaught -> bool Mvbdu_sig.mvbdu -> - Exception_without_parameter.exceptions_caught_and_uncaught * (handler * (int * int) list list) + Exception_without_parameter.exceptions_caught_and_uncaught + * (handler * (int * int) list list) val extensional_description_of_range_list : 'g -> @@ -140,7 +141,8 @@ val extensional_description_of_variables_list : Remanent_parameters_sig.parameters -> handler -> 'h List_sig.list -> - Exception_without_parameter.exceptions_caught_and_uncaught * (handler * int list option) + Exception_without_parameter.exceptions_caught_and_uncaught + * (handler * int list option) val overwrite_association_lists : Remanent_parameters_sig.parameters -> diff --git a/core/KaSa_rep/abstract_domains/mvbdu/list_algebra.mli b/core/KaSa_rep/abstract_domains/mvbdu/list_algebra.mli index a4d45127a..880069a88 100644 --- a/core/KaSa_rep/abstract_domains/mvbdu/list_algebra.mli +++ b/core/KaSa_rep/abstract_domains/mvbdu/list_algebra.mli @@ -11,7 +11,8 @@ val overwrite : Exception_without_parameter.exceptions_caught_and_uncaught -> 'c -> 'b List_sig.list * 'b List_sig.list -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('c * 'b List_sig.list option)) -> + Exception_without_parameter.exceptions_caught_and_uncaught + * ('c * 'b List_sig.list option)) -> (Remanent_parameters_sig.parameters -> Exception_without_parameter.exceptions_caught_and_uncaught -> 'c -> @@ -23,7 +24,8 @@ val overwrite : 'c -> 'b List_sig.list -> 'b List_sig.list -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('c * 'b List_sig.list option) + Exception_without_parameter.exceptions_caught_and_uncaught + * ('c * 'b List_sig.list option) val length : 'a -> @@ -40,7 +42,8 @@ val extensional_without_asso : Exception_without_parameter.exceptions_caught_and_uncaught -> 'a -> 'b List_sig.list -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('a * int list option)) -> + Exception_without_parameter.exceptions_caught_and_uncaught + * ('a * int list option)) -> (Remanent_parameters_sig.parameters -> Exception_without_parameter.exceptions_caught_and_uncaught -> 'a -> @@ -51,14 +54,16 @@ val extensional_without_asso : Remanent_parameters_sig.parameters -> 'a -> 'b List_sig.list -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('a * int list option) + Exception_without_parameter.exceptions_caught_and_uncaught + * ('a * int list option) val extensional_with_asso : (Remanent_parameters_sig.parameters -> Exception_without_parameter.exceptions_caught_and_uncaught -> 'a -> 'b List_sig.list -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('a * (int * 'b) list option)) -> + Exception_without_parameter.exceptions_caught_and_uncaught + * ('a * (int * 'b) list option)) -> (Remanent_parameters_sig.parameters -> Exception_without_parameter.exceptions_caught_and_uncaught -> 'a -> @@ -69,7 +74,8 @@ val extensional_with_asso : Remanent_parameters_sig.parameters -> 'a -> 'b List_sig.list -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('a * (int * 'b) list option) + Exception_without_parameter.exceptions_caught_and_uncaught + * ('a * (int * 'b) list option) val build_reversed_sorted_list : (Exception_without_parameter.exceptions_caught_and_uncaught -> @@ -84,7 +90,8 @@ val build_reversed_sorted_list : Exception_without_parameter.exceptions_caught_and_uncaught -> 'c -> (int * 'b) list -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('c * 'b List_sig.list) + Exception_without_parameter.exceptions_caught_and_uncaught + * ('c * 'b List_sig.list) val build_sorted_list : (Exception_without_parameter.exceptions_caught_and_uncaught -> @@ -99,7 +106,8 @@ val build_sorted_list : Exception_without_parameter.exceptions_caught_and_uncaught -> 'c -> (int * 'b) list -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('c * 'b List_sig.list) + Exception_without_parameter.exceptions_caught_and_uncaught + * ('c * 'b List_sig.list) val build_list : (Exception_without_parameter.exceptions_caught_and_uncaught -> @@ -114,7 +122,8 @@ val build_list : Remanent_parameters_sig.parameters -> 'c -> (int * 'b) list -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('c * 'b List_sig.list) + Exception_without_parameter.exceptions_caught_and_uncaught + * ('c * 'b List_sig.list) val print_variables_list : Remanent_parameters_sig.parameters -> 'a List_sig.list -> unit diff --git a/core/KaSa_rep/abstract_domains/mvbdu/memo_sig.ml b/core/KaSa_rep/abstract_domains/mvbdu/memo_sig.ml index 29eaf0938..cfe16e99f 100644 --- a/core/KaSa_rep/abstract_domains/mvbdu/memo_sig.ml +++ b/core/KaSa_rep/abstract_domains/mvbdu/memo_sig.ml @@ -13,14 +13,18 @@ * under the terms of the GNU Library General Public License *) type ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'f, 'g) memoized_fun = { - f: Remanent_parameters_sig.parameters -> Exception.exceptions_caught_and_uncaught -> 'c; + f: + Remanent_parameters_sig.parameters -> + Exception.exceptions_caught_and_uncaught -> + 'c; store: Remanent_parameters_sig.parameters -> Exception.exceptions_caught_and_uncaught -> ('f, 'b, 'blist, 'rlist, 'vlist, 'a, 'g) handler -> 'd -> 'a Mvbdu_sig.mvbdu -> - Exception.exceptions_caught_and_uncaught * ('f, 'b, 'blist, 'rlist, 'vlist, 'a, 'g) handler; + Exception.exceptions_caught_and_uncaught + * ('f, 'b, 'blist, 'rlist, 'vlist, 'a, 'g) handler; get: Remanent_parameters_sig.parameters -> Exception.exceptions_caught_and_uncaught -> @@ -53,7 +57,8 @@ type ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'e) unary_memoized_fun = 'vlist, 'a -> Exception.exceptions_caught_and_uncaught - * (Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * 'c), + * (Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * 'c), 'a Mvbdu_sig.mvbdu, 'd, 'e ) @@ -82,7 +87,8 @@ type ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'e) unary_other_memoized_fun = 'vlist, 'a -> Exception.exceptions_caught_and_uncaught - * (Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell), + * (Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell), 'd * 'a Mvbdu_sig.mvbdu, 'c, 'e ) @@ -101,7 +107,8 @@ type ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'e) reset = { leaf: 'a -> Exception.exceptions_caught_and_uncaught - * (Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); + * (Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); clean_head: Exception.exceptions_caught_and_uncaught * ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'e) unary_memoized_fun; @@ -109,12 +116,14 @@ type ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'e) reset = { int -> int -> Exception.exceptions_caught_and_uncaught - * (Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); + * (Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); build_true: int -> int -> 'a Mvbdu_sig.mvbdu -> 'a Mvbdu_sig.mvbdu -> Exception.exceptions_caught_and_uncaught - * (Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); + * (Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); } diff --git a/core/KaSa_rep/abstract_domains/mvbdu/memo_sig.mli b/core/KaSa_rep/abstract_domains/mvbdu/memo_sig.mli index 0325c2af5..fa8ec62bf 100644 --- a/core/KaSa_rep/abstract_domains/mvbdu/memo_sig.mli +++ b/core/KaSa_rep/abstract_domains/mvbdu/memo_sig.mli @@ -1,12 +1,16 @@ type ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'f, 'g) memoized_fun = { - f: Remanent_parameters_sig.parameters -> Exception.exceptions_caught_and_uncaught -> 'c; + f: + Remanent_parameters_sig.parameters -> + Exception.exceptions_caught_and_uncaught -> + 'c; store: Remanent_parameters_sig.parameters -> Exception.exceptions_caught_and_uncaught -> ('f, 'b, 'blist, 'rlist, 'vlist, 'a, 'g) handler -> 'd -> 'a Mvbdu_sig.mvbdu -> - Exception.exceptions_caught_and_uncaught * ('f, 'b, 'blist, 'rlist, 'vlist, 'a, 'g) handler; + Exception.exceptions_caught_and_uncaught + * ('f, 'b, 'blist, 'rlist, 'vlist, 'a, 'g) handler; get: Remanent_parameters_sig.parameters -> Exception.exceptions_caught_and_uncaught -> @@ -39,7 +43,8 @@ type ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'e) unary_memoized_fun = 'vlist, 'a -> Exception.exceptions_caught_and_uncaught - * (Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * 'c), + * (Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * 'c), 'a Mvbdu_sig.mvbdu, 'd, 'e ) @@ -68,7 +73,8 @@ type ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'e) unary_other_memoized_fun = 'vlist, 'a -> Exception.exceptions_caught_and_uncaught - * (Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell), + * (Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell), 'd * 'a Mvbdu_sig.mvbdu, 'c, 'e ) @@ -87,7 +93,8 @@ type ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'e) reset = { leaf: 'a -> Exception.exceptions_caught_and_uncaught - * (Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); + * (Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); clean_head: Exception.exceptions_caught_and_uncaught * ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'e) unary_memoized_fun; @@ -95,12 +102,14 @@ type ('a, 'b, 'blist, 'rlist, 'vlist, 'c, 'd, 'e) reset = { int -> int -> Exception.exceptions_caught_and_uncaught - * (Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); + * (Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); build_true: int -> int -> 'a Mvbdu_sig.mvbdu -> 'a Mvbdu_sig.mvbdu -> Exception.exceptions_caught_and_uncaught - * (Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); + * (Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * 'a Mvbdu_sig.cell); } diff --git a/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_algebra.ml b/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_algebra.ml index d844933bc..bf3d88ffb 100644 --- a/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_algebra.ml +++ b/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_algebra.ml @@ -910,7 +910,9 @@ let not_recursive_memoize_unary f g (get_handler : 'a -> 'b) let a = (not_recursive_memoize_unary : (Exception.exceptions_caught_and_uncaught -> 'handler -> 'g) -> - (Remanent_parameters_sig.parameters -> Exception.exceptions_caught_and_uncaught -> 'e) -> + (Remanent_parameters_sig.parameters -> + Exception.exceptions_caught_and_uncaught -> + 'e) -> ('handler -> 'dic) -> ('dic -> 'handler -> 'handler) -> (Exception.exceptions_caught_and_uncaught -> diff --git a/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_algebra.mli b/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_algebra.mli index abbe98beb..09f3ae3dd 100644 --- a/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_algebra.mli +++ b/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_algebra.mli @@ -5,7 +5,8 @@ val generic_zeroary : 'd Mvbdu_sig.cell -> (int -> 'd Mvbdu_sig.mvbdu) -> 'e -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('f * 'g * 'h * 'e) option) -> + Exception_without_parameter.exceptions_caught_and_uncaught + * ('f * 'g * 'h * 'e) option) -> 'e -> ('i -> 'a * (('d Mvbdu_sig.mvbdu, 'd) Mvbdu_sig.precell, 'd) Mvbdu_sig.premvbdu) -> @@ -505,7 +506,8 @@ val a : 'h Mvbdu_sig.mvbdu -> Exception_without_parameter.exceptions_caught_and_uncaught * ('a, 'b, 'd, 'f, 'g, 'h, 'i) Memo_sig.handler) -> - Exception_without_parameter.exceptions_caught_and_uncaught * 'h Mvbdu_sig.mvbdu option) -> + Exception_without_parameter.exceptions_caught_and_uncaught + * 'h Mvbdu_sig.mvbdu option) -> (Exception_without_parameter.exceptions_caught_and_uncaught -> 'c -> 'h Mvbdu_sig.mvbdu -> diff --git a/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.ml b/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.ml index b9db5a2d2..730ebc459 100644 --- a/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.ml +++ b/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.ml @@ -269,7 +269,8 @@ module type Internalized_mvbdu = sig val import_handler : handler -> unit val export_handler : - Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * handler option + Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * handler option val is_init : unit -> bool val equal : mvbdu -> mvbdu -> bool diff --git a/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.mli b/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.mli index dd412fac7..4a1b07120 100644 --- a/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.mli +++ b/core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.mli @@ -271,7 +271,8 @@ module type Internalized_mvbdu = sig val import_handler : handler -> unit val export_handler : - Exception.exceptions_caught_and_uncaught -> Exception.exceptions_caught_and_uncaught * handler option + Exception.exceptions_caught_and_uncaught -> + Exception.exceptions_caught_and_uncaught * handler option val is_init : unit -> bool val equal : mvbdu -> mvbdu -> bool diff --git a/core/KaSa_rep/abstract_domains/numerical_domains/mat_inter.ml b/core/KaSa_rep/abstract_domains/numerical_domains/mat_inter.ml index fb6c39caf..3c6ea151c 100644 --- a/core/KaSa_rep/abstract_domains/numerical_domains/mat_inter.ml +++ b/core/KaSa_rep/abstract_domains/numerical_domains/mat_inter.ml @@ -90,7 +90,8 @@ module type Mat_inter = sig Exception.exceptions_caught_and_uncaught -> prod -> var -> - Exception.exceptions_caught_and_uncaught * (Fraction.ffraction * Fraction.ffraction) option + Exception.exceptions_caught_and_uncaught + * (Fraction.ffraction * Fraction.ffraction) option val is_infinite : prod -> var -> bool diff --git a/core/KaSa_rep/abstract_domains/numerical_domains/mat_inter.mli b/core/KaSa_rep/abstract_domains/numerical_domains/mat_inter.mli index 09df19d88..b74414df5 100644 --- a/core/KaSa_rep/abstract_domains/numerical_domains/mat_inter.mli +++ b/core/KaSa_rep/abstract_domains/numerical_domains/mat_inter.mli @@ -84,7 +84,8 @@ module type Mat_inter = sig Exception.exceptions_caught_and_uncaught -> prod -> var -> - Exception.exceptions_caught_and_uncaught * (Fraction.ffraction * Fraction.ffraction) option + Exception.exceptions_caught_and_uncaught + * (Fraction.ffraction * Fraction.ffraction) option val is_infinite : prod -> var -> bool diff --git a/core/KaSa_rep/abstract_domains/numerical_domains/matrices.ml b/core/KaSa_rep/abstract_domains/numerical_domains/matrices.ml index 74567199c..6acd970b5 100644 --- a/core/KaSa_rep/abstract_domains/numerical_domains/matrices.ml +++ b/core/KaSa_rep/abstract_domains/numerical_domains/matrices.ml @@ -569,7 +569,8 @@ module Matrice = struct | [] -> failwith "compteur_pivot_3" ) - let normalise parameters (error : Exception.exceptions_caught_and_uncaught) m = + let normalise parameters (error : Exception.exceptions_caught_and_uncaught) m + = let rec aux (error : Exception.exceptions_caught_and_uncaught) k = if k > !(m.nligne) then ( del_last_ligne m; @@ -615,7 +616,8 @@ module Matrice = struct in aux error 1 - let rec push parameters (error : Exception.exceptions_caught_and_uncaught) m j k = + let rec push parameters (error : Exception.exceptions_caught_and_uncaught) m j + k = if Working_list_imperative.member j (get_all_entry m) then ( let rec aux error i = if i > !(m.nligne) then @@ -888,7 +890,8 @@ module Matrice = struct in union parameters error nm m - let pushbool parameters (error : Exception.exceptions_caught_and_uncaught) m a = + let pushbool parameters (error : Exception.exceptions_caught_and_uncaught) m a + = let error, m2 = copy parameters error m in let error = new_copy_ligne parameters error m2 diff --git a/core/KaSa_rep/counting_enumerating_species/counting_engine.ml b/core/KaSa_rep/counting_enumerating_species/counting_engine.ml index 78be5d793..678d05ec9 100644 --- a/core/KaSa_rep/counting_enumerating_species/counting_engine.ml +++ b/core/KaSa_rep/counting_enumerating_species/counting_engine.ml @@ -17,13 +17,17 @@ let verbose_mode = false type ('hole, 'brick) hole_handler = { dual: - Exception.exceptions_caught_and_uncaught -> 'hole -> Exception.exceptions_caught_and_uncaught * 'hole list; + Exception.exceptions_caught_and_uncaught -> + 'hole -> + Exception.exceptions_caught_and_uncaught * 'hole list; dual_and_self: Exception.exceptions_caught_and_uncaught -> 'hole -> Exception.exceptions_caught_and_uncaught * 'hole list * bool; interface_of_brick: - Exception.exceptions_caught_and_uncaught -> 'brick -> Exception.exceptions_caught_and_uncaught * 'hole list; + Exception.exceptions_caught_and_uncaught -> + 'brick -> + Exception.exceptions_caught_and_uncaught * 'hole list; print_hole: out_channel -> 'hole -> unit; } @@ -68,7 +72,8 @@ functor Interfaces.Map.t; } - let print_handler exceptions_caught_and_uncaught kappa_handler hole_handler = + let print_handler exceptions_caught_and_uncaught kappa_handler hole_handler + = { Counting_print.iter_map1 = Puzzle_hole_map_and_set.Map.iter; Counting_print.iter_map2 = Interfaces.Map.iter; @@ -98,25 +103,28 @@ functor let find_dependence parameters error hole graph = Puzzle_hole_map_and_set.Map.find_default parameters error [] hole graph - let add_dependence parameters exceptions_caught_and_uncaught hole interface graph = + let add_dependence parameters exceptions_caught_and_uncaught hole interface + graph = let exceptions_caught_and_uncaught, old_interface_list = find_dependence parameters exceptions_caught_and_uncaught hole graph in - Puzzle_hole_map_and_set.Map.add parameters exceptions_caught_and_uncaught hole + Puzzle_hole_map_and_set.Map.add parameters exceptions_caught_and_uncaught + hole (interface :: old_interface_list) graph - let add_species parameters exceptions_caught_and_uncaught _hole_handler species holeset - interface interface_map = + let add_species parameters exceptions_caught_and_uncaught _hole_handler + species holeset interface interface_map = let exceptions_caught_and_uncaught, (old, old_holeset) = - Interfaces.Map.find_default_without_logs parameters exceptions_caught_and_uncaught + Interfaces.Map.find_default_without_logs parameters + exceptions_caught_and_uncaught (E.nil, Puzzle_hole_map_and_set.Set.empty) interface interface_map in let new_species = E.sum old species in let exceptions_caught_and_uncaught, new_hole_set = - Puzzle_hole_map_and_set.Set.union parameters exceptions_caught_and_uncaught old_holeset - holeset + Puzzle_hole_map_and_set.Set.union parameters + exceptions_caught_and_uncaught old_holeset holeset in Interfaces.Map.add parameters exceptions_caught_and_uncaught interface (new_species, new_hole_set) @@ -124,9 +132,12 @@ functor let remove_species parameters hole self state = let species = state.species in - let exceptions_caught_and_uncaught = state.exceptions_caught_and_uncaught in + let exceptions_caught_and_uncaught = + state.exceptions_caught_and_uncaught + in let exceptions_caught_and_uncaught, interface_other = - Puzzle_hole_map_and_set.Map.add parameters exceptions_caught_and_uncaught hole 1 + Puzzle_hole_map_and_set.Map.add parameters + exceptions_caught_and_uncaught hole 1 Puzzle_hole_map_and_set.Map.empty in let exceptions_caught_and_uncaught, k = @@ -139,16 +150,19 @@ functor Exception.warn parameters state.exceptions_caught_and_uncaught __POS__ ~message:"unknown interface in remove_species" Exit state in - { state with exceptions_caught_and_uncaught }, (E.nil, Puzzle_hole_map_and_set.Set.empty) + ( { state with exceptions_caught_and_uncaught }, + (E.nil, Puzzle_hole_map_and_set.Set.empty) ) | Some k -> let exceptions_caught_and_uncaught, species = - Interfaces.Map.remove parameters exceptions_caught_and_uncaught (interface_other, self) - species + Interfaces.Map.remove parameters exceptions_caught_and_uncaught + (interface_other, self) species in { state with species; exceptions_caught_and_uncaught }, k let add_interface parameters hole_handler interface species holeset state = - let exceptions_caught_and_uncaught = state.exceptions_caught_and_uncaught in + let exceptions_caught_and_uncaught = + state.exceptions_caught_and_uncaught + in let interface_other, interface_self = interface in let empty_interface_other = Puzzle_hole_map_and_set.Map.for_all (fun _ x -> x = 0) interface_other @@ -169,8 +183,8 @@ functor (*1*) if empty_interface_other then ( let exceptions_caught_and_uncaught, species = - add_species parameters state.exceptions_caught_and_uncaught hole_handler species - holeset + add_species parameters state.exceptions_caught_and_uncaught + hole_handler species holeset (interface_other, interface_self) state.species in @@ -187,7 +201,8 @@ functor match hole with | None -> let exceptions_caught_and_uncaught, state = - Exception.warn parameters state.exceptions_caught_and_uncaught __POS__ Exit state + Exception.warn parameters state.exceptions_caught_and_uncaught + __POS__ Exit state in { state with exceptions_caught_and_uncaught } | Some (hole, _) -> @@ -203,8 +218,8 @@ functor if Interfaces.Set.mem interface state.dependence_graph.interfaces then ( (*4*) let exceptions_caught_and_uncaught, species = - add_species parameters exceptions_caught_and_uncaught hole_handler species holeset - interface state.species + add_species parameters exceptions_caught_and_uncaught hole_handler + species holeset interface state.species in { state with species; exceptions_caught_and_uncaught } ) else ( @@ -217,17 +232,19 @@ functor if n = 0 then exceptions_caught_and_uncaught, graph else - add_dependence parameters exceptions_caught_and_uncaught hole interface graph) + add_dependence parameters exceptions_caught_and_uncaught hole + interface graph) interface_other - (exceptions_caught_and_uncaught, state.dependence_graph.dependences) + ( exceptions_caught_and_uncaught, + state.dependence_graph.dependences ) in let exceptions_caught_and_uncaught, interfaces = - Interfaces.Set.add parameters exceptions_caught_and_uncaught interface - state.dependence_graph.interfaces + Interfaces.Set.add parameters exceptions_caught_and_uncaught + interface state.dependence_graph.interfaces in let exceptions_caught_and_uncaught, species = - add_species parameters exceptions_caught_and_uncaught hole_handler species holeset - interface state.species + add_species parameters exceptions_caught_and_uncaught hole_handler + species holeset interface state.species in { state with @@ -271,22 +288,28 @@ functor in let output = old + delta in if output = 0 then - Puzzle_hole_map_and_set.Map.remove parameters exceptions_caught_and_uncaught x map + Puzzle_hole_map_and_set.Map.remove parameters + exceptions_caught_and_uncaught x map else - Puzzle_hole_map_and_set.Map.add parameters exceptions_caught_and_uncaught x output map + Puzzle_hole_map_and_set.Map.add parameters + exceptions_caught_and_uncaught x output map let init parameters hole_handler _print_handler empty_state linear_combination = - let exceptions_caught_and_uncaught = empty_state.exceptions_caught_and_uncaught in + let exceptions_caught_and_uncaught = + empty_state.exceptions_caught_and_uncaught + in List.fold_left (fun state (n, i) -> let exceptions_caught_and_uncaught, interface = hole_handler.interface_of_brick exceptions_caught_and_uncaught i in let exceptions_caught_and_uncaught, partition = - let rec aux list exceptions_caught_and_uncaught other self_other self = + let rec aux list exceptions_caught_and_uncaught other self_other + self = match list with - | [] -> exceptions_caught_and_uncaught, Some (other, self_other, self) + | [] -> + exceptions_caught_and_uncaught, Some (other, self_other, self) | (elt : E.puzzle_hole) :: tail -> let exceptions_caught_and_uncaught, dual_other, can_self = hole_handler.dual_and_self exceptions_caught_and_uncaught elt @@ -305,9 +328,11 @@ functor in aux tail exceptions_caught_and_uncaught other self_other self | true, true -> - aux tail exceptions_caught_and_uncaught other (elt :: self_other) self) + aux tail exceptions_caught_and_uncaught other + (elt :: self_other) self) in - aux interface exceptions_caught_and_uncaught Puzzle_hole_map_and_set.Map.empty [] + aux interface exceptions_caught_and_uncaught + Puzzle_hole_map_and_set.Map.empty [] Puzzle_hole_map_and_set.Map.empty in match partition with @@ -317,15 +342,20 @@ functor List.fold_left (fun (exceptions_caught_and_uncaught, interface_list) elt -> List.fold_left - (fun (exceptions_caught_and_uncaught, list) (prefix1, prefix2) -> + (fun (exceptions_caught_and_uncaught, list) + (prefix1, prefix2) -> let exceptions_caught_and_uncaught, sol1 = - inc parameters exceptions_caught_and_uncaught elt 1 prefix1 + inc parameters exceptions_caught_and_uncaught elt 1 + prefix1 in let exceptions_caught_and_uncaught, sol2 = - inc parameters exceptions_caught_and_uncaught elt 1 prefix2 + inc parameters exceptions_caught_and_uncaught elt 1 + prefix2 in - exceptions_caught_and_uncaught, (sol1, prefix2) :: (prefix1, sol2) :: list) - (exceptions_caught_and_uncaught, []) interface_list) + ( exceptions_caught_and_uncaught, + (sol1, prefix2) :: (prefix1, sol2) :: list )) + (exceptions_caught_and_uncaught, []) + interface_list) (exceptions_caught_and_uncaught, [ other, self ]) self_other in @@ -353,13 +383,16 @@ functor abstract_species) state.species E.nil - let induction parameters exceptions_caught_and_uncaught hole_handler print_handler state = + let induction parameters exceptions_caught_and_uncaught hole_handler + print_handler state = let rec aux state = let _ = trace_state "Induction\n" " " print_handler state in match state.to_visit with | [] -> state | (hole, formula, forbidden, self) :: q -> - let exceptions_caught_and_uncaught, dual_list = hole_handler.dual exceptions_caught_and_uncaught hole in + let exceptions_caught_and_uncaught, dual_list = + hole_handler.dual exceptions_caught_and_uncaught hole + in let state = { state with exceptions_caught_and_uncaught } in let state, _ = remove_species parameters hole self state in let state = { state with to_visit = q } in @@ -380,30 +413,33 @@ functor | interface :: tail -> (match Interfaces.Map.find_option_without_logs parameters - exceptions_caught_and_uncaught interface state.species + exceptions_caught_and_uncaught interface + state.species with | exceptions_caught_and_uncaught, None -> aux3 tail { state with exceptions_caught_and_uncaught } - | exceptions_caught_and_uncaught, Some (abstract_species_set, hole_set) -> + | ( exceptions_caught_and_uncaught, + Some (abstract_species_set, hole_set) ) -> if Puzzle_hole_map_and_set.Set.mem hole hole_set || Puzzle_hole_map_and_set.Set.mem dual forbidden then - infinite_state parameters exceptions_caught_and_uncaught + infinite_state parameters + exceptions_caught_and_uncaught else ( let new_abstract_species = E.combine formula hole dual abstract_species_set in let exceptions_caught_and_uncaught, new_interface = let exceptions_caught_and_uncaught, new_other = - inc parameters exceptions_caught_and_uncaught dual (-1) - (fst interface) + inc parameters exceptions_caught_and_uncaught dual + (-1) (fst interface) in let exceptions_caught_and_uncaught, new_self = Puzzle_hole_map_and_set.Map.map2z parameters exceptions_caught_and_uncaught - (fun _paramters exceptions_caught_and_uncaught x y -> - exceptions_caught_and_uncaught, x + y) + (fun _paramters exceptions_caught_and_uncaught x + y -> exceptions_caught_and_uncaught, x + y) (snd interface) self in exceptions_caught_and_uncaught, (new_other, new_self) @@ -430,8 +466,8 @@ functor in aux state - let count parameters exceptions_caught_and_uncaught kappa_handler hole_handler print_handler - linear_combination = + let count parameters exceptions_caught_and_uncaught kappa_handler + hole_handler print_handler linear_combination = let empty_state = empty_state exceptions_caught_and_uncaught in let print_handler = print_handler exceptions_caught_and_uncaught kappa_handler hole_handler @@ -443,12 +479,14 @@ functor in let _ = trace_state "\nInitial state\n" " " print_handler init_state in let final_state = - induction parameters exceptions_caught_and_uncaught hole_handler print_handler init_state + induction parameters exceptions_caught_and_uncaught hole_handler + print_handler init_state in let _ = trace_state "\nFinal state\n" " " print_handler final_state in let sol = conclude final_state in let _ = - E.print exceptions_caught_and_uncaught kappa_handler stdout hole_handler.print_hole sol + E.print exceptions_caught_and_uncaught kappa_handler stdout + hole_handler.print_hole sol in sol end diff --git a/core/KaSa_rep/counting_enumerating_species/counting_test.ml b/core/KaSa_rep/counting_enumerating_species/counting_test.ml index d8020a5d7..62bcdf7b7 100644 --- a/core/KaSa_rep/counting_enumerating_species/counting_test.ml +++ b/core/KaSa_rep/counting_enumerating_species/counting_test.ml @@ -17,10 +17,12 @@ module D = Counting_engine.Count (Counting_algebrae.Counting) let f parameters dual dual_and_self interface_of_brick init = let _exceptions_caught_and_uncaught, kappa_handler = - List_tokens.empty_handler parameters Exception.empty_exceptions_caught_and_uncaught + List_tokens.empty_handler parameters + Exception.empty_exceptions_caught_and_uncaught in let i = - C.count parameters Exception.empty_exceptions_caught_and_uncaught kappa_handler + C.count parameters Exception.empty_exceptions_caught_and_uncaught + kappa_handler { Counting_engine.print_hole = (fun log -> Printf.fprintf log "%d"); Counting_engine.dual; @@ -30,7 +32,8 @@ let f parameters dual dual_and_self interface_of_brick init = C.print_handler init in let j = - D.count parameters Exception.empty_exceptions_caught_and_uncaught kappa_handler + D.count parameters Exception.empty_exceptions_caught_and_uncaught + kappa_handler { Counting_engine.print_hole = (fun log -> Printf.fprintf log "%d"); Counting_engine.dual; diff --git a/core/KaSa_rep/frontend/ckappa_sig.mli b/core/KaSa_rep/frontend/ckappa_sig.mli index 40135b02d..c784efcd7 100644 --- a/core/KaSa_rep/frontend/ckappa_sig.mli +++ b/core/KaSa_rep/frontend/ckappa_sig.mli @@ -457,7 +457,8 @@ val array_of_list_rule_id : Remanent_parameters_sig.parameters -> Exception.exceptions_caught_and_uncaught -> 'a list -> - Exception.exceptions_caught_and_uncaught * 'a Rule_nearly_Inf_Int_storage_Imperatif.t + Exception.exceptions_caught_and_uncaught + * 'a Rule_nearly_Inf_Int_storage_Imperatif.t (***************************************************************************) diff --git a/core/KaSa_rep/frontend/dune b/core/KaSa_rep/frontend/dune index 78dd580c5..a217932e2 100644 --- a/core/KaSa_rep/frontend/dune +++ b/core/KaSa_rep/frontend/dune @@ -10,7 +10,7 @@ -open Kappa_data_structures -open - Kappa_site_graphs + Kappa_site_graphs -open Kappa_parameters -open diff --git a/core/KaSa_rep/frontend/list_tokens.mli b/core/KaSa_rep/frontend/list_tokens.mli index ed819ccce..b24b07836 100644 --- a/core/KaSa_rep/frontend/list_tokens.mli +++ b/core/KaSa_rep/frontend/list_tokens.mli @@ -12,9 +12,11 @@ val scan_compil : 'a, Ckappa_sig.mixture Ckappa_sig.rule ) Ast.compil -> - Exception_without_parameter.exceptions_caught_and_uncaught * Cckappa_sig.kappa_handler + Exception_without_parameter.exceptions_caught_and_uncaught + * Cckappa_sig.kappa_handler val empty_handler : Remanent_parameters_sig.parameters -> Exception_without_parameter.exceptions_caught_and_uncaught -> - Exception_without_parameter.exceptions_caught_and_uncaught * Cckappa_sig.kappa_handler + Exception_without_parameter.exceptions_caught_and_uncaught + * Cckappa_sig.kappa_handler diff --git a/core/KaSa_rep/frontend/prepreprocess.ml b/core/KaSa_rep/frontend/prepreprocess.ml index 6129826e5..dfe09528b 100644 --- a/core/KaSa_rep/frontend/prepreprocess.ml +++ b/core/KaSa_rep/frontend/prepreprocess.ml @@ -287,7 +287,8 @@ let translate_counter parameters error int_set counter = Some a); } ) -let translate_counter_sig parameters error int_set (counter : Counters_info.counter_sig) = +let translate_counter_sig parameters error int_set + (counter : Counters_info.counter_sig) = let error, _ = check_freshness parameters error "Counters" (fst counter.Counters_info.counter_sig_name) diff --git a/core/KaSa_rep/frontend/prepreprocess.mli b/core/KaSa_rep/frontend/prepreprocess.mli index 0e1ca6f24..dcbba6ced 100644 --- a/core/KaSa_rep/frontend/prepreprocess.mli +++ b/core/KaSa_rep/frontend/prepreprocess.mli @@ -40,7 +40,10 @@ val add_entry : * ('a * 'b * 'c) list Ckappa_sig.Agent_id_map_and_set.Map.t val map_with_pos : - ('a -> 'b -> 'c -> Exception_without_parameter.exceptions_caught_and_uncaught * 'e) -> + ('a -> + 'b -> + 'c -> + Exception_without_parameter.exceptions_caught_and_uncaught * 'e) -> 'a -> 'b -> 'c * 'f -> @@ -52,7 +55,8 @@ val alg_map : Exception_without_parameter.exceptions_caught_and_uncaught * 'c) -> Exception_without_parameter.exceptions_caught_and_uncaught -> ('b, 'd) Alg_expr.e -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('c, 'd) Alg_expr.e + Exception_without_parameter.exceptions_caught_and_uncaught + * ('c, 'd) Alg_expr.e val bool_map : (Exception_without_parameter.exceptions_caught_and_uncaught -> @@ -60,7 +64,8 @@ val bool_map : Exception_without_parameter.exceptions_caught_and_uncaught * 'c) -> Exception_without_parameter.exceptions_caught_and_uncaught -> ('b, 'd) Alg_expr.bool -> - Exception_without_parameter.exceptions_caught_and_uncaught * ('c, 'd) Alg_expr.bool + Exception_without_parameter.exceptions_caught_and_uncaught + * ('c, 'd) Alg_expr.bool val with_option_map : ('a -> diff --git a/core/KaSa_rep/frontend/preprocess.mli b/core/KaSa_rep/frontend/preprocess.mli index b6c073031..74c62566e 100644 --- a/core/KaSa_rep/frontend/preprocess.mli +++ b/core/KaSa_rep/frontend/preprocess.mli @@ -10,7 +10,8 @@ val empty_agent : val empty_mixture : Remanent_parameters_sig.parameters -> Exception_without_parameter.exceptions_caught_and_uncaught -> - Exception_without_parameter.exceptions_caught_and_uncaught * Cckappa_sig.mixture + Exception_without_parameter.exceptions_caught_and_uncaught + * Cckappa_sig.mixture val empty_rule : Remanent_parameters_sig.parameters -> @@ -20,7 +21,8 @@ val empty_rule : val empty_e_rule : Remanent_parameters_sig.parameters -> Exception_without_parameter.exceptions_caught_and_uncaught -> - Exception_without_parameter.exceptions_caught_and_uncaught * Cckappa_sig.enriched_rule + Exception_without_parameter.exceptions_caught_and_uncaught + * Cckappa_sig.enriched_rule val init_contact_map : 'a Ckappa_sig.Agent_map_and_set.Map.t @@ -119,25 +121,29 @@ val translate_pert : Cckappa_sig.kappa_handler -> (Ckappa_sig.mixture, string) Alg_expr.e * Loc.t -> Ckappa_sig.mixture * 'a -> - Exception_without_parameter.exceptions_caught_and_uncaught * Cckappa_sig.enriched_init + Exception_without_parameter.exceptions_caught_and_uncaught + * Cckappa_sig.enriched_init val rename_rule_lhs : Remanent_parameters_sig.parameters -> Exception_without_parameter.exceptions_caught_and_uncaught -> Ckappa_sig.c_agent_id -> Cckappa_sig.rule -> - Exception_without_parameter.exceptions_caught_and_uncaught * Ckappa_sig.c_agent_id + Exception_without_parameter.exceptions_caught_and_uncaught + * Ckappa_sig.c_agent_id val rename_rule_rhs : Remanent_parameters_sig.parameters -> Exception_without_parameter.exceptions_caught_and_uncaught -> Ckappa_sig.c_agent_id -> Cckappa_sig.rule -> - Exception_without_parameter.exceptions_caught_and_uncaught * Ckappa_sig.c_agent_id + Exception_without_parameter.exceptions_caught_and_uncaught + * Ckappa_sig.c_agent_id val lift_forbidding_question_marks : Remanent_parameters_sig.parameters -> Cckappa_sig.kappa_handler -> Exception_without_parameter.exceptions_caught_and_uncaught -> Ckappa_sig.mixture -> - Exception_without_parameter.exceptions_caught_and_uncaught * Cckappa_sig.mixture + Exception_without_parameter.exceptions_caught_and_uncaught + * Cckappa_sig.mixture diff --git a/core/KaSa_rep/frontend/print_ckappa.ml b/core/KaSa_rep/frontend/print_ckappa.ml index 14e34da70..eacddcfcf 100644 --- a/core/KaSa_rep/frontend/print_ckappa.ml +++ b/core/KaSa_rep/frontend/print_ckappa.ml @@ -324,7 +324,8 @@ let get_agent_close_symbol parameter = "%s" (Remanent_parameters.get_agent_close_symbol parameter) -let rec print_alg parameter (error : Exception.exceptions_caught_and_uncaught) alg = +let rec print_alg parameter (error : Exception.exceptions_caught_and_uncaught) + alg = match alg with | Alg_expr.BIN_ALG_OP (op, (alg1, _), (alg2, _)) -> let () = get_agent_open_symbol parameter in @@ -395,7 +396,8 @@ let rec print_alg parameter (error : Exception.exceptions_caught_and_uncaught) a let () = get_agent_close_symbol parameter in error -and print_bool parameter (error : Exception.exceptions_caught_and_uncaught) = function +and print_bool parameter (error : Exception.exceptions_caught_and_uncaught) = + function | Alg_expr.TRUE, _ -> let () = Loggers.fprintf (Remanent_parameters.get_logger parameter) "[true]" diff --git a/core/KaSa_rep/frontend/print_handler.ml b/core/KaSa_rep/frontend/print_handler.ml index 388fc6676..86abdf07e 100644 --- a/core/KaSa_rep/frontend/print_handler.ml +++ b/core/KaSa_rep/frontend/print_handler.ml @@ -177,8 +177,8 @@ let print_handler parameters error handler = in error -let dot_of_contact_map ?loggers parameters (error : Exception.exceptions_caught_and_uncaught) - handler = +let dot_of_contact_map ?loggers parameters + (error : Exception.exceptions_caught_and_uncaught) handler = let parameters_dot = match loggers with | None -> Remanent_parameters.open_contact_map_file parameters @@ -393,8 +393,8 @@ let print_list_of_lines parameters list = ()) list -let gexf_of_contact_map ?loggers parameters (error : Exception.exceptions_caught_and_uncaught) - handler = +let gexf_of_contact_map ?loggers parameters + (error : Exception.exceptions_caught_and_uncaught) handler = let parameters_gexf = match loggers with | None -> Remanent_parameters.open_contact_map_file parameters diff --git a/core/KaSa_rep/more_datastructures/dictionary.ml b/core/KaSa_rep/more_datastructures/dictionary.ml index d22e2976c..9bdac28f8 100644 --- a/core/KaSa_rep/more_datastructures/dictionary.ml +++ b/core/KaSa_rep/more_datastructures/dictionary.ml @@ -37,7 +37,8 @@ module type Dictionary = sig 'a -> (key -> 'b) -> ('a, 'b) dictionary -> - Exception.exceptions_caught_and_uncaught * (key * 'a * 'b * ('a, 'b) dictionary) option + Exception.exceptions_caught_and_uncaught + * (key * 'a * 'b * ('a, 'b) dictionary) option val allocate_uniquely : Remanent_parameters_sig.parameters -> @@ -47,7 +48,8 @@ module type Dictionary = sig 'a -> (key -> 'b) -> ('a, 'b) dictionary -> - Exception.exceptions_caught_and_uncaught * (key * 'a * 'b * ('a, 'b) dictionary) option + Exception.exceptions_caught_and_uncaught + * (key * 'a * 'b * ('a, 'b) dictionary) option (* val allocate_f_id: Exception.exceptions_caught_and_uncaught -> ('a -> 'a -> int) -> value -> (int -> 'a) -> 'a dictionary -> Exception.exceptions_caught_and_uncaught * (int * 'a * 'a dictionary) option*) val allocate_bool : @@ -68,7 +70,8 @@ module type Dictionary = sig 'a -> (key -> 'b) -> ('a, 'b) dictionary -> - Exception.exceptions_caught_and_uncaught * (key * 'a * 'b * ('a, 'b) dictionary) + Exception.exceptions_caught_and_uncaught + * (key * 'a * 'b * ('a, 'b) dictionary) val translate : Remanent_parameters_sig.parameters -> diff --git a/core/KaSa_rep/more_datastructures/dictionary.mli b/core/KaSa_rep/more_datastructures/dictionary.mli index dba7b55f0..117962edb 100644 --- a/core/KaSa_rep/more_datastructures/dictionary.mli +++ b/core/KaSa_rep/more_datastructures/dictionary.mli @@ -20,7 +20,8 @@ module type Dictionary = sig 'a -> (key -> 'b) -> ('a, 'b) dictionary -> - Exception.exceptions_caught_and_uncaught * (key * 'a * 'b * ('a, 'b) dictionary) option + Exception.exceptions_caught_and_uncaught + * (key * 'a * 'b * ('a, 'b) dictionary) option val allocate_uniquely : Remanent_parameters_sig.parameters -> @@ -30,7 +31,8 @@ module type Dictionary = sig 'a -> (key -> 'b) -> ('a, 'b) dictionary -> - Exception.exceptions_caught_and_uncaught * (key * 'a * 'b * ('a, 'b) dictionary) option + Exception.exceptions_caught_and_uncaught + * (key * 'a * 'b * ('a, 'b) dictionary) option (* val allocate_f_id: Exception.exceptions_caught_and_uncaught -> ('a -> 'a -> int) -> value -> (int -> 'a) -> 'a dictionary -> Exception.exceptions_caught_and_uncaught * (int * 'a * 'a dictionary) option*) val allocate_bool : @@ -51,7 +53,8 @@ module type Dictionary = sig 'a -> (key -> 'b) -> ('a, 'b) dictionary -> - Exception.exceptions_caught_and_uncaught * (key * 'a * 'b * ('a, 'b) dictionary) + Exception.exceptions_caught_and_uncaught + * (key * 'a * 'b * ('a, 'b) dictionary) val translate : Remanent_parameters_sig.parameters -> diff --git a/core/KaSa_rep/more_datastructures/map_wrapper.ml b/core/KaSa_rep/more_datastructures/map_wrapper.ml index 4cce46605..9c25d50ad 100644 --- a/core/KaSa_rep/more_datastructures/map_wrapper.ml +++ b/core/KaSa_rep/more_datastructures/map_wrapper.ml @@ -320,7 +320,9 @@ module type Map_with_logs = sig 'a -> Exception.exceptions_caught_and_uncaught * 'b -> Exception.exceptions_caught_and_uncaught * 'b) -> - (elt -> Exception.exceptions_caught_and_uncaught * 'b -> Exception.exceptions_caught_and_uncaught * 'b) -> + (elt -> + Exception.exceptions_caught_and_uncaught * 'b -> + Exception.exceptions_caught_and_uncaught * 'b) -> set -> 'a t -> 'b -> diff --git a/core/KaSa_rep/more_datastructures/map_wrapper.mli b/core/KaSa_rep/more_datastructures/map_wrapper.mli index a7d858f72..3624a2ec9 100644 --- a/core/KaSa_rep/more_datastructures/map_wrapper.mli +++ b/core/KaSa_rep/more_datastructures/map_wrapper.mli @@ -320,7 +320,9 @@ module type Map_with_logs = sig 'a -> Exception.exceptions_caught_and_uncaught * 'b -> Exception.exceptions_caught_and_uncaught * 'b) -> - (elt -> Exception.exceptions_caught_and_uncaught * 'b -> Exception.exceptions_caught_and_uncaught * 'b) -> + (elt -> + Exception.exceptions_caught_and_uncaught * 'b -> + Exception.exceptions_caught_and_uncaught * 'b) -> set -> 'a t -> 'b -> diff --git a/core/KaSa_rep/polymer_detection/contact_map_scc.mli b/core/KaSa_rep/polymer_detection/contact_map_scc.mli index 5a88221ed..c29f8c973 100644 --- a/core/KaSa_rep/polymer_detection/contact_map_scc.mli +++ b/core/KaSa_rep/polymer_detection/contact_map_scc.mli @@ -48,4 +48,5 @@ val compute_graph_scc : Remanent_parameters_sig.parameters -> Exception.exceptions_caught_and_uncaught -> converted_contact_map -> - Exception.exceptions_caught_and_uncaught * Remanent_state.internal_scc_decomposition + Exception.exceptions_caught_and_uncaught + * Remanent_state.internal_scc_decomposition diff --git a/core/KaSa_rep/reachability_analysis/agents_domain.ml b/core/KaSa_rep/reachability_analysis/agents_domain.ml index 9e8896214..6931a60d6 100644 --- a/core/KaSa_rep/reachability_analysis/agents_domain.ml +++ b/core/KaSa_rep/reachability_analysis/agents_domain.ml @@ -427,7 +427,8 @@ module Domain = struct (* ignore the flag *) (* Please check that each agent type occuring in the pattern is reachable *) - exception False of Exception.exceptions_caught_and_uncaught * dynamic_information + exception + False of Exception.exceptions_caught_and_uncaught * dynamic_information let maybe_reachable static dynamic error _flag pattern precondition = let parameters = get_parameter static in diff --git a/core/KaSa_rep/reachability_analysis/communication.ml b/core/KaSa_rep/reachability_analysis/communication.ml index f50f5a65c..69080afa7 100644 --- a/core/KaSa_rep/reachability_analysis/communication.ml +++ b/core/KaSa_rep/reachability_analysis/communication.ml @@ -191,7 +191,8 @@ let fold_over_potential_partners parameters error precondition agent_type site f let overwrite_potential_partners_map (_parameters : Remanent_parameters_sig.parameters) - (error : Exception.exceptions_caught_and_uncaught) precondition f (fold : prefold) = + (error : Exception.exceptions_caught_and_uncaught) precondition f + (fold : prefold) = ( error, { precondition with diff --git a/core/KaSa_rep/reachability_analysis/communication.mli b/core/KaSa_rep/reachability_analysis/communication.mli index de981e4ca..bdf8739fa 100644 --- a/core/KaSa_rep/reachability_analysis/communication.mli +++ b/core/KaSa_rep/reachability_analysis/communication.mli @@ -154,7 +154,9 @@ val fold_over_potential_partners : Exception.exceptions_caught_and_uncaught * 'a -> Exception.exceptions_caught_and_uncaught * 'a) -> 'a -> - Exception.exceptions_caught_and_uncaught * precondition * 'a Usual_domains.top_or_not + Exception.exceptions_caught_and_uncaught + * precondition + * 'a Usual_domains.top_or_not val overwrite_potential_partners_map : Remanent_parameters_sig.parameters -> @@ -200,7 +202,10 @@ val get_state_of_site_in_precondition : Ckappa_sig.c_agent_id -> Ckappa_sig.c_site_name -> precondition -> - Exception.exceptions_caught_and_uncaught * 'dynamic * precondition * Ckappa_sig.c_state list + Exception.exceptions_caught_and_uncaught + * 'dynamic + * precondition + * Ckappa_sig.c_state list val get_state_of_site_in_postcondition : ('static -> Analyzer_headers.global_static_information) -> @@ -213,7 +218,10 @@ val get_state_of_site_in_postcondition : Ckappa_sig.c_agent_id -> Ckappa_sig.c_site_name -> precondition -> - Exception.exceptions_caught_and_uncaught * 'b * precondition * Ckappa_sig.c_state list + Exception.exceptions_caught_and_uncaught + * 'b + * precondition + * Ckappa_sig.c_state list val add_rule : ?local_trace:bool -> diff --git a/core/KaSa_rep/reachability_analysis/composite_domain.ml b/core/KaSa_rep/reachability_analysis/composite_domain.ml index e1de54d11..a40a8adf4 100644 --- a/core/KaSa_rep/reachability_analysis/composite_domain.ml +++ b/core/KaSa_rep/reachability_analysis/composite_domain.ml @@ -21,7 +21,9 @@ module type Composite_domain = sig Analyzer_headers.global_static_information -> Analyzer_headers.global_dynamic_information -> Exception.exceptions_caught_and_uncaught -> - Exception.exceptions_caught_and_uncaught * static_information * dynamic_information + Exception.exceptions_caught_and_uncaught + * static_information + * dynamic_information type 'a zeroary = static_information -> diff --git a/core/KaSa_rep/reachability_analysis/composite_domain.mli b/core/KaSa_rep/reachability_analysis/composite_domain.mli index 80a59930e..eacc0bf48 100644 --- a/core/KaSa_rep/reachability_analysis/composite_domain.mli +++ b/core/KaSa_rep/reachability_analysis/composite_domain.mli @@ -23,7 +23,9 @@ module type Composite_domain = sig Analyzer_headers.global_static_information -> Analyzer_headers.global_dynamic_information -> Exception.exceptions_caught_and_uncaught -> - Exception.exceptions_caught_and_uncaught * static_information * dynamic_information + Exception.exceptions_caught_and_uncaught + * static_information + * dynamic_information type 'a zeroary = static_information -> diff --git a/core/KaSa_rep/reachability_analysis/counters_domain.ml b/core/KaSa_rep/reachability_analysis/counters_domain.ml index 703caa6a3..008c0479d 100644 --- a/core/KaSa_rep/reachability_analysis/counters_domain.ml +++ b/core/KaSa_rep/reachability_analysis/counters_domain.ml @@ -908,8 +908,8 @@ functor | None -> Exception.warn parameters error __POS__ Exit intervalle_opt) back_site (error, None) - let print ?dead_rules static dynamic (error : Exception.exceptions_caught_and_uncaught) - loggers = + let print ?dead_rules static dynamic + (error : Exception.exceptions_caught_and_uncaught) loggers = let _ = dead_rules in let kappa_handler = get_kappa_handler static in let counter_set = get_counters_set static in diff --git a/core/KaSa_rep/reachability_analysis/parallel_bonds.ml b/core/KaSa_rep/reachability_analysis/parallel_bonds.ml index a8bd6b811..f3d2c46e6 100644 --- a/core/KaSa_rep/reachability_analysis/parallel_bonds.ml +++ b/core/KaSa_rep/reachability_analysis/parallel_bonds.ml @@ -1280,8 +1280,8 @@ module Domain = struct let stabilize _static dynamic error = error, dynamic, () - let print ?dead_rules static dynamic (error : Exception.exceptions_caught_and_uncaught) - loggers = + let print ?dead_rules static dynamic + (error : Exception.exceptions_caught_and_uncaught) loggers = let _ = dead_rules in let kappa_handler = get_kappa_handler static in let parameters = get_parameter static in diff --git a/core/KaSa_rep/reachability_analysis/site_across_bonds_domain.ml b/core/KaSa_rep/reachability_analysis/site_across_bonds_domain.ml index 805c257e1..1afd7d05c 100644 --- a/core/KaSa_rep/reachability_analysis/site_across_bonds_domain.ml +++ b/core/KaSa_rep/reachability_analysis/site_across_bonds_domain.ml @@ -1708,8 +1708,8 @@ module Domain = struct (*PRINT*) (****************************************************************) - let print ?dead_rules static dynamic (error : Exception.exceptions_caught_and_uncaught) - loggers = + let print ?dead_rules static dynamic + (error : Exception.exceptions_caught_and_uncaught) loggers = let _ = dead_rules in let parameters = get_parameter static in let kappa_handler = get_kappa_handler static in diff --git a/core/KaSa_rep/reachability_analysis/translation_in_natural_language.mli b/core/KaSa_rep/reachability_analysis/translation_in_natural_language.mli index c574895d2..e43d7f110 100644 --- a/core/KaSa_rep/reachability_analysis/translation_in_natural_language.mli +++ b/core/KaSa_rep/reachability_analysis/translation_in_natural_language.mli @@ -44,7 +44,8 @@ val translate : Exception.exceptions_caught_and_uncaught -> rename_sites -> Ckappa_sig.Views_bdu.mvbdu -> - Exception.exceptions_caught_and_uncaught * (Ckappa_sig.Views_bdu.handler * token) + Exception.exceptions_caught_and_uncaught + * (Ckappa_sig.Views_bdu.handler * token) val print : ?beginning_of_sentence:bool -> diff --git a/core/KaSa_rep/reachability_analysis/views_domain.ml b/core/KaSa_rep/reachability_analysis/views_domain.ml index 75524b6b8..ed178a95f 100644 --- a/core/KaSa_rep/reachability_analysis/views_domain.ml +++ b/core/KaSa_rep/reachability_analysis/views_domain.ml @@ -917,7 +917,8 @@ module Domain = struct (****************************************************************) - exception False of Exception.exceptions_caught_and_uncaught * dynamic_information + exception + False of Exception.exceptions_caught_and_uncaught * dynamic_information (****************************************************************) (*compute condition of bdu whether or not it is enable by doing the diff --git a/core/KaSa_rep/remanent_state/remanent_state.mli b/core/KaSa_rep/remanent_state/remanent_state.mli index cd6e0a410..0321e8566 100644 --- a/core/KaSa_rep/remanent_state/remanent_state.mli +++ b/core/KaSa_rep/remanent_state/remanent_state.mli @@ -187,7 +187,9 @@ val set_c_compil : Cckappa_sig.compil -> ('static, 'compile) state -> ('static, 'compile) state val get_c_compil : ('static, 'compile) state -> Cckappa_sig.compil option -val get_errors : ('static, 'compile) state -> Exception.exceptions_caught_and_uncaught + +val get_errors : + ('static, 'compile) state -> Exception.exceptions_caught_and_uncaught val set_errors : Exception.exceptions_caught_and_uncaught -> diff --git a/core/KaSa_rep/sanity_test/sanity_test.expected b/core/KaSa_rep/sanity_test/sanity_test.expected index 22ee181ff..97fa65b0b 100644 --- a/core/KaSa_rep/sanity_test/sanity_test.expected +++ b/core/KaSa_rep/sanity_test/sanity_test.expected @@ -301,9 +301,9 @@ Print Hash_7: Print Hash_8: Print Hash_9: Some exceptions have been raised -error: file_name: core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.ml; message: line 889; exception:Exit +error: file_name: core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.ml; message: line 890; exception:Exit Some exceptions have been raised -error: file_name: core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.ml; message: line 889; exception:Exit +error: file_name: core/KaSa_rep/abstract_domains/mvbdu/mvbdu_wrapper.ml; message: line 890; exception:Exit Mvbdu.001: ok Mvbdu.002: ok Mvbdu.003: ok diff --git a/core/api/kappa_facade.ml b/core/api/kappa_facade.ml index 39c8ad78f..7142c2aaa 100644 --- a/core/api/kappa_facade.ml +++ b/core/api/kappa_facade.ml @@ -165,10 +165,9 @@ let parse ~patternSharing (ast : Ast.parsing_compil) var_overwrite ~pause:(fun f -> Lwt.bind (yield ()) f) ~return:Lwt.return ?rescale_init:None ?overwrite_t0:None ~compile_mode_on:false ~outputs ~sharing:patternSharing - ast_compiled_data.agents_sig - ast_compiled_data.counters_info - ast_compiled_data.token_names - ast_compiled_data.contact_map ast_compiled_data.result + ast_compiled_data.agents_sig ast_compiled_data.counters_info + ast_compiled_data.token_names ast_compiled_data.contact_map + ast_compiled_data.result >>= fun (env, with_trace, init_l) -> let counter = Counter.create diff --git a/core/cflow/causal.mli b/core/cflow/causal.mli index 202bed13c..2e65999bb 100644 --- a/core/cflow/causal.mli +++ b/core/cflow/causal.mli @@ -76,7 +76,9 @@ val cut : Exception.exceptions_caught_and_uncaught -> (int * int * int) list -> grid -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * config + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * config val enrich_grid : Remanent_parameters_sig.parameters -> @@ -85,7 +87,9 @@ val enrich_grid : Exception.exceptions_caught_and_uncaught -> Graph_closure.config -> grid -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * enriched_grid + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * enriched_grid val fold_over_causal_past_of_obs : Remanent_parameters_sig.parameters -> @@ -105,8 +109,12 @@ val fold_over_causal_past_of_obs : * StoryProfiling.StoryStats.log_info * ('b, 'c) Stop.stop) -> 'b -> - ( Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'b, - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'c ) + ( Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'b, + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'c ) Stop.stop val debug_print_grid : Format.formatter -> grid -> unit diff --git a/core/cflow/cflow_handler.ml b/core/cflow/cflow_handler.ml index 20e4d0772..571fb4f42 100644 --- a/core/cflow/cflow_handler.ml +++ b/core/cflow/cflow_handler.ml @@ -75,7 +75,9 @@ module type Cflow_handler = sig handler -> StoryProfiling.StoryStats.log_info -> Exception.exceptions_caught_and_uncaught -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'a + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'a type ('a, 'b) unary = parameter -> @@ -83,7 +85,9 @@ module type Cflow_handler = sig StoryProfiling.StoryStats.log_info -> Exception.exceptions_caught_and_uncaught -> 'a -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'b + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'b type ('a, 'b, 'c) binary = parameter -> @@ -92,7 +96,9 @@ module type Cflow_handler = sig Exception.exceptions_caught_and_uncaught -> 'a -> 'b -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'c + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'c type ('a, 'b, 'c, 'd) ternary = parameter -> @@ -102,7 +108,9 @@ module type Cflow_handler = sig 'a -> 'b -> 'c -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'd + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'd type ('a, 'b, 'c, 'd, 'e) quaternary = parameter -> @@ -113,7 +121,9 @@ module type Cflow_handler = sig 'b -> 'c -> 'd -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'e + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'e val do_not_bound_itterations : parameter -> parameter val set_itteration_bound : parameter -> int -> parameter @@ -185,7 +195,9 @@ module type Cflow_handler = sig val set_reset_progress_bar : parameter -> (unit -> unit) -> parameter val save_error_log : - parameter -> Exception_without_parameter.exceptions_caught_and_uncaught -> unit + parameter -> + Exception_without_parameter.exceptions_caught_and_uncaught -> + unit val set_save_error_log : parameter -> @@ -330,7 +342,9 @@ module Cflow_handler : Cflow_handler = struct handler -> StoryProfiling.StoryStats.log_info -> Exception.exceptions_caught_and_uncaught -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'a + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'a type ('a, 'b) unary = parameter -> @@ -338,7 +352,9 @@ module Cflow_handler : Cflow_handler = struct StoryProfiling.StoryStats.log_info -> Exception.exceptions_caught_and_uncaught -> 'a -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'b + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'b type ('a, 'b, 'c) binary = parameter -> @@ -347,7 +363,9 @@ module Cflow_handler : Cflow_handler = struct Exception.exceptions_caught_and_uncaught -> 'a -> 'b -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'c + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'c type ('a, 'b, 'c, 'd) ternary = parameter -> @@ -357,7 +375,9 @@ module Cflow_handler : Cflow_handler = struct 'a -> 'b -> 'c -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'd + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'd type ('a, 'b, 'c, 'd, 'e) quaternary = parameter -> @@ -368,7 +388,9 @@ module Cflow_handler : Cflow_handler = struct 'b -> 'c -> 'd -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'e + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'e let init_handler env = let n_rules = Model.nb_rules env in diff --git a/core/cflow/cflow_handler.mli b/core/cflow/cflow_handler.mli index 7db80af02..db1bae81b 100644 --- a/core/cflow/cflow_handler.mli +++ b/core/cflow/cflow_handler.mli @@ -54,7 +54,9 @@ module type Cflow_handler = sig handler -> StoryProfiling.StoryStats.log_info -> Exception.exceptions_caught_and_uncaught -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'a + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'a type ('a, 'b) unary = parameter -> @@ -62,7 +64,9 @@ module type Cflow_handler = sig StoryProfiling.StoryStats.log_info -> Exception.exceptions_caught_and_uncaught -> 'a -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'b + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'b type ('a, 'b, 'c) binary = parameter -> @@ -71,7 +75,9 @@ module type Cflow_handler = sig Exception.exceptions_caught_and_uncaught -> 'a -> 'b -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'c + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'c type ('a, 'b, 'c, 'd) ternary = parameter -> @@ -81,7 +87,9 @@ module type Cflow_handler = sig 'a -> 'b -> 'c -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'd + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'd type ('a, 'b, 'c, 'd, 'e) quaternary = parameter -> @@ -92,7 +100,9 @@ module type Cflow_handler = sig 'b -> 'c -> 'd -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * 'e + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * 'e val do_not_bound_itterations : parameter -> parameter val set_itteration_bound : parameter -> int -> parameter @@ -164,7 +174,9 @@ module type Cflow_handler = sig val set_reset_progress_bar : parameter -> (unit -> unit) -> parameter val save_error_log : - parameter -> Exception_without_parameter.exceptions_caught_and_uncaught -> unit + parameter -> + Exception_without_parameter.exceptions_caught_and_uncaught -> + unit val set_save_error_log : parameter -> diff --git a/core/cflow/dag.ml b/core/cflow/dag.ml index 2e1056835..dcca946a9 100644 --- a/core/cflow/dag.ml +++ b/core/cflow/dag.ml @@ -635,8 +635,8 @@ module ListTable : StoryTable = struct let count_stories list = List.fold_left (fun n l -> n + List.length (snd l)) 0 list - let fold_table parameter handler log_info (error : Exception.exceptions_caught_and_uncaught) g - list a = + let fold_table parameter handler log_info + (error : Exception.exceptions_caught_and_uncaught) g list a = List.fold_left (fun a (_, l) -> List.fold_left diff --git a/core/cflow/utilities.ml b/core/cflow/utilities.ml index 7da9b6904..86c3799c3 100644 --- a/core/cflow/utilities.ml +++ b/core/cflow/utilities.ml @@ -269,7 +269,9 @@ let lift_to_care_about_ambiguities f requirement effect parameters StoryProfiling.StoryStats.log_info -> Exception.exceptions_caught_and_uncaught -> trace -> - Exception.exceptions_caught_and_uncaught * StoryProfiling.StoryStats.log_info * trace) + Exception.exceptions_caught_and_uncaught + * StoryProfiling.StoryStats.log_info + * trace) parameters ~shall_we_compute ~shall_we_compute_profiling_information ~print_if_zero kappa_handler profiling_info error trace in diff --git a/core/cli/cli_init.ml b/core/cli/cli_init.ml index 6ffd7e8fe..8b326444e 100644 --- a/core/cli/cli_init.ml +++ b/core/cli/cli_init.ml @@ -19,7 +19,7 @@ type preprocessed_ast = { type compilation_result = { conf: Configuration.t; - counters_info: Counters_info.t; + counters_info: Counters_info.t; env: Model.t; contact_map: Contact_map.t; updated_alg_vars: int list; @@ -61,8 +61,7 @@ let preprocess_ast ~warning ~debug_mode ?kasim_args cli_args let conf, _, _, _ = Configuration.parse compil.Ast.configurations in ( Some (LKappa_compiler.init_of_ast ~warning ~syntax_version - ast_compiled_data.agents_sig - ast_compiled_data.counters_info + ast_compiled_data.agents_sig ast_compiled_data.counters_info ast_compiled_data.contact_map ast_compiled_data.token_names.NamedDecls.finder ast_compiled_data.alg_vars_finder compil.Ast.init), @@ -191,8 +190,7 @@ let get_pack_from_marshalizedfile ~warning kasim_args cli_args marshalized_file LKappa_compiler.init_of_ast ~warning ~syntax_version:cli_args.Run_cli_args.syntaxVersion (Model.signatures compilation_result.env) - compilation_result.counters_info - compilation_result.contact_map + compilation_result.counters_info compilation_result.contact_map (Model.tokens_finder compilation_result.env) (Model.algs_finder compilation_result.env) compil.Ast.init diff --git a/core/cli/cli_init.mli b/core/cli/cli_init.mli index 872022aa7..9d4f11aa1 100644 --- a/core/cli/cli_init.mli +++ b/core/cli/cli_init.mli @@ -20,7 +20,7 @@ type preprocessed_ast = { (* TODO contact map is also in env *) type compilation_result = { conf: Configuration.t; - counters_info: Counters_info.t; + counters_info: Counters_info.t; env: Model.t; contact_map: Contact_map.t; updated_alg_vars: int list; diff --git a/core/cli/dune b/core/cli/dune index 93060b073..e74210288 100644 --- a/core/cli/dune +++ b/core/cli/dune @@ -29,5 +29,4 @@ -open Kappa_grammar -open - Kappa_runtime - ))) + Kappa_runtime))) diff --git a/core/dataStructures/setMap.ml b/core/dataStructures/setMap.ml index 685b9dc72..12493fe72 100644 --- a/core/dataStructures/setMap.ml +++ b/core/dataStructures/setMap.ml @@ -272,8 +272,18 @@ module type Map = sig 'b -> 'c -> 'exceptions_caught_and_uncaught * 'c) -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt -> 'a -> 'c -> 'exceptions_caught_and_uncaught * 'c) -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt -> 'b -> 'c -> 'exceptions_caught_and_uncaught * 'c) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt -> + 'a -> + 'c -> + 'exceptions_caught_and_uncaught * 'c) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt -> + 'b -> + 'c -> + 'exceptions_caught_and_uncaught * 'c) -> 'a t -> 'b t -> 'c -> @@ -297,7 +307,12 @@ module type Map = sig val monadic_iter2_sparse : 'parameters -> 'exceptions_caught_and_uncaught -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt -> 'a -> 'b -> 'exceptions_caught_and_uncaught) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt -> + 'a -> + 'b -> + 'exceptions_caught_and_uncaught) -> 'a t -> 'b t -> 'exceptions_caught_and_uncaught @@ -305,7 +320,12 @@ module type Map = sig val monadic_fold_restriction : 'parameters -> 'exceptions_caught_and_uncaught -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt -> 'a -> 'b -> 'exceptions_caught_and_uncaught * 'b) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt -> + 'a -> + 'b -> + 'exceptions_caught_and_uncaught * 'b) -> set -> 'a t -> 'b -> @@ -2189,7 +2209,11 @@ module type Projection = sig 'exceptions_caught_and_uncaught -> (elt_a -> elt_b) -> 'b -> - ('parameters -> 'exceptions_caught_and_uncaught -> 'b -> 'a -> 'exceptions_caught_and_uncaught * 'b) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + 'b -> + 'a -> + 'exceptions_caught_and_uncaught * 'b) -> 'a map_a -> 'exceptions_caught_and_uncaught * 'b map_b @@ -2198,7 +2222,10 @@ module type Projection = sig val proj_set_monadic : 'parameters -> 'exceptions_caught_and_uncaught -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt_a -> 'exceptions_caught_and_uncaught * elt_b) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt_a -> + 'exceptions_caught_and_uncaught * elt_b) -> set_a -> 'exceptions_caught_and_uncaught * set_b @@ -2207,7 +2234,10 @@ module type Projection = sig val partition_set_monadic : 'parameters -> 'exceptions_caught_and_uncaught -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt_a -> 'exceptions_caught_and_uncaught * elt_b) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt_a -> + 'exceptions_caught_and_uncaught * elt_b) -> set_a -> 'exceptions_caught_and_uncaught * set_a map_b end @@ -2342,7 +2372,11 @@ module type Projection2 = sig (elt_a -> elt_b) -> (elt_a -> elt_c) -> 'b -> - ('parameters -> 'exceptions_caught_and_uncaught -> 'b -> 'a -> 'exceptions_caught_and_uncaught * 'b) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + 'b -> + 'a -> + 'exceptions_caught_and_uncaught * 'b) -> 'a map_a -> 'exceptions_caught_and_uncaught * 'b map_c map_b end diff --git a/core/dataStructures/setMap.mli b/core/dataStructures/setMap.mli index 52feeb0dd..e7974f213 100644 --- a/core/dataStructures/setMap.mli +++ b/core/dataStructures/setMap.mli @@ -274,8 +274,18 @@ module type Map = sig 'b -> 'c -> 'exceptions_caught_and_uncaught * 'c) -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt -> 'a -> 'c -> 'exceptions_caught_and_uncaught * 'c) -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt -> 'b -> 'c -> 'exceptions_caught_and_uncaught * 'c) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt -> + 'a -> + 'c -> + 'exceptions_caught_and_uncaught * 'c) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt -> + 'b -> + 'c -> + 'exceptions_caught_and_uncaught * 'c) -> 'a t -> 'b t -> 'c -> @@ -299,7 +309,12 @@ module type Map = sig val monadic_iter2_sparse : 'parameters -> 'exceptions_caught_and_uncaught -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt -> 'a -> 'b -> 'exceptions_caught_and_uncaught) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt -> + 'a -> + 'b -> + 'exceptions_caught_and_uncaught) -> 'a t -> 'b t -> 'exceptions_caught_and_uncaught @@ -307,7 +322,12 @@ module type Map = sig val monadic_fold_restriction : 'parameters -> 'exceptions_caught_and_uncaught -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt -> 'a -> 'b -> 'exceptions_caught_and_uncaught * 'b) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt -> + 'a -> + 'b -> + 'exceptions_caught_and_uncaught * 'b) -> set -> 'a t -> 'b -> @@ -372,7 +392,11 @@ module type Projection = sig 'exceptions_caught_and_uncaught -> (elt_a -> elt_b) -> 'b -> - ('parameters -> 'exceptions_caught_and_uncaught -> 'b -> 'a -> 'exceptions_caught_and_uncaught * 'b) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + 'b -> + 'a -> + 'exceptions_caught_and_uncaught * 'b) -> 'a map_a -> 'exceptions_caught_and_uncaught * 'b map_b @@ -382,7 +406,10 @@ module type Projection = sig val proj_set_monadic : 'parameters -> 'exceptions_caught_and_uncaught -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt_a -> 'exceptions_caught_and_uncaught * elt_b) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt_a -> + 'exceptions_caught_and_uncaught * elt_b) -> set_a -> 'exceptions_caught_and_uncaught * set_b @@ -393,7 +420,10 @@ module type Projection = sig val partition_set_monadic : 'parameters -> 'exceptions_caught_and_uncaught -> - ('parameters -> 'exceptions_caught_and_uncaught -> elt_a -> 'exceptions_caught_and_uncaught * elt_b) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + elt_a -> + 'exceptions_caught_and_uncaught * elt_b) -> set_a -> 'exceptions_caught_and_uncaught * set_a map_b end @@ -427,7 +457,11 @@ module type Projection2 = sig (elt_a -> elt_b) -> (elt_a -> elt_c) -> 'b -> - ('parameters -> 'exceptions_caught_and_uncaught -> 'b -> 'a -> 'exceptions_caught_and_uncaught * 'b) -> + ('parameters -> + 'exceptions_caught_and_uncaught -> + 'b -> + 'a -> + 'exceptions_caught_and_uncaught * 'b) -> 'a map_a -> 'exceptions_caught_and_uncaught * 'b map_c map_b end diff --git a/core/dataStructures/tools.ml b/core/dataStructures/tools.ml index d499060ae..76aabe661 100644 --- a/core/dataStructures/tools.ml +++ b/core/dataStructures/tools.ml @@ -464,4 +464,7 @@ let sort_by_priority f n = in sort -let map_opt f opt = match opt with | None -> None | Some a -> Some (f a) +let map_opt f opt = + match opt with + | None -> None + | Some a -> Some (f a) diff --git a/core/dataStructures/tools.mli b/core/dataStructures/tools.mli index 960ee044a..38812d985 100644 --- a/core/dataStructures/tools.mli +++ b/core/dataStructures/tools.mli @@ -74,5 +74,4 @@ val default_message_delimter : char val get_ref : int ref -> int val remove_double_elements : 'a list -> 'a list val sort_by_priority : ('a -> int) -> int -> 'a list -> 'a list - -val map_opt: ('a -> 'b) -> 'a option -> 'b option +val map_opt : ('a -> 'b) -> 'a option -> 'b option diff --git a/core/error_handlers/exception.ml b/core/error_handlers/exception.ml index 9aeb300d9..b52e68059 100644 --- a/core/error_handlers/exception.ml +++ b/core/error_handlers/exception.ml @@ -12,12 +12,17 @@ * en Automatique. All rights reserved. This file is distributed * under the terms of the GNU Library General Public License *) -type exceptions_caught_and_uncaught = Exception_without_parameter.exceptions_caught_and_uncaught +type exceptions_caught_and_uncaught = + Exception_without_parameter.exceptions_caught_and_uncaught -let empty_exceptions_caught_and_uncaught = Exception_without_parameter.empty_exceptions_caught_and_uncaught -let is_empty_exceptions_caught_and_uncaught = Exception_without_parameter.is_empty_exceptions_caught_and_uncaught +let empty_exceptions_caught_and_uncaught = + Exception_without_parameter.empty_exceptions_caught_and_uncaught -let safe_warn parameters _exceptions_caught_and_uncaught file_name message exn _default = +let is_empty_exceptions_caught_and_uncaught = + Exception_without_parameter.is_empty_exceptions_caught_and_uncaught + +let safe_warn parameters _exceptions_caught_and_uncaught file_name message exn + _default = let uncaught = Exception_without_parameter.build_uncaught_exception ?file_name ?message exn in @@ -33,25 +38,30 @@ let safe_warn parameters _exceptions_caught_and_uncaught file_name message exn _ let _ = Loggers.print_newline (Remanent_parameters.get_logger parameters) in raise (Exception_without_parameter.Uncaught_exception uncaught) -let unsafe_warn _parameters exceptions_caught_and_uncaught ?to_ui file_name message exn default = +let unsafe_warn _parameters exceptions_caught_and_uncaught ?to_ui file_name + message exn default = let uncaught = Exception_without_parameter.build_uncaught_exception ?file_name ?message exn in - ( Exception_without_parameter.add_uncaught_error uncaught ?to_ui exceptions_caught_and_uncaught, + ( Exception_without_parameter.add_uncaught_error uncaught ?to_ui + exceptions_caught_and_uncaught, default () ) -let warn_aux parameters exceptions_caught_and_uncaught ?to_ui file message exn default = +let warn_aux parameters exceptions_caught_and_uncaught ?to_ui file message exn + default = let error, dft = if Remanent_parameters.get_unsafe parameters then - unsafe_warn parameters exceptions_caught_and_uncaught ?to_ui file message exn default + unsafe_warn parameters exceptions_caught_and_uncaught ?to_ui file message + exn default else - safe_warn parameters exceptions_caught_and_uncaught file message exn default + safe_warn parameters exceptions_caught_and_uncaught file message exn + default in let () = Remanent_parameters.save_error_list parameters error in error, dft -let warn_with_exn parameters exceptions_caught_and_uncaught ?to_ui (file, line, _, _) - ?(message = "") ?(pos = None) exn default = +let warn_with_exn parameters exceptions_caught_and_uncaught ?to_ui + (file, line, _, _) ?(message = "") ?(pos = None) exn default = let liaison = if message = "" && pos = None then "" @@ -67,10 +77,10 @@ let warn_with_exn parameters exceptions_caught_and_uncaught ?to_ui (file, line, (Some ("line " ^ string_of_int line ^ pos ^ liaison ^ message)) exn default -let warn parameters exceptions_caught_and_uncaught ?to_ui file_line ?(message = "") ?pos exn - default = - warn_with_exn parameters exceptions_caught_and_uncaught ?to_ui file_line ~message ~pos exn - (fun () -> default) +let warn parameters exceptions_caught_and_uncaught ?to_ui file_line + ?(message = "") ?pos exn default = + warn_with_exn parameters exceptions_caught_and_uncaught ?to_ui file_line + ~message ~pos exn (fun () -> default) let print_for_KaSim parameters handlers = let parameters = Remanent_parameters.update_prefix parameters "error: " in @@ -180,7 +190,8 @@ let check_point ?pos:Loc.t -> exn -> unit -> - exceptions_caught_and_uncaught * unit) parameter error error' s ?to_ui ?message ?pos exn = + exceptions_caught_and_uncaught * unit) parameter error error' s ?to_ui + ?message ?pos exn = if error == error' then error else ( diff --git a/core/error_handlers/exception.mli b/core/error_handlers/exception.mli index 1c764170b..b1cf72c78 100644 --- a/core/error_handlers/exception.mli +++ b/core/error_handlers/exception.mli @@ -1,9 +1,12 @@ (** Time-stamp: *) -type exceptions_caught_and_uncaught = Exception_without_parameter.exceptions_caught_and_uncaught +type exceptions_caught_and_uncaught = + Exception_without_parameter.exceptions_caught_and_uncaught val empty_exceptions_caught_and_uncaught : exceptions_caught_and_uncaught -val is_empty_exceptions_caught_and_uncaught : exceptions_caught_and_uncaught -> bool + +val is_empty_exceptions_caught_and_uncaught : + exceptions_caught_and_uncaught -> bool val warn_with_exn : Remanent_parameters_sig.parameters -> @@ -27,7 +30,8 @@ val warn : 'a -> exceptions_caught_and_uncaught * 'a -val print : Remanent_parameters_sig.parameters -> exceptions_caught_and_uncaught -> unit +val print : + Remanent_parameters_sig.parameters -> exceptions_caught_and_uncaught -> unit val print_errors_light_for_kasim : Remanent_parameters_sig.parameters -> exceptions_caught_and_uncaught -> unit diff --git a/core/grammar/counters_compiler.ml b/core/grammar/counters_compiler.ml index 78330c456..11f227476 100644 --- a/core/grammar/counters_compiler.ml +++ b/core/grammar/counters_compiler.ml @@ -46,7 +46,8 @@ let update_rate counter_var_values (k, a) = | _ :: _ -> raise (ExceptionDefn.Malformed_Decl - (Format.sprintf "Counter variable %s appears twice in rule" s,Loc.dummy)) + ( Format.sprintf "Counter variable %s appears twice in rule" s, + Loc.dummy )) in let rec update_bool_expr k = @@ -218,8 +219,8 @@ let counters_signature s agents = (** [split_cvar_counter_in_rules_per_value var_name annot counter_delta counter_def] translates a counter CVAR whose value acts upon the rate expression into a rule per possible value, that are selected by a CEQ expression. * *) let split_cvar_counter_in_rules_per_value (var_name : string) (annot : Loc.t) - (counter_delta : int Loc.annoted) (counter_def : Counters_info.counter_sig) : - (Ast.counter Ast.site * cvar_value list) list = + (counter_delta : int Loc.annoted) (counter_def : Counters_info.counter_sig) + : (Ast.counter Ast.site * cvar_value list) list = let (min_value, max_value) : int * int = match counter_def.counter_sig_min, counter_def.counter_sig_max with | Some (Some min_loc, _), Some (Some max_loc, _) -> min_loc, max_loc @@ -275,43 +276,57 @@ let split_counter_variables_into_separate_rules ~warning rules signatures = counter_defs in let (min_value, max_value) : int * int = - match counter_def.Counters_info.counter_sig_min, counter_def.Counters_info.counter_sig_max with + match + ( counter_def.Counters_info.counter_sig_min, + counter_def.Counters_info.counter_sig_max ) + with | Some (Some min_loc, _), Some (Some max_loc, _) -> min_loc, max_loc | (None | Some (None, _)), _ | _, (None | Some (None, _)) -> raise (ExceptionDefn.Malformed_Decl - ( "Invalid counter signature - have to specify min/max bound", - Loc.get_annot counter_def.Counters_info.counter_sig_name )) + ( "Invalid counter signature - have to specify min/max bound", + Loc.get_annot counter_def.Counters_info.counter_sig_name )) in let delta = Loc.v c.Ast.counter_delta in (match c.counter_test with | Some (Ast.CEQ value, _) -> - if (delta > 0 || min_value <= value + delta) + if + (delta > 0 || min_value <= value + delta) && (delta < 0 || value + delta <= max_value) then - [ Ast.Counter c, [] ] + [ Ast.Counter c, [] ] + else if delta > 0 || min_value <= value + delta then + raise + (ExceptionDefn.Malformed_Decl + ( "Counter " ^ Loc.v c.counter_name + ^ " becomes less than the minimal value " + ^ string_of_int min_value, + Loc.get_annot c.counter_name )) else - if (delta > 0 || min_value <= value + delta) - then - raise - (ExceptionDefn.Malformed_Decl - ( "Counter " ^ Loc.v c.counter_name ^ " becomes less than the minimal value " ^ (string_of_int min_value), - Loc.get_annot c.counter_name )) - else raise (ExceptionDefn.Malformed_Decl - ( "Counter " ^ Loc.v c.counter_name ^ " becomes greater than the maximal value " ^ (string_of_int max_value), + ( "Counter " ^ Loc.v c.counter_name + ^ " becomes greater than the maximal value " + ^ string_of_int max_value, Loc.get_annot c.counter_name )) | Some (Ast.CLTE _value, _annot) -> - raise (ExceptionDefn.Internal_Error (Loc.annot_with_dummy "<= Should have been removed not implemented")) (* TODO NOW *) + raise + (ExceptionDefn.Internal_Error + (Loc.annot_with_dummy "<= Should have been removed not implemented")) + (* TODO NOW *) | Some (Ast.CGTE value, annot) -> if value + delta < min_value then raise (ExceptionDefn.Malformed_Decl - ( "Counter " ^ Loc.v c.counter_name ^ " becomes less than tha minimal value " ^ (string_of_int min_value), + ( "Counter " ^ Loc.v c.counter_name + ^ " becomes less than tha minimal value " + ^ string_of_int min_value, Loc.get_annot c.counter_name )); if value = min_value then ( - let error = "Counter " ^ Loc.v c.counter_name ^ "=>" ^ (string_of_int min_value) ^ " always holds" in + let error = + "Counter " ^ Loc.v c.counter_name ^ "=>" ^ string_of_int min_value + ^ " always holds" + in warning ~pos:annot (fun f -> Format.pp_print_string f error) ); [ Ast.Counter c, [] ] @@ -322,12 +337,16 @@ let split_counter_variables_into_separate_rules ~warning rules signatures = | None | Some (Ast.CVAR _, _) -> if delta < 0 then ( let counter_delta : Ast.counter = - { c with counter_test = Some (Ast.CGTE (abs delta + min_value), Loc.dummy) } + { + c with + counter_test = Some (Ast.CGTE (abs delta + min_value), Loc.dummy); + } in [ Ast.Counter counter_delta, [] ] ) else [ - ( Ast.Counter { c with counter_test = Some (Ast.CGTE min_value, Loc.dummy) }, + ( Ast.Counter + { c with counter_test = Some (Ast.CGTE min_value, Loc.dummy) }, [] ); ]) in @@ -563,8 +582,9 @@ let raw_counter_agent (is_first, first_link) (is_last, last_link) i j sigs equal Raw_mixture.a_ints = internals; } -let rec add_incr (i : int) (first_link : int) (last_link : int) (min_value : int) (delta : int) - (equal : bool) (sigs : Signature.s) : Raw_mixture.agent list = +let rec add_incr (i : int) (first_link : int) (last_link : int) + (min_value : int) (delta : int) (equal : bool) (sigs : Signature.s) : + Raw_mixture.agent list = if i = delta then [] else ( @@ -585,11 +605,11 @@ let rec link_incr (sigs : Signature.s) (i : int) (nb : int) if i = nb then [] else ( - let is_first = i = 0 in + let is_first = i = 0 in let is_last = i = nb - 1 in let ra_agent = - make_counter_agent sigs (is_first, ag_info) (is_last, equal) (link + i ) - (link + i + 1 ) + make_counter_agent sigs (is_first, ag_info) (is_last, equal) (link + i) + (link + i + 1) loc (delta > 0) in ra_agent :: link_incr sigs (i + 1) nb ag_info equal link loc min_value delta @@ -597,7 +617,6 @@ let rec link_incr (sigs : Signature.s) (i : int) (nb : int) let rec erase_incr (sigs : Signature.s) (i : int) (incrs : LKappa.rule_mixture) (delta : int) (link : int) : LKappa.rule_mixture = - let counter_agent_info = Signature.get_counter_agent_info sigs in let port_b = fst counter_agent_info.ports in match incrs with @@ -618,7 +637,8 @@ let rec erase_incr (sigs : Signature.s) (i : int) (incrs : LKappa.rule_mixture) (** Returns mixtures for agent with site changed from counter to port, as well as new [link_nb] after previous additions * Used by [compile_counter_in_rule_agent]*) let counter_becomes_port (sigs : Signature.s) (ra : LKappa.rule_agent) - (port_id : int) (counter_def : Counters_info.counter_sig) (counter : Ast.counter) (start_link_nb : int) : + (port_id : int) (counter_def : Counters_info.counter_sig) + (counter : Ast.counter) (start_link_nb : int) : (LKappa.rule_mixture * Raw_mixture.t) * int = (* Returns positive part of value *) let positive_part (i : int) : int = @@ -638,7 +658,7 @@ let counter_becomes_port (sigs : Signature.s) (ra : LKappa.rule_agent) in let loc : Loc.t = Loc.get_annot counter.Ast.counter_name in let (delta, loc_delta) : int * Loc.t = counter.Ast.counter_delta in - let counter_test : Ast.counter_test Loc.annoted = + let counter_test : Ast.counter_test Loc.annoted = Option_util.unsome_or_raise ~excep: (ExceptionDefn.Internal_Error @@ -660,16 +680,23 @@ let counter_becomes_port (sigs : Signature.s) (ra : LKappa.rule_agent) Loc.get_annot counter_test )) | Ast.CEQ j -> j, true | Ast.CGTE j -> j, false - | Ast.CLTE _j -> raise (ExceptionDefn.Internal_Error (Loc.annot_with_dummy "PORT : <= should have been removed, not implemented")) (* TODO now *) + | Ast.CLTE _j -> + raise + (ExceptionDefn.Internal_Error + (Loc.annot_with_dummy + "PORT : <= should have been removed, not implemented")) + (* TODO now *) in let start_link_for_created : int = start_link_nb + (test - min_value + 1) in - let link_for_erased : int = start_link_nb + (abs delta) (*+ min_value*) in + let link_for_erased : int = start_link_nb + abs delta (*+ min_value*) in let ag_info : (int * int) * bool = (port_id, ra.LKappa.ra_type), ra.LKappa.ra_erased in let test_incr : LKappa.rule_mixture = - link_incr sigs 0 (test + 1 - min_value) ag_info equal start_link_nb loc min_value delta + link_incr sigs 0 + (test + 1 - min_value) + ag_info equal start_link_nb loc min_value delta in let adjust_delta : LKappa.rule_mixture = if delta < 0 then @@ -684,7 +711,7 @@ let counter_becomes_port (sigs : Signature.s) (ra : LKappa.rule_agent) [] in - if test + delta < min_value then + if test + delta < min_value then raise (ExceptionDefn.Internal_Error ("Counter test + delta should be greater than min_value", loc_delta)); @@ -705,7 +732,9 @@ let counter_becomes_port (sigs : Signature.s) (ra : LKappa.rule_agent) ra.LKappa.ra_ports.(port_id) <- ( (LKappa.LNK_VALUE (start_link_nb, (port_b, counter_agent_info.id)), loc), switch ); - let new_link_nb : int = start_link_nb + 1 + test + positive_part delta - min_value in + let new_link_nb : int = + start_link_nb + 1 + test + positive_part delta - min_value + in (adjust_delta, created), new_link_nb @@ -716,7 +745,7 @@ let counter_becomes_port (sigs : Signature.s) (ra : LKappa.rule_agent) returns: agent with explicit counters; created incr agents; the next link number to use *) let compile_counter_in_rule_agent (sigs : Signature.s) - (counters_defs : Counters_info.counter_sig option Array.t ) + (counters_defs : Counters_info.counter_sig option Array.t) (rule_agent_ : LKappa.rule_agent with_agent_counters) (lnk_nb : int) : LKappa.rule_mixture * Raw_mixture.t * int = let (incrs, lnk_nb') : (LKappa.rule_mixture * Raw_mixture.t) list * int = @@ -724,26 +753,27 @@ let compile_counter_in_rule_agent (sigs : Signature.s) (fun id (acc_incrs, lnk_nb) -> function | None -> acc_incrs, lnk_nb | Some (counter, _) -> - begin - match counters_defs.(id) with - | None -> - raise (ExceptionDefn.Internal_Error (Loc.annot_with_dummy "SIGNATURE of COUNTERS IS NOT INITIALIZED")) - | Some counter_sig -> - - (*let counter_defs = (Signature.get sigs rule_agent.ra_type) in*) - (*let counter_defs = (* TO DO *) - { - Counters_info.counter_sig_name = Loc.annot_with_dummy ""; - counter_sig_min = None; - counter_sig_max = None; - counter_sig_visible = Ast.From_original_ast; - counter_sig_default = 0; - } in*) - let new_incrs, new_lnk_nb = - counter_becomes_port sigs rule_agent_.agent id counter_sig counter lnk_nb - in - new_incrs :: acc_incrs, new_lnk_nb - end + (match counters_defs.(id) with + | None -> + raise + (ExceptionDefn.Internal_Error + (Loc.annot_with_dummy + "SIGNATURE of COUNTERS IS NOT INITIALIZED")) + | Some counter_sig -> + (*let counter_defs = (Signature.get sigs rule_agent.ra_type) in*) + (*let counter_defs = (* TO DO *) + { + Counters_info.counter_sig_name = Loc.annot_with_dummy ""; + counter_sig_min = None; + counter_sig_max = None; + counter_sig_visible = Ast.From_original_ast; + counter_sig_default = 0; + } in*) + let new_incrs, new_lnk_nb = + counter_becomes_port sigs rule_agent_.agent id counter_sig counter + lnk_nb + in + new_incrs :: acc_incrs, new_lnk_nb) (* JF: link ids were colliding after counter decrementations -> I do not think that we should add delta when negative *)) ([], lnk_nb) rule_agent_.counters in @@ -753,7 +783,8 @@ let compile_counter_in_rule_agent (sigs : Signature.s) als, bls, lnk_nb' (** Compiles the counter value change in the right hand side of a rule into dummy chain changes *) -let compile_counter_in_raw_agent (sigs : Signature.s) (counters_info: Counters_info.t) +let compile_counter_in_raw_agent (sigs : Signature.s) + (counters_info : Counters_info.t) (raw_agent_ : Raw_mixture.agent with_agent_counters) (lnk_nb : int) : Raw_mixture.agent list * int = let raw_agent : Raw_mixture.agent = raw_agent_.agent in @@ -772,29 +803,42 @@ let compile_counter_in_raw_agent (sigs : Signature.s) (counters_info: Counters_i LKappa.raise_not_enough_specified ~status:"counter" ~side:"left" agent_name c.Ast.counter_name | Some (test, _) -> - (let agent_name = - Format.asprintf "@[%a@]" - (Signature.print_agent sigs) - raw_agent.Raw_mixture.a_type - in - let counter_name = Format.sprintf "@[%s@]" (Loc.v c.Ast.counter_name) in - match test with + let agent_name = + Format.asprintf "@[%a@]" + (Signature.print_agent sigs) + raw_agent.Raw_mixture.a_type + in + let counter_name = + Format.sprintf "@[%s@]" (Loc.v c.Ast.counter_name) + in + (match test with | Ast.CGTE _ | Ast.CLTE _ | Ast.CVAR _ -> LKappa.raise_not_enough_specified ~status:"counter" ~side:"left" agent_name c.Ast.counter_name | Ast.CEQ j -> let p = Raw_mixture.VAL lnk_nb in let () = ports.(port_id) <- p in - let counter_sig = Counters_info.get_counter_sig sigs counters_info raw_agent.Raw_mixture.a_type port_id in + let counter_sig = + Counters_info.get_counter_sig sigs counters_info + raw_agent.Raw_mixture.a_type port_id + in let min_value = - match counter_sig.Counters_info.counter_sig_min with - | None | Some (None, _) -> - raise (ExceptionDefn.Internal_Error (Loc.annot_with_dummy (Format.asprintf "Counter %s of agent %s should have a lower bound" counter_name agent_name))) - | Some (Some min_value,_) -> min_value + match counter_sig.Counters_info.counter_sig_min with + | None | Some (None, _) -> + raise + (ExceptionDefn.Internal_Error + (Loc.annot_with_dummy + (Format.asprintf + "Counter %s of agent %s should have a lower bound" + counter_name agent_name))) + | Some (Some min_value, _) -> min_value in let corrected_j = j - min_value in let final_lnk_nb = lnk_nb + corrected_j in - let incrs = add_incr 0 lnk_nb final_lnk_nb min_value (corrected_j + 1) true sigs in + let incrs = + add_incr 0 lnk_nb final_lnk_nb min_value (corrected_j + 1) true + sigs + in acc @ incrs, final_lnk_nb + 1))) ([], lnk_nb) raw_agent_.counters @@ -895,17 +939,20 @@ let rule_agent_with_max_counter sigs c ((agent_name, loc_ag) as agent_type) : in let max_val' = max_val + 1 in let min_value = - match c.Counters_info.counter_sig_min with - | Some (Some min, _) -> min - | None | Some (None, _) -> - raise - (ExceptionDefn.Internal_Error - ( "Counter " ^ fst c_na ^ " in " ^ agent_name - ^ " should have a lower bound", - loc_ag )) + match c.Counters_info.counter_sig_min with + | Some (Some min, _) -> min + | None | Some (None, _) -> + raise + (ExceptionDefn.Internal_Error + ( "Counter " ^ fst c_na ^ " in " ^ agent_name + ^ " should have a lower bound", + loc_ag )) in let incrs = - link_incr sigs 0 (max_val' + 1 - min_value) ((c_id, ag_id), false) false 1 loc min_value (-1) + link_incr sigs 0 + (max_val' + 1 - min_value) + ((c_id, ag_id), false) + false 1 loc min_value (-1) in let counter_agent_info = Signature.get_counter_agent_info sigs in let port_b = fst counter_agent_info.ports in @@ -1107,7 +1154,7 @@ let annotate_created_counters sigs ((agent_name, _) as agent_type) counter_list match Signature.counter_of_site_id port_id agent_signature with | Some counter_info -> let counter_name = Signature.site_of_num port_id agent_signature in - (try + (try (* find counter matching port *) let c : Ast.counter = List.find diff --git a/core/grammar/counters_compiler.mli b/core/grammar/counters_compiler.mli index 52676d40b..147c94bef 100644 --- a/core/grammar/counters_compiler.mli +++ b/core/grammar/counters_compiler.mli @@ -31,7 +31,8 @@ val split_counter_variables_into_separate_rules : val make_counter : int -> string -> Ast.counter val compile_counter_in_rule : - Signature.s -> Counters_info.t -> + Signature.s -> + Counters_info.t -> LKappa.rule_agent with_agent_counters list -> Raw_mixture.agent with_agent_counters list -> LKappa.rule_agent list * Raw_mixture.agent list diff --git a/core/grammar/eval.ml b/core/grammar/eval.ml index be3706756..7aea2f1d1 100644 --- a/core/grammar/eval.ml +++ b/core/grammar/eval.ml @@ -500,7 +500,7 @@ let compile_inits ~debug_mode ~warning ?rescale ~compile_mode_on contact_map env match init_t with | INIT_MIX (raw_mix, mix_pos) -> let sigs = Model.signatures env in - let counters_info = Model.counters_info env in + let counters_info = Model.counters_info env in let preenv', alg' = compile_alg ~debug_mode ~compile_mode_on contact_map preenv alg in @@ -623,8 +623,8 @@ let compile_rules ~debug_mode ~warning alg_deps ~compile_mode_on contact_map Export_to_KaSim.flush_errors kasa_state *) let compile ~outputs ~pause ~return ~sharing ~debug_mode ~compile_mode_on - ?overwrite_init ?overwrite_t0 ?rescale_init sigs_nd counters_info tk_nd contact_map result - = + ?overwrite_init ?overwrite_t0 ?rescale_init sigs_nd counters_info tk_nd + contact_map result = let warning ~pos msg = outputs (Data.Warning (Some pos, msg)) in outputs (Data.Log "+ Building initial simulation conditions..."); let preenv = Pattern.PreEnv.empty sigs_nd counters_info in diff --git a/core/grammar/eval.mli b/core/grammar/eval.mli index 8cca7cda4..da772fadc 100644 --- a/core/grammar/eval.mli +++ b/core/grammar/eval.mli @@ -59,7 +59,7 @@ val compile : ?overwrite_t0:float -> ?rescale_init:float -> Signature.s -> - Counters_info.t -> + Counters_info.t -> unit NamedDecls.t -> Contact_map.t -> ('c, 'd, LKappa.rule_mixture, Raw_mixture.t, int, LKappa.rule) Ast.compil -> diff --git a/core/grammar/evaluator.ml b/core/grammar/evaluator.ml index a3d89798c..042f1174e 100644 --- a/core/grammar/evaluator.ml +++ b/core/grammar/evaluator.ml @@ -14,8 +14,8 @@ let do_interactive_directives ~debug_mode ~outputs ~sharing ~syntax_version let e', _ = List_util.fold_right_map (LKappa_compiler.modif_expr_of_ast ~warning ~syntax_version - (Model.signatures env) (Model.counters_info env) (Model.tokens_finder env) - (Model.algs_finder env) contact_map') + (Model.signatures env) (Model.counters_info env) + (Model.tokens_finder env) (Model.algs_finder env) contact_map') e [] in let () = @@ -59,7 +59,8 @@ let get_pause_criteria ~debug_mode ~outputs ~sharing ~syntax_version contact_map let cc_preenv = Pattern.PreEnv.of_env (Model.domain env) in let b' = LKappa_compiler.bool_expr_of_ast ~warning ~syntax_version - (Model.signatures env) (Model.counters_info env) (Model.tokens_finder env) (Model.algs_finder env) b + (Model.signatures env) (Model.counters_info env) (Model.tokens_finder env) + (Model.algs_finder env) b in let cc_preenv', ((b'', pos_b'') as bpos'') = Eval.compile_bool ~debug_mode ~compile_mode_on:false contact_map cc_preenv diff --git a/core/grammar/lKappa_compiler.ml b/core/grammar/lKappa_compiler.ml index 73eeb52ab..a75036b85 100644 --- a/core/grammar/lKappa_compiler.ml +++ b/core/grammar/lKappa_compiler.ml @@ -6,7 +6,10 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) -let map_opt f opt = match opt with | None -> None | Some a -> Some (f a) +let map_opt f opt = + match opt with + | None -> None + | Some a -> Some (f a) (* TODO originally_from term/lKappa.ml, see if it makes sense here *) let raise_if_modification_agent (pos : Loc.t) = function @@ -1152,18 +1155,19 @@ let give_rule_label bidirectional (id, set) printer r = function ) else (id, set'), lab -let mixture_of_ast ~warning ~syntax_version sigs counters_info ?contact_map (pos : Loc.t) - (mix : Ast.mixture) = +let mixture_of_ast ~warning ~syntax_version sigs counters_info ?contact_map + (pos : Loc.t) (mix : Ast.mixture) = match annotate_edit_mixture ~warning ~syntax_version ~is_rule:false sigs ?contact_map mix with - | r, [] -> fst (Counters_compiler.compile_counter_in_rule sigs counters_info r []) + | r, [] -> + fst (Counters_compiler.compile_counter_in_rule sigs counters_info r []) | _, _ -> raise (ExceptionDefn.Internal_Error ("A mixture cannot create agents", pos)) -let raw_mixture_of_ast ~warning ~syntax_version sigs (counters_info : Counters_info.t) ?contact_map - (mix : Ast.mixture) = +let raw_mixture_of_ast ~warning ~syntax_version sigs + (counters_info : Counters_info.t) ?contact_map (mix : Ast.mixture) = let b = annotate_created_mixture ~warning ~syntax_version sigs ?contact_map mix in @@ -1194,8 +1198,8 @@ let convert_token_name tk_name tok pos = raise (ExceptionDefn.Malformed_Decl (tk_name ^ " is not a declared token", pos)) -let rec alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs ?max_allowed_var - (alg, pos) = +let rec alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs + ?max_allowed_var (alg, pos) = ( (match alg with | Alg_expr.KAPPA_INSTANCE ast -> Alg_expr.KAPPA_INSTANCE @@ -1237,8 +1241,8 @@ let rec alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs ?ma ?max_allowed_var no )), pos ) -and bool_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs ?max_allowed_var = - function +and bool_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs + ?max_allowed_var = function | ((Alg_expr.TRUE | Alg_expr.FALSE), _) as x -> x | Alg_expr.BIN_BOOL_OP (op, x, y), pos -> ( Alg_expr.BIN_BOOL_OP @@ -1263,7 +1267,8 @@ and bool_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs ?max_a ?max_allowed_var y ), pos ) -let print_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs = function +let print_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs = + function | Primitives.Str_pexpr _ as x -> x | Primitives.Alg_pexpr x -> Primitives.Alg_pexpr @@ -1293,7 +1298,8 @@ let assemble_rule ~warning ~syntax_version (rule : rule_inter_rep) (sigs : Signature.s) counters_info (tok : int Mods.StringMap.t) (algs : int Mods.StringMap.t) : LKappa.rule = let (r_mix, r_created) : LKappa.rule_mixture * Raw_mixture.t = - Counters_compiler.compile_counter_in_rule sigs counters_info rule.mixture rule.created_mix + Counters_compiler.compile_counter_in_rule sigs counters_info rule.mixture + rule.created_mix in let r_delta_tokens = @@ -1305,13 +1311,15 @@ let assemble_rule ~warning ~syntax_version (rule : rule_inter_rep) rule.rm_token |> List_util.rev_map_append (fun (al, (tk, pos)) -> - ( alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs al, + ( alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok + algs al, convert_token_name tk tok pos )) rule.add_token |> List.rev in let r_rate = - alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs rule.k_def + alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs + rule.k_def in let r_un_rate = let r_dist d = @@ -1338,8 +1346,8 @@ let assemble_rule ~warning ~syntax_version (rule : rule_inter_rep) r_un_rate; } -let modif_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs contact_map modif - acc = +let modif_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs + contact_map modif acc = match modif with | Ast.APPLY (nb, (ast_rule, pos)) -> let rule : rule_inter_rep = @@ -1379,7 +1387,9 @@ let modif_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs conta in ( Ast.APPLY ( alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs nb, - (assemble_rule ~warning ~syntax_version rule sigs counters_info tok algs, pos) ), + ( assemble_rule ~warning ~syntax_version rule sigs counters_info tok + algs, + pos ) ), acc ) | Ast.UPDATE ((lab, pos), how) -> let i = @@ -1390,51 +1400,76 @@ let modif_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs conta (Mods.StringMap.find_option lab algs) in ( Ast.UPDATE - ((i, pos), alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs how), + ( (i, pos), + alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs + how ), i :: acc ) | Ast.STOP p -> ( Ast.STOP - (List.map (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs) p), + (List.map + (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok + algs) + p), acc ) | Ast.SNAPSHOT (raw, p) -> ( Ast.SNAPSHOT ( raw, - List.map (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs) p - ), + List.map + (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok + algs) + p ), acc ) | Ast.DIN (rel, p) -> ( Ast.DIN ( rel, - List.map (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs) p - ), + List.map + (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok + algs) + p ), acc ) | Ast.DINOFF p -> ( Ast.DINOFF - (List.map (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs) p), + (List.map + (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok + algs) + p), acc ) | (Ast.PLOTENTRY | Ast.CFLOWLABEL (_, _)) as x -> x, acc | Ast.PRINT (p, p') -> ( Ast.PRINT - ( List.map (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs) p, - List.map (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs) p' - ), + ( List.map + (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok + algs) + p, + List.map + (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok + algs) + p' ), acc ) | Ast.CFLOWMIX (b, (m, pos)) -> - ( Ast.CFLOWMIX (b, (mixture_of_ast ~warning ~syntax_version sigs counters_info pos m, pos)), + ( Ast.CFLOWMIX + ( b, + (mixture_of_ast ~warning ~syntax_version sigs counters_info pos m, pos) + ), acc ) | Ast.SPECIES_OF (b, p, (m, pos)) -> ( Ast.SPECIES_OF ( b, - List.map (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs) p, - (mixture_of_ast ~warning ~syntax_version sigs counters_info pos m, pos) ), + List.map + (print_expr_of_ast ~warning ~syntax_version sigs counters_info tok + algs) + p, + (mixture_of_ast ~warning ~syntax_version sigs counters_info pos m, pos) + ), acc ) -let perturbation_of_ast ~warning ~syntax_version sigs counters_info tok algs contact_map - ((alarm, pre, mods, post), pos) up_vars : +let perturbation_of_ast ~warning ~syntax_version sigs counters_info tok algs + contact_map ((alarm, pre, mods, post), pos) up_vars : (_, _, _, _) Ast.perturbation * int list = let mods', up_vars' = List_util.fold_right_map - (modif_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs contact_map) + (modif_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs + contact_map) mods up_vars in let max_allowed_var = None in @@ -1451,10 +1486,13 @@ let perturbation_of_ast ~warning ~syntax_version sigs counters_info tok algs con pos ), up_vars' ) -let init_of_ast ~warning ~syntax_version sigs counters_info tok contact_map = function +let init_of_ast ~warning ~syntax_version sigs counters_info tok contact_map = + function | Ast.INIT_MIX (who, pos) -> Ast.INIT_MIX - (raw_mixture_of_ast ~warning ~syntax_version sigs counters_info ~contact_map who, pos) + ( raw_mixture_of_ast ~warning ~syntax_version sigs counters_info + ~contact_map who, + pos ) | Ast.INIT_TOK lab -> Ast.INIT_TOK (List.map @@ -1685,7 +1723,8 @@ let prepare_agent_sig ~(sites : Counters_info.counter_sig Ast.site list) : (match c.Counters_info.counter_sig_max with | Some (Some i, _) -> Some i | None | Some (None, _) -> None); - counter_default_value = c.Counters_info.counter_sig_default; + counter_default_value = + c.Counters_info.counter_sig_default; }; } ) :: acc_site_sigs, @@ -1857,11 +1896,13 @@ let create_sigs (l : Ast.agent_sig list) : Signature.s = (* TODO see agent_sigs namings *) Signature.create ~counters_per_agent agent_sigs -let init_of_ast ~warning ~syntax_version sigs counters_info contact_map tok algs inits = +let init_of_ast ~warning ~syntax_version sigs counters_info contact_map tok algs + inits = List.map (fun (expr, ini) -> ( alg_expr_of_ast ~warning ~syntax_version sigs counters_info tok algs expr, - init_of_ast ~warning ~syntax_version sigs counters_info tok contact_map ini )) + init_of_ast ~warning ~syntax_version sigs counters_info tok contact_map + ini )) inits type ast_compiled_data = { @@ -1892,9 +1933,6 @@ let inverted_counter_name (name : string) : string = * Each test [> value] is then translated into a test to the "inverted" counter as [< a+b-value]. * Each delta [+ delta] is translated into a [- delta] *) - - - let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = let counter_fold_in_mixture f acc mixture = List.fold_left @@ -1909,61 +1947,66 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = match site with | Ast.Port _ -> acc4 | Counter counter -> f acc4 (Loc.v agent_name) counter) - acc3 site_list) - acc2 agent_list) + acc3 site_list) + acc2 agent_list) acc mixture in let rec counter_fold_in_expr f acc expr = match Loc.v expr with | Alg_expr.BIN_ALG_OP (_, e1, e2) -> - counter_fold_in_expr f (counter_fold_in_expr f acc e1) e2 - | UN_ALG_OP (_, e) | DIFF_TOKEN (e, _) -> - counter_fold_in_expr f acc e + counter_fold_in_expr f (counter_fold_in_expr f acc e1) e2 + | UN_ALG_OP (_, e) | DIFF_TOKEN (e, _) -> counter_fold_in_expr f acc e | STATE_ALG_OP _ | ALG_VAR _ | TOKEN_ID _ | CONST _ -> acc - | KAPPA_INSTANCE mixture -> - counter_fold_in_mixture f acc mixture + | KAPPA_INSTANCE mixture -> counter_fold_in_mixture f acc mixture | IF (eb, e1, e2) -> - counter_fold_in_bexpr f (counter_fold_in_expr f (counter_fold_in_expr f acc e1) e2) eb + counter_fold_in_bexpr f + (counter_fold_in_expr f (counter_fold_in_expr f acc e1) e2) + eb | DIFF_KAPPA_INSTANCE (e, mixture) -> - counter_fold_in_expr f (counter_fold_in_mixture f acc mixture) e + counter_fold_in_expr f (counter_fold_in_mixture f acc mixture) e and counter_fold_in_bexpr f acc bexpr = match Loc.v bexpr with | TRUE | FALSE -> acc | BIN_BOOL_OP (_, be1, be2) -> - counter_fold_in_bexpr f (counter_fold_in_bexpr f acc be1) be2 - | UN_BOOL_OP (_, be) -> - counter_fold_in_bexpr f acc be + counter_fold_in_bexpr f (counter_fold_in_bexpr f acc be1) be2 + | UN_BOOL_OP (_, be) -> counter_fold_in_bexpr f acc be | COMPARE_OP (_, e1, e2) -> - counter_fold_in_expr f (counter_fold_in_expr f acc e1) e2 + counter_fold_in_expr f (counter_fold_in_expr f acc e1) e2 in let counter_fold_in_bexpr_opt f acc bexpr = match bexpr with - | None -> acc - | Some e -> counter_fold_in_bexpr f acc e + | None -> acc + | Some e -> counter_fold_in_bexpr f acc e in let counter_fold_in_rule f acc rule = let rule : Ast.rule = rule |> Loc.v in let acc = match rule.rewrite with - | Ast.Edit _ -> acc (* no counter test allowed in edit rule *) (* to do *) + | Ast.Edit _ -> + acc + (* no counter test allowed in edit rule *) + (* to do *) | Ast.Arrow content -> counter_fold_in_mixture f acc content.lhs in let acc = - match rule.k_un with None -> acc - | Some (e, Some e') -> - counter_fold_in_expr f (counter_fold_in_expr f acc e' ) e - | Some (e, None) -> counter_fold_in_expr f acc e + match rule.k_un with + | None -> acc + | Some (e, Some e') -> + counter_fold_in_expr f (counter_fold_in_expr f acc e') e + | Some (e, None) -> counter_fold_in_expr f acc e in let acc = counter_fold_in_expr f acc rule.k_def in let acc = - match rule.k_op_un with None -> acc - | Some (e, Some e') -> - counter_fold_in_expr f (counter_fold_in_expr f acc e' ) e - | Some (e, None) -> counter_fold_in_expr f acc e + match rule.k_op_un with + | None -> acc + | Some (e, Some e') -> + counter_fold_in_expr f (counter_fold_in_expr f acc e') e + | Some (e, None) -> counter_fold_in_expr f acc e in - let acc= - match rule.k_op with None -> acc - | Some e -> counter_fold_in_expr f acc e + let acc = + match rule.k_op with + | None -> acc + | Some e -> counter_fold_in_expr f acc e in acc in @@ -1974,7 +2017,7 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = counter_fold_in_expr f acc obs_def in let counter_fold_in_init f acc init = - let e,_ = init in + let e, _ = init in counter_fold_in_expr f acc e in let counter_fold_in_print f acc p = @@ -1984,70 +2027,55 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = in let counter_fold_in_mod f acc mod_def = match mod_def with - | Ast.APPLY (e,r) -> - counter_fold_in_expr f (counter_fold_in_rule f acc r) e - | UPDATE (_,e) -> - counter_fold_in_expr f acc e - | STOP l | SNAPSHOT (_,l) | DIN (_, l) | DINOFF l -> - List.fold_left (counter_fold_in_print f) acc l + | Ast.APPLY (e, r) -> + counter_fold_in_expr f (counter_fold_in_rule f acc r) e + | UPDATE (_, e) -> counter_fold_in_expr f acc e + | STOP l | SNAPSHOT (_, l) | DIN (_, l) | DINOFF l -> + List.fold_left (counter_fold_in_print f) acc l | PRINT (l, l') -> - List.fold_left - (counter_fold_in_print f) - ((List.fold_left (counter_fold_in_print f) acc l')) - l - | PLOTENTRY - | CFLOWLABEL _ -> acc - | CFLOWMIX (_, p) -> - counter_fold_in_mixture f acc (Loc.v p) + List.fold_left (counter_fold_in_print f) + (List.fold_left (counter_fold_in_print f) acc l') + l + | PLOTENTRY | CFLOWLABEL _ -> acc + | CFLOWMIX (_, p) -> counter_fold_in_mixture f acc (Loc.v p) | SPECIES_OF (_, l, m) -> - List.fold_left - (counter_fold_in_print f) - (counter_fold_in_mixture f acc (Loc.v m)) - l + List.fold_left (counter_fold_in_print f) + (counter_fold_in_mixture f acc (Loc.v m)) + l in let counter_fold_in_perturbation f acc perturbation = - let (_,b1_opt,mod_list,b2_opt) = Loc.v perturbation in + let _, b1_opt, mod_list, b2_opt = Loc.v perturbation in counter_fold_in_bexpr_opt f (counter_fold_in_bexpr_opt f - (List.fold_left - (counter_fold_in_mod f) - acc mod_list) - b2_opt) + (List.fold_left (counter_fold_in_mod f) acc mod_list) + b2_opt) b1_opt in - let counter_fold f init = + let counter_fold f init = let l1 = List.fold_left (fun acc r -> counter_fold_in_rule f acc (snd r)) init ast_compil.rules in let l2 = - List.fold_left - (counter_fold_in_variable f) - l1 ast_compil.variables + List.fold_left (counter_fold_in_variable f) l1 ast_compil.variables in let l3 = - List.fold_left - (counter_fold_in_observable f) - l2 ast_compil.observables - in - let l4 = - List.fold_left - (counter_fold_in_init f) - l3 ast_compil.init + List.fold_left (counter_fold_in_observable f) l2 ast_compil.observables in + let l4 = List.fold_left (counter_fold_in_init f) l3 ast_compil.init in let l5 = List.fold_left - (counter_fold_in_perturbation f) - l4 ast_compil.perturbations + (counter_fold_in_perturbation f) + l4 ast_compil.perturbations in l5 in (* Find counters that have CLTE tests, and build list: agent_name, counter_name, sum_bounds_ref list. * sum_bounds_ref is then filled when reading the signature and used to specify for inverted counter init value or test value as [sum_bounds_ref - value] *) - let counters_with_clte_tests : - Mods.StringSet.t Mods.StringMap.t = - counter_fold (fun map agent_name counter -> + let counters_with_clte_tests : Mods.StringSet.t Mods.StringMap.t = + counter_fold + (fun map agent_name counter -> let counter_name = Loc.v counter.counter_name in (* Forbid prefix to avoid nonsense in counter definition *) if Signature.is_inverted_counter counter_name then @@ -2059,43 +2087,42 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = (* Return counter name along with matching agent_name *) match Option_util.map Loc.v counter.counter_test with | Some (Ast.CLTE _) -> - let sites = Mods.StringMap.find_default Mods.StringSet.empty agent_name map in - if - Mods.StringSet.mem counter_name sites - then + let sites = + Mods.StringMap.find_default Mods.StringSet.empty agent_name map + in + if Mods.StringSet.mem counter_name sites then map else Mods.StringMap.add agent_name - (Mods.StringSet.add counter_name sites) - map - | Some (Ast.CEQ _) | Some (Ast.CGTE _) | Some (Ast.CVAR _) | None -> map) Mods.StringMap.empty + (Mods.StringSet.add counter_name sites) + map + | Some (Ast.CEQ _) | Some (Ast.CGTE _) | Some (Ast.CVAR _) | None -> map) + Mods.StringMap.empty in - let add (x,y) data map = - Mods.StringMap.add - x - (Mods.StringMap.add y data - (Mods.StringMap.find_default Mods.StringMap.empty x map)) - map + let add (x, y) data map = + Mods.StringMap.add x + (Mods.StringMap.add y data + (Mods.StringMap.find_default Mods.StringMap.empty x map)) + map in (* Create opposite counters that have the same tests *) - let (signatures : Ast.agent_sig list), - (counter_conversion_info_map : Counters_info.counter_sig Mods.StringMap.t Mods.StringMap.t)= + let ( (signatures : Ast.agent_sig list), + (counter_conversion_info_map : + Counters_info.counter_sig Mods.StringMap.t Mods.StringMap.t) ) = List.fold_left - (fun (acc,map) agent -> + (fun (acc, map) agent -> match agent with - | Ast.Absent _ -> agent::acc, map + | Ast.Absent _ -> agent :: acc, map | Present (agent_name_, site_list, agent_mod) -> let agent_name = Loc.v agent_name_ in - let counters_with_clte_tests_from_agent : - Mods.StringSet.t = - Mods.StringMap.find_default - Mods.StringSet.empty agent_name counters_with_clte_tests + let counters_with_clte_tests_from_agent : Mods.StringSet.t = + Mods.StringMap.find_default Mods.StringSet.empty agent_name + counters_with_clte_tests in - let (new_counter_sites : Counters_info.counter_sig Ast.site list), - map - = + let (new_counter_sites : Counters_info.counter_sig Ast.site list), map + = Mods.StringSet.fold - (fun counter_name (acc,map) -> + (fun counter_name (acc, map) -> (* Find counter to invert *) let counter_orig : Counters_info.counter_sig = List.find_map @@ -2103,7 +2130,9 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = match site with | Ast.Port _ -> None | Counter counter -> - if Loc.v counter.Counters_info.counter_sig_name = counter_name + if + Loc.v counter.Counters_info.counter_sig_name + = counter_name then Some counter else @@ -2119,7 +2148,8 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = counter_orig.counter_sig_name in let _counter_sig_default, _inf_bound, _sup_bound = - match counter_orig.counter_sig_min, counter_orig.counter_sig_max + match + counter_orig.counter_sig_min, counter_orig.counter_sig_max with | Some (Some min, _), Some (Some max, _) -> max + min - counter_orig.counter_sig_default, min, max @@ -2129,29 +2159,36 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = ( "Cannot take the opposite of an unbounded counters ", Loc.get_annot counter_orig.counter_sig_name )) in - let convert_value = Counters_info.BASIS_MINUS_INPUT 0 (*(inf_bound + sup_bound)*) in + let convert_value = + Counters_info.BASIS_MINUS_INPUT 0 (*(inf_bound + sup_bound)*) + in let convert_delta = Counters_info.BASIS_MINUS_INPUT 0 in let update x = match x with - | None -> None - | Some (None,loc) -> Some (None,loc) - | Some (Some i,loc) -> Some (Some (Counters_info.apply_int convert_value i), loc) + | None -> None + | Some (None, loc) -> Some (None, loc) + | Some (Some i, loc) -> + Some (Some (Counters_info.apply_int convert_value i), loc) + in + let ref_min, ref_max = + Counters_info.reorder_bounds convert_value + (counter_orig.counter_sig_min, counter_orig.counter_sig_max) in - let ref_min,ref_max = - Counters_info.reorder_bounds convert_value (counter_orig.counter_sig_min,counter_orig.counter_sig_max) in let counter_sig_min = update ref_min in let counter_sig_max = update ref_max in let counter_sig_default = - Counters_info.apply_int convert_value counter_orig.counter_sig_default in + Counters_info.apply_int convert_value + counter_orig.counter_sig_default + in let convert_info = { Counters_info.from_sig_name = counter_orig.counter_sig_name; - convert_value ; - convert_delta ; + convert_value; + convert_delta; } in let counter_sig_visible = - Counters_info.From_clte_elimination convert_info + Counters_info.From_clte_elimination convert_info in (* Write in sum_bounds_ref the sum of the counter bounds above *) let counter = @@ -2163,20 +2200,20 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = Counters_info.counter_sig_visible; } in - (Ast.Counter counter)::acc, - add - (agent_name,Loc.v counter_orig.counter_sig_name) - counter map) - counters_with_clte_tests_from_agent - ([],map) + ( Ast.Counter counter :: acc, + add + (agent_name, Loc.v counter_orig.counter_sig_name) + counter map )) + counters_with_clte_tests_from_agent ([], map) in - (Ast.Present (agent_name_, site_list @ new_counter_sites, agent_mod))::acc, - map) - ([], Mods.StringMap.empty) (List.rev ast_compil.signatures) + ( Ast.Present (agent_name_, site_list @ new_counter_sites, agent_mod) + :: acc, + map )) + ([], Mods.StringMap.empty) + (List.rev ast_compil.signatures) in (* In rules, we need to replace the counter tests and the counter modifications *) - let replace_counter_by_invert (mix : Ast.mixture) : Ast.mixture = List.map (fun agent_list -> @@ -2187,9 +2224,9 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = | Present (agent_name_, site_list, agent_mod) -> let agent_name : string = Loc.v agent_name_ in let counters_with_clte_tests_from_agent : - Counters_info.counter_sig Mods.StringMap.t = - Mods.StringMap.find_default - Mods.StringMap.empty agent_name counter_conversion_info_map + Counters_info.counter_sig Mods.StringMap.t = + Mods.StringMap.find_default Mods.StringMap.empty agent_name + counter_conversion_info_map in (* Add delta to counter as opposite deltas to counter_delta *) let (added_sites, site_list_with_opposite_deltas) : @@ -2201,11 +2238,10 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = | Counter counter -> (match Mods.StringMap.find_option - (Loc.v counter.Ast.counter_name) - counters_with_clte_tests_from_agent + (Loc.v counter.Ast.counter_name) + counters_with_clte_tests_from_agent with - | None -> - acc, site + | None -> acc, site | Some counter_sig' -> (* As we know that this counter uses a CLTE test, We introduce the inverted counter *) (* [clte_value_or_none] discriminates the case where this site in this expression has a CLTE test *) @@ -2231,15 +2267,15 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = Ast.Counter { Ast.counter_name = - Loc.map_annot - inverted_counter_name + Loc.map_annot inverted_counter_name counter.counter_name; Ast.counter_test = None; Ast.counter_delta = Loc.map_annot (Counters_info.apply_int - conversion_info.Counters_info.convert_delta) - counter.counter_delta; + conversion_info + .Counters_info.convert_delta) + counter.counter_delta; } in inverted_counter_site :: acc, site @@ -2256,16 +2292,19 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = counter.counter_name; Ast.counter_test = Some - (Ast.CGTE (Counters_info.apply_int - conversion_info.Counters_info.convert_value value) + (Ast.CGTE + (Counters_info.apply_int + conversion_info + .Counters_info.convert_value value) |> Loc.copy_annot (Option_util.unsome_or_raise counter.counter_test)); Ast.counter_delta = Loc.map_annot (Counters_info.apply_int - conversion_info.Counters_info.convert_delta) - counter.counter_delta; + conversion_info + .Counters_info.convert_delta) + counter.counter_delta; } in if Loc.v counter.counter_delta == 0 then @@ -2295,12 +2334,12 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = | Ast.Absent _ -> agent | Present (agent_name_, site_list, agent_mod) -> let agent_name : string = Loc.v agent_name_ in - let counters_with_clte_tests_from_agent : - Counters_info.counter_sig Mods.StringMap.t = - Mods.StringMap.find_default - Mods.StringMap.empty agent_name counter_conversion_info_map + let counters_with_clte_tests_from_agent : + Counters_info.counter_sig Mods.StringMap.t = + Mods.StringMap.find_default Mods.StringMap.empty agent_name + counter_conversion_info_map in -(* + (* let counters_with_clte_tests_from_agent : (string * string * int ref) list = List.filter @@ -2315,14 +2354,16 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = match site with | Ast.Port _ -> acc | Counter counter -> - ( - match + (match Mods.StringMap.find_option - (Loc.v counter.Ast.counter_name) counters_with_clte_tests_from_agent - with + (Loc.v counter.Ast.counter_name) + counters_with_clte_tests_from_agent + with | None -> acc - | Some counter_sig -> - let counter_info = Counters_info.get_conversion_info counter_sig in + | Some counter_sig -> + let counter_info = + Counters_info.get_conversion_info counter_sig + in (* As we know that this counter uses a CLTE test, We introduce the inverted counter *) (match counter.counter_test with | None -> @@ -2355,7 +2396,11 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = Ast.counter_test = Some (Loc.copy_annot test - (Ast.CEQ (Counters_info.apply_int counter_info.Counters_info.convert_value value))); + (Ast.CEQ + (Counters_info.apply_int + counter_info + .Counters_info.convert_value + value))); Ast.counter_delta = counter.Ast.counter_delta (* 0 with annot as tested above *); @@ -2372,21 +2417,20 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = in let map_expr expr = - Alg_expr.map_on_mixture - (fun x -> Alg_expr.KAPPA_INSTANCE (replace_counter_by_invert x)) - expr + Alg_expr.map_on_mixture + (fun x -> Alg_expr.KAPPA_INSTANCE (replace_counter_by_invert x)) + expr in let map_bexpr expr = - Alg_expr.map_bool_on_mixture - (fun x -> Alg_expr.KAPPA_INSTANCE (replace_counter_by_invert x)) - expr + Alg_expr.map_bool_on_mixture + (fun x -> Alg_expr.KAPPA_INSTANCE (replace_counter_by_invert x)) + expr in let map_rule rule = let rewrite = match rule.Ast.rewrite with | Edit content -> - Ast.Edit - { content with mix = replace_counter_by_invert content.mix } + Ast.Edit { content with mix = replace_counter_by_invert content.mix } | Arrow content -> Arrow { @@ -2397,15 +2441,17 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = in let k_def = map_expr rule.k_def in let k_op = map_opt map_expr rule.k_op in - let k_un = map_opt (fun (a,b) -> map_expr a, map_opt map_expr b) rule.k_un in - let k_op_un = map_opt (fun (a,b) -> map_expr a, map_opt map_expr b) rule.k_op_un in - { rule with rewrite ; k_def ; k_op ; k_un ; k_op_un} + let k_un = + map_opt (fun (a, b) -> map_expr a, map_opt map_expr b) rule.k_un + in + let k_op_un = + map_opt (fun (a, b) -> map_expr a, map_opt map_expr b) rule.k_op_un + in + { rule with rewrite; k_def; k_op; k_un; k_op_un } in let rules : (string Loc.annoted option * Ast.rule Loc.annoted) list = List.rev_map - (fun rule_def -> - fst rule_def, - Loc.map_annot map_rule (snd rule_def)) + (fun rule_def -> fst rule_def, Loc.map_annot map_rule (snd rule_def)) (List.rev ast_compil.rules) in @@ -2420,46 +2466,61 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = ast_compil.init in let variables = - List.rev_map - (fun (a, b) -> (a, map_expr b)) - (List.rev ast_compil.variables) + List.rev_map (fun (a, b) -> a, map_expr b) (List.rev ast_compil.variables) in let observables = List.rev_map map_expr (List.rev ast_compil.observables) in let map_print a = - match a with - | Primitives.Str_pexpr _ -> a - | Alg_pexpr e -> Alg_pexpr (map_expr e) + match a with + | Primitives.Str_pexpr _ -> a + | Alg_pexpr e -> Alg_pexpr (map_expr e) in let map_modif modif = - match modif with - | Ast.APPLY (a,r) -> Ast.APPLY (map_expr a,Loc.map_annot map_rule r ) - | UPDATE (a,e) -> UPDATE (a,map_expr e) - | STOP l -> STOP (List.rev_map map_print (List.rev l)) - | SNAPSHOT (b,l) -> SNAPSHOT (b,List.rev_map map_print (List.rev l)) - | PRINT (l,l') -> - PRINT(List.rev_map map_print (List.rev l),List.rev_map map_print (List.rev l')) - | PLOTENTRY - | CFLOWLABEL _ -> modif - | CFLOWMIX (b,mixture) -> CFLOWMIX(b, - Loc.map_annot replace_counter_by_invert mixture) - | DIN (a, l) -> DIN(a, List.rev_map map_print (List.rev l)) - | DINOFF l -> DINOFF(List.rev_map map_print (List.rev l)) - | SPECIES_OF (b,l,m) -> - SPECIES_OF(b,List.rev_map map_print l,Loc.map_annot replace_counter_by_invert m) + match modif with + | Ast.APPLY (a, r) -> Ast.APPLY (map_expr a, Loc.map_annot map_rule r) + | UPDATE (a, e) -> UPDATE (a, map_expr e) + | STOP l -> STOP (List.rev_map map_print (List.rev l)) + | SNAPSHOT (b, l) -> SNAPSHOT (b, List.rev_map map_print (List.rev l)) + | PRINT (l, l') -> + PRINT + ( List.rev_map map_print (List.rev l), + List.rev_map map_print (List.rev l') ) + | PLOTENTRY | CFLOWLABEL _ -> modif + | CFLOWMIX (b, mixture) -> + CFLOWMIX (b, Loc.map_annot replace_counter_by_invert mixture) + | DIN (a, l) -> DIN (a, List.rev_map map_print (List.rev l)) + | DINOFF l -> DINOFF (List.rev_map map_print (List.rev l)) + | SPECIES_OF (b, l, m) -> + SPECIES_OF + (b, List.rev_map map_print l, Loc.map_annot replace_counter_by_invert m) in let perturbations = List.rev_map - (fun ((a,b,c,d), ext)-> (a,map_opt map_bexpr b,List.rev_map map_modif (List.rev c),map_opt map_bexpr d ),ext) + (fun ((a, b, c, d), ext) -> + ( ( a, + map_opt map_bexpr b, + List.rev_map map_modif (List.rev c), + map_opt map_bexpr d ), + ext )) (List.rev ast_compil.perturbations) in - {ast_compil with signatures; rules; init; variables; observables; perturbations}, counter_conversion_info_map + ( { + ast_compil with + signatures; + rules; + init; + variables; + observables; + perturbations; + }, + counter_conversion_info_map ) let compil_of_ast ~warning ~debug_mode ~syntax_version ~var_overwrite ast_compil = (* TODO test this *) (* Translate CLTE tests in ast_compil into CGTE tests *) - - let ast_compil, _counter_conversion_info_map = translate_clte_into_cgte ast_compil in + let ast_compil, _counter_conversion_info_map = + translate_clte_into_cgte ast_compil + in let has_counters = Counters_compiler.has_counters ast_compil in let agent_sig_is_implicit = ast_compil.Ast.signatures = [] && ast_compil.Ast.tokens = [] @@ -2490,42 +2551,44 @@ let compil_of_ast ~warning ~debug_mode ~syntax_version ~var_overwrite ast_compil let size = Signature.size agents_sig in let t = Array.make size [||] in let rec aux k = - if k=size then () - else - let () = t.(k)<-Array.make (Signature.arity agents_sig k) None in - aux (k+1) + if k = size then + () + else ( + let () = t.(k) <- Array.make (Signature.arity agents_sig k) None in + aux (k + 1) + ) in let () = aux 0 in t in (*let () = - Mods.StringMap.iter - (fun agent_name m -> - let agent_name = Loc.annot_with_dummy agent_name in - let agent_id = Signature.num_of_agent agent_name agents_sig in - Mods.StringMap.iter - (fun site_name counter_sig -> - let site_id = Signature.id_of_site agent_name (Loc.annot_with_dummy site_name) agents_sig in - counters_info.(agent_id).(site_id)<-Some counter_sig) - m) counter_conversion_info_map - in*) + Mods.StringMap.iter + (fun agent_name m -> + let agent_name = Loc.annot_with_dummy agent_name in + let agent_id = Signature.num_of_agent agent_name agents_sig in + Mods.StringMap.iter + (fun site_name counter_sig -> + let site_id = Signature.id_of_site agent_name (Loc.annot_with_dummy site_name) agents_sig in + counters_info.(agent_id).(site_id)<-Some counter_sig) + m) counter_conversion_info_map + in*) let () = - List.iter - (function - | Ast.Present (agent_name, interface, _) -> - let agent_id = Signature.num_of_agent agent_name agents_sig in - - List.iter - (function - | Ast.Port _ -> () - | Ast.Counter counter_sig -> - let site_name = counter_sig.Counters_info.counter_sig_name in - let site_id = Signature.id_of_site agent_name site_name agents_sig in - counters_info.(agent_id).(site_id)<-Some counter_sig) - interface - | Ast.Absent _ -> () - - ) + List.iter + (function + | Ast.Present (agent_name, interface, _) -> + let agent_id = Signature.num_of_agent agent_name agents_sig in + + List.iter + (function + | Ast.Port _ -> () + | Ast.Counter counter_sig -> + let site_name = counter_sig.Counters_info.counter_sig_name in + let site_id = + Signature.id_of_site agent_name site_name agents_sig + in + counters_info.(agent_id).(site_id) <- Some counter_sig) + interface + | Ast.Absent _ -> ()) ast_compil.Ast.signatures in let contact_map : (Mods.IntSet.t * Mods.Int2Set.t) array array = @@ -2602,8 +2665,8 @@ let compil_of_ast ~warning ~debug_mode ~syntax_version ~var_overwrite ast_compil let pertubations_without_counters, updated_alg_vars = List_util.fold_right_map - (perturbation_of_ast ~warning ~syntax_version agents_sig counters_info tokens_finder - alg_vars_finder contact_map) + (perturbation_of_ast ~warning ~syntax_version agents_sig counters_info + tokens_finder alg_vars_finder contact_map) ast_compil.Ast.perturbations [] in let perturbations = @@ -2619,8 +2682,8 @@ let compil_of_ast ~warning ~debug_mode ~syntax_version ~var_overwrite ast_compil List.rev_map (fun (rule : rule_inter_rep) -> ( rule.label_opt, - ( assemble_rule ~warning ~syntax_version rule agents_sig counters_info tokens_finder - alg_vars_finder, + ( assemble_rule ~warning ~syntax_version rule agents_sig counters_info + tokens_finder alg_vars_finder, rule.pos ) )) cleaned_rules in @@ -2638,13 +2701,14 @@ let compil_of_ast ~warning ~debug_mode ~syntax_version ~var_overwrite ast_compil let observables = List.rev_map (fun expr -> - alg_expr_of_ast ~warning ~syntax_version agents_sig counters_info tokens_finder - alg_vars_finder expr) + alg_expr_of_ast ~warning ~syntax_version agents_sig counters_info + tokens_finder alg_vars_finder expr) (List.rev ast_compil.observables) in let init = - init_of_ast ~warning ~syntax_version agents_sig counters_info contact_map tokens_finder alg_vars_finder ast_compil.init + init_of_ast ~warning ~syntax_version agents_sig counters_info contact_map + tokens_finder alg_vars_finder ast_compil.init in { diff --git a/core/parameters/exception_without_parameter.ml b/core/parameters/exception_without_parameter.ml index 0e10b10d2..984830de3 100644 --- a/core/parameters/exception_without_parameter.ml +++ b/core/parameters/exception_without_parameter.ml @@ -158,6 +158,7 @@ let rec pp_exception f = function Format.fprintf f "Uncaught_exception(%a)" pp_uncaught x | Caught_exception x -> Format.fprintf f "Caught_exception(%a)" pp_caught x | exc -> Utils.pp_exception f exc + and pp_uncaught f x = let with_space = false in Format.fprintf f "@[%a%aexception:@ %a@]" diff --git a/core/parameters/exception_without_parameter.mli b/core/parameters/exception_without_parameter.mli index 9ef88d12e..3bdf119f2 100644 --- a/core/parameters/exception_without_parameter.mli +++ b/core/parameters/exception_without_parameter.mli @@ -17,7 +17,7 @@ these exceptions did not stop execution, so `uncaught` and `caught` may not be good naming here. `caught` here basically add a trace to uncaught info TODO: revamp/rename this? - *) +*) type uncaught_exception diff --git a/core/parameters/remanent_parameters_sig.ml b/core/parameters/remanent_parameters_sig.ml index 268e495b1..22a777d7e 100644 --- a/core/parameters/remanent_parameters_sig.ml +++ b/core/parameters/remanent_parameters_sig.ml @@ -164,7 +164,8 @@ type parameters = { profiler: Loggers.t; compression_status: Loggers.t; print_efficiency: bool; - save_error_list: Exception_without_parameter.exceptions_caught_and_uncaught -> unit; + save_error_list: + Exception_without_parameter.exceptions_caught_and_uncaught -> unit; save_progress_bar: bool * int * int * int -> unit; reset_progress_bar: unit -> unit; save_current_phase_title: string -> unit; diff --git a/core/symmetries/kade_backend.ml b/core/symmetries/kade_backend.ml index eedaf89ca..0697de6f4 100644 --- a/core/symmetries/kade_backend.ml +++ b/core/symmetries/kade_backend.ml @@ -100,12 +100,8 @@ module Pattern = struct let print_cc ?(full_species = false) ?domain ?cc_id ~noCounters ~with_id ?(symbol_table = Symbol_table.symbol_table_V4) f cc = - let sigs = - Tools.map_opt Pattern.Env.signatures domain - in - let counters_info = - Tools.map_opt Pattern.Env.counters_info domain - in + let sigs = Tools.map_opt Pattern.Env.signatures domain in + let counters_info = Tools.map_opt Pattern.Env.counters_info domain in let print_intf ((ag_i, ag_t) as ag) link_ids neigh = snd (Tools.array_fold_lefti @@ -149,12 +145,14 @@ module Pattern = struct Signature.is_counter_agent sigs dst_ty && not noCounters then ( let counter_sig = - match sigs, counters_info with - | Some sigs, Some counters_info -> - Counters_info.get_counter_sig sigs counters_info ag_t p - | None, _ | _,None -> assert false + match sigs, counters_info with + | Some sigs, Some counters_info -> + Counters_info.get_counter_sig sigs counters_info ag_t p + | None, _ | _, None -> assert false + in + let counter = + Pattern.counter_value_cc sigs counter_sig cc (dst_a, dst_p) in - let counter = Pattern.counter_value_cc sigs counter_sig cc (dst_a, dst_p) in let () = Format.fprintf f "{=%d}" counter in (* to do: add symbols in symbol table for counters *) true, out @@ -219,9 +217,7 @@ module Pattern = struct else None in - print_cc - ?domain - ?cc_id ~noCounters ~with_id ~symbol_table f + print_cc ?domain ?cc_id ~noCounters ~with_id ~symbol_table f (Pattern.Env.content (Pattern.Env.get env id)) end diff --git a/core/symmetries/kade_backend.mli b/core/symmetries/kade_backend.mli index 6b9386193..96d4f6fe4 100644 --- a/core/symmetries/kade_backend.mli +++ b/core/symmetries/kade_backend.mli @@ -17,7 +17,7 @@ module Pattern : sig val print_cc : ?full_species:bool -> - ?domain:Pattern.Env.t -> + ?domain:Pattern.Env.t -> ?cc_id:Pattern.id -> noCounters:bool -> with_id:bool -> diff --git a/core/symmetries/lKappa_group_action.ml b/core/symmetries/lKappa_group_action.ml index b5d3a7214..665fd1a4d 100644 --- a/core/symmetries/lKappa_group_action.ml +++ b/core/symmetries/lKappa_group_action.ml @@ -15,11 +15,10 @@ let local_trace = false -let do_print ?trace ?fmt ?env f = - match (local_trace, trace), fmt, env with +let do_print ?trace ?fmt ?env f = + match (local_trace, trace), fmt, env with | (true, _ | _, Some true), Some fmt, Some env -> f env fmt - | (false, (Some false | None)), _, _ - | _, None, _ | _, _, None -> () + | (false, (Some false | None)), _, _ | _, None, _ | _, _, None -> () let binding_equal ((a_t, _), a_m) ((b_t, _), b_m) = a_t = b_t && a_m = b_m @@ -193,9 +192,7 @@ let for_all_elt_permutation ~fmt_err ~env (positions : int list) let rule_tail = shift ~fmt_err ~env rule_tail in next ~fmt_err ~env (agent_id + 1) rule_tail pos_id positions_tail accu | pos_head :: pos_tail when agent_id = pos_head -> - (match - apply_head_predicate ~fmt_err ~env f f_raw accu rule_tail rule - with + (match apply_head_predicate ~fmt_err ~env f f_raw accu rule_tail rule with | accu, false -> accu, false | accu, true -> let rule_tail = shift ~fmt_err ~env rule_tail in @@ -253,7 +250,8 @@ let for_all_over_orbit ~trace ~fmt ~fmt_err ~env (positions : int list) 0 positions accu else ( let () = - backtrack ~fmt_err ~env sigma_inv sigma_raw_inv counter positions rule + backtrack ~fmt_err ~env sigma_inv sigma_raw_inv counter positions + rule in accu, false ) @@ -621,7 +619,8 @@ let check_orbit ~trace ~fmt ~fmt_err ~env let weight ~correct ~card_stabilizer ~rate = Affine_combinations.div_scal rate (correct * card_stabilizer) -let check_orbit_internal_state_permutation ?trace ?fmt ?fmt_err ?env ~agent_type ~site1 ~site2 rule ~correct rates cache ~counter to_be_checked = +let check_orbit_internal_state_permutation ?trace ?fmt ?fmt_err ?env ~agent_type + ~site1 ~site2 rule ~correct rates cache ~counter to_be_checked = check_orbit ~trace ~fmt ~fmt_err ~env ( potential_positions_for_swapping_internal_states, swap_internal_state_regular, @@ -640,7 +639,8 @@ let check_orbit_binding_state_permutation ?trace ?fmt ?fmt_err ?env ~agent_type swap_binding_state_created ) weight agent_type site1 site2 rule correct rates cache counter to_be_checked -let check_orbit_full_permutation ?trace ?fmt ?fmt_err ?env ~agent_type ~site1 ~site2 rule ~correct rates cache ~counter to_be_checked = +let check_orbit_full_permutation ?trace ?fmt ?fmt_err ?env ~agent_type ~site1 + ~site2 rule ~correct rates cache ~counter to_be_checked = check_orbit ~trace ~fmt ~fmt_err ~env ( potential_positions_for_swapping_full, swap_full_regular, diff --git a/core/symmetries/pattern_group_action.ml b/core/symmetries/pattern_group_action.ml index d565bec2e..09101739e 100644 --- a/core/symmetries/pattern_group_action.ml +++ b/core/symmetries/pattern_group_action.ml @@ -360,8 +360,7 @@ let equiv_class_gen ?parameters ~partitions_internal_states in cache, preenv, seen, l -let equiv_class_of_a_species ?parameters ~env - ~partitions_internal_states +let equiv_class_of_a_species ?parameters ~env ~partitions_internal_states ~partitions_binding_states ~partitions_full_states cache preenv seen species = equiv_class_gen ?parameters ~partitions_internal_states @@ -380,6 +379,6 @@ let equiv_class_of_a_pattern ?parameters ~env ~partitions_internal_states Patterns_extra.pattern_id_to_lkappa_rule_and_unspec ?parameters ~env pattern) (fun a b c -> - Patterns_extra.mixture_to_pattern ?parameters a b.LKappa.r_mix c) + Patterns_extra.mixture_to_pattern ?parameters a b.LKappa.r_mix c) (fun (_, a, b) -> a, b) cache preenv seen species diff --git a/core/symmetries/patterns_extra.ml b/core/symmetries/patterns_extra.ml index 2618106d1..dd35b4989 100644 --- a/core/symmetries/patterns_extra.ml +++ b/core/symmetries/patterns_extra.ml @@ -123,7 +123,9 @@ let raw_mixture_to_species ?parameters ?env preenv mix unspec = let () = trace_print ?parameters "OUTPUT:" in let () = safe_print_str __POS__ ?parameters - (fun fmt -> Pattern.print_cc ~noCounters ~sigs ~counters_info ~with_id:false fmt b) + (fun fmt -> + Pattern.print_cc ~noCounters ~sigs ~counters_info ~with_id:false fmt + b) (fun fmt -> Pattern.print_cc ~noCounters ~with_id:false fmt b) in () @@ -137,11 +139,13 @@ let mixture_to_pattern ?parameters preenv mix unspec = let () = trace_print ?parameters "Translation from mixture to pattern" in let () = trace_print ?parameters "INPUT:" in let () = - safe_print_str __POS__ ?parameters - (fun fmt -> - LKappa.print_rule_mixture ~noCounters ~ltypes:true sigs counters_info [] fmt mix) - (fun fmt -> - LKappa.print_rule_mixture ~noCounters ~ltypes:true sigs counters_info [] fmt mix) + safe_print_str __POS__ ?parameters + (fun fmt -> + LKappa.print_rule_mixture ~noCounters ~ltypes:true sigs counters_info [] + fmt mix) + (fun fmt -> + LKappa.print_rule_mixture ~noCounters ~ltypes:true sigs counters_info [] + fmt mix) in let unspec = List.fold_left @@ -192,19 +196,19 @@ let mixture_to_pattern ?parameters preenv mix unspec = let work, _bond_map = aux 0 mix (work, Mods.IntMap.empty) in let a, _, b, c = Pattern.finish_new ~debug_mode:noCounters work in let () = - let () = trace_print ?parameters "OUTPUT:" in - let () = - if noCounters then ( - let _ = Pattern.id_to_yojson c in - () - ) - in - let () = - safe_print_str __POS__ ?parameters - (fun fmt -> Pattern.print_cc ~noCounters ~sigs ~with_id:true fmt b) - (fun fmt -> Pattern.print_cc ~noCounters ~with_id:true fmt b) - in - () + let () = trace_print ?parameters "OUTPUT:" in + let () = + if noCounters then ( + let _ = Pattern.id_to_yojson c in + () + ) + in + let () = + safe_print_str __POS__ ?parameters + (fun fmt -> Pattern.print_cc ~noCounters ~sigs ~with_id:true fmt b) + (fun fmt -> Pattern.print_cc ~noCounters ~with_id:true fmt b) + in + () in a, b, c @@ -317,7 +321,8 @@ let species_to_raw_mixture ?parameters ~env pattern = let () = safe_print_str __POS__ ?parameters (fun fmt -> - Pattern.print_cc ~noCounters ~sigs:(Model.signatures env) ~with_id:false fmt pattern) + Pattern.print_cc ~noCounters ~sigs:(Model.signatures env) + ~with_id:false fmt pattern) (fun fmt -> Pattern.print_cc ~noCounters ~with_id:false fmt pattern) in () @@ -415,8 +420,7 @@ let species_to_raw_mixture ?parameters ~env pattern = (fun fmt -> Raw_mixture.print ~noCounters ~created:false ~initial_comma:false ~sigs:(Model.signatures env) - ~counters_info:(Model.counters_info env) - fmt output) + ~counters_info:(Model.counters_info env) fmt output) (fun fmt -> Raw_mixture.print ~noCounters ~created:false ~initial_comma:false fmt output) @@ -431,7 +435,9 @@ let pattern_to_mixture ?parameters ~env pattern = let () = trace_print ?parameters "INPUT:" in let () = safe_print_str __POS__ ?parameters - (fun fmt -> Pattern.print_cc ~noCounters ~sigs ~counters_info ~with_id:false fmt pattern) + (fun fmt -> + Pattern.print_cc ~noCounters ~sigs ~counters_info ~with_id:false fmt + pattern) (fun fmt -> Pattern.print_cc ~noCounters ~with_id:false fmt pattern) in let _agent_list, site_list, agent_type_map, bond_map = parse pattern in @@ -534,9 +540,11 @@ let pattern_to_mixture ?parameters ~env pattern = let () = safe_print_str __POS__ ?parameters (fun fmt -> - LKappa.print_rule_mixture ~noCounters sigs counters_info ~ltypes:false [] fmt output) + LKappa.print_rule_mixture ~noCounters sigs counters_info ~ltypes:false + [] fmt output) (fun fmt -> - LKappa.print_rule_mixture ~noCounters sigs counters_info ~ltypes:false [] fmt output) + LKappa.print_rule_mixture ~noCounters sigs counters_info ~ltypes:false + [] fmt output) in Some (output, unspec) @@ -621,5 +629,4 @@ let pattern_id_to_lkappa_rule ?parameters ~env id = let pattern_id_to_lkappa_rule_and_unspec ?parameters ~env id = match pattern_id_to_cc env id with | None -> lkappa_init, [] - | Some cc -> pattern_to_lkappa_rule_and_unspec - ?parameters ~env cc + | Some cc -> pattern_to_lkappa_rule_and_unspec ?parameters ~env cc diff --git a/core/symmetries/symmetries.ml b/core/symmetries/symmetries.ml index da8025d85..74b6fb26f 100644 --- a/core/symmetries/symmetries.ml +++ b/core/symmetries/symmetries.ml @@ -482,8 +482,7 @@ let check_invariance_gen p ?trace ?fmt ?fmt_err ?env ~to_be_checked ~counter let id = LKappa_auto.RuleCache.int_of_hashed_list hash in if to_be_checked.(id) then ( let (cache, counter, to_be_checked), b = - p ?trace ?fmt ?fmt_err ?env - ~agent_type ~site1 ~site2 rule ~correct + p ?trace ?fmt ?fmt_err ?env ~agent_type ~site1 ~site2 rule ~correct rates cache ~counter to_be_checked in if b then @@ -495,7 +494,8 @@ let check_invariance_gen p ?trace ?fmt ?fmt_err ?env ~to_be_checked ~counter in aux hash_and_rule_list (cache, to_be_checked, counter) -let check_invariance_internal_states ~correct ~rates ?trace ?fmt ?fmt_err ?env (hash_and_rule_list : +let check_invariance_internal_states ~correct ~rates ?trace ?fmt ?fmt_err ?env + (hash_and_rule_list : (LKappa_auto.RuleCache.hashed_list * LKappa.rule) list) (cache, to_be_checked, counter) agent_type site1 site2 = check_invariance_gen @@ -503,17 +503,16 @@ let check_invariance_internal_states ~correct ~rates ?trace ?fmt ?fmt_err ?env ( ?fmt_err ?env ~to_be_checked ~counter ~correct ~rates hash_and_rule_list cache agent_type site1 site2 -let check_invariance_binding_states ~correct ~rates ?trace ?fmt ?fmt_err ?env hash_and_rule_list (cache, to_be_checked, counter) agent_type site1 site2 = +let check_invariance_binding_states ~correct ~rates ?trace ?fmt ?fmt_err ?env + hash_and_rule_list (cache, to_be_checked, counter) agent_type site1 site2 = check_invariance_gen LKappa_group_action.check_orbit_binding_state_permutation - ?trace ?fmt ?fmt_err ?env - ~to_be_checked ~counter ~correct ~rates + ?trace ?fmt ?fmt_err ?env ~to_be_checked ~counter ~correct ~rates hash_and_rule_list cache agent_type site1 site2 let check_invariance_both ~correct ~rates ?trace ?fmt ?fmt_err ?env hash_and_rule_list (cache, to_be_checked, counter) agent_type site1 site2 = check_invariance_gen LKappa_group_action.check_orbit_full_permutation ?trace - ?fmt ?fmt_err ?env - ~to_be_checked ~counter ~correct ~rates + ?fmt ?fmt_err ?env ~to_be_checked ~counter ~correct ~rates hash_and_rule_list cache agent_type site1 site2 let print_symmetries_gen parameters env contact_map partitioned_contact_map @@ -576,8 +575,8 @@ let initial_value_of_arrays cannonic_list arrays = ()) cannonic_list -let detect_symmetries ~parameters ~env - cache rate_convention chemical_species get_rules contact_map = +let detect_symmetries ~parameters ~env cache rate_convention chemical_species + get_rules contact_map = (*-------------------------------------------------------------*) let trace = Some (Remanent_parameters.get_trace parameters) in let fmt = @@ -635,8 +634,8 @@ let detect_symmetries ~parameters ~env (cache, to_be_checked, counter) (check_invariance_internal_states ?trace ?fmt ?fmt_err ~env ~correct ~rates hash_and_rule_list) - (check_invariance_binding_states ?trace ?fmt ?fmt_err ~env ~correct - ~rates hash_and_rule_list) + (check_invariance_binding_states ?trace ?fmt ?fmt_err ~env ~correct ~rates + hash_and_rule_list) (check_invariance_both ?trace ?fmt ?fmt_err ~env ~correct ~rates hash_and_rule_list) p' @@ -657,8 +656,8 @@ let detect_symmetries ~parameters ~env (cache, to_be_checked_init, counter_init) (check_invariance_internal_states ?trace ?fmt ?fmt_err ~env ~correct ~rates hash_and_rule_list_init) - (check_invariance_binding_states ?trace ?fmt ?fmt_err ~env ~correct - ~rates hash_and_rule_list_init) + (check_invariance_binding_states ?trace ?fmt ?fmt_err ~env ~correct ~rates + hash_and_rule_list_init) (check_invariance_both ?trace ?fmt ?fmt_err ~env ~correct ~rates hash_and_rule_list_init) refined_partitioned_contact_map_copy diff --git a/core/symmetries/symmetries.mli b/core/symmetries/symmetries.mli index 9f33b0f12..e6aecd74e 100644 --- a/core/symmetries/symmetries.mli +++ b/core/symmetries/symmetries.mli @@ -54,7 +54,9 @@ val detect_symmetries : val print_symmetries : parameters:Remanent_parameters_sig.parameters -> - env:Model.t -> symmetries -> unit + env:Model.t -> + symmetries -> + unit type cache diff --git a/core/symmetries/symmetry_interface.ml b/core/symmetries/symmetry_interface.ml index b12615dda..7ac68c04b 100644 --- a/core/symmetries/symmetry_interface.ml +++ b/core/symmetries/symmetry_interface.ml @@ -152,9 +152,8 @@ let print_chemical_species ?compil f = (match compil with | None -> false | Some c -> c.debug_mode) - ~full_species:true - ?domain:(domain_opt compil) - ?cc_id:None ~symbol_table:(symbol_table_opt compil) ~with_id:false) + ~full_species:true ?domain:(domain_opt compil) ?cc_id:None + ~symbol_table:(symbol_table_opt compil) ~with_id:false) let print_token ?compil fmt k = Format.fprintf fmt "%a" (Model.print_token ?env:(environment_opt compil)) k @@ -666,8 +665,7 @@ let detect_symmetries parameters compil cache chemical_species contact_map = let rule_cache = get_rule_cache cache in let env = compil.environment in let rule_cache, symmetries = - Symmetries.detect_symmetries - ~parameters ~env rule_cache + Symmetries.detect_symmetries ~parameters ~env rule_cache compil.rule_rate_convention chemical_species (get_rules compil) contact_map in diff --git a/core/term/kappa_printer.ml b/core/term/kappa_printer.ml index b33a830bb..0121f70f5 100644 --- a/core/term/kappa_printer.ml +++ b/core/term/kappa_printer.ml @@ -65,7 +65,8 @@ let decompiled_rule ~noCounters ~full env f r = Format.fprintf f "%a %a" pr_alg va (Model.print_token ~env) tok in Format.fprintf f "%a%a%t%a%t" - (LKappa.print_rule_mixture ~noCounters sigs counters_info ~ltypes:false r_created) + (LKappa.print_rule_mixture ~noCounters sigs counters_info ~ltypes:false + r_created) r_mix (Raw_mixture.print ~noCounters ~created:true ~initial_comma:(r_mix <> []) ~sigs ~counters_info) diff --git a/core/term/lKappa.ml b/core/term/lKappa.ml index e1b3cc1c8..dac6b9d0f 100644 --- a/core/term/lKappa.ml +++ b/core/term/lKappa.ml @@ -148,16 +148,16 @@ let print_rule_link sigs ~show_erased ~ltypes f ((e, _), s) = s let print_counter_test f = function - | c, min_value, true, _convert -> Format.fprintf f "=%i" ((*Counters_info.apply_origin_to_value convert*) (c+min_value) ) + | c, min_value, true, _convert -> + Format.fprintf f "=%i" + ((*Counters_info.apply_origin_to_value convert*) c + min_value) | c, min_value, false, convert -> - let i = ((*Counters_info.apply_origin_to_value convert*) (c+min_value)) in - match convert with - | Counters_info.From_original_ast -> - Format.fprintf f ">=%i" i - | Counters_info.From_clte_elimination x -> - match x.Counters_info.convert_value with - | Counters_info.BASIS_MINUS_INPUT _ -> - Format.fprintf f ">=%i" i + let i = (*Counters_info.apply_origin_to_value convert*) c + min_value in + (match convert with + | Counters_info.From_original_ast -> Format.fprintf f ">=%i" i + | Counters_info.From_clte_elimination x -> + (match x.Counters_info.convert_value with + | Counters_info.BASIS_MINUS_INPUT _ -> Format.fprintf f ">=%i" i)) let print_counter_delta counters _convert j f switch = match switch with @@ -201,18 +201,22 @@ let print_rule_intf ~noCounters sigs counters_info ~show_erased ~ltypes ag_ty f in if is_counter' && not noCounters then ( let counter_sig = - Counters_info.get_counter_sig sigs - counters_info ag_ty i + Counters_info.get_counter_sig sigs counters_info ag_ty i in let min_value = - match counter_sig.Counters_info.counter_sig_min with - | None | Some (None, _) -> - let msg = - Format.asprintf - "Counter %a in agent %a should have a lower bound" (Signature.print_site sigs ag_ty) i - (Signature.print_agent sigs) ag_ty - in raise (ExceptionDefn.Syntax_Error (Loc.annot_with_dummy msg)) - | Some (Some min_value,_) -> min_value + match counter_sig.Counters_info.counter_sig_min with + | None | Some (None, _) -> + let msg = + Format.asprintf + "Counter %a in agent %a should have a lower bound" + (Signature.print_site sigs ag_ty) + i + (Signature.print_agent sigs) + ag_ty + in + raise + (ExceptionDefn.Syntax_Error (Loc.annot_with_dummy msg)) + | Some (Some min_value, _) -> min_value in Format.fprintf f "%t%a{%a%a}" (if empty then @@ -221,8 +225,12 @@ let print_rule_intf ~noCounters sigs counters_info ~show_erased ~ltypes ag_ty f Pp.space) (Signature.print_site sigs ag_ty) i print_counter_test - (c - 1 , min_value, eq, counter_sig.Counters_info.counter_sig_visible) - (print_counter_delta created_counters counter_sig.Counters_info.counter_sig_visible j) + ( c - 1, + min_value, + eq, + counter_sig.Counters_info.counter_sig_visible ) + (print_counter_delta created_counters + counter_sig.Counters_info.counter_sig_visible j) switch; true ) else @@ -286,11 +294,12 @@ let union_find_counters sigs mix = in t -let print_rule_agent ~noCounters sigs counters_info ~ltypes counters created_counters f ag = +let print_rule_agent ~noCounters sigs counters_info ~ltypes counters + created_counters f ag = Format.fprintf f "%a(@[%a@])%t" (Signature.print_agent sigs) ag.ra_type - (print_rule_intf ~noCounters sigs counters_info ~show_erased:false ~ltypes ag.ra_type) - (ag.ra_ports, ag.ra_ints, counters, created_counters) (fun f -> - if ag.ra_erased then Format.pp_print_string f "-") + (print_rule_intf ~noCounters sigs counters_info ~show_erased:false ~ltypes + ag.ra_type) (ag.ra_ports, ag.ra_ints, counters, created_counters) + (fun f -> if ag.ra_erased then Format.pp_print_string f "-") let print_rule_mixture ~noCounters sigs counters_info ~ltypes created f mix = let counter_agents = union_find_counters (Some sigs) mix in @@ -303,8 +312,8 @@ let print_rule_mixture ~noCounters sigs counters_info ~ltypes created f mix = else ( let () = if some then Pp.comma f in let () = - print_rule_agent ~noCounters sigs counters_info ~ltypes counter_agents created_incr - f h + print_rule_agent ~noCounters sigs counters_info ~ltypes counter_agents + created_incr f h in aux_print true t ) @@ -484,7 +493,8 @@ let print_rates ~noCounters sigs counters_info pr_tok pr_var f r = (Alg_expr.print (fun f m -> Format.fprintf f "|%a|" - (print_rule_mixture ~noCounters sigs counters_info ~ltypes []) + (print_rule_mixture ~noCounters sigs counters_info + ~ltypes []) m) pr_tok pr_var) md)) @@ -495,10 +505,11 @@ let print_rule ~noCounters ~full sigs counters_info pr_tok pr_var f r = (fun f -> if full || r.r_edit_style then Format.fprintf f "%a%a" - (print_rule_mixture ~noCounters sigs counters_info ~ltypes:false r.r_created) + (print_rule_mixture ~noCounters sigs counters_info ~ltypes:false + r.r_created) r.r_mix (Raw_mixture.print ~noCounters ~created:true - ~initial_comma:(r.r_mix <> []) ~sigs ~counters_info ) + ~initial_comma:(r.r_mix <> []) ~sigs ~counters_info) r.r_created else Format.fprintf f "%a%t%a -> %a" @@ -518,12 +529,14 @@ let print_rule ~noCounters ~full sigs counters_info pr_tok pr_var f r = (Alg_expr.print (fun f m -> Format.fprintf f "|%a|" - (print_rule_mixture ~noCounters sigs counters_info ~ltypes:false []) + (print_rule_mixture ~noCounters sigs counters_info + ~ltypes:false []) m) pr_tok pr_var) nb pr_tok tk)) r.r_delta_tokens - (fun f -> if full then print_rates ~noCounters sigs counters_info pr_tok pr_var f r) + (fun f -> + if full then print_rates ~noCounters sigs counters_info pr_tok pr_var f r) let rule_agent_to_json filenames a = `Assoc diff --git a/core/term/lKappa.mli b/core/term/lKappa.mli index 560ecec95..2fbea9b2d 100644 --- a/core/term/lKappa.mli +++ b/core/term/lKappa.mli @@ -64,7 +64,6 @@ type rule = { (** If rule was written in edit style, else it's rewrite style *) } - val agent_to_erased : Signature.s -> rule_agent -> rule_agent val to_erased : Signature.s -> rule_mixture -> rule_mixture val to_maintained : rule_mixture -> rule_mixture @@ -129,7 +128,7 @@ val print_rule : noCounters:bool -> full:bool -> Signature.s -> - Counters_info.t -> + Counters_info.t -> (Format.formatter -> int -> unit) -> (Format.formatter -> int -> unit) -> Format.formatter -> diff --git a/core/term/pattern.ml b/core/term/pattern.ml index 64072ea42..d48f151e9 100644 --- a/core/term/pattern.ml +++ b/core/term/pattern.ml @@ -595,21 +595,24 @@ let intersection renaming cc1 cc2 = type extremity = Open | Closed -let fetch_exit_site _sigs sid = sid+1 +let fetch_exit_site _sigs sid = sid + 1 + let rec counter_value sigs nodes (nid, sid) count = match Mods.IntMap.find_option nid nodes with - | None -> failwith "pending bonds encountered when computing the length of a chain (counters)" + | None -> + failwith + "pending bonds encountered when computing the length of a chain \ + (counters)" | Some ag -> let other = fetch_exit_site sigs sid in - let (el,_) = ag.(other) in - match el with - | UnSpec -> count, Open - | Free -> count, Closed - | Link (dn, di) -> - counter_value sigs nodes (dn, di) (count + 1) + let el, _ = ag.(other) in + (match el with + | UnSpec -> count, Open + | Free -> count, Closed + | Link (dn, di) -> counter_value sigs nodes (dn, di) (count + 1)) let counter_value sigs min_value nodes (nid, sid) = - let a,b = counter_value sigs nodes (nid, sid) 0 in + let a, b = counter_value sigs nodes (nid, sid) 0 in min_value + a, b let counter_value_cc sigs counter_sig cc (nid, sid) = @@ -618,13 +621,19 @@ let counter_value_cc sigs counter_sig cc (nid, sid) = match min_value with | None -> assert false | Some (None, _) -> assert false - | Some (Some min_value,_) -> min_value + | Some (Some min_value, _) -> min_value in let nodes = cc.nodes in let count, extremity = counter_value sigs min_value nodes (nid, sid) in - let () = match extremity with Open -> failwith "pending bonds encountered when computing the length of a chain (counters)" - | Closed -> () - in count + let () = + match extremity with + | Open -> + failwith + "pending bonds encountered when computing the length of a chain \ + (counters)" + | Closed -> () + in + count let dotcomma dotnet = if dotnet then @@ -633,8 +642,8 @@ let dotcomma dotnet = else Pp.space -let print_cc ~noCounters ?(dotnet = false) ?(full_species = false) ?sigs ?counters_info ?cc_id - ~with_id f cc = +let print_cc ~noCounters ?(dotnet = false) ?(full_species = false) ?sigs + ?counters_info ?cc_id ~with_id f cc = let print_intf ((ag_i, ag_t) as ag) link_ids neigh = snd (Tools.array_fold_lefti @@ -676,22 +685,28 @@ let print_cc ~noCounters ?(dotnet = false) ?(full_species = false) ?sigs ?counte Signature.is_counter_agent sigs dst_ty && not noCounters then ( match sigs, counters_info with - | None, _ | _, None -> assert false - | Some sigs, Some counters_info -> - let min_value = - let counter_sig = Counters_info.get_counter_sig sigs counters_info ag_t p in - match counter_sig.Counters_info.counter_sig_min with - | None -> assert false - | Some (None, _) -> assert false - | Some (Some min_value,_) -> min_value - in - let (counter,kind) = counter_value sigs min_value cc.nodes (dst_a, dst_p) in - let () = - Format.fprintf f "{%s%d}" - (match kind with Closed -> "=" | Open -> ">=") - counter - in - true, out + | None, _ | _, None -> assert false + | Some sigs, Some counters_info -> + let min_value = + let counter_sig = + Counters_info.get_counter_sig sigs counters_info ag_t p + in + match counter_sig.Counters_info.counter_sig_min with + | None -> assert false + | Some (None, _) -> assert false + | Some (Some min_value, _) -> min_value + in + let counter, kind = + counter_value sigs min_value cc.nodes (dst_a, dst_p) + in + let () = + Format.fprintf f "{%s%d}" + (match kind with + | Closed -> "=" + | Open -> ">=") + counter + in + true, out ) else ( let i, out' = match Mods.Int2Map.find_option (dst_a, dst_p) link_ids with @@ -769,14 +784,22 @@ let print_cc_as_id sigs counters_info f cc = let dst_ty = find_ty cc dst_a in if Signature.is_counter_agent sigs dst_ty then ( let min_value = - let counter_sig = Counters_info.get_counter_sig sigs counters_info ag_t p in - match counter_sig.Counters_info.counter_sig_min with - | None -> assert false - | Some (None, _) -> assert false - | Some (Some min_value,_) -> min_value + let counter_sig = + Counters_info.get_counter_sig sigs counters_info ag_t p + in + match counter_sig.Counters_info.counter_sig_min with + | None -> assert false + | Some (None, _) -> assert false + | Some (Some min_value, _) -> min_value + in + let counter, extremity = + counter_value sigs min_value cc.nodes (dst_a, dst_p) + in + let () = + match extremity with + | Open -> failwith "bonds should not be opened" + | Closed -> () in - let counter,extremity = counter_value sigs min_value cc.nodes (dst_a, dst_p) in - let () = match extremity with Open -> failwith ("bonds should not be opened") | Closed -> () in let () = Format.fprintf f "~+%d" counter in true, out ) else ( @@ -1266,14 +1289,14 @@ end = struct } let signatures env = env.sig_decl - let counters_info env = env.counters_info let print ~noCounters f env = let pp_point p_id f p = Format.fprintf f "@[@[%a@]@ %t-> @[(%a)@]@]" (fun x -> - print_cc ~noCounters ~sigs:env.sig_decl ~counters_info:env.counters_info ~cc_id:p_id ~with_id:true x) + print_cc ~noCounters ~sigs:env.sig_decl + ~counters_info:env.counters_info ~cc_id:p_id ~with_id:true x) p.content (fun f -> if p.roots <> None then @@ -1395,7 +1418,8 @@ end = struct (try { sig_decl; - counters_info = [||]; (* TO DO *) + counters_info = [||]; + (* TO DO *) (* Si json le prendre, sinon le synthétiser avec l'ancien fonctionnement *) single_agent_points = (match List.assoc "single_agents" l with @@ -1484,7 +1508,8 @@ let print ~noCounters ?domain ~with_id f id = else None in - print_cc ~noCounters ~sigs:(Env.signatures env) ~counters_info:(Env.counters_info env) ?cc_id ~with_id f + print_cc ~noCounters ~sigs:(Env.signatures env) + ~counters_info:(Env.counters_info env) ?cc_id ~with_id f env.Env.domain.(id).Env.content let embeddings_to_fully_specified ~debug_mode domain a_id b = @@ -1532,7 +1557,14 @@ module PreEnv = struct let counters_info preenv = preenv.counters_info let fresh sigs counters_info id_by_type nb_id domain = - { sig_decl = sigs; counters_info ; id_by_type; nb_id; domain; used_by_a_begin_new = false } + { + sig_decl = sigs; + counters_info; + id_by_type; + nb_id; + domain; + used_by_a_begin_new = false; + } let empty sigs counters_info = let nbt' = Array.make (Signature.size sigs) [] in @@ -1913,7 +1945,10 @@ let raw_finish_new ~debug_mode ~toplevel ?origin wk = PreEnv.add_cc ~debug_mode ~toplevel ?origin wk.cc_env (fresh_cc_id wk.cc_env) cc_candidate in - PreEnv.fresh wk.sigs wk.counters wk.reserved_id wk.free_id preenv, r, out, out_id + ( PreEnv.fresh wk.sigs wk.counters wk.reserved_id wk.free_id preenv, + r, + out, + out_id ) let finish_new ~debug_mode ?origin wk = raw_finish_new ~debug_mode ~toplevel:true ?origin wk @@ -1979,7 +2014,7 @@ let new_node wk type_id = ( node, { sigs = wk.sigs; - counters = wk.counters ; + counters = wk.counters; cc_env = wk.cc_env; reserved_id = wk.reserved_id; used_id = wk.used_id; diff --git a/core/term/pattern.mli b/core/term/pattern.mli index 957c69ec4..d3cca5a68 100644 --- a/core/term/pattern.mli +++ b/core/term/pattern.mli @@ -70,7 +70,7 @@ module Env : sig (id * point * Renaming.t) option val signatures : t -> Signature.s - val counters_info: t -> Counters_info.t + val counters_info : t -> Counters_info.t val new_obs_map : t -> (id -> 'a) -> 'a ObsMap.t val to_navigation : t -> id -> Navigation.abstract Navigation.t val print : noCounters:bool -> Format.formatter -> t -> unit @@ -132,7 +132,8 @@ val print_cc : t -> unit -val print_cc_as_id : Signature.s -> Counters_info.t -> Format.formatter -> t -> unit +val print_cc_as_id : + Signature.s -> Counters_info.t -> Format.formatter -> t -> unit val print : noCounters:bool -> @@ -214,4 +215,9 @@ val length : t -> int module Set : SetMap.Set with type elt = id module Map : SetMap.Map with type elt = id -val counter_value_cc : Signature.s option -> Counters_info.counter_sig -> cc -> Mods.IntMap.elt * int -> int +val counter_value_cc : + Signature.s option -> + Counters_info.counter_sig -> + cc -> + Mods.IntMap.elt * int -> + int diff --git a/core/term/pattern_compiler.ml b/core/term/pattern_compiler.ml index 5bf7fabf2..1f3d191a9 100644 --- a/core/term/pattern_compiler.ml +++ b/core/term/pattern_compiler.ml @@ -409,7 +409,7 @@ let rec add_agents_in_cc sigs id wk registered_links ((removed, added) as transf) links_transf instantiations remains = function | [] -> (match Mods.IntMap.root registered_links with - | None -> wk, transf, links_transf, instantiations, remains + | None -> wk, transf, links_transf, instantiations, remains | Some (key, _) -> link_occurence_failure key Loc.dummy) | ag :: ag_l -> let node, wk = Pattern.new_node wk ag.LKappa.ra_type in @@ -485,7 +485,7 @@ let rec add_agents_in_cc sigs id wk registered_links "Try to create the connected components of an ambiguous \ mixture.")) | (LKappa.LNK_VALUE (i, _), pos), s -> - ( match Mods.IntMap.find_option i r_l with + (match Mods.IntMap.find_option i r_l with | Some ((node', site') as dst) -> let dst_place = Matching.Agent.Existing (node', id), site' in let wk'' = Pattern.new_link wk' (node, site_id) dst in @@ -547,8 +547,7 @@ let rec add_agents_in_cc sigs id wk registered_links when List.for_all (fun x -> not (is_linked_on i x)) acc -> handle_ports wk' r_l' c_l transf' l_t' re' (n :: acc) (succ site_id) - | _, _ -> - link_occurence_failure i pos))) + | _, _ -> link_occurence_failure i pos))) ) in handle_ports wk registered_links Mods.IntMap.empty transf' links_transf @@ -708,7 +707,8 @@ let connected_components_sum_of_ambiguous_rule ~debug_mode ~compile_mode_on Format.eprintf "@[_____(%i)@,%a@]@." (List.length all_mixs) (Pp.list Pp.cut (fun f x -> Format.fprintf f "@[%a%a@]" - (LKappa.print_rule_mixture ~noCounters sigs counters_info ~ltypes:true created) + (LKappa.print_rule_mixture ~noCounters sigs counters_info + ~ltypes:true created) x (Raw_mixture.print ~noCounters ~created:true ~initial_comma:(x <> []) ~sigs ~counters_info) diff --git a/core/term/raw_mixture.ml b/core/term/raw_mixture.ml index 4d4c66b85..736b4e8be 100644 --- a/core/term/raw_mixture.ml +++ b/core/term/raw_mixture.ml @@ -104,7 +104,10 @@ let print_link ~noCounters ?min_value counter_agents f = function Mods.DynArray.get counter_agents.rank root in if is_counter && not noCounters then - Format.fprintf f "{=%d}" (match min_value with None -> counter | Some m -> m+counter) + Format.fprintf f "{=%d}" + (match min_value with + | None -> counter + | Some m -> m + counter) else Format.fprintf f "[%i]" i with Invalid_argument _ -> Format.fprintf f "[%i]" i) @@ -117,25 +120,27 @@ let aux_pp_si sigs a s f i = | Some i -> Format.fprintf f "%i{%i}" s i | None -> Format.pp_print_int f s) -let print_intf ~noCounters with_link ?sigs ?counters_info counter_agents ag_ty f (ports, ints) - = +let print_intf ~noCounters with_link ?sigs ?counters_info counter_agents ag_ty f + (ports, ints) = let rec aux empty i = if i < Array.length ports then ( let min_value = - if noCounters then None - else - match sigs, counters_info with + if noCounters then + None + else ( + match sigs, counters_info with | None, _ | _, None -> None | Some sigs, Some counters_info -> - if Signature.site_is_counter sigs ag_ty i - then - let counter_sig = Counters_info.get_counter_sig sigs counters_info ag_ty i in - match counter_sig.Counters_info.counter_sig_min - with - | None - | Some (None, _) -> None - | Some (Some i,_) -> Some i - else None + if Signature.site_is_counter sigs ag_ty i then ( + let counter_sig = + Counters_info.get_counter_sig sigs counters_info ag_ty i + in + match counter_sig.Counters_info.counter_sig_min with + | None | Some (None, _) -> None + | Some (Some i, _) -> Some i + ) else + None + ) in let () = Format.fprintf f "%t%a%a" @@ -161,7 +166,8 @@ let aux_pp_ag sigs f a = | Some sigs -> Signature.print_agent sigs f a | None -> Format.pp_print_int f a -let print_agent ~noCounters created link ?sigs ?counters_info counter_agents f ag = +let print_agent ~noCounters created link ?sigs ?counters_info counter_agents f + ag = Format.fprintf f "%a(@[%a@])%t" (aux_pp_ag sigs) ag.a_type (print_intf ~noCounters link ?sigs ?counters_info counter_agents ag.a_type) (ag.a_ports, ag.a_ints) (fun f -> @@ -182,7 +188,8 @@ let print ~noCounters ~created ~initial_comma ?sigs ?counters_info f mix = else ( let () = if some then Pp.comma f in let () = - print_agent ~noCounters created true ?sigs ?counters_info counter_agents f h + print_agent ~noCounters created true ?sigs ?counters_info + counter_agents f h in aux_print true t ) diff --git a/core/term/raw_mixture.mli b/core/term/raw_mixture.mli index cf6da9e00..cac0a744a 100644 --- a/core/term/raw_mixture.mli +++ b/core/term/raw_mixture.mli @@ -20,7 +20,7 @@ val print : created:bool -> initial_comma:bool -> ?sigs:Signature.s -> - ?counters_info:Counters_info.t -> + ?counters_info:Counters_info.t -> Format.formatter -> t -> unit diff --git a/core/utils/utils.ml b/core/utils/utils.ml index 836958585..7b1d277a2 100644 --- a/core/utils/utils.ml +++ b/core/utils/utils.ml @@ -28,4 +28,3 @@ let pp_exception f = function | Failure x -> Format.fprintf f "Failure(%s)" x | Stack_overflow -> Format.pp_print_string f "Stack_overflow" | exc -> Format.pp_print_string f (Printexc.to_string exc) - diff --git a/core/utils/utils.mli b/core/utils/utils.mli index 97c7a73c5..a4e5b4285 100644 --- a/core/utils/utils.mli +++ b/core/utils/utils.mli @@ -6,5 +6,4 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) - val pp_exception : Format.formatter -> exn -> unit diff --git a/gui/dune b/gui/dune index da2603b92..0754a2f91 100644 --- a/gui/dune +++ b/gui/dune @@ -84,13 +84,7 @@ (js_of_ocaml (flags (:include js_of_ocaml_flags))) - (modules - :standard - \ - KaSimWorker - KaSaWorker - KaStorWorker - KaMoHaWorker) + (modules :standard \ KaSimWorker KaSaWorker KaStorWorker KaMoHaWorker) (libraries js_of_ocaml-tyxml lwt_react @@ -132,10 +126,9 @@ Kappa_logging -open Kappa_cflow - -open + -open Kappa_webapp_ui -open Kappa_webapp_ui -open - Kappa_webapp_state - )) + Kappa_webapp_state)) diff --git a/gui/lib/dune b/gui/lib/dune index 4c8027d3d..be035ce3c 100644 --- a/gui/lib/dune +++ b/gui/lib/dune @@ -1,28 +1,24 @@ (library (name kappa_webapp_lib) (preprocess - (pps - js_of_ocaml-ppx - tyxml-ppx - ppx_inline_test - )) - (libraries - js_of_ocaml-lwt + (pps js_of_ocaml-ppx tyxml-ppx ppx_inline_test)) + (libraries + js_of_ocaml-lwt lwt_react - js_of_ocaml-tyxml + js_of_ocaml-tyxml ppx_inline_test kappa_webapp_lib_no_jsoo kappa_parameters kappa_kasa_type_interface) - (flags :standard -w +a - -open + (flags + :standard + -w + +a + -open Js_of_ocaml -open Js_of_ocaml_tyxml -open Kappa_kasa_type_interface -open - Kappa_parameters - )) - - + Kappa_parameters)) diff --git a/gui/lib/html_utility.mli b/gui/lib/html_utility.mli index 575a4fd2c..9e1842243 100644 --- a/gui/lib/html_utility.mli +++ b/gui/lib/html_utility.mli @@ -25,4 +25,5 @@ val print_site_graph : 'a Html.elt list val print_exceptions_caught_and_uncaught : - Exception_without_parameter.exceptions_caught_and_uncaught -> [> Html_types.p ] Html.elt list + Exception_without_parameter.exceptions_caught_and_uncaught -> + [> Html_types.p ] Html.elt list diff --git a/gui/lib_no_jsoo/dune b/gui/lib_no_jsoo/dune index cc7f5dda0..d6988dbc0 100644 --- a/gui/lib_no_jsoo/dune +++ b/gui/lib_no_jsoo/dune @@ -2,16 +2,6 @@ (name kappa_webapp_lib_no_jsoo) (inline_tests) (preprocess - (pps - ppx_inline_test - )) - (libraries - unix - lwt_react - ppx_inline_test) - (flags :standard -w +a-69 - -open - Ppx_inline_test - )) - - + (pps ppx_inline_test)) + (libraries unix lwt_react ppx_inline_test) + (flags :standard -w +a-69 -open Ppx_inline_test)) diff --git a/gui/state/dune b/gui/state/dune index a0770bc27..faa71e8fe 100644 --- a/gui/state/dune +++ b/gui/state/dune @@ -1,6 +1,6 @@ (library (name kappa_webapp_state) - (libraries + (libraries js_of_ocaml-tyxml lwt_react kappa_webapp_lib diff --git a/gui/state/state_simulation.ml b/gui/state/state_simulation.ml index 811e7e438..0151b4be8 100644 --- a/gui/state/state_simulation.ml +++ b/gui/state/state_simulation.ml @@ -77,9 +77,7 @@ let eval_with_sim_manager_and_info ~(label : string) ?(initializing : Api.concrete_manager -> 'a Api.lwt_result = fun _ -> fail_lwt "Simulation initalizing") ?(ready : - Api.concrete_manager -> - Api_types_j.simulation_info -> - 'a Api.lwt_result = + Api.concrete_manager -> Api_types_j.simulation_info -> 'a Api.lwt_result = fun _ _ -> fail_lwt "Simulation ready") () : 'a Api.lwt_result = eval_with_sim_manager ~label (fun manager s -> match s.simulation_state with @@ -210,7 +208,8 @@ let start_simulation (simulation_parameter : Api_types_j.simulation_parameter) : (* set state to initalize *) let () = update_simulation_state SIMULATION_STATE_INITALIZING in manager#simulation_start simulation_parameter - >>= Api_common.result_bind_with_lwt ~ok:(fun _ -> manager#simulation_info) + >>= Api_common.result_bind_with_lwt ~ok:(fun _ -> + manager#simulation_info) >>= Api_common.result_bind_with_lwt ~ok:(fun simulation_status -> let simulation_state = SIMULATION_STATE_READY simulation_status diff --git a/gui/ui/dune b/gui/ui/dune index 41c013019..5a238ced7 100644 --- a/gui/ui/dune +++ b/gui/ui/dune @@ -2,7 +2,7 @@ (library (name kappa_webapp_ui) - (libraries + (libraries js_of_ocaml-tyxml lwt_react kappa_webapp_lib @@ -43,6 +43,5 @@ Kappa_logging -open Kappa_cflow - -open - Kappa_webapp_state - ))) + -open + Kappa_webapp_state))) diff --git a/gui/ui/panel_projects.ml b/gui/ui/panel_projects.ml index 08963f401..94a64899e 100644 --- a/gui/ui/panel_projects.ml +++ b/gui/ui/panel_projects.ml @@ -99,7 +99,8 @@ let content () = in List.rev_append acc [ li_new; li_prefs ]) State_project.model)); - Ui_common.create_modal_text_input ~id:project_id_modal_id ~title_label:"New Project" + Ui_common.create_modal_text_input ~id:project_id_modal_id + ~title_label:"New Project" ~body: [ [%html diff --git a/gui/ui/panel_tabs/tab_editor/editor_controller.ml b/gui/ui/panel_tabs/tab_editor/editor_controller.ml index 9a410ca83..1b3cf057b 100644 --- a/gui/ui/panel_tabs/tab_editor/editor_controller.ml +++ b/gui/ui/panel_tabs/tab_editor/editor_controller.ml @@ -8,8 +8,7 @@ open Lwt.Infix -let with_file (handler : (string * string) Api.result -> unit Api.lwt_result) - = +let with_file (handler : (string * string) Api.result -> unit Api.lwt_result) = Common.async __LOC__ (fun () -> State_error.wrap __LOC__ (State_file.get_file () >>= handler) >>= fun _ -> Lwt.return_unit) diff --git a/gui/ui/panel_tabs/tab_editor/editor_menu_file.ml b/gui/ui/panel_tabs/tab_editor/editor_menu_file.ml index 627502adb..1115b70f9 100644 --- a/gui/ui/panel_tabs/tab_editor/editor_menu_file.ml +++ b/gui/ui/panel_tabs/tab_editor/editor_menu_file.ml @@ -197,7 +197,8 @@ let content = Tyxml_js.R.Html.ul ~a:[ Html.a_id file_dropdown_menu_id; Html.a_class [ "dropdown-menu" ] ] li_list; - Ui_common.create_modal_text_input ~id:file_new_modal_id ~title_label:"New File" + Ui_common.create_modal_text_input ~id:file_new_modal_id + ~title_label:"New File" ~body: [ [%html {|
|} [ file_new_input ] {|
|}] ] ~submit_label:"Create File" diff --git a/gui/ui/panel_tabs/tab_editor/subtab_polymers.ml b/gui/ui/panel_tabs/tab_editor/subtab_polymers.ml index 90cdebb64..68134f7c5 100644 --- a/gui/ui/panel_tabs/tab_editor/subtab_polymers.ml +++ b/gui/ui/panel_tabs/tab_editor/subtab_polymers.ml @@ -15,7 +15,8 @@ let tab_was_active = ref false let site a = [ a, None, Some (Public_data.Bound_to 1), None ] let print_edge ((a, b), (c, d)) list = - Html_utility.print_newline (Html_utility.print_site_graph [ a, site b; c, site d ] list) + Html_utility.print_newline + (Html_utility.print_site_graph [ a, site b; c, site d ] list) let content () = let scc = diff --git a/tests/integration/Makefile b/tests/integration/Makefile index f61fbdc6e..011006726 100644 --- a/tests/integration/Makefile +++ b/tests/integration/Makefile @@ -87,7 +87,6 @@ build: .PHONY: clean clean_all clean: - # deleting remaining temporary test files @find "$(CURDIR)" \( -name \#\* -or -name \*~ -or -name \*.sxw \) -delete @for i in $(DIRS_OF_TEST:=/$(OUTPUT_PATH)) ;\ do [ -d $${i} ] && find $${i} -mindepth 1 \( -not -name \*.ref \) -delete || true;\ diff --git a/tests/integration/compiler/site_mismatch/output/LOG.ref b/tests/integration/compiler/site_mismatch/output/LOG.ref index 8ed225fd8..7ced75a7a 100644 --- a/tests/integration/compiler/site_mismatch/output/LOG.ref +++ b/tests/integration/compiler/site_mismatch/output/LOG.ref @@ -73,4 +73,4 @@ every agent may occur in the model ------------------------------------------------------------ Some exceptions have been raised -error: file_name: core/KaSa_rep/frontend/prepreprocess.ml; message: line 766, File "crash.ka", line 4, characters 5-69:: missaligned rule: the rule is ignored; exception:Exit +error: file_name: core/KaSa_rep/frontend/prepreprocess.ml; message: line 767, File "crash.ka", line 4, characters 5-69:: missaligned rule: the rule is ignored; exception:Exit