diff --git a/core/KaSa_rep/abstract_domains/mvbdu/dune b/core/KaSa_rep/abstract_domains/mvbdu/dune index ea559ca43f..a26bb9ce15 100644 --- a/core/KaSa_rep/abstract_domains/mvbdu/dune +++ b/core/KaSa_rep/abstract_domains/mvbdu/dune @@ -1,10 +1,17 @@ (library - (name kappa_mvbdu) - (libraries kappa_kasa_kastor_toolset kappa-library.generic) - (flags (:standard -w @a - -open Kappa_parameters - -open Kappa_errors - -open Kappa_logging - -open Kappa_kasa_kastor_toolset - -open Kappa_generic_toolset - ))) + (name kappa_mvbdu) + (libraries kappa_kasa_kastor_toolset kappa-library.generic) + (flags + (:standard + -w + @a + -open + Kappa_parameters + -open + Kappa_errors + -open + Kappa_logging + -open + Kappa_kasa_kastor_toolset + -open + Kappa_generic_toolset))) diff --git a/core/KaSa_rep/abstract_domains/numerical_domains/dune b/core/KaSa_rep/abstract_domains/numerical_domains/dune index eb8d0e432b..7e5d94465b 100644 --- a/core/KaSa_rep/abstract_domains/numerical_domains/dune +++ b/core/KaSa_rep/abstract_domains/numerical_domains/dune @@ -1,11 +1,19 @@ (library - (name kappa_numerical_domains) - (libraries kappa_kasa_frontend) - (flags (:standard -w @a - -open Kappa_parameters - -open Kappa_errors - -open Kappa_logging - -open Kappa_kasa_kastor_toolset - -open Kappa_generic_toolset - -open Kappa_kasa_frontend - ))) + (name kappa_numerical_domains) + (libraries kappa_kasa_frontend) + (flags + (:standard + -w + @a + -open + Kappa_parameters + -open + Kappa_errors + -open + Kappa_logging + -open + Kappa_kasa_kastor_toolset + -open + Kappa_generic_toolset + -open + Kappa_kasa_frontend))) diff --git a/core/KaSa_rep/backend/dune b/core/KaSa_rep/backend/dune index 6f72c5a515..c5c4bd8c2f 100644 --- a/core/KaSa_rep/backend/dune +++ b/core/KaSa_rep/backend/dune @@ -1,14 +1,29 @@ (library - (name kappa_kasa_backend) - (libraries yojson kappa_kasa_frontend kappa_kasa_remanent_state kappa_kasa_site_graphs) - (flags (:standard -w @a - -open Kappa_kasa_frontend - -open Kappa_kasa_kastor_toolset - -open Kappa_parameters - -open Kappa_errors - -open Kappa_logging - -open Kappa_generic_toolset - -open Kappa_kasa_remanent_state - -open Kappa_kasa_site_graphs - -open Kappa_kasa_type_interface - ))) + (name kappa_kasa_backend) + (libraries + yojson + kappa_kasa_frontend + kappa_kasa_remanent_state + kappa_kasa_site_graphs) + (flags + (:standard + -w + @a + -open + Kappa_kasa_frontend + -open + Kappa_kasa_kastor_toolset + -open + Kappa_parameters + -open + Kappa_errors + -open + Kappa_logging + -open + Kappa_generic_toolset + -open + Kappa_kasa_remanent_state + -open + Kappa_kasa_site_graphs + -open + Kappa_kasa_type_interface))) diff --git a/core/KaSa_rep/counting_enumerating_species/dune b/core/KaSa_rep/counting_enumerating_species/dune index 1537000c19..3d2268303b 100644 --- a/core/KaSa_rep/counting_enumerating_species/dune +++ b/core/KaSa_rep/counting_enumerating_species/dune @@ -1,12 +1,19 @@ (library - (name kappa_species_count_enumeration) - (libraries num kappa_kasa_remanent_state kappa-library.generic) - (flags (:standard) - -open Kappa_parameters - -open Kappa_errors - -open Kappa_kasa_remanent_state - -open Kappa_kasa_frontend - -open Kappa_logging - -open Kappa_generic_toolset - -open Kappa_kasa_kastor_toolset -)) + (name kappa_species_count_enumeration) + (libraries num kappa_kasa_remanent_state kappa-library.generic) + (flags + (:standard) + -open + Kappa_parameters + -open + Kappa_errors + -open + Kappa_kasa_remanent_state + -open + Kappa_kasa_frontend + -open + Kappa_logging + -open + Kappa_generic_toolset + -open + Kappa_kasa_kastor_toolset)) diff --git a/core/KaSa_rep/export/dune b/core/KaSa_rep/export/dune index eb0c8be693..06dd1eeb83 100644 --- a/core/KaSa_rep/export/dune +++ b/core/KaSa_rep/export/dune @@ -1,25 +1,50 @@ (library - (name kappa_kasa_export) - (libraries kappa_flow_analysis kappa_reachability kappa_influence_map kappa_polymers_analysis kappa_symmetries) - (flags (:standard) - -open Kappa_kasa_frontend - -open Kappa_kasa_remanent_state - -open Kappa_grammar - -open Kappa_terms - -open Kappa_logging - -open Kappa_generic_toolset - -open Kappa_errors - -open Kappa_reachability - -open Kappa_flow_analysis - -open Kappa_parameters - -open Kappa_kasa_kastor_toolset - -open Kappa_cli - -open Kappa_profiling - -open Kappa_mixtures - -open Kappa_influence_map - -open Kappa_polymers_analysis - -open Kappa_kasa_site_graphs - -open Kappa_kasa_backend - -open Kappa_symmetries - -open Kappa_kasa_type_interface -)) + (name kappa_kasa_export) + (libraries + kappa_flow_analysis + kappa_reachability + kappa_influence_map + kappa_polymers_analysis + kappa_symmetries) + (flags + (:standard) + -open + Kappa_kasa_frontend + -open + Kappa_kasa_remanent_state + -open + Kappa_grammar + -open + Kappa_terms + -open + Kappa_logging + -open + Kappa_generic_toolset + -open + Kappa_errors + -open + Kappa_reachability + -open + Kappa_flow_analysis + -open + Kappa_parameters + -open + Kappa_kasa_kastor_toolset + -open + Kappa_cli + -open + Kappa_profiling + -open + Kappa_mixtures + -open + Kappa_influence_map + -open + Kappa_polymers_analysis + -open + Kappa_kasa_site_graphs + -open + Kappa_kasa_backend + -open + Kappa_symmetries + -open + Kappa_kasa_type_interface)) diff --git a/core/KaSa_rep/export/export.ml b/core/KaSa_rep/export/export.ml index c91a8b8c87..6f1369e1bc 100644 --- a/core/KaSa_rep/export/export.ml +++ b/core/KaSa_rep/export/export.ml @@ -221,17 +221,21 @@ functor in let () = cli.Run_cli_args.syntaxVersion <- syntax_version in let () = cli.Run_cli_args.inputKappaFileNames <- files in - let (_, env, contactmap, _, _, _, _, init), _ = + let compilation_result : Cli_init.compilation_result = Cli_init.get_compilation ~warning:(fun ~pos:_ _msg -> ()) - ~debugMode:false cli + ~debug_mode:false cli in let state = - Remanent_state.set_init_state init - (Remanent_state.set_env (Some env) - (Remanent_state.set_contact_map_int (Some contactmap) state)) + Remanent_state.set_init_state compilation_result.init_l + (Remanent_state.set_env (Some compilation_result.env) + (Remanent_state.set_contact_map_int + (Some compilation_result.contact_map) state)) in - state, Some (env : Model.t), Some init, Some contactmap + ( state, + Some (compilation_result.env : Model.t), + Some compilation_result.init_l, + Some compilation_result.contact_map ) let compute_env show_title state = let state, env, _, _ = compute_env_init show_title state in @@ -1713,27 +1717,38 @@ functor (Ckappa_sig.site_name_of_int y) in ( state, - (Locality.dummy_annot sx, Locality.dummy_annot sy) + (Loc.annot_with_dummy sx, Loc.annot_with_dummy sy) :: list )) (state, []) rev_binding in let states' = NamedDecls.create (Tools.array_map_of_list - (fun i -> Locality.dummy_annot i, ()) + (fun i -> Loc.annot_with_dummy i, ()) states) in ( state, - (Locality.dummy_annot x, (states', binding', None)) :: acc - )) + ( Loc.annot_with_dummy x, + { + Signature.internal_state = states'; + links = Some binding'; + counters_info = None; + } ) + :: acc )) (state, []) interface in ( state, - (Locality.dummy_annot a, NamedDecls.create (Array.of_list acc)) + (Loc.annot_with_dummy a, NamedDecls.create_from_list acc) :: list )) (state, []) l.(0) in - let signature = Signature.create ~counters:[] true l in + + let agent_sigs = + LKappa_compiler.agent_sigs_of_agent_sigs_with_links_as_lists + ~build_contact_map:true + (NamedDecls.create_from_list l) + in + let signature = Signature.create ~counters_per_agent:[] agent_sigs in Remanent_state.set_signature signature state, signature let get_signature = get_gen Remanent_state.get_signature compute_signature @@ -1907,7 +1922,7 @@ functor let cache = LKappa_auto.init_cache () in let cc_cache = Pattern.PreEnv.of_env (Model.domain env) in let _cc_cache, chemical_species = - Symmetry_interface.species_of_initial_state_env ~debugMode:false env + Symmetry_interface.species_of_initial_state_env ~debug_mode:false env contact_map_int cc_cache init in let state, contact_map = get_contact_map ~accuracy_level state in diff --git a/core/KaSa_rep/flow/dune b/core/KaSa_rep/flow/dune index d29ed6c19f..e4644deea5 100644 --- a/core/KaSa_rep/flow/dune +++ b/core/KaSa_rep/flow/dune @@ -1,11 +1,15 @@ (library - (name kappa_flow_analysis) - (libraries kappa_kasa_frontend) - (flags (:standard) - -open Kappa_kasa_frontend - -open Kappa_generic_toolset - -open Kappa_parameters - -open Kappa_logging - -open Kappa_errors - -)) + (name kappa_flow_analysis) + (libraries kappa_kasa_frontend) + (flags + (:standard) + -open + Kappa_kasa_frontend + -open + Kappa_generic_toolset + -open + Kappa_parameters + -open + Kappa_logging + -open + Kappa_errors)) diff --git a/core/KaSa_rep/frontend/build_graph.ml b/core/KaSa_rep/frontend/build_graph.ml index 8e7ef914b5..00f47cb622 100644 --- a/core/KaSa_rep/frontend/build_graph.ml +++ b/core/KaSa_rep/frontend/build_graph.ml @@ -29,7 +29,7 @@ let add_agent parameters error handler cckappa_only agent_id agent_type mixture Cckappa_sig.agent_kasim_id = agent_id; Cckappa_sig.agent_name = agent_type; Cckappa_sig.agent_interface = Ckappa_sig.Site_map_and_set.Map.empty; - Cckappa_sig.agent_position = Locality.dummy; + Cckappa_sig.agent_position = Loc.dummy; Cckappa_sig.is_created = false; } in @@ -45,7 +45,7 @@ let add_agent parameters error handler cckappa_only agent_id agent_type mixture let empty_port = { Cckappa_sig.site_name = Ckappa_sig.dummy_site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_free = None; Cckappa_sig.site_state = { @@ -81,7 +81,7 @@ let add_site parameters error handler cckappa_only agent_id site_name mixture = let site = { Cckappa_sig.site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_free = None; Cckappa_sig.site_state = { @@ -330,7 +330,7 @@ let add_link parameters error agent_id site_name agent_id' site_name' in_progress = let handler = in_progress.kappa_handler in let lnk_id = in_progress.fresh_bond_id in - let fresh_bond_id = Ckappa_sig.next_lnk_value in_progress.fresh_bond_id in + let fresh_bond_id = Ckappa_sig.next_link_value in_progress.fresh_bond_id in let error, mixture = add_link parameters error handler in_progress.cckappa_only agent_id site_name agent_id' site_name' lnk_id in_progress.mixture diff --git a/core/KaSa_rep/frontend/cckappa_sig.ml b/core/KaSa_rep/frontend/cckappa_sig.ml index e2689b6f48..870de1196f 100644 --- a/core/KaSa_rep/frontend/cckappa_sig.ml +++ b/core/KaSa_rep/frontend/cckappa_sig.ml @@ -26,7 +26,7 @@ type kappa_handler = { nagents: Ckappa_sig.c_agent_name; agents_dic: Ckappa_sig.agent_dic; agents_annotation: - (string * Locality.t list) + (string * Loc.t list) Ckappa_sig.Agent_type_nearly_Inf_Int_storage_Imperatif.t; interface_constraints: Ckappa_sig.agent_specification @@ -201,8 +201,7 @@ type compil = { rules: enriched_rule Ckappa_sig.Rule_nearly_Inf_Int_storage_Imperatif.t; (*rules (possibly named)*) observables: - (mixture, string) Alg_expr.e Locality.annot - Int_storage.Nearly_inf_Imperatif.t; + (mixture, string) Alg_expr.e Loc.annoted Int_storage.Nearly_inf_Imperatif.t; (*list of patterns to plot*) init: enriched_init Int_storage.Nearly_inf_Imperatif.t; (*initial graph declaration*) @@ -615,7 +614,7 @@ let empty_port site = site_name = site; site_free = None; site_state = empty_interval; - site_position = Locality.dummy; + site_position = Loc.dummy; } in empty_port diff --git a/core/KaSa_rep/frontend/cckappa_sig.mli b/core/KaSa_rep/frontend/cckappa_sig.mli index 19e1fb6c23..a051d0a371 100644 --- a/core/KaSa_rep/frontend/cckappa_sig.mli +++ b/core/KaSa_rep/frontend/cckappa_sig.mli @@ -26,7 +26,7 @@ type kappa_handler = { nagents: Ckappa_sig.c_agent_name; agents_dic: Ckappa_sig.agent_dic; agents_annotation: - (string * Locality.t list) + (string * Loc.t list) Ckappa_sig.Agent_type_nearly_Inf_Int_storage_Imperatif.t; interface_constraints: Ckappa_sig.agent_specification @@ -194,8 +194,7 @@ type compil = { rules: enriched_rule Ckappa_sig.Rule_nearly_Inf_Int_storage_Imperatif.t; (*rules (possibly named)*) observables: - (mixture, string) Alg_expr.e Locality.annot - Int_storage.Nearly_inf_Imperatif.t; + (mixture, string) Alg_expr.e Loc.annoted Int_storage.Nearly_inf_Imperatif.t; (*list of patterns to plot*) init: enriched_init Int_storage.Nearly_inf_Imperatif.t; (*initial graph declaration*) diff --git a/core/KaSa_rep/frontend/ckappa_sig.ml b/core/KaSa_rep/frontend/ckappa_sig.ml index 878629330c..f17b89ebac 100644 --- a/core/KaSa_rep/frontend/ckappa_sig.ml +++ b/core/KaSa_rep/frontend/ckappa_sig.ml @@ -17,7 +17,7 @@ module Int_Set_and_Map = Map_wrapper.Make (Mods.IntSetMap) let local_trace = true let _ = local_trace -type position = Locality.t +type position = Loc.t type agent_name = string type site_name = string type internal_state = string @@ -40,9 +40,9 @@ type mixture = | EMPTY_MIX and agent = { - ag_nme: string; + agent_name: string; ag_intf: interface; - ag_nme_pos: position; (*; ag_pos:position*) + agent_name_pos: position; (*; ag_pos:position*) } and interface = @@ -51,17 +51,17 @@ and interface = | COUNTER_SEP of counter * interface and port = { - port_nme: string; + port_name: string; port_int: internal; - port_lnk: link; + port_link: link; (*port_pos: position ;*) port_free: bool option; } and counter = { - count_nme: string; - count_test: counter_test option; - count_delta: int option; + counter_name: string; + counter_test: counter_test option; + counter_delta: int option; } and counter_test = CEQ of int | CGTE of int | CVAR of string | UNKNOWN @@ -72,7 +72,7 @@ and link = | FREE | LNK_ANY of position | LNK_SOME of position - | LNK_TYPE of (string Locality.annot * string Locality.annot) + | LNK_TYPE of (string Loc.annoted * string Loc.annoted) | LNK_MISSING let rec skip_only mix = @@ -84,7 +84,7 @@ let rec skip_only mix = type direction = Direct | Reverse type 'pattern rule = { - position: Locality.t; + position: Loc.t; prefix: int; interprete_delta: direction; delta: int; @@ -95,8 +95,8 @@ type 'pattern rule = { substract delta to agents with id >= prefix in the lhs *) lhs: 'pattern; rhs: 'pattern; - k_def: ('pattern, string) Alg_expr.e Locality.annot; - k_un: ('pattern, string) Alg_expr.e Locality.annot option; + k_def: ('pattern, string) Alg_expr.e Loc.annoted; + k_un: ('pattern, string) Alg_expr.e Loc.annoted option; ast: string; ast_no_rate: string; original_ast: string; @@ -152,7 +152,7 @@ let dummy_site_name_minus1 = -1 (*REMOVE:Use in views_domain*) let dummy_state_index_1 = 1 let dummy_agent = - { ag_nme = ""; ag_intf = EMPTY_INTF; ag_nme_pos = Locality.dummy } + { agent_name = ""; ag_intf = EMPTY_INTF; agent_name_pos = Loc.dummy } let dummy_link_value = 1 let fst_site = 1 @@ -160,9 +160,9 @@ let snd_site = 2 let string_of_agent_name (a : c_agent_name) : string = string_of_int a let int_of_agent_name (a : c_agent_name) : int = a let agent_name_of_int (a : int) : c_agent_name = a -let _int_of_lnk_value (a : c_link_value) : int = a +let _int_of_link_value (a : c_link_value) : int = a let lnk_value_of_int (a : int) : c_link_value = a -let next_lnk_value (i : c_link_value) : c_link_value = i + 1 +let next_link_value (i : c_link_value) : c_link_value = i + 1 let site_name_of_int (a : int) : c_site_name = a let int_of_site_name (a : c_site_name) : int = a let string_of_site_name (a : c_site_name) : string = string_of_int a @@ -210,8 +210,8 @@ let rename_link parameters error f link = | LNK_MISSING | FREE | LNK_ANY _ | LNK_SOME _ | LNK_TYPE _ -> error, link let rename_port parameters error f port = - let error, port_lnk = rename_link parameters error f port.port_lnk in - error, { port with port_lnk } + let error, port_link = rename_link parameters error f port.port_link in + error, { port with port_link } let rec rename_interface parameters error f interface = match interface with @@ -312,14 +312,14 @@ let join_link parameters error link1 link2 = | (LNK_ANY _ | LNK_MISSING), _ -> error, link2 | _, (LNK_ANY _ | LNK_MISSING) -> error, link1 | FREE, _ | _, FREE -> - Exception.warn parameters error __POS__ Exit (LNK_ANY Locality.dummy) + Exception.warn parameters error __POS__ Exit (LNK_ANY Loc.dummy) | LNK_SOME _, _ -> error, link2 | _, LNK_SOME _ -> error, link1 | LNK_TYPE ((a, _), (b, _)), LNK_TYPE ((a', _), (b', _)) when a = a' && b = b' -> error, link1 | LNK_TYPE _, LNK_TYPE _ -> - Exception.warn parameters error __POS__ Exit (LNK_ANY Locality.dummy) + Exception.warn parameters error __POS__ Exit (LNK_ANY Loc.dummy) | LNK_VALUE (_, x, y, _, _), LNK_TYPE ((a, _), (b, _)) when x = a && b = y -> error, link1 @@ -330,17 +330,19 @@ let join_link parameters error link1 link2 = when ag = ag' && x = x' && y = y' -> error, link1 | (LNK_VALUE _ | LNK_TYPE _), (LNK_VALUE _ | LNK_TYPE _) -> - Exception.warn parameters error __POS__ Exit (LNK_ANY Locality.dummy) + Exception.warn parameters error __POS__ Exit (LNK_ANY Loc.dummy) ) let join_port parameters error port1 port2 = if - port1.port_nme = port2.port_nme + port1.port_name = port2.port_name && port1.port_int = port2.port_int && port1.port_free = port2.port_free then ( - let error, lnk = join_link parameters error port1.port_lnk port2.port_lnk in - error, { port1 with port_lnk = lnk } + let error, lnk = + join_link parameters error port1.port_link port2.port_link + in + error, { port1 with port_link = lnk } ) else Exception.warn parameters error __POS__ Exit port1 @@ -354,13 +356,14 @@ let join_counter_test parameters error test1 test2 = let join_counter parameters error counter1 counter2 = if - counter1.count_nme = counter2.count_nme - && counter1.count_delta = counter2.count_delta + counter1.counter_name = counter2.counter_name + && counter1.counter_delta = counter2.counter_delta then ( let error, test = - join_counter_test parameters error counter1.count_test counter2.count_test + join_counter_test parameters error counter1.counter_test + counter2.counter_test in - error, { counter1 with count_test = test } + error, { counter1 with counter_test = test } ) else Exception.warn parameters error __POS__ Exit counter1 @@ -393,11 +396,11 @@ let join_interface parameters error interface1 interface2 = | EMPTY_INTF -> map_ports, map_counters | COUNTER_SEP (counter, interface) -> let map_counters = - Mods.StringMap.add counter.count_nme counter map_counters + Mods.StringMap.add counter.counter_name counter map_counters in collect interface map_ports map_counters | PORT_SEP (port, interface) -> - let map_ports = Mods.StringMap.add port.port_nme port map_ports in + let map_ports = Mods.StringMap.add port.port_name port map_ports in collect interface map_ports map_counters in let map_ports_1, map_counters_1 = @@ -437,14 +440,14 @@ let join_interface parameters error interface1 interface2 = error, rev_interface_of_list list let join_agent parameters error agent1 agent2 = - if agent1.ag_nme = agent2.ag_nme then ( + if agent1.agent_name = agent2.agent_name then ( let error, interface = join_interface parameters error agent1.ag_intf agent2.ag_intf in error, { agent1 with ag_intf = interface } ) else Exception.warn parameters error __POS__ - ?message:(Some (agent1.ag_nme ^ agent2.ag_nme)) + ?message:(Some (agent1.agent_name ^ agent2.agent_name)) Exit dummy_agent let rec join_mixture parameters error mixture1 mixture2 = @@ -471,7 +474,7 @@ let rec join_mixture parameters error mixture1 mixture2 = Exception.warn parameters error __POS__ Exit EMPTY_MIX let add_agent parameters error agent_id agent_name mixture = - let agent = { dummy_agent with ag_nme = agent_name } in + let agent = { dummy_agent with agent_name } in let k = int_of_agent_id agent_id in let rec aux k mixture = match mixture with @@ -559,7 +562,7 @@ let rec has_site x interface = | EMPTY_INTF -> false | COUNTER_SEP (_, intf) -> has_site x intf | PORT_SEP (p, intf) -> - if p.port_nme = x then + if p.port_name = x then true else has_site x intf @@ -569,7 +572,7 @@ let rec has_counter x interface = | EMPTY_INTF -> false | PORT_SEP (_, intf) -> has_site x intf | COUNTER_SEP (c, intf) -> - if c.count_nme = x then + if c.counter_name = x then true else has_counter x intf @@ -582,8 +585,8 @@ let add_site parameters error agent_id site_name mixture = else ( let port = { - port_nme = site_name; - port_lnk = LNK_ANY Locality.dummy; + port_name = site_name; + port_link = LNK_ANY Loc.dummy; port_int = []; port_free = None; } @@ -600,7 +603,7 @@ let add_counter parameters error agent_id counter_name mixture = error, agent else ( let counter = - { count_nme = counter_name; count_test = None; count_delta = None } + { counter_name; counter_test = None; counter_delta = None } in let interface = COUNTER_SEP (counter, agent.ag_intf) in error, { agent with ag_intf = interface } @@ -617,7 +620,7 @@ let mod_site_gen parameters error agent_id site_name f mixture = let error, intf = aux intf in error, COUNTER_SEP (counter, intf) | PORT_SEP (port, intf) -> - if port.port_nme = site_name then ( + if port.port_name = site_name then ( let error, port = f parameters error port in error, PORT_SEP (port, intf) ) else ( @@ -633,9 +636,9 @@ let add_binding_state parameters error agent_id site_name p state bool_opt mixture = mod_site_gen parameters error agent_id site_name (fun parameters error port -> - let error, b = p parameters error port.port_lnk in + let error, b = p parameters error port.port_link in if b then - error, { port with port_lnk = state; port_free = bool_opt } + error, { port with port_link = state; port_free = bool_opt } else Exception.warn parameters error __POS__ Exit port) mixture @@ -655,7 +658,7 @@ let add_binding_type parameters error agent_id site_name agent_name' site_name' match lnk with | LNK_MISSING | LNK_SOME _ | LNK_ANY _ -> error, true | FREE | LNK_VALUE _ | LNK_TYPE _ -> error, false) - (LNK_TYPE (Locality.dummy_annot agent_name', Locality.dummy_annot site_name')) + (LNK_TYPE (Loc.annot_with_dummy agent_name', Loc.annot_with_dummy site_name')) (Some false) mixture let add_bound parameters error agent_id site_name mixture = @@ -664,7 +667,7 @@ let add_bound parameters error agent_id site_name mixture = match lnk with | LNK_MISSING | LNK_ANY _ -> error, true | LNK_SOME _ | FREE | LNK_VALUE _ | LNK_TYPE _ -> error, false) - (LNK_SOME Locality.dummy) (Some false) mixture + (LNK_SOME Loc.dummy) (Some false) mixture let add_pointer parameters error agent_id site_name agent_id' agent_name' site_name' lnk_value mixture = @@ -675,7 +678,7 @@ let add_pointer parameters error agent_id site_name agent_id' agent_name' | LNK_TYPE ((agent_name'', _), (site_name'', _)) -> error, agent_name'' = agent_name' && site_name'' = site_name' | FREE | LNK_VALUE _ -> error, false) - (LNK_VALUE (agent_id', agent_name', site_name', lnk_value, Locality.dummy)) + (LNK_VALUE (agent_id', agent_name', site_name', lnk_value, Loc.dummy)) (Some false) mixture let rec get_agent_name parameters error k mixture = @@ -688,7 +691,7 @@ let rec get_agent_name parameters error k mixture = | COMMA (agent, mixture) | DOT (_, agent, mixture) | PLUS (_, agent, mixture) -> if k = 0 then - error, agent.ag_nme + error, agent.agent_name else get_agent_name parameters error (k - 1) mixture | EMPTY_MIX -> Exception.warn parameters error __POS__ Exit "" @@ -876,7 +879,7 @@ type c_compil = { c_init: enriched_init Int_storage.Nearly_inf_Imperatif.t; (*initial graph declaration*) c_perturbations: - (c_mixture Locality.annot, enriched_rule) perturbation + (c_mixture Loc.annoted, enriched_rule) perturbation Int_storage.Nearly_inf_Imperatif.t; } diff --git a/core/KaSa_rep/frontend/ckappa_sig.mli b/core/KaSa_rep/frontend/ckappa_sig.mli index 8cb23b88c8..0b5272e80b 100644 --- a/core/KaSa_rep/frontend/ckappa_sig.mli +++ b/core/KaSa_rep/frontend/ckappa_sig.mli @@ -16,7 +16,7 @@ module Int_Set_and_Map : Map_wrapper.S_with_logs with type elt = int (***************************************************************************) -type position = Locality.t +type position = Loc.t type agent_name = string type site_name = string type internal_state = string @@ -50,7 +50,7 @@ val dummy_agent_id : c_agent_id val dummy_link_value : c_link_value val dummy_site_name_1 : c_site_name val dummy_site_name_minus1 : c_site_name -val next_lnk_value : c_link_value -> c_link_value +val next_link_value : c_link_value -> c_link_value val fst_site : c_site_name val snd_site : c_site_name val dummy_state_index_1 : c_state @@ -120,9 +120,9 @@ type mixture = | EMPTY_MIX and agent = { - ag_nme: string; + agent_name: string; ag_intf: interface; - ag_nme_pos: position; (*; ag_pos:position*) + agent_name_pos: position; (*; ag_pos:position*) } and interface = @@ -131,16 +131,16 @@ and interface = | COUNTER_SEP of counter * interface and port = { - port_nme: string; + port_name: string; port_int: internal; - port_lnk: link; + port_link: link; port_free: bool option; } and counter = { - count_nme: string; - count_test: counter_test option; - count_delta: int option; + counter_name: string; + counter_test: counter_test option; + counter_delta: int option; } and counter_test = CEQ of int | CGTE of int | CVAR of string | UNKNOWN @@ -151,7 +151,7 @@ and link = | FREE | LNK_ANY of position | LNK_SOME of position - | LNK_TYPE of (string Locality.annot * string Locality.annot) + | LNK_TYPE of (string Loc.annoted * string Loc.annoted) | LNK_MISSING val skip_only : mixture -> bool @@ -159,7 +159,7 @@ val skip_only : mixture -> bool type direction = Direct | Reverse type 'pattern rule = { - position: Locality.t; + position: Loc.t; prefix: int; interprete_delta: direction; delta: int; @@ -170,8 +170,8 @@ type 'pattern rule = { substract delta to agents with id >= prefix in the lhs *) lhs: 'pattern; rhs: 'pattern; - k_def: ('pattern, string) Alg_expr.e Locality.annot; - k_un: ('pattern, string) Alg_expr.e Locality.annot option; + k_def: ('pattern, string) Alg_expr.e Loc.annoted; + k_un: ('pattern, string) Alg_expr.e Loc.annoted option; ast: string; ast_no_rate: string; original_ast: string; @@ -425,7 +425,7 @@ type c_compil = { c_init: enriched_init Int_storage.Nearly_inf_Imperatif.t; (*initial graph declaration*) c_perturbations: - (c_mixture Locality.annot, enriched_rule) perturbation + (c_mixture Loc.annoted, enriched_rule) perturbation Int_storage.Nearly_inf_Imperatif.t; } diff --git a/core/KaSa_rep/frontend/dune b/core/KaSa_rep/frontend/dune index 51e7cc945b..8fb1f74a54 100644 --- a/core/KaSa_rep/frontend/dune +++ b/core/KaSa_rep/frontend/dune @@ -1,15 +1,27 @@ (library - (name kappa_kasa_frontend ) - (libraries kappa_kasa_kastor_toolset kappa_classical_graphs kappa_mvbdu) - (flags (:standard -w @a - -open Kappa_kasa_kastor_toolset - -open Kappa_generic_toolset - -open Kappa_parameters - -open Kappa_logging - -open Kappa_classical_graphs - -open Kappa_terms - -open Kappa_grammar - -open Kappa_errors - -open Kappa_mvbdu - -open Kappa_kasa_type_interface - ))) + (name kappa_kasa_frontend) + (libraries kappa_kasa_kastor_toolset kappa_classical_graphs kappa_mvbdu) + (flags + (:standard + -w + @a + -open + Kappa_kasa_kastor_toolset + -open + Kappa_generic_toolset + -open + Kappa_parameters + -open + Kappa_logging + -open + Kappa_classical_graphs + -open + Kappa_terms + -open + Kappa_grammar + -open + Kappa_errors + -open + Kappa_mvbdu + -open + Kappa_kasa_type_interface))) diff --git a/core/KaSa_rep/frontend/handler.ml b/core/KaSa_rep/frontend/handler.ml index 4a2edacffa..fb259ff3f6 100644 --- a/core/KaSa_rep/frontend/handler.ml +++ b/core/KaSa_rep/frontend/handler.ml @@ -205,7 +205,7 @@ let info_of_rule parameters ?(with_rates = false) ?(original = false) error | None -> Exception.warn parameters error __POS__ Exit ( "", - Locality.dummy, + Loc.dummy, Public_data.Dummy_rule_direction, "", Ckappa_sig.dummy_rule_id ) @@ -213,7 +213,7 @@ let info_of_rule parameters ?(with_rates = false) ?(original = false) error let label_opt = rule.Cckappa_sig.e_rule_label in let error, (label, _) = Misc_sa.unsome (error, label_opt) (fun error -> - error, Locality.dummy_annot "") + error, Loc.annot_with_dummy "") in let label = if label = "" then @@ -268,7 +268,7 @@ let info_of_var parameters error handler compiled | None -> Exception.warn parameters error __POS__ Exit ( "VAR " ^ Ckappa_sig.string_of_rule_id var_id, - Locality.dummy, + Loc.dummy, Public_data.Variable, "", var_id ) @@ -291,10 +291,10 @@ let string_of_info ?(with_rule = true) ?(with_rule_name = true) "" in let pos = - if (not with_loc) || pos = Locality.dummy then + if (not with_loc) || pos = Loc.dummy then "" else - Locality.to_string pos + Loc.to_string pos in let ast = if not with_ast then @@ -706,7 +706,7 @@ let print_rule_or_var parameters error handler compiled print_rule print_var let error, label = get_label_of_rule parameters error rule in let error, (m1, _) = Misc_sa.unsome (error, label) (fun error -> - error, Locality.dummy_annot "") + error, Loc.annot_with_dummy "") in let m1 = if m1 = "" then diff --git a/core/KaSa_rep/frontend/handler.mli b/core/KaSa_rep/frontend/handler.mli index b6f7877232..06716505e6 100644 --- a/core/KaSa_rep/frontend/handler.mli +++ b/core/KaSa_rep/frontend/handler.mli @@ -16,13 +16,13 @@ val get_label_of_rule_txt : Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> Cckappa_sig.enriched_rule -> - Exception_without_parameter.method_handler * (string * Locality.t) option + Exception_without_parameter.method_handler * (string * Loc.t) option val get_label_of_rule_dot : Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> Cckappa_sig.enriched_rule -> - Exception_without_parameter.method_handler * (string * Locality.t) option + Exception_without_parameter.method_handler * (string * Loc.t) option val print_site_contact_map : ('a, 'a, 'a) Ckappa_sig.site_type -> 'a @@ -84,7 +84,7 @@ val print_rule_or_var : (Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> Cckappa_sig.enriched_rule -> - 'a * string Locality.annot option) -> + 'a * string Loc.annoted option) -> (Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> Cckappa_sig.enriched_variable -> @@ -120,7 +120,7 @@ val state_list : val last_site_of_agent : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t option -> + ?ka_pos:Loc.t option -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> @@ -130,7 +130,7 @@ val last_site_of_agent : val last_state_of_site : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t option -> + ?ka_pos:Loc.t option -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> @@ -141,7 +141,7 @@ val last_state_of_site : val translate_agent : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t -> + ?ka_pos:Loc.t -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> @@ -158,7 +158,7 @@ val string_of_agent : val is_counter : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t option -> + ?ka_pos:Loc.t option -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> @@ -169,7 +169,7 @@ val is_counter : val is_internal_site : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t option -> + ?ka_pos:Loc.t option -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> @@ -180,7 +180,7 @@ val is_internal_site : val is_binding_site : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t option -> + ?ka_pos:Loc.t option -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> @@ -224,7 +224,7 @@ val string_of_site_update_views : val string_of_site_contact_map : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t option -> + ?ka_pos:Loc.t option -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> @@ -308,7 +308,7 @@ val pos_of_var : Cckappa_sig.kappa_handler -> Cckappa_sig.compil -> Ckappa_sig.c_rule_id -> - Exception_without_parameter.method_handler * Locality.t + Exception_without_parameter.method_handler * Loc.t val pos_of_rule : Remanent_parameters_sig.parameters -> @@ -316,7 +316,7 @@ val pos_of_rule : Cckappa_sig.kappa_handler -> Cckappa_sig.compil -> Ckappa_sig.c_rule_id -> - Exception_without_parameter.method_handler * Locality.t + Exception_without_parameter.method_handler * Loc.t val hide : Public_data.rule -> Public_data.rule @@ -327,7 +327,7 @@ val info_of_agent : Cckappa_sig.compil -> Quark_type.agent_quark -> Exception_without_parameter.method_handler - * (string * Locality.t list * Quark_type.agent_quark) + * (string * Loc.t list * Quark_type.agent_quark) val info_of_rule : Remanent_parameters_sig.parameters -> @@ -338,7 +338,7 @@ val info_of_rule : Ckappa_sig.c_rule_id -> Exception_without_parameter.method_handler * (string - * Locality.t + * Loc.t * Public_data.rule_direction * string * Ckappa_sig.c_rule_id) @@ -359,7 +359,7 @@ val is_reverse : val complementary_interface : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t option -> + ?ka_pos:Loc.t option -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> @@ -370,7 +370,7 @@ val complementary_interface : val dual : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t option -> + ?ka_pos:Loc.t option -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> @@ -384,7 +384,7 @@ val dual : val translate_state : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t option -> + ?ka_pos:Loc.t option -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> @@ -397,7 +397,7 @@ val translate_state : val translate_site : ?ml_pos:(string * int * int * int) option -> - ?ka_pos:Locality.t option -> + ?ka_pos:Loc.t option -> ?message:string -> Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> diff --git a/core/KaSa_rep/frontend/list_tokens.ml b/core/KaSa_rep/frontend/list_tokens.ml index 3e617f0b8f..bb0614bb65 100644 --- a/core/KaSa_rep/frontend/list_tokens.ml +++ b/core/KaSa_rep/frontend/list_tokens.ml @@ -92,12 +92,12 @@ let add_agent_declaration parameters error handler agent_id pos_opt = Ckappa_sig.Agent_type_nearly_Inf_Int_storage_Imperatif.get parameters error agent_id handler.Cckappa_sig.agents_annotation in - let error, (ag_name, list) = + let error, (agent_name, list) = match info_opt with | None -> Exception.warn parameters error __POS__ Exit ("", []) | Some info -> error, info in - let agent_annotation = ag_name, pos :: list in + let agent_annotation = agent_name, pos :: list in let error, agents_annotation = Ckappa_sig.Agent_type_nearly_Inf_Int_storage_Imperatif.set parameters error agent_id agent_annotation handler.Cckappa_sig.agents_annotation @@ -287,8 +287,8 @@ let declare_dual parameter error handler ag site state ag' site' state' = let scan_agent parameters (error, handler) agent = let error, (handler, ag_id) = - declare_agent parameters error handler agent.Ckappa_sig.ag_nme - (Some agent.Ckappa_sig.ag_nme_pos) + declare_agent parameters error handler agent.Ckappa_sig.agent_name + (Some agent.Ckappa_sig.agent_name_pos) in let rec aux error interface handler = match interface with @@ -296,11 +296,11 @@ let scan_agent parameters (error, handler) agent = | Ckappa_sig.COUNTER_SEP (counter, interface) -> let error, (handler, _, _c) = declare_site_with_counter parameters (error, handler) ag_id - counter.Ckappa_sig.count_nme + counter.Ckappa_sig.counter_name in aux error interface handler | Ckappa_sig.PORT_SEP (port, interface) -> - let site_name = port.Ckappa_sig.port_nme in + let site_name = port.Ckappa_sig.port_name in let error, handler = match port.Ckappa_sig.port_int with | [] -> error, handler @@ -320,7 +320,7 @@ let scan_agent parameters (error, handler) agent = error, handler in let error, handler = - match port.Ckappa_sig.port_lnk with + match port.Ckappa_sig.port_link with | Ckappa_sig.LNK_MISSING | Ckappa_sig.FREE | Ckappa_sig.LNK_ANY _ -> error, handler | Ckappa_sig.LNK_VALUE (_, agent', site', _, _) diff --git a/core/KaSa_rep/frontend/prepreprocess.ml b/core/KaSa_rep/frontend/prepreprocess.ml index 096da3b8fa..d9b20cf3c6 100644 --- a/core/KaSa_rep/frontend/prepreprocess.ml +++ b/core/KaSa_rep/frontend/prepreprocess.ml @@ -37,7 +37,7 @@ let add_entry parameters id agent site index (error, map) = ((agent, site, index) :: old_list) map -let add_entry_lnk parameters id agent site index (error, map) = +let add_entry_link parameters id agent site index (error, map) = let error, old_list = Ckappa_sig.Lnk_id_map_and_set.Map.find_default_without_logs parameters error [] id map @@ -116,22 +116,22 @@ let rec scan_interface parameters k agent interface | Ast.Counter counter :: interface -> let error, set_counters = check_freshness parameters error "Counter" - (fst counter.Ast.count_nme) + (fst counter.Ast.counter_name) set_counters in scan_interface parameters k agent interface ((error, a), (set_sites, set_counters)) | Ast.Port port :: interface -> let error, set_sites = - check_freshness parameters error "Site" (fst port.Ast.port_nme) set_sites + check_freshness parameters error "Site" (fst port.Ast.port_name) set_sites in let remanent = error, a in scan_interface parameters k agent interface - ( (match port.Ast.port_lnk with + ( (match port.Ast.port_link with | [ (LKappa.LNK_VALUE (i, ()), _) ] -> - add_entry_lnk parameters + add_entry_link parameters (Ckappa_sig.lnk_value_of_int i) - agent (fst port.Ast.port_nme) k remanent + agent (fst port.Ast.port_name) k remanent | [] | ( ( LKappa.LNK_ANY | LKappa.LNK_FREE | LKappa.LNK_TYPE _ | LKappa.LNK_SOME | LKappa.ANY_FREE @@ -176,7 +176,7 @@ let collect_binding_label parameters mixture f k remanent = map (error, (map, Ckappa_sig.Lnk_id_map_and_set.Set.empty)) -let translate_lnk_state parameters lnk_state remanent = +let translate_link_state parameters lnk_state remanent = match lnk_state with | [ (LKappa.LNK_VALUE (id, ()), pos) ] -> let error, remanent = remanent in @@ -222,10 +222,10 @@ let translate_lnk_state parameters lnk_state remanent = let translate_port is_signature parameters int_set port remanent = let error, map = remanent in let error, _ = - check_freshness parameters error "Site" (fst port.Ast.port_nme) int_set + check_freshness parameters error "Site" (fst port.Ast.port_name) int_set in let error', is_free = - match port.Ast.port_lnk with + match port.Ast.port_link with | [ ((LKappa.LNK_FREE | LKappa.ANY_FREE), _) ] -> error, Some true | [] -> (match Remanent_parameters.get_syntax_version parameters with @@ -242,12 +242,12 @@ let translate_port is_signature parameters int_set port remanent = if is_signature then Ckappa_sig.FREE, remanent else - translate_lnk_state parameters port.Ast.port_lnk (error', map) + translate_link_state parameters port.Ast.port_link (error', map) in ( { - Ckappa_sig.port_nme = fst port.Ast.port_nme; + Ckappa_sig.port_name = fst port.Ast.port_name; Ckappa_sig.port_int = List.rev_map fst (List.rev port.Ast.port_int); - Ckappa_sig.port_lnk = lnk; + Ckappa_sig.port_link = lnk; Ckappa_sig.port_free = is_free; }, remanent ) @@ -266,15 +266,15 @@ let fst_opt a_opt = let translate_counter parameters error int_set counter = let error, _ = check_freshness parameters error "Counters" - (fst counter.Ast.count_nme) + (fst counter.Ast.counter_name) int_set in ( error, { - Ckappa_sig.count_nme = fst counter.Ast.count_nme; - Ckappa_sig.count_test = fst_opt counter.Ast.count_test; - Ckappa_sig.count_delta = - (let a = fst counter.Ast.count_delta in + Ckappa_sig.counter_name = fst counter.Ast.counter_name; + Ckappa_sig.counter_test = fst_opt counter.Ast.counter_test; + Ckappa_sig.counter_delta = + (let a = fst counter.Ast.counter_delta in if a = 0 then None else @@ -312,15 +312,15 @@ let translate_interface parameters is_signature = let translate_agent parameters is_signature ag remanent = match ag with | Ast.Absent _pos -> None, remanent - | Ast.Present ((ag_nme, ag_nme_pos), intf, _modif) -> + | Ast.Present ((agent_name, agent_name_pos), intf, _modif) -> let interface, remanent = translate_interface parameters is_signature intf remanent in ( Some { - Ckappa_sig.ag_nme; + Ckappa_sig.agent_name; Ckappa_sig.ag_intf = interface; - Ckappa_sig.ag_nme_pos; + Ckappa_sig.agent_name_pos; }, remanent ) @@ -381,7 +381,7 @@ let support_agent = function let rec scan intf list = match intf with | [] -> List.sort compare list - | Ast.Port port :: intf -> scan intf (fst port.Ast.port_nme :: list) + | Ast.Port port :: intf -> scan intf (fst port.Ast.port_name :: list) | Ast.Counter _ :: intf -> scan intf list in scan intfs [] diff --git a/core/KaSa_rep/frontend/prepreprocess.mli b/core/KaSa_rep/frontend/prepreprocess.mli index 1f59f6325a..175261cffd 100644 --- a/core/KaSa_rep/frontend/prepreprocess.mli +++ b/core/KaSa_rep/frontend/prepreprocess.mli @@ -13,7 +13,7 @@ val translate_compil : Ast.compil val modif_map : - ('a -> 'b Locality.annot -> 'a * 'c Locality.annot) -> + ('a -> 'b Loc.annoted -> 'a * 'c Loc.annoted) -> ('a -> 'd -> 'a * 'e) -> 'a -> ('d, 'f, 'g, 'b) Ast.modif_expr -> diff --git a/core/KaSa_rep/frontend/preprocess.ml b/core/KaSa_rep/frontend/preprocess.ml index 1c79020109..9441581231 100644 --- a/core/KaSa_rep/frontend/preprocess.ml +++ b/core/KaSa_rep/frontend/preprocess.ml @@ -23,7 +23,7 @@ let empty_agent handler error = Cckappa_sig.agent_kasim_id = Ckappa_sig.dummy_agent_id; Cckappa_sig.agent_name = Ckappa_sig.dummy_agent_name; Cckappa_sig.agent_interface = interface; - Cckappa_sig.agent_position = Locality.dummy; + Cckappa_sig.agent_position = Loc.dummy; Cckappa_sig.is_created = false; } ) @@ -78,7 +78,7 @@ let empty_e_rule handler error = Cckappa_sig.e_rule_initial_direction = Ckappa_sig.Direct; Cckappa_sig.e_rule_rule = { - Ckappa_sig.position = Locality.dummy; + Ckappa_sig.position = Loc.dummy; Ckappa_sig.prefix = 0; Ckappa_sig.delta = 0; Ckappa_sig.interprete_delta = Ckappa_sig.Direct; @@ -157,7 +157,7 @@ let translate_agent_sig parameters error handler agent (kasim_id : Ckappa_sig.c_agent_id) map = let error, (bool, output) = Ckappa_sig.Dictionary_of_agents.allocate_bool parameters error - Ckappa_sig.compare_unit_agent_name agent.Ckappa_sig.ag_nme () + Ckappa_sig.compare_unit_agent_name agent.Ckappa_sig.agent_name () Misc_sa.const_unit handler.Cckappa_sig.agents_dic in let error, agent_name = @@ -185,7 +185,7 @@ let translate_agent_sig parameters error handler agent let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Counter counter.Ckappa_sig.count_nme) () + (Ckappa_sig.Counter counter.Ckappa_sig.counter_name) () Misc_sa.const_unit site_dic in let error, counter_name = @@ -193,13 +193,14 @@ let translate_agent_sig parameters error handler agent | _, None | true, _ -> Exception.warn parameters error __POS__ ~message: - (agent.Ckappa_sig.ag_nme ^ " " ^ counter.Ckappa_sig.count_nme) + (agent.Ckappa_sig.agent_name ^ " " + ^ counter.Ckappa_sig.counter_name) Exit Ckappa_sig.dummy_site_name | _, Some (i, _, _, _) -> error, i in let (error', c_interface), test = let test = - match counter.Ckappa_sig.count_test with + match counter.Ckappa_sig.counter_test with | Some (Ckappa_sig.CEQ i) -> [ Ckappa_sig.state_index_of_int i ] | Some (Ckappa_sig.CGTE _) | Some (Ckappa_sig.CVAR _) @@ -210,7 +211,7 @@ let translate_agent_sig parameters error handler agent ( Ckappa_sig.Site_map_and_set.Map.add parameters error counter_name { Cckappa_sig.site_name = counter_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_state = test; Cckappa_sig.site_free = None; } @@ -240,7 +241,7 @@ let translate_agent_sig parameters error handler agent let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Internal port.Ckappa_sig.port_nme) () + (Ckappa_sig.Internal port.Ckappa_sig.port_name) () Misc_sa.const_unit site_dic in let error, site_name = @@ -248,7 +249,7 @@ let translate_agent_sig parameters error handler agent | _, None | true, _ -> Exception.warn parameters error __POS__ ~message: - (agent.Ckappa_sig.ag_nme ^ " " ^ port.Ckappa_sig.port_nme) + (agent.Ckappa_sig.agent_name ^ " " ^ port.Ckappa_sig.port_name) Exit Ckappa_sig.dummy_site_name | _, Some (i, _, _, _) -> error, i in @@ -288,7 +289,7 @@ let translate_agent_sig parameters error handler agent Ckappa_sig.Site_map_and_set.Map.add parameters error site_name { Cckappa_sig.site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; (*port.Ckappa_sig.port_pos ;*) Cckappa_sig.site_state = internal_list; Cckappa_sig.site_free = port.Ckappa_sig.port_free; @@ -302,14 +303,14 @@ let translate_agent_sig parameters error handler agent error, c_interface in let error, c_interface = - match port.Ckappa_sig.port_lnk with + match port.Ckappa_sig.port_link with | Ckappa_sig.LNK_ANY _ | Ckappa_sig.LNK_MISSING -> Exception.warn parameters error __POS__ Exit c_interface | Ckappa_sig.FREE -> let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Binding port.Ckappa_sig.port_nme) () + (Ckappa_sig.Binding port.Ckappa_sig.port_name) () Misc_sa.const_unit site_dic in (match bool, output with @@ -319,7 +320,7 @@ let translate_agent_sig parameters error handler agent Ckappa_sig.Site_map_and_set.Map.add parameters error site_name { Cckappa_sig.site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_state = [ Ckappa_sig.dummy_state_index ]; Cckappa_sig.site_free = port.Ckappa_sig.port_free; } @@ -347,7 +348,7 @@ let translate_agent_sig parameters error handler agent Cckappa_sig.agent_kasim_id = kasim_id; Cckappa_sig.agent_name; Cckappa_sig.agent_interface = c_interface; - Cckappa_sig.agent_position = Locality.dummy; + Cckappa_sig.agent_position = Loc.dummy; Cckappa_sig.is_created = false; } : Cckappa_sig.agent_sig), @@ -358,14 +359,14 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) delta = let error, (bool, output) = Ckappa_sig.Dictionary_of_agents.allocate_bool parameters error - Ckappa_sig.compare_unit_agent_name agent.Ckappa_sig.ag_nme () + Ckappa_sig.compare_unit_agent_name agent.Ckappa_sig.agent_name () Misc_sa.const_unit handler.Cckappa_sig.agents_dic in match bool, output with | _, None -> let error, ag = Exception.warn parameters error __POS__ Exit - (Cckappa_sig.Unknown_agent (agent.Ckappa_sig.ag_nme, kasim_id)) + (Cckappa_sig.Unknown_agent (agent.Ckappa_sig.agent_name, kasim_id)) in error, bond_list, question_marks, delta, ag | true, _ -> @@ -373,7 +374,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) bond_list, question_marks, delta, - Cckappa_sig.Unknown_agent (agent.Ckappa_sig.ag_nme, kasim_id) ) + Cckappa_sig.Unknown_agent (agent.Ckappa_sig.agent_name, kasim_id) ) | _, Some (agent_name, _, _, _) -> let error, site_dic = match @@ -403,40 +404,41 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Counter counter.Ckappa_sig.count_nme) () + (Ckappa_sig.Counter counter.Ckappa_sig.counter_name) () Misc_sa.const_unit site_dic in match bool, output with | _, None -> Exception.warn parameters error __POS__ ~message: - (agent.Ckappa_sig.ag_nme ^ " " ^ counter.Ckappa_sig.count_nme) + (agent.Ckappa_sig.agent_name ^ " " + ^ counter.Ckappa_sig.counter_name) Exit (c_interface, dead_sites, dead_state_sites, delta) | true, _ -> let error, dead_sites = Cckappa_sig.KaSim_Site_map_and_set.Set.add parameters error - (Ckappa_sig.Counter counter.Ckappa_sig.count_nme) dead_sites + (Ckappa_sig.Counter counter.Ckappa_sig.counter_name) dead_sites in error, (c_interface, dead_sites, dead_state_sites, delta) | _, Some (site_name, _, _, _) -> let error, delta = - match counter.Ckappa_sig.count_delta with + match counter.Ckappa_sig.counter_delta with | None | Some 0 -> error, delta | Some n -> Ckappa_sig.AgentsSite_map_and_set.Map.add parameters error (k, agent_name, site_name) n delta in let error, c_interface = - match counter.Ckappa_sig.count_test with + match counter.Ckappa_sig.counter_test with | Some (Ckappa_sig.CEQ _) | Some (Ckappa_sig.CGTE _) -> Ckappa_sig.Site_map_and_set.Map.add parameters error site_name { Cckappa_sig.site_name; Cckappa_sig.site_free = None; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_state = - (match counter.Ckappa_sig.count_test with + (match counter.Ckappa_sig.counter_test with | Some (Ckappa_sig.CEQ i) -> { Cckappa_sig.min = @@ -473,20 +475,20 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Internal port.Ckappa_sig.port_nme) () + (Ckappa_sig.Internal port.Ckappa_sig.port_name) () Misc_sa.const_unit site_dic in (match bool, output with | _, None -> Exception.warn parameters error __POS__ ~message: - (agent.Ckappa_sig.ag_nme ^ " " ^ port.Ckappa_sig.port_nme) + (agent.Ckappa_sig.agent_name ^ " " ^ port.Ckappa_sig.port_name) Exit (c_interface, question_marks, dead_sites, dead_state_sites) | true, _ -> let error, dead_sites = Cckappa_sig.KaSim_Site_map_and_set.Set.add parameters error - (Ckappa_sig.Internal port.Ckappa_sig.port_nme) dead_sites + (Ckappa_sig.Internal port.Ckappa_sig.port_name) dead_sites in error, (c_interface, question_marks, dead_sites, dead_state_sites) | _, Some (site_name, _, _, _) -> @@ -510,7 +512,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) Ckappa_sig.Site_map_and_set.Map.add parameters error site_name { Cckappa_sig.site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_free = None; Cckappa_sig.site_state = { @@ -536,20 +538,20 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Internal port.Ckappa_sig.port_nme) () + (Ckappa_sig.Internal port.Ckappa_sig.port_name) () Misc_sa.const_unit site_dic in (match bool, output with | _, None -> Exception.warn parameters error __POS__ ~message: - (agent.Ckappa_sig.ag_nme ^ " " ^ port.Ckappa_sig.port_nme) + (agent.Ckappa_sig.agent_name ^ " " ^ port.Ckappa_sig.port_name) Exit (c_interface, question_marks, dead_sites, dead_state_sites) | true, _ -> let error, dead_sites = Cckappa_sig.KaSim_Site_map_and_set.Set.add parameters error - (Ckappa_sig.Internal port.Ckappa_sig.port_nme) dead_sites + (Ckappa_sig.Internal port.Ckappa_sig.port_name) dead_sites in error, (c_interface, question_marks, dead_sites, dead_state_sites) | _, Some (site_name, _, _, _) -> @@ -562,8 +564,8 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) (fun error -> Exception.warn parameters error __POS__ ~message: - (agent.Ckappa_sig.ag_nme ^ " " - ^ port.Ckappa_sig.port_nme) + (agent.Ckappa_sig.agent_name ^ " " + ^ port.Ckappa_sig.port_name) Exit (Ckappa_sig.Dictionary_of_States.init ())) in @@ -589,7 +591,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) Ckappa_sig.Site_map_and_set.Map.add parameters error site_name { Cckappa_sig.site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_free = None; Cckappa_sig.site_state = { @@ -617,12 +619,12 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) question_marks, dead_sites, dead_link_sites ) ) = - match port.Ckappa_sig.port_lnk with + match port.Ckappa_sig.port_link with | Ckappa_sig.LNK_MISSING when creation -> let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Binding port.Ckappa_sig.port_nme) () + (Ckappa_sig.Binding port.Ckappa_sig.port_name) () Misc_sa.const_unit site_dic in (match bool, output with @@ -638,7 +640,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) Ckappa_sig.Site_map_and_set.Map.add parameters error site_name { Cckappa_sig.site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_free = port.Ckappa_sig.port_free; Cckappa_sig.site_state = { @@ -662,7 +664,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Binding port.Ckappa_sig.port_nme) () + (Ckappa_sig.Binding port.Ckappa_sig.port_name) () Misc_sa.const_unit site_dic in (match bool, output with @@ -711,7 +713,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) { Cckappa_sig.site_name; Cckappa_sig.site_free = port.Ckappa_sig.port_free; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_state = { Cckappa_sig.min = Some state_min; @@ -734,7 +736,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Binding port.Ckappa_sig.port_nme) () + (Ckappa_sig.Binding port.Ckappa_sig.port_name) () Misc_sa.const_unit site_dic in (match bool, output with @@ -750,7 +752,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) Ckappa_sig.Site_map_and_set.Map.add parameters error site_name { Cckappa_sig.site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_free = port.Ckappa_sig.port_free; Cckappa_sig.site_state = { @@ -774,15 +776,15 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Binding port.Ckappa_sig.port_nme) () + (Ckappa_sig.Binding port.Ckappa_sig.port_name) () Misc_sa.const_unit site_dic in (match bool, output with | _, None -> Exception.warn parameters error __POS__ ~message: - ("this site cannot be bound, " ^ agent.Ckappa_sig.ag_nme ^ " " - ^ port.Ckappa_sig.port_nme) + ("this site cannot be bound, " ^ agent.Ckappa_sig.agent_name + ^ " " ^ port.Ckappa_sig.port_name) ~pos Exit ( c_interface, bond_list, @@ -792,7 +794,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) | true, _ -> let error, dead_sites = Cckappa_sig.KaSim_Site_map_and_set.Set.add parameters error - (Ckappa_sig.Binding port.Ckappa_sig.port_nme) dead_sites + (Ckappa_sig.Binding port.Ckappa_sig.port_name) dead_sites in ( error, ( c_interface, @@ -810,7 +812,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) | error, None -> let error', dead_link_sites = Ckappa_sig.Site_map_and_set.Map.add parameters error site_name - port.Ckappa_sig.port_lnk dead_link_sites + port.Ckappa_sig.port_link dead_link_sites in ( Exception.check_point Exception.warn parameters error error' __POS__ @@ -834,7 +836,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) then ( let error', dead_link_sites = Ckappa_sig.Site_map_and_set.Map.add parameters error - site_name port.Ckappa_sig.port_lnk dead_link_sites + site_name port.Ckappa_sig.port_link dead_link_sites in ( Exception.check_point Exception.warn parameters error error' __POS__ @@ -864,7 +866,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) { Cckappa_sig.site_name; Cckappa_sig.site_free = port.Ckappa_sig.port_free; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_state = { Cckappa_sig.min = Some state_min; @@ -888,15 +890,15 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Binding port.Ckappa_sig.port_nme) () + (Ckappa_sig.Binding port.Ckappa_sig.port_name) () Misc_sa.const_unit site_dic in (match bool, output with | _, None -> Exception.warn parameters error __POS__ ~message: - ("this site cannot be bound, " ^ agent.Ckappa_sig.ag_nme ^ " " - ^ port.Ckappa_sig.port_nme) + ("this site cannot be bound, " ^ agent.Ckappa_sig.agent_name + ^ " " ^ port.Ckappa_sig.port_name) ~pos Exit ( c_interface, bond_list, @@ -906,7 +908,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) | true, _ -> let error, dead_sites = Cckappa_sig.KaSim_Site_map_and_set.Set.add parameters error - (Ckappa_sig.Binding port.Ckappa_sig.port_nme) dead_sites + (Ckappa_sig.Binding port.Ckappa_sig.port_name) dead_sites in ( error, ( c_interface, @@ -924,7 +926,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) | error, None -> let error', dead_link_sites = Ckappa_sig.Site_map_and_set.Map.add parameters error site_name - port.Ckappa_sig.port_lnk dead_link_sites + port.Ckappa_sig.port_link dead_link_sites in ( Exception.check_point Exception.warn parameters error error' __POS__ @@ -994,7 +996,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) { Cckappa_sig.site_free = port.Ckappa_sig.port_free; Cckappa_sig.site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_state = { Cckappa_sig.min = Some i; @@ -1019,7 +1021,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Binding port.Ckappa_sig.port_nme) () + (Ckappa_sig.Binding port.Ckappa_sig.port_name) () Misc_sa.const_unit site_dic in let error, site_name = @@ -1094,7 +1096,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) { Cckappa_sig.site_free = port.Ckappa_sig.port_free; Cckappa_sig.site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_state = { Cckappa_sig.min = Some i; Cckappa_sig.max = Some i }; } @@ -1145,7 +1147,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) Cckappa_sig.agent_kasim_id = kasim_id; Cckappa_sig.agent_name; Cckappa_sig.agent_interface = c_interface; - Cckappa_sig.agent_position = Locality.dummy; + Cckappa_sig.agent_position = Loc.dummy; Cckappa_sig.is_created = creation; } else @@ -1154,7 +1156,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id) Cckappa_sig.agent_kasim_id = kasim_id; Cckappa_sig.agent_name; Cckappa_sig.agent_interface = c_interface; - Cckappa_sig.agent_position = Locality.dummy; + Cckappa_sig.agent_position = Loc.dummy; Cckappa_sig.is_created = creation; }, dead_sites, @@ -1632,7 +1634,7 @@ let translate_rule parameters error handler rule = error { Cckappa_sig.site_name; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_free = None; Cckappa_sig.site_state = { Cckappa_sig.min = None; Cckappa_sig.max = None }; diff --git a/core/KaSa_rep/frontend/preprocess.mli b/core/KaSa_rep/frontend/preprocess.mli index 93188307d3..8c72b6b862 100644 --- a/core/KaSa_rep/frontend/preprocess.mli +++ b/core/KaSa_rep/frontend/preprocess.mli @@ -116,7 +116,7 @@ val translate_pert : Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> Cckappa_sig.kappa_handler -> - (Ckappa_sig.mixture, string) Alg_expr.e * Locality.t -> + (Ckappa_sig.mixture, string) Alg_expr.e * Loc.t -> Ckappa_sig.mixture * 'a -> Exception_without_parameter.method_handler * Cckappa_sig.enriched_init diff --git a/core/KaSa_rep/frontend/print_cckappa.ml b/core/KaSa_rep/frontend/print_cckappa.ml index 54c789dd79..022227e9ff 100644 --- a/core/KaSa_rep/frontend/print_cckappa.ml +++ b/core/KaSa_rep/frontend/print_cckappa.ml @@ -533,7 +533,7 @@ let print_var parameters error handler var = Loggers.fprintf (Remanent_parameters.get_logger parameters) "%s: " s in print_short_alg parameters error handler - (Locality.dummy_annot var.Cckappa_sig.c_variable) + (Loc.annot_with_dummy var.Cckappa_sig.c_variable) let print_variables parameters error handler var = Ckappa_sig.Rule_nearly_Inf_Int_storage_Imperatif.print parameters error @@ -921,7 +921,7 @@ let print_agent_annotation parameters error handler = (Remanent_parameters.get_logger parameters) "%s %s" (Remanent_parameters.get_prefix parameters) - (Locality.to_string position) + (Loc.to_string position) in Loggers.print_newline (Remanent_parameters.get_logger parameters)) locations diff --git a/core/KaSa_rep/frontend/print_ckappa.ml b/core/KaSa_rep/frontend/print_ckappa.ml index 936d99819d..5c5c7f8c8a 100644 --- a/core/KaSa_rep/frontend/print_ckappa.ml +++ b/core/KaSa_rep/frontend/print_ckappa.ml @@ -149,7 +149,7 @@ let print_port parameter error port = let _ = Loggers.fprintf (Remanent_parameters.get_logger parameter) - "%s" port.Ckappa_sig.port_nme + "%s" port.Ckappa_sig.port_name in let _ = List.iter @@ -165,17 +165,17 @@ let print_port parameter error port = (Remanent_parameters.get_close_internal_state parameter)) port.Ckappa_sig.port_int in - let error = print_link_state parameter error port.Ckappa_sig.port_lnk in + let error = print_link_state parameter error port.Ckappa_sig.port_link in error let print_counter parameter error counter = let _ = Loggers.fprintf (Remanent_parameters.get_logger parameter) - "%s" counter.Ckappa_sig.count_nme + "%s" counter.Ckappa_sig.counter_name in let _ = - match counter.Ckappa_sig.count_test with + match counter.Ckappa_sig.counter_test with | Some (Ckappa_sig.CEQ n) -> Loggers.fprintf (Remanent_parameters.get_logger parameter) @@ -203,7 +203,7 @@ let print_counter parameter error counter = | Some Ckappa_sig.UNKNOWN | None -> () in let () = - match counter.Ckappa_sig.count_delta with + match counter.Ckappa_sig.counter_delta with | Some 0 | None -> () | Some n when n > 0 -> Loggers.fprintf @@ -249,7 +249,7 @@ let print_agent parameter error agent = let () = Loggers.fprintf (Remanent_parameters.get_logger parameter) - "%s%s" agent.Ckappa_sig.ag_nme + "%s%s" agent.Ckappa_sig.agent_name (Remanent_parameters.get_agent_open_symbol parameter) in let error = print_interface parameter error agent.Ckappa_sig.ag_intf in diff --git a/core/KaSa_rep/frontend/print_ckappa.mli b/core/KaSa_rep/frontend/print_ckappa.mli index ad69aba66c..b8d301204d 100644 --- a/core/KaSa_rep/frontend/print_ckappa.mli +++ b/core/KaSa_rep/frontend/print_ckappa.mli @@ -9,7 +9,7 @@ val print_rule : val print_bool : Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> - (Ckappa_sig.mixture, string) Alg_expr.bool Locality.annot -> + (Ckappa_sig.mixture, string) Alg_expr.bool Loc.annoted -> Exception_without_parameter.method_handler val print_alg : diff --git a/core/KaSa_rep/influence_map/algebraic_construction.ml b/core/KaSa_rep/influence_map/algebraic_construction.ml index 85e1cf3bfa..2afa8ca6c7 100644 --- a/core/KaSa_rep/influence_map/algebraic_construction.ml +++ b/core/KaSa_rep/influence_map/algebraic_construction.ml @@ -36,7 +36,7 @@ let complete_interface parameters error handler proper_agent = Ckappa_sig.Site_map_and_set.Map.add parameters error site { Cckappa_sig.site_name = site; - Cckappa_sig.site_position = Locality.dummy; + Cckappa_sig.site_position = Loc.dummy; Cckappa_sig.site_free = (if is_binding_site then Some true diff --git a/core/KaSa_rep/influence_map/dune b/core/KaSa_rep/influence_map/dune index ce5151276b..f3f50e1980 100644 --- a/core/KaSa_rep/influence_map/dune +++ b/core/KaSa_rep/influence_map/dune @@ -1,14 +1,27 @@ (library - (name kappa_influence_map) - (libraries kappa_kasa_frontend kappa_kasa_remanent_state kappa_classical_graphs kappa-library.terms) - (flags (:standard) - -open Kappa_kasa_frontend - -open Kappa_kasa_remanent_state - -open Kappa_errors - -open Kappa_parameters - -open Kappa_logging - -open Kappa_classical_graphs - -open Kappa_kasa_kastor_toolset - -open Kappa_generic_toolset - -open Kappa_terms -)) + (name kappa_influence_map) + (libraries + kappa_kasa_frontend + kappa_kasa_remanent_state + kappa_classical_graphs + kappa-library.terms) + (flags + (:standard) + -open + Kappa_kasa_frontend + -open + Kappa_kasa_remanent_state + -open + Kappa_errors + -open + Kappa_parameters + -open + Kappa_logging + -open + Kappa_classical_graphs + -open + Kappa_kasa_kastor_toolset + -open + Kappa_generic_toolset + -open + Kappa_terms)) diff --git a/core/KaSa_rep/main/dune b/core/KaSa_rep/main/dune index 7bc33e1009..4b83362bb0 100644 --- a/core/KaSa_rep/main/dune +++ b/core/KaSa_rep/main/dune @@ -1,46 +1,85 @@ (library - (name kappa_staticanalyses) - (libraries unix kappa_species_count_enumeration kappa_reachability kappa_influence_map kappa_kasa_export) - (modules (:standard \ KaSa)) - (flags (:standard -w @a - -open Kappa_generic_toolset - -open Kappa_mixtures - -open Kappa_terms - -open Kappa_runtime - -open Kappa_grammar - -open Kappa_cli - -open Kappa_profiling - -open Kappa_logging - -open Kappa_errors - -open Kappa_version - -open Kappa_kasa_kastor_toolset - -open Kappa_symmetries - -open Kappa_parameters - -open Kappa_reachability - -open Kappa_flow_analysis - -open Kappa_kasa_remanent_state - -open Kappa_mvbdu - -open Kappa_kasa_frontend - -open Kappa_kasa_site_graphs - -open Kappa_kasa_backend - -open Kappa_influence_map - -open Kappa_kasa_export - -open Kappa_kasa_type_interface - ))) - + (name kappa_staticanalyses) + (libraries + unix + kappa_species_count_enumeration + kappa_reachability + kappa_influence_map + kappa_kasa_export) + (modules + (:standard \ KaSa)) + (flags + (:standard + -w + @a + -open + Kappa_generic_toolset + -open + Kappa_mixtures + -open + Kappa_terms + -open + Kappa_runtime + -open + Kappa_grammar + -open + Kappa_cli + -open + Kappa_profiling + -open + Kappa_logging + -open + Kappa_errors + -open + Kappa_version + -open + Kappa_kasa_kastor_toolset + -open + Kappa_symmetries + -open + Kappa_parameters + -open + Kappa_reachability + -open + Kappa_flow_analysis + -open + Kappa_kasa_remanent_state + -open + Kappa_mvbdu + -open + Kappa_kasa_frontend + -open + Kappa_kasa_site_graphs + -open + Kappa_kasa_backend + -open + Kappa_influence_map + -open + Kappa_kasa_export + -open + Kappa_kasa_type_interface))) (executable - (name KaSa) - (libraries num yojson str kappa_staticanalyses kappa_kasa_frontend) - (modules KaSa) - (public_name KaSa) - (package kappa-binaries) - (flags (:standard - -open Kappa_logging - -open Kappa_errors - -open Kappa_parameters - -open Kappa_reachability - -open Kappa_staticanalyses - -open Kappa_kasa_frontend - -open Kappa_kasa_export - -open Kappa_kasa_type_interface))) + (name KaSa) + (libraries num yojson str kappa_staticanalyses kappa_kasa_frontend) + (modules KaSa) + (public_name KaSa) + (package kappa-binaries) + (flags + (:standard + -open + Kappa_logging + -open + Kappa_errors + -open + Kappa_parameters + -open + Kappa_reachability + -open + Kappa_staticanalyses + -open + Kappa_kasa_frontend + -open + Kappa_kasa_export + -open + Kappa_kasa_type_interface))) diff --git a/core/KaSa_rep/more_datastructures/dune b/core/KaSa_rep/more_datastructures/dune index 45a5cc84ac..e27524c3a1 100644 --- a/core/KaSa_rep/more_datastructures/dune +++ b/core/KaSa_rep/more_datastructures/dune @@ -1,8 +1,22 @@ (library - (name kappa_kasa_kastor_toolset) - (libraries str yojson result kappa_logging kappa_parameters kappa_errors kappa-library.generic) - (flags (:standard -w @a - -open Kappa_logging - -open Kappa_parameters - -open Kappa_errors - -open Kappa_generic_toolset))) + (name kappa_kasa_kastor_toolset) + (libraries + str + yojson + result + kappa_logging + kappa_parameters + kappa_errors + kappa-library.generic) + (flags + (:standard + -w + @a + -open + Kappa_logging + -open + Kappa_parameters + -open + Kappa_errors + -open + Kappa_generic_toolset))) diff --git a/core/KaSa_rep/polymer_detection/dune b/core/KaSa_rep/polymer_detection/dune index 8c6f747ebc..21787d0f35 100644 --- a/core/KaSa_rep/polymer_detection/dune +++ b/core/KaSa_rep/polymer_detection/dune @@ -1,11 +1,17 @@ (library - (name kappa_polymers_analysis) - (libraries kappa_kasa_remanent_state) - (flags (:standard) - -open Kappa_parameters - -open Kappa_errors - -open Kappa_kasa_remanent_state - -open Kappa_kasa_frontend - -open Kappa_logging - -open Kappa_kasa_kastor_toolset -)) + (name kappa_polymers_analysis) + (libraries kappa_kasa_remanent_state) + (flags + (:standard) + -open + Kappa_parameters + -open + Kappa_errors + -open + Kappa_kasa_remanent_state + -open + Kappa_kasa_frontend + -open + Kappa_logging + -open + Kappa_kasa_kastor_toolset)) diff --git a/core/KaSa_rep/reachability_analysis/dune b/core/KaSa_rep/reachability_analysis/dune index 372005a754..6b29adafd1 100644 --- a/core/KaSa_rep/reachability_analysis/dune +++ b/core/KaSa_rep/reachability_analysis/dune @@ -1,19 +1,37 @@ (library - (name kappa_reachability) - (libraries kappa_kasa_remanent_state kappa_numerical_domains kappa_classical_graphs kappa_kasa_backend) - (flags (:standard) - -open Kappa_kasa_kastor_toolset - -open Kappa_kasa_frontend - -open Kappa_generic_toolset - -open Kappa_parameters - -open Kappa_kasa_site_graphs - -open Kappa_kasa_remanent_state - -open Kappa_errors - -open Kappa_profiling - -open Kappa_mvbdu - -open Kappa_numerical_domains - -open Kappa_logging - -open Kappa_classical_graphs - -open Kappa_kasa_backend - -open Kappa_kasa_type_interface -)) + (name kappa_reachability) + (libraries + kappa_kasa_remanent_state + kappa_numerical_domains + kappa_classical_graphs + kappa_kasa_backend) + (flags + (:standard) + -open + Kappa_kasa_kastor_toolset + -open + Kappa_kasa_frontend + -open + Kappa_generic_toolset + -open + Kappa_parameters + -open + Kappa_kasa_site_graphs + -open + Kappa_kasa_remanent_state + -open + Kappa_errors + -open + Kappa_profiling + -open + Kappa_mvbdu + -open + Kappa_numerical_domains + -open + Kappa_logging + -open + Kappa_classical_graphs + -open + Kappa_kasa_backend + -open + Kappa_kasa_type_interface)) 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 7c68477d41..1167cb8479 100644 --- a/core/KaSa_rep/reachability_analysis/site_across_bonds_domain.ml +++ b/core/KaSa_rep/reachability_analysis/site_across_bonds_domain.ml @@ -61,7 +61,7 @@ module Domain = struct (*--------------------------------------------------------------*) type local_dynamic_information = { - dumy: unit; + dummy: unit; store_value: Ckappa_sig.Views_bdu.mvbdu Site_across_bonds_domain_type.PairAgentSitesState_map_and_set.Map.t; @@ -619,7 +619,7 @@ module Domain = struct in let init_local_dynamic_information = { - dumy = (); + dummy = (); store_value = Site_across_bonds_domain_type.PairAgentSitesState_map_and_set.Map .empty; diff --git a/core/KaSa_rep/remanent_state/dune b/core/KaSa_rep/remanent_state/dune index 6e8de1c570..0b823fd43c 100644 --- a/core/KaSa_rep/remanent_state/dune +++ b/core/KaSa_rep/remanent_state/dune @@ -1,20 +1,41 @@ (library - (name kappa_kasa_remanent_state) - (libraries kappa_kasa_site_graphs kappa_symmetries kappa_profiling kappa_flow_analysis) - (flags (:standard -w @a - -open Kappa_terms - -open Kappa_grammar - -open Kappa_kasa_frontend - -open Kappa_logging - -open Kappa_kasa_kastor_toolset - -open Kappa_generic_toolset - -open Kappa_kasa_site_graphs - -open Kappa_symmetries - -open Kappa_parameters - -open Kappa_errors - -open Kappa_profiling - -open Kappa_mixtures - -open Kappa_flow_analysis - -open Kappa_mvbdu - -open Kappa_kasa_type_interface - ))) + (name kappa_kasa_remanent_state) + (libraries + kappa_kasa_site_graphs + kappa_symmetries + kappa_profiling + kappa_flow_analysis) + (flags + (:standard + -w + @a + -open + Kappa_terms + -open + Kappa_grammar + -open + Kappa_kasa_frontend + -open + Kappa_logging + -open + Kappa_kasa_kastor_toolset + -open + Kappa_generic_toolset + -open + Kappa_kasa_site_graphs + -open + Kappa_symmetries + -open + Kappa_parameters + -open + Kappa_errors + -open + Kappa_profiling + -open + Kappa_mixtures + -open + Kappa_flow_analysis + -open + Kappa_mvbdu + -open + Kappa_kasa_type_interface))) diff --git a/core/KaSa_rep/remanent_state/remanent_state.mli b/core/KaSa_rep/remanent_state/remanent_state.mli index 6f6db73ec2..3ede63057c 100644 --- a/core/KaSa_rep/remanent_state/remanent_state.mli +++ b/core/KaSa_rep/remanent_state/remanent_state.mli @@ -33,15 +33,11 @@ type var_id = int type dead_agents = Public_data.agent_kind list val info_to_rule : - string - * Locality.t - * Public_data.rule_direction - * string - * Ckappa_sig.c_rule_id -> + string * Loc.t * Public_data.rule_direction * string * Ckappa_sig.c_rule_id -> Public_data.rule val info_to_agent : - string * Locality.t list * Ckappa_sig.c_agent_name -> Public_data.agent_kind + string * Loc.t list * Ckappa_sig.c_agent_name -> Public_data.agent_kind type separating_transitions = Public_data.separating_transitions diff --git a/core/KaSa_rep/sanity_test/dune b/core/KaSa_rep/sanity_test/dune index d4b7935a7b..c1cb46f0df 100644 --- a/core/KaSa_rep/sanity_test/dune +++ b/core/KaSa_rep/sanity_test/dune @@ -1,10 +1,17 @@ (tests - (names sanity_test) - (libraries num str kappa_mvbdu kappa_species_count_enumeration) - (flags (:standard - -open Kappa_generic_toolset - -open Kappa_kasa_kastor_toolset - -open Kappa_parameters - -open Kappa_errors - -open Kappa_mvbdu - -open Kappa_species_count_enumeration))) + (names sanity_test) + (libraries num str kappa_mvbdu kappa_species_count_enumeration) + (flags + (:standard + -open + Kappa_generic_toolset + -open + Kappa_kasa_kastor_toolset + -open + Kappa_parameters + -open + Kappa_errors + -open + Kappa_mvbdu + -open + Kappa_species_count_enumeration))) diff --git a/core/KaSa_rep/site_graphs/dune b/core/KaSa_rep/site_graphs/dune index a0232dea66..1d52e44898 100644 --- a/core/KaSa_rep/site_graphs/dune +++ b/core/KaSa_rep/site_graphs/dune @@ -1,12 +1,21 @@ (library - (name kappa_kasa_site_graphs) - (libraries yojson kappa_kasa_frontend) - (flags (:standard -w @a - -open Kappa_kasa_frontend - -open Kappa_kasa_kastor_toolset - -open Kappa_parameters - -open Kappa_errors - -open Kappa_logging - -open Kappa_generic_toolset - -open Kappa_kasa_type_interface - ))) + (name kappa_kasa_site_graphs) + (libraries yojson kappa_kasa_frontend) + (flags + (:standard + -w + @a + -open + Kappa_kasa_frontend + -open + Kappa_kasa_kastor_toolset + -open + Kappa_parameters + -open + Kappa_errors + -open + Kappa_logging + -open + Kappa_generic_toolset + -open + Kappa_kasa_type_interface))) diff --git a/core/KaSa_rep/type_interface/dune b/core/KaSa_rep/type_interface/dune index 1328e63114..b1135bf18a 100644 --- a/core/KaSa_rep/type_interface/dune +++ b/core/KaSa_rep/type_interface/dune @@ -1,6 +1,5 @@ (library - (name kappa_kasa_type_interface) - (libraries yojson kappa-library.mixtures) - (flags (:standard -w @a - -open Kappa_generic_toolset - -open Kappa_mixtures))) + (name kappa_kasa_type_interface) + (libraries yojson kappa-library.mixtures) + (flags + (:standard -w @a -open Kappa_generic_toolset -open Kappa_mixtures))) diff --git a/core/KaSa_rep/type_interface/public_data.ml b/core/KaSa_rep/type_interface/public_data.ml index 92717011df..77c377fa29 100644 --- a/core/KaSa_rep/type_interface/public_data.ml +++ b/core/KaSa_rep/type_interface/public_data.ml @@ -348,7 +348,7 @@ type rule = { rule_id: int; rule_label: string; rule_ast: string; - rule_position: Locality.t; + rule_position: Loc.t; rule_direction: rule_direction; rule_hidden: bool; } @@ -376,8 +376,7 @@ let rule_to_json rule = rule_id, JsonUtil.of_int rule.rule_id; label, JsonUtil.of_string rule.rule_label; ast, JsonUtil.of_string rule.rule_ast; - ( position, - Locality.annot_to_yojson JsonUtil.of_unit ((), rule.rule_position) ); + position, Loc.yojson_of_annoted JsonUtil.of_unit ((), rule.rule_position); direction, direction_to_json rule.rule_direction; rule_hidden, JsonUtil.of_bool rule.rule_hidden; ] @@ -391,7 +390,7 @@ let json_to_rule = function rule_ast = JsonUtil.to_string (List.assoc ast l); rule_position = snd - (Locality.annot_of_yojson + (Loc.annoted_of_yojson (JsonUtil.to_unit ~error_msg:(JsonUtil.build_msg "locality")) (List.assoc position l)); rule_direction = json_to_direction (List.assoc direction l); @@ -405,7 +404,7 @@ type var = { var_id: int; var_label: string; var_ast: string; - var_position: Locality.t; + var_position: Loc.t; } let var_to_json var = @@ -414,7 +413,7 @@ let var_to_json var = rule_id, JsonUtil.of_int var.var_id; label, JsonUtil.of_string var.var_label; ast, JsonUtil.of_string var.var_ast; - position, Locality.annot_to_yojson JsonUtil.of_unit ((), var.var_position); + position, Loc.yojson_of_annoted JsonUtil.of_unit ((), var.var_position); ] let json_to_var = function @@ -426,7 +425,7 @@ let json_to_var = function var_ast = JsonUtil.to_string (List.assoc ast l); var_position = snd - (Locality.annot_of_yojson + (Loc.annoted_of_yojson (JsonUtil.to_unit ~error_msg:(JsonUtil.build_msg "locality")) (List.assoc position l)); } @@ -435,7 +434,7 @@ let json_to_var = function | x -> raise (Yojson.Basic.Util.Type_error ("var", x)) type ('rule, 'var) influence_node = Rule of 'rule | Var of 'var -type pos_of_rules_and_vars = ((int, int) influence_node * Locality.t) list +type pos_of_rules_and_vars = ((int, int) influence_node * Loc.t) list let influence_node_to_json rule_to_json var_to_json a = match a with @@ -460,14 +459,14 @@ let short_influence_node_of_json = let pos_of_rules_and_vars_to_json = JsonUtil.of_list (JsonUtil.of_pair ~lab1:key ~lab2:locality short_influence_node_to_json - (fun loc -> Locality.annot_to_yojson JsonUtil.of_unit ((), loc))) + (fun loc -> Loc.yojson_of_annoted JsonUtil.of_unit ((), loc))) let pos_of_rules_and_vars_of_json = JsonUtil.to_list (JsonUtil.to_pair ~lab1:key ~lab2:locality short_influence_node_of_json (fun x -> snd - (Locality.annot_of_yojson + (Loc.annoted_of_yojson (JsonUtil.to_unit ~error_msg:(JsonUtil.build_msg "locality")) x))) @@ -748,7 +747,7 @@ let dead_rules_of_json = function type agent_kind = { agent_id: int; agent_ast: string; - agent_position: Locality.t list; + agent_position: Loc.t list; } let json_to_agent_kind = function @@ -762,7 +761,7 @@ let json_to_agent_kind = function ~error_msg:(JsonUtil.build_msg "locality list") (fun json -> snd - (Locality.annot_of_yojson + (Loc.annoted_of_yojson (JsonUtil.to_unit ~error_msg:(JsonUtil.build_msg "locality")) json)) @@ -779,7 +778,7 @@ let agent_kind_to_json agent_kind = ast, JsonUtil.of_string agent_kind.agent_ast; ( position_list, JsonUtil.of_list - (fun a -> Locality.annot_to_yojson JsonUtil.of_unit ((), a)) + (fun a -> Loc.yojson_of_annoted JsonUtil.of_unit ((), a)) agent_kind.agent_position ); ] diff --git a/core/KaSa_rep/type_interface/public_data.mli b/core/KaSa_rep/type_interface/public_data.mli index 137e754142..1f7826895f 100644 --- a/core/KaSa_rep/type_interface/public_data.mli +++ b/core/KaSa_rep/type_interface/public_data.mli @@ -78,7 +78,7 @@ type rule = { rule_id: int; rule_label: string; rule_ast: string; - rule_position: Locality.t; + rule_position: Loc.t; rule_direction: rule_direction; rule_hidden: bool; } @@ -87,11 +87,11 @@ type var = { var_id: int; var_label: string; var_ast: string; - var_position: Locality.t; + var_position: Loc.t; } type ('rule, 'var) influence_node = Rule of 'rule | Var of 'var -type pos_of_rules_and_vars = ((int, int) influence_node * Locality.t) list +type pos_of_rules_and_vars = ((int, int) influence_node * Loc.t) list val pos_of_rules_and_vars_of_json : Yojson.Basic.t -> pos_of_rules_and_vars val pos_of_rules_and_vars_to_json : pos_of_rules_and_vars -> Yojson.Basic.t @@ -108,8 +108,7 @@ val refined_influence_node_of_json : val refined_influence_node_to_json : (rule, var) influence_node -> Yojson.Basic.t -val position_of_refined_influence_node : - (rule, var) influence_node -> Locality.t +val position_of_refined_influence_node : (rule, var) influence_node -> Loc.t module InfluenceNodeMap : SetMap.Map with type elt = (int, int) influence_node @@ -157,7 +156,7 @@ val dead_rules_to_json : dead_rules -> Yojson.Basic.t type agent_kind = { agent_id: int; agent_ast: string; - agent_position: Locality.t list; + agent_position: Loc.t list; } type dead_agents = agent_kind list diff --git a/core/agents/KaStor.ml b/core/agents/KaStor.ml index ee2ca9334d..144b4e9b4d 100644 --- a/core/agents/KaStor.ml +++ b/core/agents/KaStor.ml @@ -32,7 +32,7 @@ let options = | _ as error -> raise (ExceptionDefn.Malformed_Decl - (Locality.dummy_annot + (Loc.annot_with_dummy ("Value " ^ error ^ " should be either \"html, dot\" or \"json\"")))), "Print stories in html format" ); diff --git a/core/agents/KappaSwitchman.ml b/core/agents/KappaSwitchman.ml index e744f26864..ce1b72ff5f 100644 --- a/core/agents/KappaSwitchman.ml +++ b/core/agents/KappaSwitchman.ml @@ -235,7 +235,7 @@ let on_message exec_command message_delimiter = JsonUtil.read_next_item Yojson.Basic.read_string st b in let pos = - JsonUtil.read_next_item Locality.read_position st b + JsonUtil.read_next_item Loc.read_position st b in manager#get_influence_map_node_at ~filename pos >>= fun out -> diff --git a/core/agents/agents_client.ml b/core/agents/agents_client.ml index ba1abbb465..4898b3ebc3 100644 --- a/core/agents/agents_client.ml +++ b/core/agents/agents_client.ml @@ -130,7 +130,7 @@ class t exec_command message_delimiter = method get_influence_map_node_at ~filename pos : _ Api.result Lwt.t = List.find_opt - (fun (_, x) -> Locality.is_included_in filename pos x) + (fun (_, x) -> Loc.is_included_in filename pos x) kasa_locator |> Option_util.map fst |> Result_util.ok ?status:None diff --git a/core/agents/dune b/core/agents/dune index fc5936cbd3..08a7903d59 100644 --- a/core/agents/dune +++ b/core/agents/dune @@ -1,37 +1,55 @@ (library - (name kappa_agents) - (modules agent_common app_args) - (libraries logs.fmt lwt.unix kappa-library.generic) - (flags (:standard -w @a - -open Kappa_generic_toolset))) + (name kappa_agents) + (modules agent_common app_args) + (libraries logs.fmt lwt.unix kappa-library.generic) + (flags + (:standard -w @a -open Kappa_generic_toolset))) (executable - (name KaStor) - (modules KaStor) - (libraries yojson lwt.unix kappa_cflow kappa_agents) - (public_name KaStor) - (package kappa-binaries) - (flags (:standard - -open Kappa_generic_toolset - -open Kappa_runtime - -open Kappa_cli - -open Kappa_logging - -open Kappa_cflow - -open Kappa_agents - -open Kappa_parameters))) + (name KaStor) + (modules KaStor) + (libraries yojson lwt.unix kappa_cflow kappa_agents) + (public_name KaStor) + (package kappa-binaries) + (flags + (:standard + -open + Kappa_generic_toolset + -open + Kappa_runtime + -open + Kappa_cli + -open + Kappa_logging + -open + Kappa_cflow + -open + Kappa_agents + -open + Kappa_parameters))) (executable - (name KaSimAgent) - (modules KaSimAgent) - (libraries logs.lwt logs.fmt lwt.unix - kappa_json_api kappa-library.runtime kappa_agents) - (public_name KaSimAgent) - (package kappa-agents) - (flags (:standard - -open Kappa_generic_toolset - -open Kappa_cli - -open Kappa_agents - -open Kappa_json_api))) + (name KaSimAgent) + (modules KaSimAgent) + (libraries + logs.lwt + logs.fmt + lwt.unix + kappa_json_api + kappa-library.runtime + kappa_agents) + (public_name KaSimAgent) + (package kappa-agents) + (flags + (:standard + -open + Kappa_generic_toolset + -open + Kappa_cli + -open + Kappa_agents + -open + Kappa_json_api))) (executable (name KaMoHa) @@ -39,44 +57,80 @@ (libraries logs.lwt lwt.unix kappa_grammar kappa_cli kappa_agents) (public_name KaMoHa) (package kappa-agents) - (flags (:standard - -open Kappa_generic_toolset - -open Kappa_grammar - -open Kappa_cli - -open Kappa_agents))) + (flags + (:standard + -open + Kappa_generic_toolset + -open + Kappa_grammar + -open + Kappa_cli + -open + Kappa_agents))) (executable (name KappaSwitchman) (modules agents_client KappaSwitchman) - (libraries logs.lwt lwt.unix kappa_json_api kappa_cli kappa_agents - kappa_staticanalyses kappa-library.runtime) + (libraries + logs.lwt + lwt.unix + kappa_json_api + kappa_cli + kappa_agents + kappa_staticanalyses + kappa-library.runtime) (public_name KappaSwitchman) (package kappa-agents) - (flags (:standard - -open Kappa_generic_toolset - -open Kappa_grammar - -open Kappa_cli - -open Kappa_kasa_type_interface - -open Kappa_runtime - -open Kappa_json_api - -open Kappa_agents))) + (flags + (:standard + -open + Kappa_generic_toolset + -open + Kappa_grammar + -open + Kappa_cli + -open + Kappa_kasa_type_interface + -open + Kappa_runtime + -open + Kappa_json_api + -open + Kappa_agents))) (executable - (name KaSaAgent) - (modules KaSaAgent) - (libraries num str lwt.unix kappa_staticanalyses - kappa_json_api kappa_agents) - (public_name KaSaAgent) - (package kappa-agents) - (flags (:standard - -open Kappa_logging - -open Kappa_errors - -open Kappa_parameters - -open Kappa_reachability - -open Kappa_staticanalyses - -open Kappa_kasa_frontend - -open Kappa_kasa_export - -open Kappa_kasa_type_interface - -open Kappa_agents - -open Kappa_cli - -open Kappa_json_api))) + (name KaSaAgent) + (modules KaSaAgent) + (libraries + num + str + lwt.unix + kappa_staticanalyses + kappa_json_api + kappa_agents) + (public_name KaSaAgent) + (package kappa-agents) + (flags + (:standard + -open + Kappa_logging + -open + Kappa_errors + -open + Kappa_parameters + -open + Kappa_reachability + -open + Kappa_staticanalyses + -open + Kappa_kasa_frontend + -open + Kappa_kasa_export + -open + Kappa_kasa_type_interface + -open + Kappa_agents + -open + Kappa_cli + -open + Kappa_json_api))) diff --git a/core/api/api.ml b/core/api/api.ml index 1ed1cde171..42f453f7d6 100644 --- a/core/api/api.ml +++ b/core/api/api.ml @@ -259,7 +259,7 @@ class type concrete_manager = object method get_influence_map_node_at : filename:string -> - Locality.position -> + Loc.position -> (int, int) Public_data.influence_node option result Lwt.t method is_running : bool diff --git a/core/api/api.mli b/core/api/api.mli index 1ed1cde171..42f453f7d6 100644 --- a/core/api/api.mli +++ b/core/api/api.mli @@ -259,7 +259,7 @@ class type concrete_manager = object method get_influence_map_node_at : filename:string -> - Locality.position -> + Loc.position -> (int, int) Public_data.influence_node option result Lwt.t method is_running : bool diff --git a/core/api/api_common.mli b/core/api/api_common.mli index c1be7ead00..828b19ebd6 100644 --- a/core/api/api_common.mli +++ b/core/api/api_common.mli @@ -7,11 +7,11 @@ (******************************************************************************) val error_msg : - ?severity:Logs.level -> ?range:Locality.range -> string -> Result_util.message + ?severity:Logs.level -> ?range:Loc.t -> string -> Result_util.message val result_error_msg : ?severity:Logs.level -> - ?range:Locality.range -> + ?range:Loc.t -> ?result_code:Result_util.status -> string -> 'ok Api.result diff --git a/core/api/dune b/core/api/dune index a9c8db223b..79d46706bc 100644 --- a/core/api/dune +++ b/core/api/dune @@ -1,34 +1,54 @@ (library (name kappa_json_api) - (libraries atdgen-runtime lwt - kappa_grammar kappa_kasa_type_interface kappa_cflow) - (flags (:standard -w +a - -open Kappa_generic_toolset - -open Kappa_mixtures - -open Kappa_terms - -open Kappa_grammar - -open Kappa_runtime - -open Kappa_parameters - -open Kappa_kasa_type_interface - -open Kappa_classical_graphs - -open Kappa_cflow))) + (libraries + atdgen-runtime + lwt + kappa_grammar + kappa_kasa_type_interface + kappa_cflow) + (flags + (:standard + -w + +a-40-42 + -open + Kappa_generic_toolset + -open + Kappa_mixtures + -open + Kappa_terms + -open + Kappa_grammar + -open + Kappa_runtime + -open + Kappa_parameters + -open + Kappa_kasa_type_interface + -open + Kappa_classical_graphs + -open + Kappa_cflow))) (rule - (targets api_types_j.ml api_types_j.mli) - (deps api_types.atd) - (action (run atdgen -j -j-std %{deps}))) + (targets api_types_j.ml api_types_j.mli) + (deps api_types.atd) + (action + (run atdgen -j -j-std %{deps}))) (rule - (targets api_types_t.ml api_types_t.mli) - (deps api_types.atd) - (action (run atdgen -t %{deps}))) + (targets api_types_t.ml api_types_t.mli) + (deps api_types.atd) + (action + (run atdgen -t %{deps}))) (rule - (targets mpi_message_j.ml mpi_message_j.mli) - (deps mpi_message.atd) - (action (run atdgen -j -j-std %{deps}))) + (targets mpi_message_j.ml mpi_message_j.mli) + (deps mpi_message.atd) + (action + (run atdgen -j -j-std %{deps}))) (rule - (targets mpi_message_t.ml mpi_message_t.mli) - (deps mpi_message.atd) - (action (run atdgen -t %{deps}))) + (targets mpi_message_t.ml mpi_message_t.mli) + (deps mpi_message.atd) + (action + (run atdgen -t %{deps}))) diff --git a/core/api/kappa_facade.ml b/core/api/kappa_facade.ml index 6030577eea..ca503613e5 100644 --- a/core/api/kappa_facade.ml +++ b/core/api/kappa_facade.ml @@ -115,11 +115,11 @@ let reinitialize ~outputs random_state t = State_interpreter.empty ~with_delta_activities:false t.counter t.env let catch_error handler = function - | ExceptionDefn.Syntax_Error ((message, range) : string Locality.annot) -> + | ExceptionDefn.Syntax_Error ((message, range) : string Loc.annoted) -> handler (Api_common.error_msg ~range message) - | ExceptionDefn.Malformed_Decl ((message, range) : string Locality.annot) -> + | ExceptionDefn.Malformed_Decl ((message, range) : string Loc.annoted) -> handler (Api_common.error_msg ~range message) - | ExceptionDefn.Internal_Error ((message, range) : string Locality.annot) -> + | ExceptionDefn.Internal_Error ((message, range) : string Loc.annoted) -> handler (Api_common.error_msg ~range message) | Invalid_argument error -> handler (Api_common.error_msg ("Runtime error " ^ error)) @@ -129,7 +129,8 @@ let catch_error handler = function in handler (Api_common.error_msg message) -let parse ~patternSharing (ast : Ast.parsing_compil) overwrite system_process = +let parse ~patternSharing (ast : Ast.parsing_compil) var_overwrite + system_process = let yield = system_process#yield in let log_buffer = Buffer.create 512 in let log_form = Format.formatter_of_buffer log_buffer in @@ -140,21 +141,11 @@ let parse ~patternSharing (ast : Ast.parsing_compil) overwrite system_process = Lwt.catch (fun () -> Lwt.wrap2 - (LKappa_compiler.compil_of_ast ~warning ~debugMode:false - ~syntax_version:Ast.V4) - overwrite ast - >>= fun ( sig_nd, - contact_map, - tk_nd, - _algs_nd, - _updated_vars, - (result : - ( Ast.agent, - LKappa.rule_agent list, - Raw_mixture.t, - int, - LKappa.rule ) - Ast.compil) ) -> + (fun var_overwrite -> + LKappa_compiler.compil_of_ast ~warning ~debug_mode:false + ~syntax_version:Ast.V4 ~var_overwrite) + var_overwrite ast + >>= fun (ast_compiled_data : LKappa_compiler.ast_compiled_data) -> yield () >>= fun () -> (* The last yield is updated after the last yield. It is gotten here for the initial last yeild value. *) @@ -170,11 +161,12 @@ let parse ~patternSharing (ast : Ast.parsing_compil) overwrite system_process = | Data.Print _ -> assert false in - Eval.compile ~debugMode:false + Eval.compile ~debug_mode:false ~pause:(fun f -> Lwt.bind (yield ()) f) ~return:Lwt.return ?rescale_init:None ?overwrite_t0:None - ~compileModeOn:false ~outputs ~sharing:patternSharing sig_nd tk_nd - contact_map result + ~compile_mode_on:false ~outputs ~sharing:patternSharing + ast_compiled_data.agents_sig ast_compiled_data.token_names + ast_compiled_data.contact_map ast_compiled_data.result >>= fun (env, with_trace, init_l) -> let counter = Counter.create @@ -199,8 +191,8 @@ let parse ~patternSharing (ast : Ast.parsing_compil) overwrite system_process = env inputs_form init_l in let simulation = - create_t ~contact_map ~log_form ~log_buffer ~inputs_buffer - ~inputs_form ~ast ~env ~counter + create_t ~contact_map:ast_compiled_data.contact_map ~log_form + ~log_buffer ~inputs_buffer ~inputs_form ~ast ~env ~counter ~dumpIfDeadlocked:conf.Configuration.dumpIfDeadlocked ~maxConsecutiveClash:conf.Configuration.maxConsecutiveClash ~patternSharing @@ -293,7 +285,7 @@ let run_simulation ~(system_process : system_process) ~(t : t) stopped : < system_process#min_run_duration () do let stop, graph', state' = - State_interpreter.a_loop ~debugMode:false ~outputs:(outputs t) + State_interpreter.a_loop ~debug_mode:false ~outputs:(outputs t) ~dumpIfDeadlocked:t.dumpIfDeadlocked ~maxConsecutiveClash:t.maxConsecutiveClash t.env t.counter t.graph t.state @@ -354,7 +346,7 @@ let start ~(system_process : system_process) try let pause = Kparser4.standalone_bool_expr Klexer4.token lexbuf in Lwt.wrap4 - (Evaluator.get_pause_criteria ~debugMode:false ~outputs:(outputs t) + (Evaluator.get_pause_criteria ~debug_mode:false ~outputs:(outputs t) ~sharing:t.patternSharing ~syntax_version:Ast.V4) t.contact_map t.env t.graph pause >>= fun (env', graph', b'') -> @@ -373,7 +365,7 @@ let start ~(system_process : system_process) Eval.build_initial_state ~bind:(fun x f -> time_yield ~system_process ~t >>= fun () -> x >>= f) - ~return:Lwt.return ~debugMode:false ~outputs:(outputs t) + ~return:Lwt.return ~debug_mode:false ~outputs:(outputs t) ~with_trace:parameter.Api_types_t.simulation_store_trace ~with_delta_activities:false t.counter t.env random_state t.init_l @@ -443,7 +435,7 @@ let perturbation ~(system_process : system_process) ~(t : t) let log_buffer = Buffer.create 512 in let log_form = Format.formatter_of_buffer log_buffer in Lwt.wrap6 - (Evaluator.do_interactive_directives ~debugMode:false + (Evaluator.do_interactive_directives ~debug_mode:false ~outputs:(interactive_outputs log_form t) ~sharing:t.patternSharing ~syntax_version:Ast.V4) t.contact_map t.env t.counter t.graph t.state e @@ -483,7 +475,7 @@ let continue ~(system_process : system_process) ~(t : t) try let pause = Kparser4.standalone_bool_expr Klexer4.token lexbuf in Lwt.wrap4 - (Evaluator.get_pause_criteria ~debugMode:false ~outputs:(outputs t) + (Evaluator.get_pause_criteria ~debug_mode:false ~outputs:(outputs t) ~sharing:t.patternSharing ~syntax_version:Ast.V4) t.contact_map t.env t.graph pause >>= fun (env', graph', b'') -> diff --git a/core/api/switchman_client.ml b/core/api/switchman_client.ml index 0e10c0257f..8e3d69d4d6 100644 --- a/core/api/switchman_client.ml +++ b/core/api/switchman_client.ml @@ -346,7 +346,7 @@ class virtual new_client ~is_running ~post mailbox = [ (fun b -> Yojson.Basic.write_string b "INFLUENCE_MAP_NODE_AT"); (fun b -> Yojson.Basic.write_string b filename); - (fun b -> Locality.write_position b pos); + (fun b -> Loc.write_position b pos); ]) method get_nodes_of_influence_map accuracy = diff --git a/core/api/switchman_client.mli b/core/api/switchman_client.mli index d8970b84f9..91811af74d 100644 --- a/core/api/switchman_client.mli +++ b/core/api/switchman_client.mli @@ -84,7 +84,7 @@ object method get_influence_map_node_at : filename:string -> - Kappa_generic_toolset.Locality.position -> + Kappa_generic_toolset.Loc.position -> ( (int, int) Kappa_kasa_type_interface.Public_data.influence_node option, Kappa_generic_toolset.Result_util.message list ) Kappa_generic_toolset.Result_util.t diff --git a/core/cflow/blackboard_generation.ml b/core/cflow/blackboard_generation.ml index 13ac83e41f..02c621bc67 100644 --- a/core/cflow/blackboard_generation.ml +++ b/core/cflow/blackboard_generation.ml @@ -1044,13 +1044,13 @@ module Preblackboard : PreBlackboard = struct ~message:"Illegal state for a side-effects" (Failure "Blackboard_generation.side_effect") [] | Free -> error, log_info, [ predicate_target_id, None, (Free, Unknown) ] - | Bound_to (pid, ag, ag_na, sname) -> + | Bound_to (pid, ag, agent_name, sname) -> ( error, log_info, [ predicate_target_id, None, (s, Unknown); ( pid, - Some ((ag, ag_na), sname), + Some ((ag, agent_name), sname), ( Bound_to ( predicate_target_id, CI.Po.K.agent_id_of_site site, @@ -1681,17 +1681,17 @@ module Preblackboard : PreBlackboard = struct | Instantiation.Is_Bound_to (site1, site2) -> let agent1 = CI.Po.K.agent_of_site site1 in let ag_id1 = CI.Po.K.agent_id_of_agent agent1 in - let ag_name1 = CI.Po.K.agent_name_of_agent agent1 in + let agent_name1 = CI.Po.K.agent_name_of_agent agent1 in let site_name1 = CI.Po.K.site_name_of_site site1 in let agent2 = CI.Po.K.agent_of_site site2 in let ag_id2 = CI.Po.K.agent_id_of_agent agent2 in - let ag_name2 = CI.Po.K.agent_name_of_agent agent2 in + let agent_name2 = CI.Po.K.agent_name_of_agent agent2 in let site_name2 = CI.Po.K.site_name_of_site site2 in let weak1 = - Instantiation.Has_Binding_type (site1, (ag_name2, site_name2)) + Instantiation.Has_Binding_type (site1, (agent_name2, site_name2)) in let weak2 = - Instantiation.Has_Binding_type (site2, (ag_name1, site_name1)) + Instantiation.Has_Binding_type (site2, (agent_name1, site_name1)) in (match ( sure_agent ag_id1 diff --git a/core/cflow/causal.ml b/core/cflow/causal.ml index 90c1cbe28f..5b125fef04 100644 --- a/core/cflow/causal.ml +++ b/core/cflow/causal.ml @@ -799,7 +799,7 @@ let log_event id quarks event_kind steps = | Instantiation.Remove _ -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot + (Loc.annot_with_dummy "init event has actions not allowed"))) actions | Trace.Rule _ | Trace.Pert _ | Trace.Obs _ | Trace.Subs _ diff --git a/core/cflow/dune b/core/cflow/dune index 03c683a973..d5e83955fe 100644 --- a/core/cflow/dune +++ b/core/cflow/dune @@ -1,16 +1,32 @@ (library - (name kappa_cflow) - (libraries yojson result - kappa_profiling kappa_kasa_kastor_toolset kappa_classical_graphs) - (flags (:standard - -open Kappa_generic_toolset - -open Kappa_mixtures - -open Kappa_terms - -open Kappa_runtime - -open Kappa_cli - -open Kappa_logging - -open Kappa_profiling - -open Kappa_errors - -open Kappa_kasa_kastor_toolset - -open Kappa_parameters - -open Kappa_classical_graphs))) + (name kappa_cflow) + (libraries + yojson + result + kappa_profiling + kappa_kasa_kastor_toolset + kappa_classical_graphs) + (flags + (:standard + -open + Kappa_generic_toolset + -open + Kappa_mixtures + -open + Kappa_terms + -open + Kappa_runtime + -open + Kappa_cli + -open + Kappa_logging + -open + Kappa_profiling + -open + Kappa_errors + -open + Kappa_kasa_kastor_toolset + -open + Kappa_parameters + -open + Kappa_classical_graphs))) diff --git a/core/cflow/pseudo_inverse.ml b/core/cflow/pseudo_inverse.ml index e17d8a84ae..8b498449da 100644 --- a/core/cflow/pseudo_inverse.ml +++ b/core/cflow/pseudo_inverse.ml @@ -42,8 +42,8 @@ module Pseudo_inv : Cut_pseudo_inverse = struct | Predicate_maps.Undefined -> "#Undef" | Predicate_maps.Present -> "#Here" | Predicate_maps.Free -> "#Free" - | Predicate_maps.Bound_to (ag, ag_name, s) -> - "Bound_to " ^ string_of_int ag ^ " " ^ string_of_int ag_name ^ " " + | Predicate_maps.Bound_to (ag, agent_name, s) -> + "Bound_to " ^ string_of_int ag ^ " " ^ string_of_int agent_name ^ " " ^ string_of_int s type pseudo_inv_blackboard = { diff --git a/core/classical_graphs/dune b/core/classical_graphs/dune index 2a75d62e20..fc8e4318f4 100644 --- a/core/classical_graphs/dune +++ b/core/classical_graphs/dune @@ -1,6 +1,5 @@ (library - (name kappa_classical_graphs) - (libraries yojson kappa-library.generic kappa_logging) - (flags (:standard -w @a - -open Kappa_generic_toolset - -open Kappa_logging))) + (name kappa_classical_graphs) + (libraries yojson kappa-library.generic kappa_logging) + (flags + (:standard -w @a -open Kappa_generic_toolset -open Kappa_logging))) diff --git a/core/classical_graphs/graph_json.ml b/core/classical_graphs/graph_json.ml index dd25934439..cb693e2ce5 100644 --- a/core/classical_graphs/graph_json.ml +++ b/core/classical_graphs/graph_json.ml @@ -77,7 +77,7 @@ let directive_to_json option = | Graph_loggers_sig.Position p -> ( "position", JsonUtil.of_list - (fun json -> Locality.annot_to_yojson JsonUtil.of_unit ((), json)) + (fun json -> Loc.yojson_of_annoted JsonUtil.of_unit ((), json)) p ) | Graph_loggers_sig.Contextual_help s -> "contextual help", JsonUtil.of_string s @@ -165,7 +165,7 @@ let directive_of_json = function (JsonUtil.to_list (fun json -> snd - (Locality.annot_of_yojson + (Loc.annoted_of_yojson (JsonUtil.to_unit ?error_msg:(Some (JsonUtil.build_msg "position"))) json)) diff --git a/core/classical_graphs/graph_loggers.ml b/core/classical_graphs/graph_loggers.ml index 06b89a0274..37a8f7995b 100644 --- a/core/classical_graphs/graph_loggers.ml +++ b/core/classical_graphs/graph_loggers.ml @@ -49,7 +49,7 @@ type node_attribute = { node_width: int option; node_height: int option; node_shape: Graph_loggers_sig.shape option; - node_positions: Locality.t list; + node_positions: Loc.t list; node_contextual_help: string option; node_on_click: Yojson.Basic.t option; } @@ -61,7 +61,7 @@ type edge_attribute = { edge_direction: Graph_loggers_sig.direction; edge_arrowhead: Graph_loggers_sig.headkind; edge_arrowtail: Graph_loggers_sig.headkind; - edge_positions: Locality.t list; + edge_positions: Loc.t list; edge_contextual_help: string option; edge_on_click: Yojson.Basic.t option; } diff --git a/core/classical_graphs/graph_loggers_sig.ml b/core/classical_graphs/graph_loggers_sig.ml index b576b85632..5e1e696022 100644 --- a/core/classical_graphs/graph_loggers_sig.ml +++ b/core/classical_graphs/graph_loggers_sig.ml @@ -46,7 +46,7 @@ type options = | LineStyle of linestyle | OnClick of Yojson.Basic.t | Contextual_help of string - | Position of Locality.t list + | Position of Loc.t list type graph = (string * options list) list * (string * string * options list) list diff --git a/core/classical_graphs/graph_loggers_sig.mli b/core/classical_graphs/graph_loggers_sig.mli index d6d1ebcbbf..411841ef0a 100644 --- a/core/classical_graphs/graph_loggers_sig.mli +++ b/core/classical_graphs/graph_loggers_sig.mli @@ -47,7 +47,7 @@ type options = | LineStyle of linestyle | OnClick of Yojson.Basic.t | Contextual_help of string - | Position of Locality.t list + | Position of Loc.t list type graph = (string * options list) list * (string * string * options list) list diff --git a/core/cli/cli_init.ml b/core/cli/cli_init.ml index f80505a955..d22d53fdf8 100644 --- a/core/cli/cli_init.ml +++ b/core/cli/cli_init.ml @@ -6,26 +6,31 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) -type preprocessed_ast = - Configuration.t - * (bool * bool * bool) - * string - * string option - * Signature.s - * Contact_map.t - * unit NamedDecls.t - * int Mods.StringMap.t - * int list - * ( Ast.agent, - LKappa.rule_agent list, - Raw_mixture.t, - int, - LKappa.rule ) - Ast.compil - * (LKappa.rule_mixture, Raw_mixture.t, int) Ast.init_statment list option - * float option +type preprocessed_ast = { + conf: Configuration.t; + story_compression: bool * bool * bool; + formatCflow: string; + cflowFile: string option; + ast_compiled_data: LKappa_compiler.ast_compiled_data; + overwrite_init: + (LKappa.rule_mixture, Raw_mixture.t, int) Ast.init_statement list option; + overwrite_t0: float option; +} -let preprocess ~warning ~debugMode ?kasim_args cli_args ast = +type compilation_result = { + conf: Configuration.t; + env: Model.t; + contact_map: Contact_map.t; + updated_alg_vars: int list; + story_compression: (bool * bool * bool) option; + formatCflow: string; + cflowFile: string option; + init_l: (Primitives.alg_expr * Primitives.elementary_rule) list; + counter_opt: Counter.t option; +} + +let preprocess_ast ~warning ~debug_mode ?kasim_args cli_args + (ast : (_, _, _, _, _) Ast.compil) : preprocessed_ast = let () = Format.printf "+ simulation parameters@." in let conf, story_compression, formatCflow, cflowFile = Configuration.parse ast.Ast.configurations @@ -38,9 +43,9 @@ let preprocess ~warning ~debugMode ?kasim_args cli_args ast = | Some kasim_args -> kasim_args.Kasim_args.alg_var_overwrite, kasim_args.Kasim_args.initialMix in - let sigs_nd, contact_map, tk_nd, alg_finder, updated_vars, result' = - LKappa_compiler.compil_of_ast ~warning ~debugMode ~syntax_version - var_overwrite ast + let ast_compiled_data : LKappa_compiler.ast_compiled_data = + LKappa_compiler.compil_of_ast ~warning ~debug_mode ~syntax_version + ~var_overwrite ast in let overwrite_init, overwrite_t0 = match initialMix with @@ -54,138 +59,141 @@ let preprocess ~warning ~debugMode ?kasim_args cli_args ast = in let conf, _, _, _ = Configuration.parse compil.Ast.configurations in ( Some - (LKappa_compiler.init_of_ast ~warning ~syntax_version sigs_nd - contact_map tk_nd.NamedDecls.finder alg_finder compil.Ast.init), + (LKappa_compiler.init_of_ast ~warning ~syntax_version + ast_compiled_data.agents_sig ast_compiled_data.contact_map + ast_compiled_data.token_names.NamedDecls.finder + ast_compiled_data.alg_vars_finder compil.Ast.init), conf.Configuration.initial ) in - ( conf, - story_compression, - formatCflow, - cflowFile, - sigs_nd, - contact_map, - tk_nd, - alg_finder, - updated_vars, - result', - overwrite_init, - overwrite_t0 ) + { + conf; + story_compression; + formatCflow; + cflowFile; + ast_compiled_data; + overwrite_init; + overwrite_t0; + } -let get_ast_from_list_of_files syntax_version list = - let f = +let get_ast_from_list_of_files syntax_version file_list = + let compiling_function = match syntax_version with | Ast.V4 -> Klexer4.compile Format.std_formatter | Ast.V3 -> KappaLexer.compile Format.std_formatter in - List.fold_left f Ast.empty_compil list + List.fold_left compiling_function Ast.empty_compil file_list let get_ast_from_cli_args cli_args = get_ast_from_list_of_files cli_args.Run_cli_args.syntaxVersion cli_args.Run_cli_args.inputKappaFileNames -let get_preprocessed_ast_from_cli_args ~warning ~debugMode +let get_preprocessed_ast_from_cli_args ~warning ~debug_mode ?(kasim_args = Kasim_args.default) cli_args = - let ast = + let ast : (Ast.agent, Ast.mixture, Ast.mixture, string, Ast.rule) Ast.compil = get_ast_from_list_of_files cli_args.Run_cli_args.syntaxVersion cli_args.Run_cli_args.inputKappaFileNames in - preprocess ~warning ~debugMode cli_args ~kasim_args ast + preprocess_ast ~warning ~debug_mode cli_args ~kasim_args ast -let get_pack_from_preprocessed_ast ~kasim_args ~compileModeOn preprocessed_ast = - let ( conf, - story_compression, - formatCflow, - cflowFile, - sigs_nd, - contact_map, - tk_nd, - _alg_finder, - updated_vars, - result', - overwrite_init, - overwrite_t0 ) = - preprocessed_ast - in - let n, w, s = story_compression in +type compilation_pack = { + compilation_result: compilation_result; + alg_overwrite: (int * Primitives.alg_expr) list; + overwrite_t0: float option; +} + +let get_pack_from_preprocessed_ast kasim_args ~(compile_mode_on : bool) + (preprocessed_ast : preprocessed_ast) : compilation_pack = + let n, w, s = preprocessed_ast.story_compression in let () = Format.printf "+ Compiling...@." in let env, has_tracking, init_l = Eval.compile ~outputs:Outputs.go ~pause:(fun f -> f ()) ~return:(fun x -> x) - ~debugMode:!Parameter.debugModeOn ~sharing:kasim_args.Kasim_args.sharing - ?rescale_init:kasim_args.Kasim_args.rescale ?overwrite_init ?overwrite_t0 - ~compileModeOn sigs_nd tk_nd contact_map result' + ~debug_mode:!Parameter.debug_modeOn ~sharing:kasim_args.Kasim_args.sharing + ?rescale_init:kasim_args.Kasim_args.rescale + ?overwrite_init:preprocessed_ast.overwrite_init + ?overwrite_t0:preprocessed_ast.overwrite_t0 ~compile_mode_on + preprocessed_ast.ast_compiled_data.agents_sig + preprocessed_ast.ast_compiled_data.token_names + preprocessed_ast.ast_compiled_data.contact_map + preprocessed_ast.ast_compiled_data.result in let story_compression = if has_tracking && (n || w || s) then - Some story_compression + Some preprocessed_ast.story_compression else None in - ( ( conf, - env, - contact_map, - updated_vars, - story_compression, - formatCflow, - cflowFile, - init_l ), - [], - overwrite_t0 ) + { + compilation_result = + { + conf = preprocessed_ast.conf; + env; + contact_map = preprocessed_ast.ast_compiled_data.contact_map; + updated_alg_vars = preprocessed_ast.ast_compiled_data.updated_alg_vars; + story_compression; + formatCflow = preprocessed_ast.formatCflow; + cflowFile = preprocessed_ast.cflowFile; + init_l; + counter_opt = None; + }; + alg_overwrite = []; + overwrite_t0 = preprocessed_ast.overwrite_t0; + } let get_pack_from_marshalizedfile ~warning kasim_args cli_args marshalized_file - = + : compilation_pack = assert (marshalized_file <> ""); try let d = open_in_bin marshalized_file in let () = if cli_args.Run_cli_args.inputKappaFileNames <> [] then - warning ~pos:Locality.dummy (fun f -> + warning ~pos:Loc.dummy (fun f -> Format.pp_print_string f "Simulation package loaded, all kappa files are ignored") in let () = Format.printf "+ Loading simulation package %s...@." marshalized_file in - let ((conf, env, contact, updated, compr, cflow, cflowfile, _) as pack) = - (Marshal.from_channel d - : Configuration.t - * Model.t - * Contact_map.t - * int list - * (bool * bool * bool) option - * string - * string option - * (Primitives.alg_expr * Primitives.elementary_rule) list) - in + let compilation_result : compilation_result = Marshal.from_channel d in let () = Stdlib.close_in d in let alg_overwrite = List.map (fun (s, v) -> - Model.num_of_alg (Locality.dummy_annot s) env, Alg_expr.CONST v) + ( Model.num_of_alg (Loc.annot_with_dummy s) compilation_result.env, + Alg_expr.CONST v )) kasim_args.Kasim_args.alg_var_overwrite in match kasim_args.Kasim_args.initialMix with - | None -> pack, alg_overwrite, None + | None -> { compilation_result; alg_overwrite; overwrite_t0 = None } | Some file -> let compil = get_ast_from_list_of_files cli_args.Run_cli_args.syntaxVersion [ file ] in - let conf', _, _, _ = Configuration.parse compil.Ast.configurations in + let overwrite_t0 : float option = + (Configuration.parse compil.Ast.configurations |> fun (a, _, _, _) -> a) + |> fun conf -> conf.Configuration.initial + in + let raw_inits = LKappa_compiler.init_of_ast ~warning ~syntax_version:cli_args.Run_cli_args.syntaxVersion - (Model.signatures env) contact (Model.tokens_finder env) - (Model.algs_finder env) compil.Ast.init + (Model.signatures compilation_result.env) + compilation_result.contact_map + (Model.tokens_finder compilation_result.env) + (Model.algs_finder compilation_result.env) + compil.Ast.init in - let inits = - Eval.compile_inits ~debugMode:!Parameter.debugModeOn ~warning - ?rescale:kasim_args.Kasim_args.rescale ~compileModeOn:false contact - env raw_inits + let init_l = + Eval.compile_inits ~debug_mode:!Parameter.debug_modeOn ~warning + ?rescale:kasim_args.Kasim_args.rescale ~compile_mode_on:false + compilation_result.contact_map compilation_result.env raw_inits in - ( (conf, env, contact, updated, compr, cflow, cflowfile, inits), - alg_overwrite, - conf'.Configuration.initial ) + { + compilation_result = { compilation_result with init_l }; + alg_overwrite; + overwrite_t0; + } with | ExceptionDefn.Malformed_Decl _ as e -> raise e | _exn -> @@ -194,23 +202,12 @@ let get_pack_from_marshalizedfile ~warning kasim_args cli_args marshalized_file of KaSim, aborting..."; exit 1 -let get_compilation_from_pack ~warning kasim_args cli_args pack = - let ( ( conf, - env0, - contact_map, - updated_vars, - story_compression, - formatCflows, - cflowFile, - init_l ), - alg_overwrite, - overwrite_t0 ) = - pack - in +let get_compilation_from_pack ~warning kasim_args cli_args + (pack : compilation_pack) : compilation_result = let init_t_from_files = Option_util.unsome - (Option_util.unsome 0. conf.Configuration.initial) - overwrite_t0 + (Option_util.unsome 0. pack.compilation_result.conf.Configuration.initial) + pack.overwrite_t0 in let init_t, max_time, init_e, max_event, plot_period = match kasim_args.Kasim_args.unit with @@ -222,8 +219,8 @@ let get_compilation_from_pack ~warning kasim_args cli_args pack = (match cli_args.Run_cli_args.plotPeriod with | Some a -> Configuration.DT a | None -> - Option_util.unsome (Configuration.DT 1.) conf.Configuration.plotPeriod) - ) + Option_util.unsome (Configuration.DT 1.) + pack.compilation_result.conf.Configuration.plotPeriod) ) | Kasim_args.Event -> ( init_t_from_files, None, @@ -233,12 +230,13 @@ let get_compilation_from_pack ~warning kasim_args cli_args pack = (match cli_args.Run_cli_args.plotPeriod with | Some a -> Configuration.DE (int_of_float (ceil a)) | None -> - Option_util.unsome (Configuration.DE 1) conf.Configuration.plotPeriod) - ) + Option_util.unsome (Configuration.DE 1) + pack.compilation_result.conf.Configuration.plotPeriod) ) in let counter = Counter.create ~init_t ?init_e ?max_time ?max_event ~plot_period - ~nb_rules:(Model.nb_rules env0) () + ~nb_rules:(Model.nb_rules pack.compilation_result.env) + () in let env = if @@ -247,36 +245,31 @@ let get_compilation_from_pack ~warning kasim_args cli_args pack = then Model.propagate_constant ~warning ?max_time:(Counter.max_time counter) ?max_events:(Counter.max_events counter) - updated_vars alg_overwrite env0 + ~updated_vars:pack.compilation_result.updated_alg_vars + ~alg_overwrite:pack.alg_overwrite pack.compilation_result.env else - Model.overwrite_vars alg_overwrite env0 + Model.overwrite_vars pack.alg_overwrite pack.compilation_result.env in - ( ( conf, - env, - contact_map, - updated_vars, - story_compression, - formatCflows, - cflowFile, - init_l ), - counter ) + { pack.compilation_result with env; counter_opt = Some counter } -let get_compilation_from_preprocessed_ast ~warning ?(compileModeOn = false) - ?(kasim_args = Kasim_args.default) cli_args preprocessed = +let get_compilation_from_preprocessed_ast ~warning ?(compile_mode_on = false) + ?(kasim_args = Kasim_args.default) cli_args preprocessed_ast : + compilation_result = let pack = - get_pack_from_preprocessed_ast ~kasim_args ~compileModeOn preprocessed + get_pack_from_preprocessed_ast kasim_args ~compile_mode_on preprocessed_ast in get_compilation_from_pack ~warning kasim_args cli_args pack -let get_compilation ~warning ~debugMode ?(compileModeOn = false) - ?(kasim_args = Kasim_args.default) cli_args = - let pack = +let get_compilation ~warning ~debug_mode ?(compile_mode_on = false) + ?(kasim_args = Kasim_args.default) cli_args : compilation_result = + let (pack : compilation_pack) = match kasim_args.Kasim_args.marshalizedInFile with | "" -> - let preprocess = - get_preprocessed_ast_from_cli_args ~warning ~debugMode cli_args + let preprocessed_ast = + get_preprocessed_ast_from_cli_args ~warning ~debug_mode cli_args in - get_pack_from_preprocessed_ast ~kasim_args ~compileModeOn preprocess + get_pack_from_preprocessed_ast kasim_args ~compile_mode_on + preprocessed_ast | marshalized_file -> get_pack_from_marshalizedfile ~warning kasim_args cli_args marshalized_file diff --git a/core/cli/cli_init.mli b/core/cli/cli_init.mli index 541e691bd2..707ab93a18 100644 --- a/core/cli/cli_init.mli +++ b/core/cli/cli_init.mli @@ -5,23 +5,40 @@ (* | . \ * This file is distributed under the terms of the *) (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) -type preprocessed_ast +type preprocessed_ast = { + conf: Configuration.t; + story_compression: bool * bool * bool; + formatCflow: string; + cflowFile: string option; + ast_compiled_data: LKappa_compiler.ast_compiled_data; + overwrite_init: + (LKappa.rule_mixture, Raw_mixture.t, int) Ast.init_statement list option; + overwrite_t0: float option; +} + +(* TODO contact map is also in env *) +type compilation_result = { + conf: Configuration.t; + env: Model.t; + contact_map: Contact_map.t; + updated_alg_vars: int list; + story_compression: (bool * bool * bool) option; + formatCflow: string; + cflowFile: string option; + init_l: (Primitives.alg_expr * Primitives.elementary_rule) list; + counter_opt: Counter.t option; + (* TODO Should we keep counter_opt here, or create another type? *) +} + +(* TODO change calls to this *) val get_compilation : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> - debugMode:bool -> - ?compileModeOn:bool -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> + debug_mode:bool -> + ?compile_mode_on:bool -> ?kasim_args:Kasim_args.t -> Run_cli_args.t -> - (Configuration.t - * Model.t - * Contact_map.t - * int list - * (bool * bool * bool) option - * string - * string option - * (Primitives.alg_expr * Primitives.elementary_rule) list) - * Counter.t + compilation_result val get_ast_from_list_of_files : Ast.syntax_version -> string list -> Ast.parsing_compil @@ -29,32 +46,24 @@ val get_ast_from_list_of_files : val get_ast_from_cli_args : Run_cli_args.t -> Ast.parsing_compil val get_preprocessed_ast_from_cli_args : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> - debugMode:bool -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> + debug_mode:bool -> ?kasim_args:Kasim_args.t -> Run_cli_args.t -> preprocessed_ast -val preprocess : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> - debugMode:bool -> +val preprocess_ast : + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> + debug_mode:bool -> ?kasim_args:Kasim_args.t -> Run_cli_args.t -> Ast.parsing_compil -> preprocessed_ast val get_compilation_from_preprocessed_ast : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> - ?compileModeOn:bool -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> + ?compile_mode_on:bool -> ?kasim_args:Kasim_args.t -> Run_cli_args.t -> preprocessed_ast -> - (Configuration.t - * Model.t - * Contact_map.t - * int list - * (bool * bool * bool) option - * string - * string option - * (Primitives.alg_expr * Primitives.elementary_rule) list) - * Counter.t + compilation_result diff --git a/core/cli/dune b/core/cli/dune index c8748cc11d..0b7b93ae10 100644 --- a/core/cli/dune +++ b/core/cli/dune @@ -1,15 +1,28 @@ (library - (name kappa_cli) - (libraries lwt - (select superargTk.ml from - (labltk.jpf -> superargTk.tk.ml) - ( -> superargTk.notk.ml)) - kappa_grammar - kappa-library.runtime kappa_version) - (flags (:standard -w @a - -open Kappa_version - -open Kappa_generic_toolset - -open Kappa_mixtures - -open Kappa_terms - -open Kappa_grammar - -open Kappa_runtime))) + (name kappa_cli) + (libraries + lwt + (select + superargTk.ml + from + (labltk.jpf -> superargTk.tk.ml) + (-> superargTk.notk.ml)) + kappa_grammar + kappa-library.runtime + kappa_version) + (flags + (:standard + -w + @a-40-42 + -open + Kappa_version + -open + Kappa_generic_toolset + -open + Kappa_mixtures + -open + Kappa_terms + -open + Kappa_grammar + -open + Kappa_runtime))) diff --git a/core/cli/kappa_files.mli b/core/cli/kappa_files.mli index a5da155fd8..690f13a634 100644 --- a/core/cli/kappa_files.mli +++ b/core/cli/kappa_files.mli @@ -6,7 +6,8 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) -(** Utilities on files *) +(** Utilities on files + * Stores file paths used by the kappa system and access to them *) val open_out : string -> out_channel diff --git a/core/cli/kasim_args.ml b/core/cli/kasim_args.ml index 5bd4aa2f3e..c25213b9e7 100644 --- a/core/cli/kasim_args.ml +++ b/core/cli/kasim_args.ml @@ -19,7 +19,7 @@ type t = { mutable domainOutputFile: string option; mutable traceFile: string option; mutable logFile: string option; - mutable compileMode: bool; + mutable compile_mode: bool; mutable sharing: Pattern.sharing_level; mutable showEfficiency: bool; mutable timeIndependent: bool; @@ -37,7 +37,7 @@ let default : t = domainOutputFile = None; traceFile = None; logFile = Some "inputs"; - compileMode = false; + compile_mode = false; sharing = Pattern.Compatible_patterns; showEfficiency = false; timeIndependent = false; @@ -115,7 +115,7 @@ let options (t : t) : (string * Arg.spec * string) list = "Level of sharing computed between patterns during initialization \ (None/Compatible/Max)" ); ( "--compile", - Arg.Unit (fun () -> t.compileMode <- true), + Arg.Unit (fun () -> t.compile_mode <- true), "Display rule compilation as action list" ); ( "-log", Arg.String (fun logFile -> t.logFile <- Some logFile), diff --git a/core/cli/kasim_args.mli b/core/cli/kasim_args.mli index d49b7fba5d..a82e882a40 100644 --- a/core/cli/kasim_args.mli +++ b/core/cli/kasim_args.mli @@ -11,7 +11,7 @@ type t = { mutable domainOutputFile: string option; mutable traceFile: string option; mutable logFile: string option; - mutable compileMode: bool; + mutable compile_mode: bool; mutable sharing: Pattern.sharing_level; mutable showEfficiency: bool; mutable timeIndependent: bool; diff --git a/core/cli/outputs.ml b/core/cli/outputs.ml index 020ceaeec8..7dcf5db096 100644 --- a/core/cli/outputs.ml +++ b/core/cli/outputs.ml @@ -42,7 +42,7 @@ let emptyActs = ref true let init_activities env = function | None -> () | Some s -> - let noCounters = !Parameter.debugModeOn in + let noCounters = !Parameter.debug_modeOn in let desc = Kappa_files.open_out s in let form = Format.formatter_of_out_channel desc in let nb_r = Model.nb_syntactic_rules env in @@ -175,7 +175,7 @@ let snapshot file s = let print_species time f mixture = Format.fprintf f "%g: @[%a@]@." time User_graph.print_cc mixture -let warning_buffer : (Locality.t option * (Format.formatter -> unit)) list ref = +let warning_buffer : (Loc.t option * (Format.formatter -> unit)) list ref = ref [] let go = function @@ -252,5 +252,5 @@ let input_modifications env event mods = (Format.formatter_of_out_channel inputs) "%%mod: [E] = %i do %a@." event (Pp.list ~trailing:Pp.colon Pp.colon - (Kappa_printer.modification ~noCounters:!Parameter.debugModeOn ~env)) + (Kappa_printer.modification ~noCounters:!Parameter.debug_modeOn ~env)) mods diff --git a/core/cli/parameter.ml b/core/cli/parameter.ml index c115ee7df3..bba815a528 100644 --- a/core/cli/parameter.ml +++ b/core/cli/parameter.ml @@ -11,7 +11,7 @@ let defaultExtArraySize = ref 5 let defaultGraphSize = ref 5 let defaultLiftSetSize = ref 5 let defaultHeapSize = ref 5 -let debugModeOn = ref false +let debug_modeOn = ref false (* expert option for stories *) diff --git a/core/cli/parameter.mli b/core/cli/parameter.mli index 7167820f13..833702327d 100644 --- a/core/cli/parameter.mli +++ b/core/cli/parameter.mli @@ -14,7 +14,7 @@ val look_down_for_better_cut : bool val log_number_of_causal_flows : bool val defaultLiftSetSize : int ref val defaultHeapSize : int ref -val debugModeOn : bool ref +val debug_modeOn : bool ref val do_global_cut : bool val cut_pseudo_inverse_event : bool val defaultExtArraySize : int ref diff --git a/core/dataStructures/ExceptionDefn.ml b/core/dataStructures/ExceptionDefn.ml index a7ea918246..f60c25c4dc 100644 --- a/core/dataStructures/ExceptionDefn.ml +++ b/core/dataStructures/ExceptionDefn.ml @@ -6,9 +6,9 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) -exception Syntax_Error of string Locality.annot -exception Malformed_Decl of string Locality.annot -exception Internal_Error of string Locality.annot +exception Syntax_Error of string Loc.annoted +exception Malformed_Decl of string Loc.annoted +exception Internal_Error of string Loc.annoted -let warning_buffer : (Locality.t option * (Format.formatter -> unit)) list ref = +let warning_buffer : (Loc.t option * (Format.formatter -> unit)) list ref = ref [] diff --git a/core/dataStructures/ExceptionDefn.mli b/core/dataStructures/ExceptionDefn.mli index cdd92cac91..1c5ec22544 100644 --- a/core/dataStructures/ExceptionDefn.mli +++ b/core/dataStructures/ExceptionDefn.mli @@ -1,5 +1,5 @@ -exception Syntax_Error of string Locality.annot -exception Malformed_Decl of string Locality.annot -exception Internal_Error of string Locality.annot +exception Syntax_Error of string Loc.annoted +exception Malformed_Decl of string Loc.annoted +exception Internal_Error of string Loc.annoted -val warning_buffer : (Locality.t option * (Format.formatter -> unit)) list ref +val warning_buffer : (Loc.t option * (Format.formatter -> unit)) list ref diff --git a/core/dataStructures/dune b/core/dataStructures/dune index 6e63ecae94..9d87752fd8 100644 --- a/core/dataStructures/dune +++ b/core/dataStructures/dune @@ -2,4 +2,5 @@ (name kappa_generic_toolset) (libraries yojson result logs stdlib-shims bigarray camlp-streams) (public_name kappa-library.generic) - (flags (:standard -w @a))) + (flags + (:standard -w @a))) diff --git a/core/dataStructures/locality.ml b/core/dataStructures/loc.ml similarity index 93% rename from core/dataStructures/locality.ml rename to core/dataStructures/loc.ml index f863fc1ff1..1a43de4688 100644 --- a/core/dataStructures/locality.ml +++ b/core/dataStructures/loc.ml @@ -7,10 +7,11 @@ (******************************************************************************) type position = { chr: int; line: int } -type range = { file: string; from_position: position; to_position: position } -type t = range -type 'a annot = 'a * t -type 'a maybe = ?pos:t -> 'a +type t = { file: string; from_position: position; to_position: position } +type 'a annoted = 'a * t + +let v (v, _) = v +let get_annot (_, annot) = annot let of_pos start_location end_location = let () = @@ -43,14 +44,14 @@ let dummy = to_position = dummy_position; } -let dummy_annot x = x, dummy +let annot_with_dummy x = x, dummy let is_dummy loc = loc.file = Lexing.dummy_pos.Lexing.pos_fname && loc.from_position = dummy_position && loc.to_position = dummy_position -let has_dummy_annot (_, loc) = is_dummy loc +let is_annoted_with_dummy (_, loc) = is_dummy loc let print f loc = let pr_f f = @@ -66,7 +67,7 @@ let print f loc = loc.to_position.chr let to_string loc = Format.asprintf "@[%a@]" print loc -let print_annot pr f (x, l) = Format.fprintf f "%a@ %a" print l pr x +let print_annoted pr f (x, l) = Format.fprintf f "%a@ %a" print l pr x let read_position p lb = match Yojson.Basic.from_lexbuf ~stream:true p lb with @@ -141,14 +142,14 @@ let of_compact_yojson ?(filenames = [||]) = function raise (Yojson.Basic.Util.Type_error ("Incorrect AST arrow_notation", x))) | x -> raise (Yojson.Basic.Util.Type_error ("Invalid location", x)) -let annot_to_yojson ?filenames f (x, l) = +let yojson_of_annoted ?filenames f (x, l) = let jp = to_compact_yojson filenames l in if jp = `Null then `Assoc [ "val", f x ] else `Assoc [ "val", f x; "loc", jp ] -let annot_of_yojson ?filenames f = function +let annoted_of_yojson ?filenames f = function | `Assoc [ ("val", x); ("loc", l) ] | `Assoc [ ("loc", l); ("val", x) ] -> f x, of_compact_yojson ?filenames l | `Assoc [ ("val", x) ] -> f x, dummy diff --git a/core/dataStructures/locality.mli b/core/dataStructures/loc.mli similarity index 72% rename from core/dataStructures/locality.mli rename to core/dataStructures/loc.mli index 11d845b6d0..e0d41f1af7 100644 --- a/core/dataStructures/locality.mli +++ b/core/dataStructures/loc.mli @@ -6,38 +6,48 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) +(** Module for type Loc.t annotating structured data with the line range + * in a file which was used to define it *) + type position = { chr: int; line: int } -type range = { file: string; from_position: position; to_position: position } -type t = range -type 'a annot = 'a * t -type 'a maybe = ?pos:t -> 'a +type t = { file: string; from_position: position; to_position: position } +type 'a annoted = 'a * t + +val v : 'a annoted -> 'a +(** Extract value from Loc.annoted *) + +val get_annot : 'a annoted -> t +(** Extract annotation from Loc.annoted *) val of_pos : Lexing.position -> Lexing.position -> t val dummy : t -val dummy_annot : 'a -> 'a annot -val has_dummy_annot : 'a annot -> bool +val annot_with_dummy : 'a -> 'a annoted +val is_annoted_with_dummy : 'a annoted -> bool -val merge : range -> range -> range +val merge : t -> t -> t (** [merge b e] creates the range from beginning of [b] to the end of [e] (filename must match) *) -val is_included_in : string -> position -> range -> bool +val is_included_in : string -> position -> t -> bool + +(** {2 I/O} *) + val to_string : t -> string val print : Format.formatter -> t -> unit -val print_annot : - (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a annot -> unit +val print_annoted : + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a annoted -> unit -val annot_of_yojson : +val annoted_of_yojson : ?filenames:string array -> (Yojson.Basic.t -> 'a) -> Yojson.Basic.t -> - 'a annot + 'a annoted -val annot_to_yojson : +val yojson_of_annoted : ?filenames:int Mods.StringMap.t -> ('a -> Yojson.Basic.t) -> - 'a annot -> + 'a annoted -> Yojson.Basic.t val write_position : Buffer.t -> position -> unit diff --git a/core/dataStructures/namedDecls.ml b/core/dataStructures/namedDecls.ml index c3e088aa79..69643f8b28 100644 --- a/core/dataStructures/namedDecls.ml +++ b/core/dataStructures/namedDecls.ml @@ -30,6 +30,12 @@ let create ?forbidden a = finder = name_map_of_array ?forbidden a; } +let create_from_list ?forbidden l = create ?forbidden (Array.of_list l) + +(* TODO see if we should keep this *) +let create_no_loc ?forbidden a = + Array.map (fun (x, y) -> (x, Loc.dummy), y) a |> create ?forbidden + let size nd = Array.length nd.decls let elt_name nd i = fst nd.decls.(i) @@ -52,12 +58,17 @@ let debug_print pr f nd = let fold f acc nd = Tools.array_fold_lefti (fun i acc (na, x) -> f i na acc x) acc nd.decls +let map f nd = + { decls = Array.map (fun (s, v) -> s, f s v) nd.decls; finder = nd.finder } + let mapi f nd = { decls = Array.mapi (fun i (s, v) -> s, f i s v) nd.decls; finder = nd.finder; } +let elt_val nd i = snd nd.decls.(i) + let to_json aux nd = `List (Array.fold_right @@ -71,7 +82,7 @@ let of_json aux = function (function | `Assoc [ ("name", `String x); ("decl", a) ] | `Assoc [ ("decl", a); ("name", `String x) ] -> - Locality.dummy_annot x, aux a + Loc.annot_with_dummy x, aux a | x -> raise (Yojson.Basic.Util.Type_error ("Not a valid NamedDecl element", x))) diff --git a/core/dataStructures/namedDecls.mli b/core/dataStructures/namedDecls.mli index be40a511be..b6682431a3 100644 --- a/core/dataStructures/namedDecls.mli +++ b/core/dataStructures/namedDecls.mli @@ -15,12 +15,30 @@ type 'a t = private { } val create : - ?forbidden:Mods.StringSet.t -> (string Locality.annot * 'a) array -> 'a t + ?forbidden:Mods.StringSet.t -> (string Loc.annoted * 'a) array -> 'a t +(** [create ~forbidden string_val_assoc] evaluates to a namedDecls.t from the string-to-variable associations [string_val_assoc] except from strings in [forbidden]. Loc info is not kept. *) +(* TODO should we remove Loc info *) + +val create_from_list : + ?forbidden:Mods.StringSet.t -> (string Loc.annoted * 'a) list -> 'a t + +(* TODO see if better name, what implementation is to be kept *) +val create_no_loc : ?forbidden:Mods.StringSet.t -> (string * 'a) array -> 'a t +(** [create_no_loc] behaves the same as [create], but without the need to provide the Loc info that will be trashed *) val size : 'a t -> int + val elt_name : 'a t -> int -> string -val elt_id : ?kind:string -> 'a t -> string Locality.annot -> int +(** [elt_name nd i] evaluates to the name declaration of id [i] in [nd], or raises an exception if it doesn't exist *) + +val elt_id : ?kind:string -> 'a t -> string Loc.annoted -> int +(** [elt_id ~kind nd (s, pos)] evaluates to the data matching declaration [s] in [nd], or if it doesn't exist, throw and exception with info about [kind] and [pos] *) + +val elt_val : 'a t -> int -> 'a +(** Access data by id *) + val fold : (int -> string -> 'a -> 'b -> 'a) -> 'a -> 'b t -> 'a +val map : (string -> 'a -> 'b) -> 'a t -> 'b t val mapi : (int -> string -> 'a -> 'b) -> 'a t -> 'b t val print : diff --git a/core/dataStructures/option_util.ml b/core/dataStructures/option_util.ml index 86522df4e7..ed97505e32 100644 --- a/core/dataStructures/option_util.ml +++ b/core/dataStructures/option_util.ml @@ -10,6 +10,11 @@ let unsome default = function | None -> default | Some a -> a +let unsome_or_raise + ?(excep = Invalid_argument "unsome_or_raise was passed a None") = function + | None -> raise excep + | Some a -> a + let map f = function | Some x -> Some (f x) | None -> None diff --git a/core/dataStructures/option_util.mli b/core/dataStructures/option_util.mli index 009fd8e6bd..fd0e2eeaec 100644 --- a/core/dataStructures/option_util.mli +++ b/core/dataStructures/option_util.mli @@ -12,4 +12,5 @@ val map : ('a -> 'b) -> 'a option -> 'b option val fold : ('a -> 'b -> 'a) -> 'a -> 'b option -> 'a val bind : ('a -> 'b option) -> 'a option -> 'b option val unsome : 'a -> 'a option -> 'a +val unsome_or_raise : ?excep:exn -> 'a option -> 'a val equal : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool diff --git a/core/dataStructures/pp.ml b/core/dataStructures/pp.ml index 6404e43a0e..d727c4ff66 100644 --- a/core/dataStructures/pp.ml +++ b/core/dataStructures/pp.ml @@ -76,7 +76,7 @@ let plain_array pr_el f a = in Format.fprintf f "[|%t|]" (aux 0) -let error pr x = eprintf "%a@." (Locality.print_annot pr) x +let error pr x = eprintf "%a@." (Loc.print_annoted pr) x let list_to_string pr_sep pr_el () l = let rec aux () = function diff --git a/core/dataStructures/pp.mli b/core/dataStructures/pp.mli index 45fbe85892..d764f1f44a 100644 --- a/core/dataStructures/pp.mli +++ b/core/dataStructures/pp.mli @@ -75,7 +75,7 @@ val array : unit val plain_array : (formatter -> 'a -> unit) -> formatter -> 'a array -> unit -val error : (formatter -> 'a -> unit) -> 'a Locality.annot -> unit +val error : (formatter -> 'a -> unit) -> 'a Loc.annoted -> unit val list_to_string : (unit -> string) -> (unit -> 'a -> string) -> unit -> 'a list -> string diff --git a/core/dataStructures/renaming.ml b/core/dataStructures/renaming.ml index 21f6eb07da..d164db007b 100644 --- a/core/dataStructures/renaming.ml +++ b/core/dataStructures/renaming.ml @@ -102,9 +102,9 @@ let unsafe_functionnal_add x y i = dsts = Mods.IntSet.add y i.dsts; } -let add ~debugMode x y i = +let add ~debug_mode x y i = let not_ok = - debugMode && x < Array.length i.immediate && i.immediate.(x) <> special_val + debug_mode && x < Array.length i.immediate && i.immediate.(x) <> special_val in if not_ok then raise Clashing @@ -130,9 +130,9 @@ let unsafe_imperative_add x y i = let () = i.is_identity <- i.is_identity && x == y in i.dsts <- Mods.IntSet.add y i.dsts -let imperative_add ~debugMode x y i = +let imperative_add ~debug_mode x y i = let not_ok = - debugMode && x < Array.length i.immediate && i.immediate.(x) <> special_val + debug_mode && x < Array.length i.immediate && i.immediate.(x) <> special_val in if not_ok then raise Clashing @@ -168,8 +168,8 @@ let fold f i acc = f i v acc) acc i.immediate -let apply ~debugMode i x = - if (not i.is_identity) || debugMode then ( +let apply ~debug_mode i x = + if (not i.is_identity) || debug_mode then ( let c = compute x i in if c = special_val then raise Undefined @@ -178,8 +178,8 @@ let apply ~debugMode i x = ) else x -let compose ~debugMode extensible i i' = - if (not i.is_identity) || extensible || debugMode then +let compose ~debug_mode extensible i i' = + if (not i.is_identity) || extensible || debug_mode then { immediate = Array.make (Array.length i.immediate) special_val; delayed = Some (i, i'); @@ -294,7 +294,7 @@ let of_yojson = function List.iter (function | `List [ `Int src; `Int dst ] as x -> - if not (imperative_add ~debugMode:false src dst out) then + if not (imperative_add ~debug_mode:false src dst out) then raise (Yojson.Basic.Util.Type_error ("Incorrect renaming item", x)) | x -> diff --git a/core/dataStructures/renaming.mli b/core/dataStructures/renaming.mli index 5cc73c06d0..0bd1cc95fa 100644 --- a/core/dataStructures/renaming.mli +++ b/core/dataStructures/renaming.mli @@ -23,18 +23,18 @@ val image : t -> Mods.IntSet.t val cyclic_permutation_from_list : stop_at:int -> int list -> t (** very specific use case for Connected_component.remove_ag_cc *) -val imperative_add : debugMode:bool -> int -> int -> t -> bool +val imperative_add : debug_mode:bool -> int -> int -> t -> bool (** @raise Clashing in debug mode @return if the addition preserves injectivity *) -val add : debugMode:bool -> int -> int -> t -> t option +val add : debug_mode:bool -> int -> int -> t -> t option (** @raise Clashing in debug mode @return [None] if the addition would break injectivity *) -val compose : debugMode:bool -> bool -> t -> t -> t +val compose : debug_mode:bool -> bool -> t -> t -> t (** @raise Undefined *) -val apply : debugMode:bool -> t -> int -> int +val apply : debug_mode:bool -> t -> int -> int (** @raise Undefined *) val mem : int -> t -> bool diff --git a/core/dataStructures/result_util.ml b/core/dataStructures/result_util.ml index fd48311e62..03a021ec61 100644 --- a/core/dataStructures/result_util.ml +++ b/core/dataStructures/result_util.ml @@ -19,7 +19,7 @@ type status = type message = { severity: Logs.level; text: string; (*should be an algebraic type*) - range: Locality.t option; + range: Loc.t option; } type ('a, 'b) t = { @@ -73,7 +73,7 @@ let write_message ob { severity; text; range } = | None -> () | Some r -> let () = JsonUtil.write_comma ob in - JsonUtil.write_field "range" Locality.write_range ob r + JsonUtil.write_field "range" Loc.write_range ob r in Buffer.add_char ob '}' @@ -86,7 +86,7 @@ let read_message p lb = else if key = "text" then s, Yojson.Basic.read_string p lb, r else if key = "range" then - s, t, Some (Locality.read_range p lb) + s, t, Some (Loc.read_range p lb) else raise (Yojson.Json_error ("No field " ^ key ^ " expected in message"))) (Logs.App, "", None) p lb @@ -95,7 +95,7 @@ let read_message p lb = let print_message f { range; text; _ } = match range with - | Some range -> Locality.print_annot Format.pp_print_string f (text, range) + | Some range -> Loc.print_annoted Format.pp_print_string f (text, range) | None -> Format.pp_print_string f text let write_t write__ok write__error ob = function diff --git a/core/dataStructures/result_util.mli b/core/dataStructures/result_util.mli index 1b29aeef2e..e28c9f903b 100644 --- a/core/dataStructures/result_util.mli +++ b/core/dataStructures/result_util.mli @@ -19,7 +19,7 @@ type status = type message = { severity: Logs.level; text: string; (*should be an algebraic type*) - range: Locality.t option; + range: Loc.t option; } type ('a, 'b) t = { diff --git a/core/dataStructures/setMap.ml b/core/dataStructures/setMap.ml index 77c043d16a..916479f503 100644 --- a/core/dataStructures/setMap.ml +++ b/core/dataStructures/setMap.ml @@ -1150,14 +1150,14 @@ module Make (Ord : OrderedType) : S with type elt = Ord.t = struct Some key ) - (* let rec find_acc k m = *) - (* match m with *) - (* Private.Empty -> None *) - (* | Private.Node (l, key, r, _, _) -> *) - (* let s = size l in *) - (* if k < s then find_acc k l *) - (* else if k = s then Some key *) - (* else find_acc (k - s - 1) r *) + (* let rec find_acc k m = + match m with + | Private.Empty -> None + | Private.Node (l, key, r, _, _) -> + let s = size l in + if k < s then find_acc k l + else if k = s then Some key + else find_acc (k - s - 1) r *) let random rs m = let s = size m in diff --git a/core/error_handlers/dune b/core/error_handlers/dune index 44bf7f4272..b0d549556e 100644 --- a/core/error_handlers/dune +++ b/core/error_handlers/dune @@ -1,7 +1,16 @@ (library - (name kappa_errors) - (libraries yojson result kappa-library.generic kappa_logging kappa_parameters) - (flags (:standard - -open Kappa_generic_toolset - -open Kappa_logging - -open Kappa_parameters ))) + (name kappa_errors) + (libraries + yojson + result + kappa-library.generic + kappa_logging + kappa_parameters) + (flags + (:standard + -open + Kappa_generic_toolset + -open + Kappa_logging + -open + Kappa_parameters))) diff --git a/core/error_handlers/exception.ml b/core/error_handlers/exception.ml index c1ebbef020..cf49557b35 100644 --- a/core/error_handlers/exception.ml +++ b/core/error_handlers/exception.ml @@ -61,7 +61,7 @@ let warn_with_exn parameters error_handler ?to_ui (file, line, _, _) let pos = match pos with | None -> "" - | Some s -> ", " ^ Locality.to_string s + | Some s -> ", " ^ Loc.to_string s in warn_aux parameters error_handler ?to_ui (Some file) (Some ("line " ^ string_of_int line ^ pos ^ liaison ^ message)) @@ -177,7 +177,7 @@ let check_point ?to_ui:bool -> 'a -> ?message:string -> - ?pos:Locality.t -> + ?pos:Loc.t -> exn -> unit -> method_handler * unit) parameter error error' s ?to_ui ?message ?pos exn = diff --git a/core/error_handlers/exception.mli b/core/error_handlers/exception.mli index d6f8941fe2..c0f9ad7853 100644 --- a/core/error_handlers/exception.mli +++ b/core/error_handlers/exception.mli @@ -11,7 +11,7 @@ val warn_with_exn : ?to_ui:bool -> string * int * int * int -> ?message:string -> - ?pos:Locality.t option -> + ?pos:Loc.t option -> exn -> (unit -> 'a) -> method_handler * 'a @@ -22,7 +22,7 @@ val warn : ?to_ui:bool -> string * int * int * int -> ?message:string -> - ?pos:Locality.t -> + ?pos:Loc.t -> exn -> 'a -> method_handler * 'a @@ -49,7 +49,7 @@ val check_point : ?to_ui:bool -> 'a -> ?message:string -> - ?pos:Locality.t -> + ?pos:Loc.t -> exn -> unit -> method_handler * unit) -> @@ -59,6 +59,6 @@ val check_point : 'a -> ?to_ui:bool -> ?message:string -> - ?pos:Locality.t -> + ?pos:Loc.t -> exn -> method_handler diff --git a/core/grammar/ast.ml b/core/grammar/ast.ml index f783499e59..cb4e8677ce 100644 --- a/core/grammar/ast.ml +++ b/core/grammar/ast.ml @@ -13,46 +13,54 @@ let merge_version a b = | V4, _ | _, V4 -> V4 | V3, V3 -> V3 -type internal = string option Locality.annot list +type internal = string option Loc.annoted list type port = { - port_nme: string Locality.annot; + port_name: string Loc.annoted; port_int: internal; - port_int_mod: string Locality.annot option; - port_lnk: (string Locality.annot, unit) LKappa.link Locality.annot list; - port_lnk_mod: int Locality.annot option option; + port_int_mod: string Loc.annoted option; + port_link: (string Loc.annoted, unit) LKappa.link Loc.annoted list; + port_link_mod: int Loc.annoted option option; } +(* TODO change name, CVAR is not a test? *) + +(** What test is done by the counter expression + * - CEQ: If counter value is equal to the specified value + * - CGTE: If counter value is greater or equal to the specified value + * - CVAR: Not a test, but defines a variable to be used in the rule rates *) type counter_test = CEQ of int | CGTE of int | CVAR of string type counter = { - count_nme: string Locality.annot; - count_test: counter_test Locality.annot option; - count_delta: int Locality.annot; + counter_name: string Loc.annoted; + counter_test: counter_test Loc.annoted option; + (** In a rule: what test is done, in an agent declaration: the initial value *) + counter_delta: int Loc.annoted; + (** In a rule: change in counter value, in an agent declaration: max value of the counter *) } type site = Port of port | Counter of counter -type agent_mod = Erase | Create +type agent_mod = NoMod | Erase | Create type agent = - | Present of string Locality.annot * site list * agent_mod option - | Absent of Locality.t + | Present of string Loc.annoted * site list * agent_mod + | Absent of Loc.t type mixture = agent list list type edit_notation = { mix: mixture; delta_token: - ((mixture, string) Alg_expr.e Locality.annot * string Locality.annot) list; + ((mixture, string) Alg_expr.e Loc.annoted * string Loc.annoted) list; } type arrow_notation = { lhs: mixture; rm_token: - ((mixture, string) Alg_expr.e Locality.annot * string Locality.annot) list; + ((mixture, string) Alg_expr.e Loc.annoted * string Loc.annoted) list; rhs: mixture; add_token: - ((mixture, string) Alg_expr.e Locality.annot * string Locality.annot) list; + ((mixture, string) Alg_expr.e Loc.annoted * string Loc.annoted) list; } type rule_content = Edit of edit_notation | Arrow of arrow_notation @@ -60,16 +68,16 @@ type rule_content = Edit of edit_notation | Arrow of arrow_notation type rule = { rewrite: rule_content; bidirectional: bool; - k_def: (mixture, string) Alg_expr.e Locality.annot; + k_def: (mixture, string) Alg_expr.e Loc.annoted; k_un: - ((mixture, string) Alg_expr.e Locality.annot - * (mixture, string) Alg_expr.e Locality.annot option) + ((mixture, string) Alg_expr.e Loc.annoted + * (mixture, string) Alg_expr.e Loc.annoted option) option; (*k_1:radius_opt*) - k_op: (mixture, string) Alg_expr.e Locality.annot option; + k_op: (mixture, string) Alg_expr.e Loc.annoted option; k_op_un: - ((mixture, string) Alg_expr.e Locality.annot - * (mixture, string) Alg_expr.e Locality.annot option) + ((mixture, string) Alg_expr.e Loc.annoted + * (mixture, string) Alg_expr.e Loc.annoted option) option; (*rate for backward rule*) } @@ -77,16 +85,16 @@ type rule = { let flip_label str = str ^ "_op" type ('pattern, 'mixture, 'id, 'rule) modif_expr = - | APPLY of (('pattern, 'id) Alg_expr.e Locality.annot * 'rule Locality.annot) - | UPDATE of ('id Locality.annot * ('pattern, 'id) Alg_expr.e Locality.annot) + | APPLY of (('pattern, 'id) Alg_expr.e Loc.annoted * 'rule Loc.annoted) + | UPDATE of ('id Loc.annoted * ('pattern, 'id) Alg_expr.e Loc.annoted) | STOP of ('pattern, 'id) Alg_expr.e Primitives.print_expr list | SNAPSHOT of bool * ('pattern, 'id) Alg_expr.e Primitives.print_expr list | PRINT of ('pattern, 'id) Alg_expr.e Primitives.print_expr list * ('pattern, 'id) Alg_expr.e Primitives.print_expr list | PLOTENTRY - | CFLOWLABEL of (bool * string Locality.annot) - | CFLOWMIX of (bool * 'pattern Locality.annot) + | CFLOWLABEL of (bool * string Loc.annoted) + | CFLOWMIX of (bool * 'pattern Loc.annoted) | DIN of Primitives.din_kind * ('pattern, 'id) Alg_expr.e Primitives.print_expr list @@ -94,61 +102,61 @@ type ('pattern, 'mixture, 'id, 'rule) modif_expr = | SPECIES_OF of bool * ('pattern, 'id) Alg_expr.e Primitives.print_expr list - * 'pattern Locality.annot + * 'pattern Loc.annoted type ('pattern, 'mixture, 'id, 'rule) perturbation = (Nbr.t option - * ('pattern, 'id) Alg_expr.bool Locality.annot option + * ('pattern, 'id) Alg_expr.bool Loc.annoted option * ('pattern, 'mixture, 'id, 'rule) modif_expr list - * ('pattern, 'id) Alg_expr.bool Locality.annot option) - Locality.annot + * ('pattern, 'id) Alg_expr.bool Loc.annoted option) + Loc.annoted -type configuration = string Locality.annot * string Locality.annot list +type configuration = string Loc.annoted * string Loc.annoted list type ('pattern, 'id) variable_def = - string Locality.annot * ('pattern, 'id) Alg_expr.e Locality.annot + string Loc.annoted * ('pattern, 'id) Alg_expr.e Loc.annoted type ('mixture, 'id) init_t = - | INIT_MIX of 'mixture Locality.annot - | INIT_TOK of 'id Locality.annot list + | INIT_MIX of 'mixture Loc.annoted + | INIT_TOK of 'id Loc.annoted list -type ('pattern, 'mixture, 'id) init_statment = - (* string Locality.annot option * (*volume*)*) - ('pattern, 'id) Alg_expr.e Locality.annot * ('mixture, 'id) init_t +type ('pattern, 'mixture, 'id) init_statement = + (* string Loc.annoted option * (*volume*)*) + ('pattern, 'id) Alg_expr.e Loc.annoted * ('mixture, 'id) init_t type ('agent, 'pattern, 'mixture, 'id, 'rule) instruction = | SIG of 'agent - | TOKENSIG of string Locality.annot + | TOKENSIG of string Loc.annoted | VOLSIG of string * float * string (* type, volume, parameter*) - | INIT of ('pattern, 'mixture, 'id) init_statment + | INIT of ('pattern, 'mixture, 'id) init_statement (*volume, init, position *) | DECLARE of ('pattern, 'id) variable_def | OBS of ('pattern, 'id) variable_def (*for backward compatibility*) - | PLOT of ('pattern, 'id) Alg_expr.e Locality.annot + | PLOT of ('pattern, 'id) Alg_expr.e Loc.annoted | PERT of ('pattern, 'mixture, 'id, 'rule) perturbation | CONFIG of configuration - | RULE of (string Locality.annot option * 'rule Locality.annot) + | RULE of (string Loc.annoted option * 'rule Loc.annoted) type ('pattern, 'mixture, 'id, 'rule) command = - | RUN of ('pattern, 'id) Alg_expr.bool Locality.annot + | RUN of ('pattern, 'id) Alg_expr.bool Loc.annoted | MODIFY of ('pattern, 'mixture, 'id, 'rule) modif_expr list | QUIT type ('agent, 'pattern, 'mixture, 'id, 'rule) compil = { filenames: string list; variables: ('pattern, 'id) variable_def list; - (*pattern declaration for reusing as variable in perturbations - or kinetic rate*) - signatures: 'agent list; (*agent signature declaration*) - rules: (string Locality.annot option * 'rule Locality.annot) list; - (*rules (possibly named)*) - observables: ('pattern, 'id) Alg_expr.e Locality.annot list; - (*list of patterns to plot*) - init: ('pattern, 'mixture, 'id) init_statment list; - (*initial graph declaration*) + (** pattern declaration for reusing as variable in perturbations + or kinetic rate *) + signatures: 'agent list; (** agent signature declaration *) + rules: (string Loc.annoted option * 'rule Loc.annoted) list; + (** rules (possibly named): [name_option * rule_definition] *) + observables: ('pattern, 'id) Alg_expr.e Loc.annoted list; + (** list of patterns to plot *) + init: ('pattern, 'mixture, 'id) init_statement list; + (** initial graph declaration *) perturbations: ('pattern, 'mixture, 'id, 'rule) perturbation list; configurations: configuration list; - tokens: string Locality.annot list; + tokens: string Loc.annoted list; volumes: (string * float * string) list; } @@ -163,16 +171,16 @@ let no_more_site_on_right error left right = List.exists (function | Counter _ -> false - | Port p' -> fst p.port_nme = fst p'.port_nme) + | Port p' -> fst p.port_name = fst p'.port_name) left || let () = if error then raise (ExceptionDefn.Malformed_Decl - ( "Site '" ^ fst p.port_nme + ( "Site '" ^ fst p.port_name ^ "' was not mentionned in the left-hand side.", - snd p.port_nme )) + snd p.port_name )) in false) right @@ -232,11 +240,11 @@ let print_ast_internal mod_i f l = mod_i let print_ast_port f p = - Format.fprintf f "%s%a%a" (fst p.port_nme) + Format.fprintf f "%s%a%a" (fst p.port_name) (print_ast_internal p.port_int_mod) p.port_int - (print_ast_link p.port_lnk_mod) - p.port_lnk + (print_ast_link p.port_link_mod) + p.port_link let print_counter_test f = function | CEQ x, _ -> Format.fprintf f "=%i" x @@ -250,27 +258,27 @@ let print_counter_delta test f (delta, _) = test delta let print_counter f c = - Format.fprintf f "%s{%a%a}" (fst c.count_nme) + Format.fprintf f "%s{%a%a}" (fst c.counter_name) (Pp.option ~with_space:false print_counter_test) - c.count_test - (print_counter_delta c.count_test) - c.count_delta + c.counter_test + (print_counter_delta c.counter_test) + c.counter_delta let print_ast_site f = function | Port p -> print_ast_port f p | Counter c -> print_counter f c let string_annot_to_json filenames = - Locality.annot_to_yojson ~filenames JsonUtil.of_string + Loc.yojson_of_annoted ~filenames JsonUtil.of_string -let string_annot_of_json filenames = - Locality.annot_of_yojson ~filenames (JsonUtil.to_string ?error_msg:None) +let string_annoted_of_json filenames = + Loc.annoted_of_yojson ~filenames (JsonUtil.to_string ?error_msg:None) let string_option_annot_to_json filenames = - Locality.annot_to_yojson ~filenames (JsonUtil.of_option JsonUtil.of_string) + Loc.yojson_of_annoted ~filenames (JsonUtil.of_option JsonUtil.of_string) -let string_option_annot_of_json filenames = - Locality.annot_of_yojson ~filenames +let string_option_annoted_of_json filenames = + Loc.annoted_of_yojson ~filenames (JsonUtil.to_option (JsonUtil.to_string ?error_msg:None)) let counter_test_to_json = function @@ -294,14 +302,14 @@ let port_to_json filenames p = let mod_l = JsonUtil.of_option (function | None -> `String "FREE" - | Some x -> Locality.annot_to_yojson ~filenames JsonUtil.of_int x) + | Some x -> Loc.yojson_of_annoted ~filenames JsonUtil.of_int x) in let mod_i = - JsonUtil.of_option (Locality.annot_to_yojson ~filenames JsonUtil.of_string) + JsonUtil.of_option (Loc.yojson_of_annoted ~filenames JsonUtil.of_string) in JsonUtil.smart_assoc [ - "port_nme", string_annot_to_json filenames p.port_nme; + "port_name", string_annot_to_json filenames p.port_name; ( "port_int", JsonUtil.smart_assoc [ @@ -311,18 +319,18 @@ let port_to_json filenames p = p.port_int ); "mod", mod_i p.port_int_mod; ] ); - ( "port_lnk", + ( "port_link", JsonUtil.smart_assoc [ ( "state", JsonUtil.of_list - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (LKappa.link_to_json (fun _ -> string_annot_to_json filenames) (string_annot_to_json filenames) (fun () -> []))) - p.port_lnk ); - "mod", mod_l p.port_lnk_mod; + p.port_link ); + "mod", mod_l p.port_link_mod; ] ); ] @@ -332,34 +340,32 @@ let build_port_of_json filenames n i l = | `String "FREE" -> None | x -> Some - (Locality.annot_of_yojson ~filenames - (JsonUtil.to_int ?error_msg:None) - x)) + (Loc.annoted_of_yojson ~filenames (JsonUtil.to_int ?error_msg:None) x)) in let mod_i = JsonUtil.to_option - (Locality.annot_of_yojson ~filenames (JsonUtil.to_string ?error_msg:None)) + (Loc.annoted_of_yojson ~filenames (JsonUtil.to_string ?error_msg:None)) in let port_int, port_int_mod = match i with | `Assoc [] | `Null -> [], None | `Assoc [ ("state", i) ] -> - JsonUtil.to_list (string_option_annot_of_json filenames) i, None + JsonUtil.to_list (string_option_annoted_of_json filenames) i, None | `Assoc [ ("mod", m) ] -> [], mod_i m | `Assoc [ ("state", i); ("mod", m) ] | `Assoc [ ("mod", m); ("state", i) ] -> - JsonUtil.to_list (string_option_annot_of_json filenames) i, mod_i m + JsonUtil.to_list (string_option_annoted_of_json filenames) i, mod_i m | _ -> raise (Yojson.Basic.Util.Type_error ("Not internal states", i)) in - let port_lnk, port_lnk_mod = + let port_link, port_link_mod = match l with | `Assoc [] | `Null -> [], None | `Assoc [ ("state", l) ] -> ( JsonUtil.to_list - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (LKappa.link_of_json - (fun _ -> string_annot_of_json filenames) - (string_annot_of_json filenames) + (fun _ -> string_annoted_of_json filenames) + (string_annoted_of_json filenames) (fun _ -> ()))) l, None ) @@ -367,10 +373,10 @@ let build_port_of_json filenames n i l = | `Assoc [ ("state", l); ("mod", m) ] | `Assoc [ ("mod", m); ("state", l) ] -> ( JsonUtil.to_list - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (LKappa.link_of_json - (fun _ -> string_annot_of_json filenames) - (string_annot_of_json filenames) + (fun _ -> string_annoted_of_json filenames) + (string_annoted_of_json filenames) (fun _ -> ()))) l, mod_l m ) @@ -378,45 +384,45 @@ let build_port_of_json filenames n i l = in Port { - port_nme = string_annot_of_json filenames n; + port_name = string_annoted_of_json filenames n; port_int; port_int_mod; - port_lnk; - port_lnk_mod; + port_link; + port_link_mod; } let site_of_json filenames = function - | `Assoc [ ("count_nme", n); ("count_test", t); ("count_delta", d) ] - | `Assoc [ ("count_nme", n); ("count_delta", d); ("count_test", t) ] - | `Assoc [ ("count_test", t); ("count_nme", n); ("count_delta", d) ] - | `Assoc [ ("count_test", t); ("count_delta", d); ("count_nme", n) ] - | `Assoc [ ("count_delta", d); ("count_nme", n); ("count_test", t) ] - | `Assoc [ ("count_delta", d); ("count_test", t); ("count_nme", n) ] -> + | `Assoc [ ("counter_name", n); ("counter_test", t); ("counter_delta", d) ] + | `Assoc [ ("counter_name", n); ("counter_delta", d); ("counter_test", t) ] + | `Assoc [ ("counter_test", t); ("counter_name", n); ("counter_delta", d) ] + | `Assoc [ ("counter_test", t); ("counter_delta", d); ("counter_name", n) ] + | `Assoc [ ("counter_delta", d); ("counter_name", n); ("counter_test", t) ] + | `Assoc [ ("counter_delta", d); ("counter_test", t); ("counter_name", n) ] -> Counter { - count_nme = - Locality.annot_of_yojson ~filenames Yojson.Basic.Util.to_string n; - count_test = + counter_name = + Loc.annoted_of_yojson ~filenames Yojson.Basic.Util.to_string n; + counter_test = JsonUtil.to_option - (Locality.annot_of_yojson ~filenames counter_test_of_json) + (Loc.annoted_of_yojson ~filenames counter_test_of_json) t; - count_delta = - Locality.annot_of_yojson ~filenames Yojson.Basic.Util.to_int d; + counter_delta = + Loc.annoted_of_yojson ~filenames Yojson.Basic.Util.to_int d; } - | `Assoc [ ("port_nme", n); ("port_int", i); ("port_lnk", l) ] - | `Assoc [ ("port_nme", n); ("port_lnk", l); ("port_int", i) ] - | `Assoc [ ("port_int", i); ("port_nme", n); ("port_lnk", l) ] - | `Assoc [ ("port_lnk", l); ("port_nme", n); ("port_int", i) ] - | `Assoc [ ("port_int", i); ("port_lnk", l); ("port_nme", n) ] - | `Assoc [ ("port_lnk", l); ("port_int", i); ("port_nme", n) ] -> + | `Assoc [ ("port_name", n); ("port_int", i); ("port_link", l) ] + | `Assoc [ ("port_name", n); ("port_link", l); ("port_int", i) ] + | `Assoc [ ("port_int", i); ("port_name", n); ("port_link", l) ] + | `Assoc [ ("port_link", l); ("port_name", n); ("port_int", i) ] + | `Assoc [ ("port_int", i); ("port_link", l); ("port_name", n) ] + | `Assoc [ ("port_link", l); ("port_int", i); ("port_name", n) ] -> build_port_of_json filenames n i l - | `Assoc [ ("port_nme", n); ("port_int", i) ] - | `Assoc [ ("port_int", i); ("port_nme", n) ] -> + | `Assoc [ ("port_name", n); ("port_int", i) ] + | `Assoc [ ("port_int", i); ("port_name", n) ] -> build_port_of_json filenames n i `Null - | `Assoc [ ("port_nme", n); ("port_lnk", l) ] - | `Assoc [ ("port_lnk", l); ("port_nme", n) ] -> + | `Assoc [ ("port_name", n); ("port_link", l) ] + | `Assoc [ ("port_link", l); ("port_name", n) ] -> build_port_of_json filenames n `Null l - | `Assoc [ ("port_nme", n) ] -> build_port_of_json filenames n `Null `Null + | `Assoc [ ("port_name", n) ] -> build_port_of_json filenames n `Null `Null | x -> raise (Yojson.Basic.Util.Type_error ("Not an AST agent", x)) let site_to_json filenames = function @@ -424,36 +430,37 @@ let site_to_json filenames = function | Counter c -> `Assoc [ - ( "count_nme", - Locality.annot_to_yojson ~filenames JsonUtil.of_string c.count_nme ); - ( "count_test", + ( "counter_name", + Loc.yojson_of_annoted ~filenames JsonUtil.of_string c.counter_name ); + ( "counter_test", JsonUtil.of_option - (Locality.annot_to_yojson ~filenames counter_test_to_json) - c.count_test ); - ( "count_delta", - Locality.annot_to_yojson ~filenames JsonUtil.of_int c.count_delta ); + (Loc.yojson_of_annoted ~filenames counter_test_to_json) + c.counter_test ); + ( "counter_delta", + Loc.yojson_of_annoted ~filenames JsonUtil.of_int c.counter_delta ); ] let print_agent_mod f = function | Create -> Format.pp_print_string f "+" | Erase -> Format.pp_print_string f "-" + | NoMod -> Format.pp_print_string f "" let print_ast_agent f = function | Absent _ -> Format.pp_print_string f "." - | Present ((ag_na, _), l, m) -> - Format.fprintf f "%s(%a)%a" ag_na + | Present ((agent_name, _), l, m) -> + Format.fprintf f "%s(%a)%a" agent_name (Pp.list (fun f -> Format.fprintf f " ") print_ast_site) - l - (Pp.option ~with_space:false print_agent_mod) - m + l print_agent_mod m let agent_mod_to_yojson = function | Create -> `String "created" | Erase -> `String "erase" + | NoMod -> `String "no_mod" let agent_mod_of_yojson = function | `String "created" -> Create | `String "erase" -> Erase + | `String "no_mod" -> NoMod | x -> raise (Yojson.Basic.Util.Type_error ("Incorrect agent modification", x)) @@ -462,13 +469,13 @@ let agent_to_json filenames = function | Present (na, l, m) -> JsonUtil.smart_assoc [ - "name", Locality.annot_to_yojson ~filenames JsonUtil.of_string na; + "name", Loc.yojson_of_annoted ~filenames JsonUtil.of_string na; "sig", JsonUtil.of_list (site_to_json filenames) l; - "mod", (JsonUtil.of_option agent_mod_to_yojson) m; + "mod", agent_mod_to_yojson m; ] let agent_of_json filenames = function - | `Null -> Absent Locality.dummy + | `Null -> Absent Loc.dummy | `Assoc [ ("name", n); ("sig", s); ("mod", m) ] | `Assoc [ ("sig", s); ("name", n); ("mod", m) ] | `Assoc [ ("name", n); ("mod", m); ("sig", s) ] @@ -476,32 +483,24 @@ let agent_of_json filenames = function | `Assoc [ ("mod", m); ("name", n); ("sig", s) ] | `Assoc [ ("mod", m); ("sig", s); ("name", n) ] -> Present - ( Locality.annot_of_yojson ~filenames - (JsonUtil.to_string ?error_msg:None) - n, + ( Loc.annoted_of_yojson ~filenames (JsonUtil.to_string ?error_msg:None) n, JsonUtil.to_list (site_of_json filenames) s, - (JsonUtil.to_option agent_mod_of_yojson) m ) + agent_mod_of_yojson m ) | `Assoc [ ("name", n); ("mod", m) ] | `Assoc [ ("mod", m); ("name", n) ] -> Present - ( Locality.annot_of_yojson ~filenames - (JsonUtil.to_string ?error_msg:None) - n, + ( Loc.annoted_of_yojson ~filenames (JsonUtil.to_string ?error_msg:None) n, [], - (JsonUtil.to_option agent_mod_of_yojson) m ) + agent_mod_of_yojson m ) | `Assoc [ ("name", n); ("sig", s) ] | `Assoc [ ("sig", s); ("name", n) ] -> Present - ( Locality.annot_of_yojson ~filenames - (JsonUtil.to_string ?error_msg:None) - n, + ( Loc.annoted_of_yojson ~filenames (JsonUtil.to_string ?error_msg:None) n, JsonUtil.to_list (site_of_json filenames) s, - None ) + NoMod ) | `Assoc [ ("name", n) ] -> Present - ( Locality.annot_of_yojson ~filenames - (JsonUtil.to_string ?error_msg:None) - n, + ( Loc.annoted_of_yojson ~filenames (JsonUtil.to_string ?error_msg:None) n, [], - None ) + NoMod ) | x -> raise (Yojson.Basic.Util.Type_error ("Not an AST agent", x)) let print_ast_mix = @@ -511,13 +510,13 @@ let to_erased_mixture = List.map (List.map (function | Absent pos -> Absent pos - | Present (n, s, _) -> Present (n, s, Some Erase))) + | Present (n, s, _) -> Present (n, s, Erase))) let to_created_mixture = List.map (List.map (function | Absent pos -> Absent pos - | Present (n, s, _) -> Present (n, s, Some Create))) + | Present (n, s, _) -> Present (n, s, Create))) let to_dummy_user_link = function | [] | [ (LKappa.LNK_ANY, _) ] -> User_graph.WHATEVER @@ -535,19 +534,20 @@ let to_dummy_user_internal = function | _ :: _ :: _ as l -> Some (List_util.map_option fst l) let to_dummy_user_site = function - | Port { port_nme; port_int; port_int_mod = _; port_lnk; port_lnk_mod = _ } -> + | Port { port_name; port_int; port_int_mod = _; port_link; port_link_mod = _ } + -> { - User_graph.site_name = fst port_nme; + User_graph.site_name = fst port_name; User_graph.site_type = User_graph.Port { - User_graph.port_links = to_dummy_user_link port_lnk; + User_graph.port_links = to_dummy_user_link port_link; User_graph.port_states = to_dummy_user_internal port_int; }; } - | Counter { count_nme; count_test = _; count_delta = _ } -> + | Counter { counter_name; counter_test = _; counter_delta = _ } -> { - User_graph.site_name = fst count_nme; + User_graph.site_name = fst counter_name; User_graph.site_type = User_graph.Counter (-1); (* TODO *) } @@ -647,22 +647,22 @@ let mixture_to_user_graph m = let init_to_json ~filenames f_mix f_var = function | INIT_MIX m -> - `List [ `String "mixture"; Locality.annot_to_yojson ~filenames f_mix m ] + `List [ `String "mixture"; Loc.yojson_of_annoted ~filenames f_mix m ] | INIT_TOK t -> `List [ `String "token"; - JsonUtil.of_list (Locality.annot_to_yojson ~filenames f_var) t; + JsonUtil.of_list (Loc.yojson_of_annoted ~filenames f_var) t; ] let init_of_json ~filenames f_mix f_var = function | `List [ `String "mixture"; m ] -> - INIT_MIX (Locality.annot_of_yojson ~filenames f_mix m) + INIT_MIX (Loc.annoted_of_yojson ~filenames f_mix m) | `List [ `String "token"; t ] -> INIT_TOK (JsonUtil.to_list ~error_msg:(JsonUtil.build_msg "INIT_TOK") - (Locality.annot_of_yojson ~filenames f_var) + (Loc.annoted_of_yojson ~filenames f_var) t) | x -> raise (Yojson.Basic.Util.Type_error ("Invalid Ast init statement", x)) @@ -861,7 +861,7 @@ let arrow_notation_to_yojson filenames f_mix f_var r = ( "rm_token", JsonUtil.of_list (JsonUtil.of_pair - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var)) (string_annot_to_json filenames)) r.rm_token ); @@ -869,7 +869,7 @@ let arrow_notation_to_yojson filenames f_mix f_var r = ( "add_token", JsonUtil.of_list (JsonUtil.of_pair - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var)) (string_annot_to_json filenames)) r.add_token ); @@ -882,17 +882,17 @@ let arrow_notation_of_yojson filenames f_mix f_var = function rm_token = JsonUtil.to_list (JsonUtil.to_pair - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var)) - (string_annot_of_json filenames)) + (string_annoted_of_json filenames)) (Yojson.Basic.Util.member "rm_token" x); rhs = f_mix (Yojson.Basic.Util.member "rhs" x); add_token = JsonUtil.to_list (JsonUtil.to_pair - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var)) - (string_annot_of_json filenames)) + (string_annoted_of_json filenames)) (Yojson.Basic.Util.member "add_token" x); } | x -> @@ -908,7 +908,7 @@ let edit_notation_to_yojson filenames r = ( "delta_token", JsonUtil.of_list (JsonUtil.of_pair - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames mix_to_json JsonUtil.of_string)) (string_annot_to_json filenames)) r.delta_token ); @@ -925,10 +925,10 @@ let edit_notation_of_yojson filenames r = delta_token = JsonUtil.to_list (JsonUtil.to_pair - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames mix_of_json (JsonUtil.to_string ?error_msg:None))) - (string_annot_of_json filenames)) + (string_annoted_of_json filenames)) (Yojson.Basic.Util.member "delta_token" x); } | x -> raise (Yojson.Basic.Util.Type_error ("Incorrect AST edit_notation", x)) @@ -950,30 +950,30 @@ let rule_to_json filenames f_mix f_var r = "rewrite", rule_content_to_yojson filenames f_mix f_var r.rewrite; "bidirectional", `Bool r.bidirectional; ( "k_def", - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var) r.k_def ); ( "k_un", JsonUtil.of_option (JsonUtil.of_pair - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var)) (JsonUtil.of_option - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var)))) r.k_un ); ( "k_op", JsonUtil.of_option - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var)) r.k_op ); ( "k_op_un", JsonUtil.of_option (JsonUtil.of_pair - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var)) (JsonUtil.of_option - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var)))) r.k_op_un ); ] @@ -989,30 +989,30 @@ let rule_of_json filenames f_mix f_var = function Yojson.Basic.Util.to_bool (Yojson.Basic.Util.member "bidirectional" x); k_def = - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var) (Yojson.Basic.Util.member "k_def" x); k_un = JsonUtil.to_option (JsonUtil.to_pair - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var)) (JsonUtil.to_option - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var)))) (Yojson.Basic.Util.member "k_un" x); k_op = JsonUtil.to_option - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var)) (Yojson.Basic.Util.member "k_op" x); k_op_un = JsonUtil.to_option (JsonUtil.to_pair - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var)) (JsonUtil.to_option - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var)))) (Yojson.Basic.Util.member "k_op_un" x); } @@ -1025,19 +1025,17 @@ let modif_to_json filenames f_mix f_var = function `List [ `String "APPLY"; - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var) alg; - Locality.annot_to_yojson ~filenames - (rule_to_json filenames f_mix f_var) - r; + Loc.yojson_of_annoted ~filenames (rule_to_json filenames f_mix f_var) r; ] | UPDATE (id, alg) -> `List [ `String "UPDATE"; - Locality.annot_to_yojson ~filenames f_var id; - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames f_var id; + Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var) alg; ] @@ -1068,8 +1066,7 @@ let modif_to_json filenames f_mix f_var = function | CFLOWLABEL (b, id) -> `List [ `String "CFLOWLABEL"; `Bool b; string_annot_to_json filenames id ] | CFLOWMIX (b, m) -> - `List - [ `String "CFLOW"; `Bool b; Locality.annot_to_yojson ~filenames f_mix m ] + `List [ `String "CFLOW"; `Bool b; Loc.yojson_of_annoted ~filenames f_mix m ] | DIN (b, file) -> `List [ @@ -1092,22 +1089,22 @@ let modif_to_json filenames f_mix f_var = function JsonUtil.of_list (Primitives.print_expr_to_yojson ~filenames f_mix f_var) l; - Locality.annot_to_yojson ~filenames f_mix m; + Loc.yojson_of_annoted ~filenames f_mix m; ] let modif_of_json filenames f_mix f_var = function | `List [ `String "APPLY"; alg; mix ] -> APPLY - ( Locality.annot_of_yojson ~filenames + ( Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var) alg, - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (rule_of_json filenames f_mix f_var) mix ) | `List [ `String "UPDATE"; id; alg ] -> UPDATE - ( Locality.annot_of_yojson ~filenames f_var id, - Locality.annot_of_yojson ~filenames + ( Loc.annoted_of_yojson ~filenames f_var id, + Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var) alg ) | `List (`String "STOP" :: l) -> @@ -1129,9 +1126,9 @@ let modif_of_json filenames f_mix f_var = function expr ) | `String "PLOTENTRY" -> PLOTENTRY | `List [ `String "CFLOWLABEL"; `Bool b; id ] -> - CFLOWLABEL (b, string_annot_of_json filenames id) + CFLOWLABEL (b, string_annoted_of_json filenames id) | `List [ `String "CFLOW"; `Bool b; m ] -> - CFLOWMIX (b, Locality.annot_of_yojson ~filenames f_mix m) + CFLOWMIX (b, Loc.annoted_of_yojson ~filenames f_mix m) | `List [ `String "DIN"; b; file ] -> DIN ( Primitives.din_kind_of_yojson b, @@ -1147,7 +1144,7 @@ let modif_of_json filenames f_mix f_var = function JsonUtil.to_list (Primitives.print_expr_of_yojson ~filenames f_mix f_var) file, - Locality.annot_of_yojson ~filenames f_mix m ) + Loc.annoted_of_yojson ~filenames f_mix m ) | x -> raise (Yojson.Basic.Util.Type_error ("Invalid modification", x)) let merge_internal_mod acc = function @@ -1174,12 +1171,12 @@ let merge_internals = let rec merge_sites_counter c = function | [] -> [ Counter c ] - | Counter c' :: _ as l when fst c.count_nme = fst c'.count_nme -> l + | Counter c' :: _ as l when fst c.counter_name = fst c'.counter_name -> l | ((Port _ | Counter _) as h) :: t -> h :: merge_sites_counter c t let rec merge_sites_port p = function - | [] -> [ Port { p with port_lnk = [] } ] - | Port h :: t when fst p.port_nme = fst h.port_nme -> + | [] -> [ Port { p with port_link = [] } ] + | Port h :: t when fst p.port_name = fst h.port_name -> Port { h with @@ -1208,13 +1205,13 @@ let merge_agents = ( x, List.map (function - | Port p -> Port { p with port_lnk = [] } + | Port p -> Port { p with port_link = [] } | Counter _ as x -> x) s, - None ); + NoMod ); ] | Present ((na', _), s', _) :: t when String.compare na na' = 0 -> - Present (x, merge_sites s' s, None) :: t + Present (x, merge_sites s' s, NoMod) :: t | ((Present _ | Absent _) as h) :: t -> h :: aux t in aux acc)) @@ -1262,7 +1259,7 @@ let sig_from_perts = p) acc p) -let implicit_signature r = +let infer_agent_signatures r = let acc = sig_from_inits (r.signatures, r.tokens) r.init in let acc' = sig_from_rules acc r.rules in let ags, toks = sig_from_perts acc' r.perturbations in @@ -1278,49 +1275,49 @@ let split_mixture m = | Absent _ -> pack | Present (((_, pos) as na), intf, modif) -> (match modif with - | Some Create -> - Absent pos :: lhs, Present (na, intf, None) :: rhs - | Some Erase -> Present (na, intf, None) :: lhs, Absent pos :: rhs - | None -> + | Create -> Absent pos :: lhs, Present (na, intf, NoMod) :: rhs + | Erase -> Present (na, intf, NoMod) :: lhs, Absent pos :: rhs + | NoMod -> let intfl, intfr = List.fold_left (fun (l, r) -> function | Port p -> ( Port { - port_nme = p.port_nme; + port_name = p.port_name; port_int = p.port_int; port_int_mod = None; - port_lnk = p.port_lnk; - port_lnk_mod = None; + port_link = p.port_link; + port_link_mod = None; } :: l, Port { - port_nme = p.port_nme; + port_name = p.port_name; port_int = (match p.port_int_mod with | None -> p.port_int | Some (x, pos) -> [ Some x, pos ]); port_int_mod = None; - port_lnk = - (match p.port_lnk_mod with - | None -> p.port_lnk + port_link = + (match p.port_link_mod with + | None -> p.port_link | Some None -> - [ Locality.dummy_annot LKappa.LNK_FREE ] + [ Loc.annot_with_dummy LKappa.LNK_FREE ] | Some (Some (i, pos)) -> [ LKappa.LNK_VALUE (i, ()), pos ]); - port_lnk_mod = None; + port_link_mod = None; } :: r ) | Counter c -> - ( Counter { c with count_delta = Locality.dummy_annot 0 } + ( Counter + { c with counter_delta = Loc.annot_with_dummy 0 } :: l, - Counter { c with count_test = None } :: r )) + Counter { c with counter_test = None } :: r )) ([], []) intf in - ( Present (na, intfl, None) :: lhs, - Present (na, intfr, None) :: rhs ))) + ( Present (na, intfl, NoMod) :: lhs, + Present (na, intfr, NoMod) :: rhs ))) l ([], []) in ll :: lhs, rr :: rhs) @@ -1348,36 +1345,36 @@ let compil_to_json c = JsonUtil.of_list (JsonUtil.of_pair (string_annot_to_json filenames) - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames mix_to_json var_to_json))) c.variables ); ( "rules", JsonUtil.of_list (JsonUtil.of_pair (JsonUtil.of_option (string_annot_to_json filenames)) - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (rule_to_json filenames mix_to_json var_to_json))) c.rules ); ( "observables", JsonUtil.of_list - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames mix_to_json var_to_json)) c.observables ); ( "init", JsonUtil.of_list (JsonUtil.of_pair - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames mix_to_json var_to_json)) (init_to_json ~filenames mix_to_json var_to_json)) c.init ); ( "perturbations", JsonUtil.of_list - (Locality.annot_to_yojson ~filenames (fun (alarm, pre, modif, post) -> + (Loc.yojson_of_annoted ~filenames (fun (alarm, pre, modif, post) -> `List [ JsonUtil.of_option Nbr.to_yojson alarm; JsonUtil.of_option - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.bool_to_yojson ~filenames mix_to_json var_to_json)) pre; @@ -1385,7 +1382,7 @@ let compil_to_json c = (modif_to_json filenames mix_to_json var_to_json) modif; JsonUtil.of_option - (Locality.annot_to_yojson ~filenames + (Loc.yojson_of_annoted ~filenames (Alg_expr.bool_to_yojson ~filenames mix_to_json var_to_json)) post; @@ -1421,46 +1418,46 @@ let compil_of_json = function tokens = JsonUtil.to_list ~error_msg:(JsonUtil.build_msg "AST token sig") - (string_annot_of_json filenames) + (string_annoted_of_json filenames) (List.assoc "tokens" l); variables = JsonUtil.to_list ~error_msg:(JsonUtil.build_msg "AST variables") (JsonUtil.to_pair - (string_annot_of_json filenames) - (Locality.annot_of_yojson ~filenames + (string_annoted_of_json filenames) + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames mix_of_json var_of_json))) (List.assoc "variables" l); rules = JsonUtil.to_list ~error_msg:(JsonUtil.build_msg "AST rules") (JsonUtil.to_pair - (JsonUtil.to_option (string_annot_of_json filenames)) - (Locality.annot_of_yojson ~filenames + (JsonUtil.to_option (string_annoted_of_json filenames)) + (Loc.annoted_of_yojson ~filenames (rule_of_json filenames mix_of_json var_of_json))) (List.assoc "rules" l); observables = JsonUtil.to_list ~error_msg:(JsonUtil.build_msg "AST observables") - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames mix_of_json var_of_json)) (List.assoc "observables" l); init = JsonUtil.to_list ~error_msg:(JsonUtil.build_msg "AST init") (JsonUtil.to_pair - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames mix_of_json var_of_json)) (init_of_json ~filenames mix_of_json var_of_json)) (List.assoc "init" l); perturbations = JsonUtil.to_list ~error_msg:(JsonUtil.build_msg "AST perturbations") - (Locality.annot_of_yojson ~filenames (function + (Loc.annoted_of_yojson ~filenames (function | `List [ alarm; pre; modif; post ] -> ( JsonUtil.to_option Nbr.of_yojson alarm, JsonUtil.to_option - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.bool_of_yojson ~filenames mix_of_json var_of_json)) pre, @@ -1468,7 +1465,7 @@ let compil_of_json = function (modif_of_json filenames mix_of_json var_of_json) modif, JsonUtil.to_option - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.bool_of_yojson ~filenames mix_of_json var_of_json)) post ) @@ -1479,8 +1476,8 @@ let compil_of_json = function JsonUtil.to_list ~error_msg:(JsonUtil.build_msg "AST configuration") (JsonUtil.to_pair - (string_annot_of_json filenames) - (JsonUtil.to_list (string_annot_of_json filenames))) + (string_annoted_of_json filenames) + (JsonUtil.to_list (string_annoted_of_json filenames))) (List.assoc "configurations" l); volumes = []; } diff --git a/core/grammar/ast.mli b/core/grammar/ast.mli index a56af3d91b..17dfe6663e 100644 --- a/core/grammar/ast.mli +++ b/core/grammar/ast.mli @@ -11,30 +11,31 @@ type syntax_version = V3 | V4 val merge_version : syntax_version -> syntax_version -> syntax_version -type internal = string option Locality.annot list +type internal = string option Loc.annoted list type port = { - port_nme: string Locality.annot; + port_name: string Loc.annoted; port_int: internal; - port_int_mod: string Locality.annot option; - port_lnk: (string Locality.annot, unit) LKappa.link Locality.annot list; - port_lnk_mod: int Locality.annot option option; + port_int_mod: string Loc.annoted option; + port_link: (string Loc.annoted, unit) LKappa.link Loc.annoted list; + port_link_mod: int Loc.annoted option option; } +(** Describe a port from an agent. [_int] references the internal state of the port, [_link], the possible links that can be made to this port, [_mod] to the changes in a rule that would be made to the state, used only in edit_notation *) type counter_test = CEQ of int | CGTE of int | CVAR of string type counter = { - count_nme: string Locality.annot; - count_test: counter_test Locality.annot option; - count_delta: int Locality.annot; + counter_name: string Loc.annoted; + counter_test: counter_test Loc.annoted option; + counter_delta: int Loc.annoted; } type site = Port of port | Counter of counter -type agent_mod = Erase | Create +type agent_mod = NoMod | Erase | Create type agent = - | Present of string Locality.annot * site list * agent_mod option - | Absent of Locality.t + | Present of string Loc.annoted * site list * agent_mod + | Absent of Loc.t type mixture = agent list list @@ -43,33 +44,35 @@ val mixture_to_user_graph : mixture -> User_graph.connected_component type edit_notation = { mix: mixture; delta_token: - ((mixture, string) Alg_expr.e Locality.annot * string Locality.annot) list; + ((mixture, string) Alg_expr.e Loc.annoted * string Loc.annoted) list; } type arrow_notation = { lhs: mixture; rm_token: - ((mixture, string) Alg_expr.e Locality.annot * string Locality.annot) list; + ((mixture, string) Alg_expr.e Loc.annoted * string Loc.annoted) list; rhs: mixture; add_token: - ((mixture, string) Alg_expr.e Locality.annot * string Locality.annot) list; + ((mixture, string) Alg_expr.e Loc.annoted * string Loc.annoted) list; } type rule_content = Edit of edit_notation | Arrow of arrow_notation type rule = { + (* TODO: is rewrite good naming ? *) rewrite: rule_content; bidirectional: bool; - k_def: (mixture, string) Alg_expr.e Locality.annot; + (* rates *) + k_def: (mixture, string) Alg_expr.e Loc.annoted; k_un: - ((mixture, string) Alg_expr.e Locality.annot - * (mixture, string) Alg_expr.e Locality.annot option) + ((mixture, string) Alg_expr.e Loc.annoted + * (mixture, string) Alg_expr.e Loc.annoted option) option; (*k_1:radius_opt*) - k_op: (mixture, string) Alg_expr.e Locality.annot option; + k_op: (mixture, string) Alg_expr.e Loc.annoted option; k_op_un: - ((mixture, string) Alg_expr.e Locality.annot - * (mixture, string) Alg_expr.e Locality.annot option) + ((mixture, string) Alg_expr.e Loc.annoted + * (mixture, string) Alg_expr.e Loc.annoted option) option; (*rate for backward rule*) } @@ -77,8 +80,8 @@ type rule = { val flip_label : string -> string type ('pattern, 'mixture, 'id, 'rule) modif_expr = - | APPLY of (('pattern, 'id) Alg_expr.e Locality.annot * 'rule Locality.annot) - | UPDATE of ('id Locality.annot * ('pattern, 'id) Alg_expr.e Locality.annot) + | APPLY of (('pattern, 'id) Alg_expr.e Loc.annoted * 'rule Loc.annoted) + | UPDATE of ('id Loc.annoted * ('pattern, 'id) Alg_expr.e Loc.annoted) (*TODO: pause*) | STOP of ('pattern, 'id) Alg_expr.e Primitives.print_expr list | SNAPSHOT of bool * ('pattern, 'id) Alg_expr.e Primitives.print_expr list @@ -87,8 +90,8 @@ type ('pattern, 'mixture, 'id, 'rule) modif_expr = ('pattern, 'id) Alg_expr.e Primitives.print_expr list * ('pattern, 'id) Alg_expr.e Primitives.print_expr list | PLOTENTRY - | CFLOWLABEL of (bool * string Locality.annot) - | CFLOWMIX of (bool * 'pattern Locality.annot) + | CFLOWLABEL of (bool * string Loc.annoted) + | CFLOWMIX of (bool * 'pattern Loc.annoted) | DIN of Primitives.din_kind * ('pattern, 'id) Alg_expr.e Primitives.print_expr list @@ -96,58 +99,58 @@ type ('pattern, 'mixture, 'id, 'rule) modif_expr = | SPECIES_OF of bool * ('pattern, 'id) Alg_expr.e Primitives.print_expr list - * 'pattern Locality.annot + * 'pattern Loc.annoted type ('pattern, 'mixture, 'id, 'rule) perturbation = (Nbr.t option - * ('pattern, 'id) Alg_expr.bool Locality.annot option + * ('pattern, 'id) Alg_expr.bool Loc.annoted option * ('pattern, 'mixture, 'id, 'rule) modif_expr list - * ('pattern, 'id) Alg_expr.bool Locality.annot option) - Locality.annot + * ('pattern, 'id) Alg_expr.bool Loc.annoted option) + Loc.annoted -type configuration = string Locality.annot * string Locality.annot list +type configuration = string Loc.annoted * string Loc.annoted list type ('pattern, 'id) variable_def = - string Locality.annot * ('pattern, 'id) Alg_expr.e Locality.annot + string Loc.annoted * ('pattern, 'id) Alg_expr.e Loc.annoted type ('mixture, 'id) init_t = - | INIT_MIX of 'mixture Locality.annot - | INIT_TOK of 'id Locality.annot list + | INIT_MIX of 'mixture Loc.annoted + | INIT_TOK of 'id Loc.annoted list -type ('pattern, 'mixture, 'id) init_statment = - ('pattern, 'id) Alg_expr.e Locality.annot * ('mixture, 'id) init_t +type ('pattern, 'mixture, 'id) init_statement = + ('pattern, 'id) Alg_expr.e Loc.annoted * ('mixture, 'id) init_t type ('agent, 'pattern, 'mixture, 'id, 'rule) instruction = | SIG of 'agent - | TOKENSIG of string Locality.annot - | VOLSIG of string * float * string (* type, volume, parameter*) - | INIT of ('pattern, 'mixture, 'id) init_statment + | TOKENSIG of string Loc.annoted + | VOLSIG of string * float * string (** type, volume, parameter *) + | INIT of ('pattern, 'mixture, 'id) init_statement | DECLARE of ('pattern, 'id) variable_def | OBS of ('pattern, 'id) variable_def (*for backward compatibility*) - | PLOT of ('pattern, 'id) Alg_expr.e Locality.annot + | PLOT of ('pattern, 'id) Alg_expr.e Loc.annoted | PERT of ('pattern, 'mixture, 'id, 'rule) perturbation | CONFIG of configuration - | RULE of (string Locality.annot option * 'rule Locality.annot) + | RULE of (string Loc.annoted option * 'rule Loc.annoted) type ('pattern, 'mixture, 'id, 'rule) command = - | RUN of ('pattern, 'id) Alg_expr.bool Locality.annot + | RUN of ('pattern, 'id) Alg_expr.bool Loc.annoted | MODIFY of ('pattern, 'mixture, 'id, 'rule) modif_expr list | QUIT type ('agent, 'pattern, 'mixture, 'id, 'rule) compil = { filenames: string list; variables: ('pattern, 'id) variable_def list; - (*pattern declaration for reusing as variable in perturbations or kinetic rate*) - signatures: 'agent list; (**agent signature declaration*) - rules: (string Locality.annot option * 'rule Locality.annot) list; + (** pattern declaration for reusing as variable in perturbations or kinetic rate *) + signatures: 'agent list; (** agent signature declarations *) + rules: (string Loc.annoted option * 'rule Loc.annoted) list; (**rules (possibly named)*) - observables: ('pattern, 'id) Alg_expr.e Locality.annot list; - (*list of patterns to plot*) - init: ('pattern, 'mixture, 'id) init_statment list; - (*initial graph declaration*) + observables: ('pattern, 'id) Alg_expr.e Loc.annoted list; + (** list of patterns to plot *) + init: ('pattern, 'mixture, 'id) init_statement list; + (** initial graph declaration *) perturbations: ('pattern, 'mixture, 'id, 'rule) perturbation list; configurations: configuration list; - tokens: string Locality.annot list; + tokens: string Loc.annoted list; volumes: (string * float * string) list; } @@ -160,8 +163,8 @@ val no_more_site_on_right : bool -> site list -> site list -> bool val split_mixture : mixture -> mixture * mixture (** @return (lhs,rhs) *) -val implicit_signature : parsing_compil -> parsing_compil -(** Infer agent signatures and tokens from init, rules and perturbations *) +val infer_agent_signatures : parsing_compil -> parsing_compil +(** Used when agent signatures is implicit: infer agent signatures and tokens from init, rules and perturbations *) (** {6 Printers} *) diff --git a/core/grammar/counters_compiler.ml b/core/grammar/counters_compiler.ml index 12af72f04e..bafc63bf45 100644 --- a/core/grammar/counters_compiler.ml +++ b/core/grammar/counters_compiler.ml @@ -6,12 +6,23 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) -type 'a rule_agent_counters = { - ra: 'a; - ra_counters: (Ast.counter * LKappa.switching) option array; +type 'a with_agent_counters = { + agent: 'a; + counters: (Ast.counter * LKappa.switching) option array; } -let combinations ls1 ls2 = +type rule_mixture_with_agent_counters = + LKappa.rule_agent with_agent_counters list + +type raw_mixture_with_agent_counters = + Raw_mixture.agent with_agent_counters list + +(** [combinations_of_var_setup ls1 ls2] + * Each element of [ls1] describes a setup of counter variables, with the first element of the tuple being the list of entities to be used in the model, where variables have been removed from counters, and the second one the mapping of variables to their values, that allows to know which instance of model entities would be chosen in this given setup. + * [ls2] adds a new entity with different kinds according to the variable values given in the list as second member of the tuple, which is then combined in this function with the other setups, combining the different variable values which those already defined. + * No check is done on the unicity of the described variables and their values *) +let combinations_of_var_setup (ls1 : ('a list * 'b list) list) + (ls2 : ('a * 'b list) list) : ('a list * 'b list) list = if ls1 = [] then List.fold_left (fun acc (b, ds) -> ([ b ], ds) :: acc) [] ls2 else @@ -20,26 +31,27 @@ let combinations ls1 ls2 = List.fold_left (fun acc' (b, ds) -> (b :: a, ds @ cs) :: acc') acc ls2) [] ls1 -let update_rate counters (k, a) = +let update_rate counter_var_values (k, a) = let update_id s k = - let a, _ = - List.partition (fun (s', _) -> String.compare s s' = 0) counters + let counters_matching_s, _ = + List.partition (fun (s', _) -> String.compare s s' = 0) counter_var_values in - match a with + match counters_matching_s with | [ (_, x) ] -> Alg_expr.CONST (Nbr.I x) | [] -> k | _ :: _ -> raise (ExceptionDefn.Malformed_Decl - ("Counter variable " ^ s ^ " appears twice in rule", Locality.dummy)) + ("Counter variable " ^ s ^ " appears twice in rule", Loc.dummy)) in - let rec update_bool k = + let rec update_bool_expr k = match k with | Alg_expr.TRUE | Alg_expr.FALSE -> k | Alg_expr.BIN_BOOL_OP (op, (k1, a1), (k2, a2)) -> - Alg_expr.BIN_BOOL_OP (op, (update_bool k1, a1), (update_bool k2, a2)) + Alg_expr.BIN_BOOL_OP + (op, (update_bool_expr k1, a1), (update_bool_expr k2, a2)) | Alg_expr.UN_BOOL_OP (op, (k, a)) -> - Alg_expr.UN_BOOL_OP (op, (update_bool k, a)) + Alg_expr.UN_BOOL_OP (op, (update_bool_expr k, a)) | Alg_expr.COMPARE_OP (op, (k1, a1), (k2, a2)) -> Alg_expr.COMPARE_OP (op, (update_expr k1, a1), (update_expr k2, a2)) and update_expr k = @@ -50,7 +62,7 @@ let update_rate counters (k, a) = Alg_expr.UN_ALG_OP (op, (update_expr k1, a1)) | Alg_expr.IF ((k1, a1), (k2, a2), (k3, a3)) -> Alg_expr.IF - ((update_bool k1, a1), (update_expr k2, a2), (update_expr k3, a3)) + ((update_bool_expr k1, a1), (update_expr k2, a2), (update_expr k3, a3)) | Alg_expr.DIFF_TOKEN ((k1, a1), k2) -> Alg_expr.DIFF_TOKEN ((update_expr k1, a1), k2) | Alg_expr.DIFF_KAPPA_INSTANCE ((k, a), m) -> @@ -61,7 +73,7 @@ let update_rate counters (k, a) = in update_expr k, a -let collect_ids expr_list expr2_list = +let collect_ids expr_list : Mods.StringSet.t = let rec aux_expr expr acc = match expr with | Alg_expr.BIN_ALG_OP (_, (k1, _), (k2, _)) -> aux_expr k2 (aux_expr k1 acc) @@ -84,19 +96,11 @@ let collect_ids expr_list expr2_list = | Alg_expr.COMPARE_OP (_, (k1, _), (k2, _)) -> aux_expr k2 (aux_expr k1 acc) in List.fold_left - (fun acc expr2_opt -> - match expr2_opt with + (fun acc expr_opt -> + match expr_opt with | None -> acc - | Some ((expr1, _), None) -> aux_expr expr1 acc - | Some ((expr1, _), Some (expr2, _)) -> - aux_expr expr2 (aux_expr expr1 acc)) - (List.fold_left - (fun acc expr_opt -> - match expr_opt with - | None -> acc - | Some (expr, _) -> aux_expr expr acc) - Mods.StringSet.empty expr_list) - expr2_list + | Some (expr, _) -> aux_expr expr acc) + Mods.StringSet.empty expr_list let name_match (s, _) (s', _) = String.compare s s' = 0 @@ -106,8 +110,8 @@ let prepare_agent rsites lsites = | [] -> [ Ast.Counter c ] | hd :: tl -> (match hd with - | Ast.Counter c' when name_match c.Ast.count_nme c'.Ast.count_nme -> - Ast.Counter { c' with Ast.count_delta = c.Ast.count_delta } :: tl + | Ast.Counter c' when name_match c.Ast.counter_name c'.Ast.counter_name -> + Ast.Counter { c' with Ast.counter_delta = c.Ast.counter_delta } :: tl | Ast.Counter _ | Ast.Port _ -> hd :: prepare_site tl c) in let counters = @@ -123,7 +127,7 @@ let prepare_agent rsites lsites = (* - add in the lhs : (i) counters only mentioned in the rhs and (ii) the deltas - syntactic checks of no test in rhs; no modif in lhs *) let prepare_counters rules = - let syntax sites f error = + let check_syntax sites f error = List.iter (function | Ast.Port _ -> () @@ -131,24 +135,23 @@ let prepare_counters rules = if f c then raise (ExceptionDefn.Malformed_Decl - ("Counter " ^ fst c.Ast.count_nme ^ error, snd c.Ast.count_nme))) + ( "Counter " ^ Loc.v c.Ast.counter_name ^ error, + Loc.get_annot c.Ast.counter_name ))) sites in - let rec fold rhs lhs = + let rec prepare_lhs_rule rhs lhs = match rhs, lhs with | Ast.Present (rna, rsites, _) :: r, Ast.Present (lna, lsites, b) :: l -> - let () = - syntax lsites - (fun c -> not (fst c.Ast.count_delta = 0)) - " has a modif in the lhs"; - syntax rsites - (fun c -> not (c.Ast.count_test = None)) - " has a test in the rhs" - in - if String.compare (fst rna) (fst lna) = 0 then ( + check_syntax lsites + (fun c -> not (Loc.v c.counter_delta = 0)) + " has a modif in the lhs"; + check_syntax rsites + (fun c -> not (c.counter_test = None)) + " has a test in the rhs"; + if String.compare (Loc.v rna) (Loc.v lna) = 0 then ( let lsites' = prepare_agent rsites lsites in - Ast.Present (lna, lsites', b) :: fold r l + Ast.Present (lna, lsites', b) :: prepare_lhs_rule r l ) else lhs (*TODO we stop our job here. LKappa_compiler will detect @@ -156,15 +159,13 @@ let prepare_counters rules = | _ :: r, (Ast.Absent _ as lagent) :: l -> (*created agent*) (* TODO Maybe some syntax check on rhs are necessary here *) - lagent :: fold r l + lagent :: prepare_lhs_rule r l | Ast.Absent _ :: r, (Ast.Present (_, lsites, _) as lagent) :: l -> (*deleted agent*) - let () = - syntax lsites - (fun c -> not (fst c.Ast.count_delta = 0)) - " has a modif in the lhs" - in - lagent :: fold r l + check_syntax lsites + (fun c -> not (Loc.v c.Ast.counter_delta = 0)) + " has a modif in the lhs"; + lagent :: prepare_lhs_rule r l | [], x -> x (* TODO x must be [] but it is for now LKappa_compiler @@ -172,18 +173,21 @@ let prepare_counters rules = | _x, [] -> (*TODO let () = assert (_x = []) in*) [] in - let aux r = - match r.Ast.rewrite with - | Ast.Edit _ -> r - | Ast.Arrow a -> + let aux (rule : Ast.rule) : Ast.rule = + match rule.rewrite with + | Ast.Edit _ -> rule + | Ast.Arrow content -> { - r with - Ast.rewrite = + rule with + rewrite = Ast.Arrow { - a with + content with Ast.lhs = - [ fold (List.flatten a.Ast.rhs) (List.flatten a.Ast.lhs) ]; + [ + prepare_lhs_rule (List.flatten content.rhs) + (List.flatten content.lhs); + ]; }; } in @@ -206,253 +210,297 @@ let counters_signature s agents = | Ast.Port _ -> acc) [] sites' -(* c': counter declaration, returns counter in rule*) -let enumerate_counter_tests x a ((delta, _) as count_delta) c' = - let max, _ = c'.Ast.count_delta in - let min = - match c'.Ast.count_test with +(** [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 : Ast.counter) : + (Ast.site * (string * int) list) list = + let max_value : int = Loc.v counter_def.counter_delta in + let min_value : int = + match counter_def.counter_test with | None | Some (Ast.CGTE _, _) | Some (Ast.CVAR _, _) -> raise (ExceptionDefn.Malformed_Decl ( "Invalid counter signature - have to specify min bound", - snd c'.Ast.count_nme )) - | Some (Ast.CEQ min, _) -> min + Loc.get_annot counter_def.counter_name )) + | Some (Ast.CEQ min_value, _) -> min_value in - let rec enum v = - if v > max then + (* Make CEQ counters with all possible values of variable *) + let rec make_ceq_counters_from_var_values (value : int) : + (Ast.site * (string * int) list) list = + if value > max_value then [] - else if v + delta <= max && v + delta >= 0 then + else if + value + Loc.v counter_delta <= max_value + && value + Loc.v counter_delta >= 0 + then ( Ast.Counter { - Ast.count_nme = c'.Ast.count_nme; - count_test = Some (Ast.CEQ v, a); - count_delta; + Ast.counter_name = counter_def.counter_name; + counter_test = Some (Ast.CEQ value, annot); + counter_delta; }, - [ x, v ] ) - :: enum (v + 1) + [ var_name, value ] ) + :: make_ceq_counters_from_var_values (value + 1) else - enum (v + 1) - in - enum min - -let enumerate rules f = - List.rev - (List.fold_left - (fun acc (s, ((rc, _) as r)) -> - let enumerate_r = - if - match rc.Ast.rewrite with - | Ast.Edit _ -> false - | Ast.Arrow a -> a.Ast.lhs = [] - then - [ None, r ] - else - List.map - (fun (s', r') -> - match s, s' with - | None, _ -> None, r' - | Some _, None -> s, r' - | Some (s1, a1), Some s2 -> Some (s1 ^ "__" ^ s2, a1), r') - (f r) - in - enumerate_r @ acc) - [] rules) - -let remove_variable_in_counters ~warning rules signatures = - let counter_gte_delta c delta = - let count_delta = - { c with Ast.count_test = Some (Ast.CGTE (abs delta), Locality.dummy) } - in - [ Ast.Counter count_delta, [] ] - in - let counter_gte_zero c = - [ - ( Ast.Counter { c with Ast.count_test = Some (Ast.CGTE 0, Locality.dummy) }, - [] ); - ] + make_ceq_counters_from_var_values (value + 1) in + make_ceq_counters_from_var_values min_value + +let has_counters compil = + List.exists + (function + | Ast.Absent _ -> false + | Ast.Present (_, sites, _) -> + List.exists + (function + | Ast.Counter _ -> true + | Ast.Port _ -> false) + sites) + compil.Ast.signatures - let remove_var_site ids counters = function +(** [split_counter_variables_into_separate_rules] ~warning rules signatures] replaces counters with CVAR contraints with counters with CEQ contraints in [rules], in lists with the variable values associated, so that in simulation, correct counter conditions are being selected. The main operation happens in [split_cvar_counter_in_rules_per_value] *) +let split_counter_variables_into_separate_rules ~warning rules signatures = + let split_for_each_counter_var_value_site ids counter_defs = function | Ast.Port p -> [ Ast.Port p, [] ] | Ast.Counter c -> - let delta, _ = c.Ast.count_delta in - (match c.Ast.count_test with - | Some (Ast.CEQ v, _) -> - if delta > 0 || abs delta <= v then + let delta = Loc.v c.counter_delta in + (match c.counter_test with + | Some (Ast.CEQ value, _) -> + if delta > 0 || abs delta <= value then [ Ast.Counter c, [] ] else raise (ExceptionDefn.Malformed_Decl - ( "Counter " ^ fst c.Ast.count_nme ^ " becomes negative", - snd c.Ast.count_nme )) - | Some (Ast.CGTE v, pos) -> - let () = - if v + delta < 0 then - raise - (ExceptionDefn.Malformed_Decl - ( "Counter " ^ fst c.Ast.count_nme ^ " becomes negative", - snd c.Ast.count_nme )) - in - let () = - if v = 0 then ( - let error = "Counter " ^ fst c.Ast.count_nme ^ ":>0 always holds" in - warning ~pos (fun f -> Format.pp_print_string f error) - ) - in + ( "Counter " ^ Loc.v c.counter_name ^ " becomes negative", + Loc.get_annot c.counter_name )) + | Some (Ast.CGTE value, annot) -> + if value + delta < 0 then + raise + (ExceptionDefn.Malformed_Decl + ( "Counter " ^ Loc.v c.counter_name ^ " becomes negative", + Loc.get_annot c.counter_name )); + if value = 0 then ( + let error = "Counter " ^ Loc.v c.counter_name ^ ":>0 always holds" in + warning ~pos:annot (fun f -> Format.pp_print_string f error) + ); [ Ast.Counter c, [] ] - | Some (Ast.CVAR x, a) when Mods.StringSet.mem x ids -> - enumerate_counter_tests x a c.Ast.count_delta - (List.find - (fun c' -> name_match c.Ast.count_nme c'.Ast.count_nme) - counters) + | Some (Ast.CVAR var_name, annot) when Mods.StringSet.mem var_name ids -> + (* If the variable is present in an rate definition expression *) + let counter_def : Ast.counter = + List.find + (fun counter -> + name_match c.Ast.counter_name counter.Ast.counter_name) + counter_defs + in + + split_cvar_counter_in_rules_per_value var_name annot c.counter_delta + counter_def | None | Some (Ast.CVAR _, _) -> - if delta < 0 then - counter_gte_delta c delta - else - counter_gte_zero c) + if delta < 0 then ( + let counter_delta : Ast.counter = + { c with counter_test = Some (Ast.CGTE (abs delta), Loc.dummy) } + in + [ Ast.Counter counter_delta, [] ] + ) else + [ + ( Ast.Counter { c with counter_test = Some (Ast.CGTE 0, Loc.dummy) }, + [] ); + ]) in - let rec remove_var_sites ids counters = function + + let rec split_for_each_counter_var_value_sites (ids : Mods.StringSet.t) + (counter_defs : Ast.counter list) : + Ast.site list -> (Ast.site list * (string * int) list) list = function | [] -> [] | s :: t -> - combinations - (remove_var_sites ids counters t) - (remove_var_site ids counters s) + combinations_of_var_setup + (split_for_each_counter_var_value_sites ids counter_defs t) + (split_for_each_counter_var_value_site ids counter_defs s) in - let remove_var_agent ids = function + let split_for_each_counter_var_value_agent (ids : Mods.StringSet.t) : + Ast.agent -> (Ast.agent * (string * int) list) list = function | Ast.Absent l -> [ Ast.Absent l, [] ] - | Ast.Present (s, sites, m) -> - let counters = counters_signature s signatures in - let enumerate_sites = remove_var_sites ids counters sites in + | Ast.Present (agent_name, sites, modif) -> + let counter_defs = counters_signature agent_name signatures in + let sites_for_each_counter_var_values = + split_for_each_counter_var_value_sites ids counter_defs sites + in List.map - (fun (sites', c) -> Ast.Present (s, sites', m), c) - enumerate_sites + (fun (sites', var_values) -> + Ast.Present (agent_name, sites', modif), var_values) + sites_for_each_counter_var_values in - let rec remove_var_mixture ids = function + let rec split_for_each_counter_var_value_mixture (ids : Mods.StringSet.t) : + Ast.agent list -> (Ast.agent list * (string * int) list) list = function | [] -> [] - | ag :: t -> - combinations (remove_var_mixture ids t) (remove_var_agent ids ag) + | ast_agent :: t -> + combinations_of_var_setup + (split_for_each_counter_var_value_mixture ids t) + (split_for_each_counter_var_value_agent ids ast_agent) in - let update_opt_rate counters = function + let update_opt_rate counter_var_values = function | None -> None - | Some r -> Some (update_rate counters r) + | Some r -> Some (update_rate counter_var_values r) in - let update_pair_rate counters = function + let update_pair_rate counter_var_values = function | None -> None | Some (r1, r2) -> - Some (update_rate counters r1, update_opt_rate counters r2) + Some + ( update_rate counter_var_values r1, + update_opt_rate counter_var_values r2 ) in - let remove_var_rule (r, a) = - let mix = - match r.Ast.rewrite with - | Ast.Edit r -> r.Ast.mix - | Ast.Arrow r -> r.Ast.lhs + (* TODO [split_for_each_counter_var_value_rule] rule evalues to a list of rules with their names *) + let split_for_each_counter_var_value_rule + (rule_name : string Loc.annoted option) + ((rule, annot) : Ast.rule Loc.annoted) : + (string Loc.annoted option * Ast.rule Loc.annoted) list = + let mix_lhs = + match rule.rewrite with + | Ast.Edit content -> content.mix + | Ast.Arrow content -> content.lhs + in + + (* Fetch ids from rule rates *) + let exprs_from_rates : + (Ast.mixture, string) Kappa_terms.Alg_expr.e Loc.annoted option list = + [ Some rule.k_def; rule.k_op ] + @ (match rule.k_un with + | None -> [] + | Some r_kun_rates -> [ Some (fst r_kun_rates); snd r_kun_rates ]) + @ + match rule.k_op_un with + | None -> [] + | Some r_k_op_un_rates -> + [ Some (fst r_k_op_un_rates); snd r_k_op_un_rates ] in - let ids = - collect_ids [ Some r.Ast.k_def; r.Ast.k_op ] [ r.Ast.k_un; r.Ast.k_op_un ] + let ids = collect_ids exprs_from_rates in + + let mixture_for_each_counter_var_value : + (Ast.agent list * (string * int) list) list = + split_for_each_counter_var_value_mixture ids (List.flatten mix_lhs) in List.map - (fun (lhs, counters) -> - let k_def = update_rate counters r.Ast.k_def in - let k_un = update_pair_rate counters r.Ast.k_un in - let k_op = update_opt_rate counters r.Ast.k_op in - let k_op_un = update_pair_rate counters r.Ast.k_op_un in + (fun (lhs, counter_var_values) -> + (* Apply counter var values to rates *) + let k_def = update_rate counter_var_values rule.k_def in + let k_un = update_pair_rate counter_var_values rule.k_un in + let k_op = update_opt_rate counter_var_values rule.k_op in + let k_op_un = update_pair_rate counter_var_values rule.k_op_un in let lhs = [ lhs ] in - let append = - if counters = [] then - None - else - Some - (List.fold_left - (fun acc (_, i) -> string_of_int i ^ acc) - "" counters) + let new_rule_name : string Loc.annoted option = + if counter_var_values = [] then + rule_name + else ( + (* Build counters_ids_as_string, that will be used to build new rule names *) + let counters_ids_as_string = + List.fold_left + (* TODO should we add a separator. maybe also add name of variable? *) + (fun acc (_, i) -> string_of_int i ^ acc) + "" counter_var_values + in + + match rule_name with + | None -> None (* No rule name, new rules will have no name too *) + | Some (rule_name_string, locality) -> + (* Make a new name for new rule including counter_var_values info *) + Some (rule_name_string ^ "__" ^ counters_ids_as_string, locality) + ) in - ( append, + + ( new_rule_name, ( { Ast.rewrite = - (match r.Ast.rewrite with - | Ast.Edit e -> Ast.Edit { e with Ast.mix = lhs } - | Ast.Arrow a -> Ast.Arrow { a with Ast.lhs }); - Ast.bidirectional = r.Ast.bidirectional; - Ast.k_def; - Ast.k_un; - Ast.k_op; - Ast.k_op_un; + (match rule.rewrite with + | Ast.Edit content -> Ast.Edit { content with Ast.mix = lhs } + | Ast.Arrow content -> Ast.Arrow { content with Ast.lhs }); + bidirectional = rule.bidirectional; + k_def; + k_un; + k_op; + k_op_un; }, - a ) )) - (remove_var_mixture ids (List.flatten mix)) + annot ) )) + mixture_for_each_counter_var_value in + let rules = prepare_counters rules in - enumerate rules remove_var_rule + List.fold_left + (fun acc (rule_name, ((rule_content, _) as rule_annoted)) -> + let new_rules_from_rule = + if + (* Per counter syntax, these rules cannot contain counter vars that need to be considered when removing CVAR counter tests *) + match rule_content.Ast.rewrite with + | Ast.Edit _ -> false + | Ast.Arrow a -> a.lhs = [] + then + [ None, rule_annoted ] + else + split_for_each_counter_var_value_rule rule_name rule_annoted + in + new_rules_from_rule @ acc) + [] rules + (* TODO: is rev relevant here? *) + |> List.rev -let with_counters c = - let with_counters_mix mix = - List.exists - (function - | Ast.Absent _ -> false - | Ast.Present (_, ls, _) -> - List.exists - (function - | Ast.Counter _ -> true - | Ast.Port _ -> false) - ls) - mix +let split_counter_variables_into_separate_rules ~warning ~debug_mode + (compil : Ast.parsing_compil) = + let rules = + split_counter_variables_into_separate_rules ~warning compil.rules + compil.signatures in - with_counters_mix c.Ast.signatures + (* Debug printing *) + if debug_mode then ( + Format.printf "@.ast rules@."; + List.iter + (fun (s, (r, _)) -> + let label = + match s with + | None -> "" + | Some (l, _) -> l + in + Format.printf "@.%s = %a" label Ast.print_ast_rule r) + rules + ); + { compil with Ast.rules } -let compile ~warning ~debugMode c = - if with_counters c then ( - let rules = - remove_variable_in_counters ~warning c.Ast.rules c.Ast.signatures - in - let () = - if debugMode then ( - let () = Format.printf "@.ast rules@." in - List.iter - (fun (s, (r, _)) -> - let label = - match s with - | None -> "" - | Some (l, _) -> l - in - Format.printf "@.%s = %a" label Ast.print_ast_rule r) - rules - ) - in - { c with Ast.rules }, true - ) else - c, false +let make_counter_agent sigs (is_first, (dst, ra_erased)) (is_last, equal) i j + loc (created : bool) : LKappa.rule_agent = + let counter_agent_info = Signature.get_counter_agent_info sigs in + let port_b, port_a = counter_agent_info.ports in + let ra_type = counter_agent_info.id in -let make_counter_agent sigs (first, (dst, ra_erased)) (last, equal) i j pos - created = - let ra_type, arity, incr_b, incr_a = Signature.incr_agent sigs in - let ra_ports = Array.make arity ((LKappa.LNK_FREE, pos), LKappa.Maintained) in + let ra_ports = + Array.make counter_agent_info.arity + ((LKappa.LNK_FREE, loc), LKappa.Maintained) + in let before_switch = - if first && created then + if is_first && created then LKappa.Linked i else LKappa.Maintained in let before = - if first then - LKappa.LNK_VALUE (i, dst), pos + if is_first then + LKappa.LNK_VALUE (i, dst), loc else - LKappa.LNK_VALUE (i, (ra_type, incr_a)), pos + LKappa.LNK_VALUE (i, (ra_type, port_a)), loc in - let () = ra_ports.(incr_b) <- before, before_switch in + let () = ra_ports.(port_b) <- before, before_switch in let after = - if last && equal then - LKappa.LNK_FREE, pos - else if last then - LKappa.LNK_ANY, pos + if is_last && equal then + LKappa.LNK_FREE, loc + else if is_last then + LKappa.LNK_ANY, loc else - LKappa.LNK_VALUE (j, (ra_type, incr_b)), pos + LKappa.LNK_VALUE (j, (ra_type, port_b)), loc in - let () = ra_ports.(incr_a) <- after, LKappa.Maintained in - let ra_ints = Array.make arity LKappa.I_ANY in + let () = ra_ports.(port_a) <- after, LKappa.Maintained in + let ra_ints = Array.make counter_agent_info.arity LKappa.I_ANY in { LKappa.ra_type; ra_erased; @@ -461,271 +509,325 @@ let make_counter_agent sigs (first, (dst, ra_erased)) (last, equal) i j pos ra_syntax = Some (Array.copy ra_ports, Array.copy ra_ints); } -let raw_counter_agent (first, first_lnk) (last, last_lnk) i j sigs equal = - let incr_type, arity, incr_b, incr_a = Signature.incr_agent sigs in - let ports = Array.make arity Raw_mixture.FREE in +let raw_counter_agent (is_first, first_link) (is_last, last_link) i j sigs equal + : Raw_mixture.agent = + let counter_agent_info = Signature.get_counter_agent_info sigs in + let port_b, port_a = counter_agent_info.ports in + let ports = Array.make counter_agent_info.arity Raw_mixture.FREE in let internals = - Array.init arity (fun i -> - Signature.default_internal_state incr_type i sigs) + Array.init counter_agent_info.arity (fun i -> + Signature.default_internal_state counter_agent_info.id i sigs) in let before = - if first then - Raw_mixture.VAL first_lnk + if is_first then + Raw_mixture.VAL first_link else Raw_mixture.VAL i in - let () = ports.(incr_b) <- before in + let () = ports.(port_b) <- before in let after = - if last && equal then + if is_last && equal then Raw_mixture.FREE - else if last then - Raw_mixture.VAL last_lnk + else if is_last then + Raw_mixture.VAL last_link else Raw_mixture.VAL j in - let () = ports.(incr_a) <- after in + let () = ports.(port_a) <- after in { - Raw_mixture.a_type = incr_type; + Raw_mixture.a_type = counter_agent_info.id; Raw_mixture.a_ports = ports; Raw_mixture.a_ints = internals; } -let rec add_incr i first_lnk last_lnk delta equal sigs = +let rec add_incr (i : int) (first_link : int) (last_link : int) (delta : int) + (equal : bool) (sigs : Signature.s) : Raw_mixture.agent list = if i = delta then [] else ( - let first = i = 0 in - let last = i = delta - 1 in + let is_first = i = 0 in + let is_last = i = delta - 1 in let raw_incr = - raw_counter_agent (first, first_lnk) (last, last_lnk) (first_lnk + i) - (first_lnk + i + 1) + raw_counter_agent (is_first, first_link) (is_last, last_link) + (first_link + i) + (first_link + i + 1) sigs equal in - raw_incr :: add_incr (i + 1) first_lnk last_lnk delta equal sigs + raw_incr :: add_incr (i + 1) first_link last_link delta equal sigs ) -let rec link_incr sigs i nb ag_info equal lnk pos delta = +let rec link_incr (sigs : Signature.s) (i : int) (nb : int) + (ag_info : (int * int) * bool) (equal : bool) (lnk : int) (loc : Loc.t) + (delta : int) : LKappa.rule_mixture = if i = nb then [] else ( - let first = i = 0 in - let last = i = nb - 1 in + let is_first = i = 0 in + let is_last = i = nb - 1 in let ra_agent = - make_counter_agent sigs (first, ag_info) (last, equal) (lnk + i) + make_counter_agent sigs (is_first, ag_info) (is_last, equal) (lnk + i) (lnk + i + 1) - pos (delta > 0) + loc (delta > 0) in - ra_agent :: link_incr sigs (i + 1) nb ag_info equal lnk pos delta + ra_agent :: link_incr sigs (i + 1) nb ag_info equal lnk loc delta ) -let rec erase_incr sigs i incrs delta lnk = - let _, _, incr_b, _ = Signature.incr_agent sigs in +let rec erase_incr (sigs : Signature.s) (i : int) (incrs : LKappa.rule_mixture) + (delta : int) (lnk : 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 - | hd :: tl -> + | incr :: incr_s -> if i = abs delta then ( - let before, _ = hd.LKappa.ra_ports.(incr_b) in - let () = hd.LKappa.ra_ports.(incr_b) <- before, LKappa.Linked lnk in - hd :: tl + let before, _ = incr.LKappa.ra_ports.(port_b) in + incr.LKappa.ra_ports.(port_b) <- before, LKappa.Linked lnk; + incr :: incr_s ) else ( - let () = - Array.iteri - (fun i (a, _) -> hd.LKappa.ra_ports.(i) <- a, LKappa.Erased) - hd.LKappa.ra_ports - in - let ag = { hd with LKappa.ra_erased = true } in - ag :: erase_incr sigs (i + 1) tl delta lnk + Array.iteri + (fun i (a, _) -> incr.LKappa.ra_ports.(i) <- a, LKappa.Erased) + incr.LKappa.ra_ports; + let rule_agent = { incr with LKappa.ra_erased = true } in + rule_agent :: erase_incr sigs (i + 1) incr_s delta lnk ) | [] -> [] -let counter_becomes_port sigs ra p_id (delta, pos') pos equal test start_lnk_nb - = - let incr_type, _, incr_b, _ = Signature.incr_agent sigs in - let start_lnk_for_created = start_lnk_nb + test + 1 in - let lnk_for_erased = start_lnk_nb + abs delta in - let ag_info = (p_id, ra.LKappa.ra_type), ra.LKappa.ra_erased in +let counter_becomes_port (sigs : Signature.s) (ra : LKappa.rule_agent) + (p_id : int) ((delta, loc_delta) : int Loc.annoted) (loc : Loc.t) + (equal : bool) (test : int) (start_link_nb : int) : + LKappa.rule_mixture * Raw_mixture.t = + let start_link_for_created : int = start_link_nb + test + 1 in + let lnk_for_erased : int = start_link_nb + abs delta in + let ag_info : (int * int) * bool = + (p_id, ra.LKappa.ra_type), ra.LKappa.ra_erased + in - let test_incr = - link_incr sigs 0 (test + 1) ag_info equal start_lnk_nb pos delta + let test_incr : LKappa.rule_mixture = + link_incr sigs 0 (test + 1) ag_info equal start_link_nb loc delta in - let adjust_delta = + let adjust_delta : LKappa.rule_mixture = if delta < 0 then erase_incr sigs 0 test_incr delta lnk_for_erased else test_incr in - let created = + let created : Raw_mixture.t = if delta > 0 then - add_incr 0 start_lnk_for_created start_lnk_nb delta false sigs + add_incr 0 start_link_for_created start_link_nb delta false sigs else [] in - let () = - if test + delta < 0 then - raise - (ExceptionDefn.Internal_Error - ("Counter test should be greater then abs(delta)", pos')) - in - let switch = + if test + delta < 0 then + raise + (ExceptionDefn.Internal_Error + ("Counter test should be greater then abs(delta)", loc_delta)); + + let switch : LKappa.switching = if delta = 0 then LKappa.Maintained else if delta > 0 then - LKappa.Linked start_lnk_for_created + LKappa.Linked start_link_for_created else LKappa.Linked lnk_for_erased in - let p = (LKappa.LNK_VALUE (start_lnk_nb, (incr_b, incr_type)), pos), switch in - let () = ra.LKappa.ra_ports.(p_id) <- p in + let counter_agent_info = Signature.get_counter_agent_info sigs in + let port_b : int = fst counter_agent_info.ports in + ra.LKappa.ra_ports.(p_id) <- + ( (LKappa.LNK_VALUE (start_link_nb, (port_b, counter_agent_info.id)), loc), + switch ); adjust_delta, created -let pos_part i = - if i < 0 then - 0 - else - i - -(* ag - agent with counters in a rule +(** Compiles the counter precondition in a left hand side mixture of a rule into a mixture which tests dummy positions + * rule_agent_ - agent with counters in a rule lnk_nb - the max link number used in the rule; - incr_info - info on the incr agent from the signature + sigs.counter_agent_info - info on the counter agent returns: agent with explicit counters; created incr agents; the next link number to use *) -let remove_counter_agent sigs ag lnk_nb = - let incrs, lnk_nb' = +let compile_counter_in_rule_agent (sigs : Signature.s) + (rule_agent_ : LKappa.rule_agent with_agent_counters) (lnk_nb : int) : + LKappa.rule_mixture * Raw_mixture.t * int = + (* Returns positive part of value *) + let positive_part (i : int) : int = + if i < 0 then + 0 + else + i + in + + let (incrs, lnk_nb') : (LKappa.rule_mixture * Raw_mixture.t) list * int = Tools.array_fold_lefti (fun id (acc_incrs, lnk_nb) -> function | None -> acc_incrs, lnk_nb | Some (counter, _) -> - let s, pos = counter.Ast.count_nme in - (match counter.Ast.count_test, counter.Ast.count_delta with - | None, _ -> + let loc = Loc.get_annot counter.Ast.counter_name in + let test = + Option_util.unsome_or_raise + ~excep: + (ExceptionDefn.Internal_Error + ( "Counter " + ^ Loc.v counter.Ast.counter_name + ^ " should have a test by now", + loc )) + counter.Ast.counter_test + in + let delta = counter.Ast.counter_delta in + (match Loc.v test with + | Ast.CEQ j -> + ( counter_becomes_port sigs rule_agent_.agent id delta loc true j + lnk_nb + :: acc_incrs, + lnk_nb + 1 + j + positive_part (Loc.v delta) ) + (* JF: link ids were colliding after counter decrementations -> I do not think that we should add delta when negative *) + | Ast.CGTE j -> + ( counter_becomes_port sigs rule_agent_.agent id delta loc false j + lnk_nb + :: acc_incrs, + lnk_nb + 1 + j + positive_part (Loc.v delta) ) + (* JF: link ids were colliding after counter decrementations -> I do not think that we should add delta when negative *) + | Ast.CVAR _ -> raise (ExceptionDefn.Internal_Error - ("Counter " ^ s ^ " should have a test by now", pos)) - | Some (test, pos'), delta -> - (match test with - | Ast.CEQ j -> - ( counter_becomes_port sigs ag.ra id delta pos true j lnk_nb - :: acc_incrs, - lnk_nb + 1 + j + pos_part (fst delta) ) - (* JF: link ids were colliding after counter decrementations -> I do not think that we should add delta when negative *) - | Ast.CGTE j -> - ( counter_becomes_port sigs ag.ra id delta pos false j lnk_nb - :: acc_incrs, - lnk_nb + 1 + j + pos_part (fst delta) ) - (* JF: link ids were colliding after counter decrementations -> I do not think that we should add delta when negative *) - | Ast.CVAR _ -> - raise - (ExceptionDefn.Internal_Error - ("Counter " ^ s ^ " should not have a var by now", pos'))))) - ([], lnk_nb) ag.ra_counters + ( "Counter " + ^ Loc.v counter.Ast.counter_name + ^ " defines a variable, which should have been replaced by \ + CEQ conditions after rule splitting", + Loc.get_annot test )))) + ([], lnk_nb) rule_agent_.counters in - let als, bls = + let (als, bls) : LKappa.rule_mixture * Raw_mixture.t = List.fold_left (fun (als, bls) (a, b) -> a @ als, b @ bls) ([], []) incrs in als, bls, lnk_nb' -let remove_counter_created_agent sigs ag lnk_nb = - let raw_ag = ag.ra in - let ports = raw_ag.Raw_mixture.a_ports in +(** 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) + (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 + let ports : Raw_mixture.link array = raw_agent.Raw_mixture.a_ports in Tools.array_fold_lefti - (fun p_id (acc, lnk) -> function - | None -> acc, lnk + (fun p_id (acc, lnk_nb) -> function + | None -> acc, lnk_nb | Some (c, _) -> - (match c.Ast.count_test with + (match c.Ast.counter_test with | None -> let agent_name = Format.asprintf "@[%a@]" (Signature.print_agent sigs) - raw_ag.Raw_mixture.a_type + raw_agent.Raw_mixture.a_type in - LKappa.not_enough_specified ~status:"counter" ~side:"left" agent_name - c.Ast.count_nme + LKappa.raise_not_enough_specified ~status:"counter" ~side:"left" + agent_name c.Ast.counter_name | Some (test, _) -> (match test with | Ast.CEQ j -> - let p = Raw_mixture.VAL lnk in + let p = Raw_mixture.VAL lnk_nb in let () = ports.(p_id) <- p in - let incrs = add_incr 0 lnk (lnk + j) (j + 1) true sigs in - acc @ incrs, lnk + j + 1 + let incrs = add_incr 0 lnk_nb (lnk_nb + j) (j + 1) true sigs in + acc @ incrs, lnk_nb + j + 1 | Ast.CGTE _ | Ast.CVAR _ -> let agent_name = Format.asprintf "@[%a@]" (Signature.print_agent sigs) - raw_ag.Raw_mixture.a_type + raw_agent.Raw_mixture.a_type in - LKappa.not_enough_specified ~status:"counter" ~side:"left" - agent_name c.Ast.count_nme))) - ([], lnk_nb) ag.ra_counters + LKappa.raise_not_enough_specified ~status:"counter" ~side:"left" + agent_name c.Ast.counter_name))) + ([], lnk_nb) raw_agent_.counters -let raw_agent_with_counters ag = - Array.fold_left (fun ok x -> x <> None || ok) false ag.ra_counters +let raw_agent_has_counters (ag_ : 'a with_agent_counters) : bool = + Array.fold_left (fun ok x -> x <> None || ok) false ag_.counters -let agent_with_counters ag sigs = - let sign = Signature.get sigs ag.LKappa.ra_type in - Signature.has_counter sign +let rule_agent_has_counters (rule_agent : LKappa.rule_agent) + (sigs : Signature.s) : bool = + Signature.has_counter (Signature.get sigs rule_agent.ra_type) -(* - adds increment agents to the rule_agent mixture +(** [compile_counter_in_rule sigs mix created] takes the intial mixture from a rule [mix], + * and the mixture obtained from the application of the rule [created], + * both with counter information, and returns two mixtures for a new rule without counters, having compiled the counter logic inside the rule. + * + * - adds increment agents to the rule_agent mixture - adds increment agents to the raw mixture - links the agents in the mixture(lhs,rhs,mix) or in the raw mixture(created) to the increments *) -let remove_counter_rule sigs mix created = - let with_counters = - List.exists (fun ag -> agent_with_counters ag.ra sigs) mix - || List.exists (fun ag -> raw_agent_with_counters ag) created - in - if with_counters then ( - let lnk_nb = - List.fold_left (fun m ag -> max m (LKappa.max_link_id [ ag.ra ])) 0 mix +let compile_counter_in_rule (sigs : Signature.s) + (mix : rule_mixture_with_agent_counters) + (created : raw_mixture_with_agent_counters) : + LKappa.rule_mixture * Raw_mixture.t = + let has_counters : bool = + List.exists + (fun rule_agent_ -> rule_agent_has_counters rule_agent_.agent sigs) + mix + || List.exists (fun raw_agent_ -> raw_agent_has_counters raw_agent_) created + in + if has_counters then ( + let lnk_nb : int = + List.fold_left + (fun (m : int) rule_agent_ -> + max m (LKappa.max_link_id [ rule_agent_.agent ])) + 0 mix in - let incrs, incrs_created, lnk_nb' = + let (incrs, incrs_created, lnk_nb') : + LKappa.rule_mixture * Raw_mixture.t * int = List.fold_left - (fun (a, b, lnk) ag -> - let a', b', lnk' = remove_counter_agent sigs ag lnk in - a' @ a, b' @ b, lnk' + 1) + (fun (mix_incr, created_incr, lnk_nb) rule_agent_ -> + let mix_incr_new, created_incr_new, lnk_nb' = + compile_counter_in_rule_agent sigs rule_agent_ lnk_nb + in + mix_incr_new @ mix_incr, created_incr_new @ created_incr, lnk_nb' + 1) ([], [], lnk_nb + 1) mix in - let incrs_created', _ = + let incrs_created' : Raw_mixture.t = List.fold_left - (fun (acc, lnk) ag -> - let a, lnk' = remove_counter_created_agent sigs ag lnk in - a @ acc, lnk') + (fun (created_incr, lnk_nb) raw_agent_ -> + let created_incr_new, lnk_nb'' = + compile_counter_in_raw_agent sigs raw_agent_ lnk_nb + in + created_incr_new @ created_incr, lnk_nb'') ([], lnk_nb' + 1) created + |> fst + (* We drop the lnk_nb as we don't need in the following *) in - let rule_agent_mix = List_util.rev_map_append (fun ag -> ag.ra) mix incrs in - let raw_mix = + (* Return initial mixtures with new agents in rule from counter compilation *) + let rule_agent_mix : LKappa.rule_mixture = + List_util.rev_map_append (fun rule_agent_ -> rule_agent_.agent) mix incrs + in + let raw_mix : Raw_mixture.t = List_util.rev_map_append - (fun ag -> ag.ra) + (fun raw_agent_ -> raw_agent_.agent) created (incrs_created @ incrs_created') in rule_agent_mix, raw_mix ) else - ( List.rev_map (fun ag -> ag.ra) (List.rev mix), - List.rev_map (fun ag -> ag.ra) (List.rev created) ) + ( List.rev_map (fun rule_agent_ -> rule_agent_.agent) (List.rev mix), + List.rev_map (fun raw_agent_ -> raw_agent_.agent) (List.rev created) ) -let agent_with_max_counter sigs c ((agent_name, _) as ag_ty) = - let incr_type, _, incr_b, _ = Signature.incr_agent sigs in +let rule_agent_with_max_counter sigs c ((agent_name, _) as ag_ty) : + LKappa.rule_mixture = let ag_id = Signature.num_of_agent ag_ty sigs in let sign = Signature.get sigs ag_id in let arity = Signature.arity sigs ag_id in let ports = - Array.make arity (Locality.dummy_annot LKappa.LNK_ANY, LKappa.Maintained) + Array.make arity (Loc.annot_with_dummy LKappa.LNK_ANY, LKappa.Maintained) in let internals = Array.make arity LKappa.I_ANY in - let c_na = c.Ast.count_nme in + let c_na = c.Ast.counter_name in let c_id = Signature.num_of_site ~agent_name c_na sign in - let max_val, pos = c.Ast.count_delta in + let max_val, loc = c.Ast.counter_delta in let max_val' = max_val + 1 in let incrs = - link_incr sigs 0 (max_val' + 1) ((c_id, ag_id), false) false 1 pos (-1) + link_incr sigs 0 (max_val' + 1) ((c_id, ag_id), false) false 1 loc (-1) in - let p = LKappa.LNK_VALUE (1, (incr_b, incr_type)), pos in - let () = ports.(c_id) <- p, LKappa.Maintained in - let ra = + let counter_agent_info = Signature.get_counter_agent_info sigs in + let port_b = fst counter_agent_info.ports in + let p = LKappa.LNK_VALUE (1, (port_b, counter_agent_info.id)), loc in + ports.(c_id) <- p, LKappa.Maintained; + let ra : LKappa.rule_agent = { LKappa.ra_type = ag_id; ra_ports = ports; @@ -737,31 +839,32 @@ let agent_with_max_counter sigs c ((agent_name, _) as ag_ty) = ra :: incrs let counter_perturbation sigs c ag_ty = - let filename = - [ Primitives.Str_pexpr ("counter_perturbation.ka", snd c.Ast.count_nme) ] - in + let annot = Loc.get_annot c.Ast.counter_name in + let filename = [ Primitives.Str_pexpr ("counter_perturbation.ka", annot) ] in let stop_message = - "Counter " ^ fst c.Ast.count_nme ^ " of agent " ^ fst ag_ty + "Counter " ^ Loc.v c.Ast.counter_name ^ " of agent " ^ Loc.v ag_ty ^ " reached maximum" in let mods = [ - Ast.PRINT ([], [ Primitives.Str_pexpr ("", snd c.Ast.count_nme) ]); - Ast.PRINT - ([], [ Primitives.Str_pexpr (stop_message, snd c.Ast.count_nme) ]); + Ast.PRINT ([], [ Primitives.Str_pexpr ("", annot) ]); + Ast.PRINT ([], [ Primitives.Str_pexpr (stop_message, annot) ]); Ast.STOP filename; ] in let val_of_counter = - Alg_expr.KAPPA_INSTANCE (agent_with_max_counter sigs c ag_ty) + Alg_expr.KAPPA_INSTANCE (rule_agent_with_max_counter sigs c ag_ty) in let pre = Alg_expr.COMPARE_OP ( Operator.EQUAL, - (val_of_counter, snd c.Ast.count_nme), - (Alg_expr.CONST (Nbr.I 1), snd c.Ast.count_nme) ) + (val_of_counter, annot), + (Alg_expr.CONST (Nbr.I 1), annot) ) in - None, Some (pre, snd ag_ty), mods, Some (Locality.dummy_annot Alg_expr.FALSE) + ( None, + Some (pre, Loc.get_annot ag_ty), + mods, + Some (Loc.annot_with_dummy Alg_expr.FALSE) ) let counters_perturbations sigs ast_sigs = List.fold_left @@ -773,114 +876,119 @@ let counters_perturbations sigs ast_sigs = match site with | Ast.Port _ -> acc' | Ast.Counter c -> - (counter_perturbation sigs c ag_ty, snd ag_ty) :: acc') + (counter_perturbation sigs c ag_ty, Loc.get_annot ag_ty) :: acc') acc sites)) [] ast_sigs let make_counter i name = { - Ast.count_nme = name, Locality.dummy; - count_test = Some (Ast.CEQ i, Locality.dummy); - count_delta = 0, Locality.dummy; + Ast.counter_name = Loc.annot_with_dummy name; + counter_test = Some (Loc.annot_with_dummy (Ast.CEQ i)); + counter_delta = Loc.annot_with_dummy 0; } let add_counter_to_contact_map sigs add_link_contact_map = - let incr_id, _, incr_b, incr_a = Signature.incr_agent sigs in - add_link_contact_map incr_id incr_a incr_id incr_b + let counter_agent_info = Signature.get_counter_agent_info sigs in + let port_b, port_a = counter_agent_info.ports in + add_link_contact_map counter_agent_info.id port_a counter_agent_info.id port_b -let forbid_modification (delta, pos) = - if delta != 0 then LKappa.forbid_modification pos (Some delta) +let raise_if_modification (delta, loc) = + if delta != 0 then LKappa.raise_if_modification loc (Some delta) -let annotate_dropped_counters sign counts ra arity agent_name aux = +let annotate_dropped_counters sign ast_counters ra arity agent_name aux = let ra_counters = Array.make arity None in let _ = List.fold_left (fun pset c -> - let p_na = c.Ast.count_nme in - let p_id = Signature.num_of_site ~agent_name p_na sign in + let port_name = c.Ast.counter_name in + let p_id = Signature.num_of_site ~agent_name port_name sign in let () = - match Signature.counter_of_site p_id sign with - | None -> LKappa.counter_misused agent_name c.Ast.count_nme + match Signature.counter_of_site_id p_id sign with + | None -> LKappa.raise_counter_misused agent_name c.Ast.counter_name | Some _ -> () in let pset' = Mods.IntSet.add p_id pset in let () = if pset == pset' then - LKappa.several_occurence_of_site agent_name c.Ast.count_nme + LKappa.raise_several_occurence_of_site agent_name c.Ast.counter_name in - let () = forbid_modification c.Ast.count_delta in + let () = raise_if_modification c.Ast.counter_delta in let () = match aux with | Some f -> f p_id | None -> () in - let () = ra_counters.(p_id) <- Some (c, LKappa.Erased) in + ra_counters.(p_id) <- Some (c, LKappa.Erased); pset') - Mods.IntSet.empty counts + Mods.IntSet.empty ast_counters in - { ra; ra_counters } + { agent = ra; counters = ra_counters } -let annotate_edit_counters sigs ((agent_name, _) as ag_ty) counts ra +let annotate_edit_counters sigs ((agent_name, _) as ag_ty) counters ra add_link_contact_map = let ag_id = Signature.num_of_agent ag_ty sigs in let sign = Signature.get sigs ag_id in let arity = Signature.arity sigs ag_id in let ra_counters = Array.make arity None in let register_counter_modif c_id = - let incr_id, _, incr_b, _ = Signature.incr_agent sigs in - add_link_contact_map ag_id c_id incr_id incr_b + let counter_agent_info = Signature.get_counter_agent_info sigs in + let port_b = fst counter_agent_info.ports in + add_link_contact_map ag_id c_id counter_agent_info.id port_b in let _ = List.fold_left (fun pset c -> - let p_na = c.Ast.count_nme in - let p_id = Signature.num_of_site ~agent_name p_na sign in + let port_name = c.Ast.counter_name in + let p_id = Signature.num_of_site ~agent_name port_name sign in let () = - match Signature.counter_of_site p_id sign with - | None -> LKappa.counter_misused agent_name c.Ast.count_nme + match Signature.counter_of_site_id p_id sign with + | None -> LKappa.raise_counter_misused agent_name c.Ast.counter_name | Some _ -> () in let pset' = Mods.IntSet.add p_id pset in let () = if pset == pset' then - LKappa.several_occurence_of_site agent_name c.Ast.count_nme + LKappa.raise_several_occurence_of_site agent_name c.Ast.counter_name in let () = register_counter_modif p_id in let () = ra_counters.(p_id) <- Some (c, LKappa.Maintained) in pset') - Mods.IntSet.empty counts + Mods.IntSet.empty counters in - { ra; ra_counters } + { agent = ra; counters = ra_counters } -let annotate_counters_with_diff sigs ((agent_name, pos) as ag_ty) lc rc ra +let annotate_counters_with_diff sigs ((agent_name, loc) as ag_ty) lc rc ra add_link_contact_map = let ag_id = Signature.num_of_agent ag_ty sigs in let sign = Signature.get sigs ag_id in let arity = Signature.arity sigs ag_id in let register_counter_modif c c_id = - let incr_id, _, incr_b, _ = Signature.incr_agent sigs in - let () = add_link_contact_map ag_id c_id incr_id incr_b in + let counter_agent_info = Signature.get_counter_agent_info sigs in + let port_b = fst counter_agent_info.ports in + let () = add_link_contact_map ag_id c_id counter_agent_info.id port_b in c, LKappa.Maintained in let ra_counters = Array.make arity None in let rc_r, _ = List.fold_left (fun (rc, cset) c -> - let ((na, _) as c_na) = c.Ast.count_nme in - let c_id = Signature.num_of_site ~agent_name c_na sign in + let ((na, _) as counter_name) = c.Ast.counter_name in + let c_id = Signature.num_of_site ~agent_name counter_name sign in let cset' = Mods.IntSet.add c_id cset in let () = - if cset == cset' then LKappa.several_occurence_of_site agent_name c_na + if cset == cset' then + LKappa.raise_several_occurence_of_site agent_name counter_name in let c', rc' = List.partition - (fun p -> String.compare (fst p.Ast.count_nme) na = 0) + (fun p -> String.compare (Loc.v p.Ast.counter_name) na = 0) rc in let c'' = match c' with | _ :: [] | [] -> register_counter_modif c c_id - | _ :: _ -> LKappa.several_occurence_of_site agent_name c_na + | _ :: _ -> + LKappa.raise_several_occurence_of_site agent_name counter_name in let () = ra_counters.(c_id) <- Some c'' in rc', cset') @@ -889,18 +997,16 @@ let annotate_counters_with_diff sigs ((agent_name, pos) as ag_ty) lc rc ra let _ = (* test if counter of rhs is in the signature *) List.map - (fun c -> Signature.num_of_site ~agent_name c.Ast.count_nme sign) + (fun c -> Signature.num_of_site ~agent_name c.Ast.counter_name sign) rc_r in - let () = - if (not (rc = [])) && not (rc_r = []) then - raise - (ExceptionDefn.Internal_Error - ("Counters in " ^ agent_name ^ " should have tests by now", pos)) - in - { ra; ra_counters } + if (not (rc = [])) && not (rc_r = []) then + raise + (ExceptionDefn.Internal_Error + ("Counters in " ^ agent_name ^ " should have tests by now", loc)); + { agent = ra; counters = ra_counters } -let annotate_created_counters sigs ((agent_name, _) as ag_ty) counts +let annotate_created_counters sigs ((agent_name, _) as ag_ty) counters add_link_contact_map ra = let ag_id = Signature.num_of_agent ag_ty sigs in let sign = Signature.get sigs ag_id in @@ -908,61 +1014,57 @@ let annotate_created_counters sigs ((agent_name, _) as ag_ty) counts let ra_counters = Array.make arity None in (* register all counters (specified or not) with min value *) - let () = - Array.iteri - (fun p_id _ -> - match Signature.counter_of_site p_id sign with - | Some (min, _) -> - let c_name = Signature.site_of_num p_id sign in - (try - let c = - List.find - (fun c' -> String.compare (fst c'.Ast.count_nme) c_name = 0) - counts - in - ra_counters.(p_id) <- - Some - ( { - Ast.count_nme = c.Ast.count_nme; - Ast.count_test = c.Ast.count_test; - Ast.count_delta = 0, Locality.dummy; - }, - LKappa.Maintained ) - with Not_found -> - ra_counters.(p_id) <- - Some - ( { - Ast.count_nme = c_name, Locality.dummy; - Ast.count_test = Some (Ast.CEQ min, Locality.dummy); - Ast.count_delta = 0, Locality.dummy; - }, - LKappa.Maintained )) - | None -> ()) - ra_counters - in + Array.iteri + (fun p_id _ -> + match Signature.counter_of_site_id p_id sign with + | Some (min, _) -> + let c_name = Signature.site_of_num p_id sign in + (try + let c = + List.find + (fun c' -> String.compare (Loc.v c'.Ast.counter_name) c_name = 0) + counters + in + ra_counters.(p_id) <- + Some + ( { + Ast.counter_name = c.Ast.counter_name; + Ast.counter_test = c.Ast.counter_test; + Ast.counter_delta = 0, Loc.dummy; + }, + LKappa.Maintained ) + with Not_found -> + ra_counters.(p_id) <- + Some + ( { + Ast.counter_name = c_name, Loc.dummy; + Ast.counter_test = Some (Ast.CEQ min, Loc.dummy); + Ast.counter_delta = 0, Loc.dummy; + }, + LKappa.Maintained )) + | None -> ()) + ra_counters; let register_counter_modif c_id = - let incr_id, _, incr_b, _ = Signature.incr_agent sigs in - add_link_contact_map ag_id c_id incr_id incr_b + let counter_agent_info = Signature.get_counter_agent_info sigs in + let port_b = fst counter_agent_info.ports in + add_link_contact_map ag_id c_id counter_agent_info.id port_b in - let _ = + let _ : Mods.IntSet.t = List.fold_left (fun pset c -> - let p_na = c.Ast.count_nme in - let p_id = Signature.num_of_site ~agent_name p_na sign in - let () = - match Signature.counter_of_site p_id sign with - | None -> LKappa.counter_misused agent_name c.Ast.count_nme - | Some _ -> () - in - let pset' = Mods.IntSet.add p_id pset in - let () = + let port_name = c.Ast.counter_name in + let p_id = Signature.num_of_site ~agent_name port_name sign in + match Signature.counter_of_site_id p_id sign with + | None -> LKappa.raise_counter_misused agent_name c.Ast.counter_name + | Some _ -> + (); + let pset' = Mods.IntSet.add p_id pset in if pset == pset' then - LKappa.several_occurence_of_site agent_name c.Ast.count_nme - in - let () = register_counter_modif p_id in - let () = ra_counters.(p_id) <- Some (c, LKappa.Maintained) in - pset') - Mods.IntSet.empty counts + LKappa.raise_several_occurence_of_site agent_name c.Ast.counter_name; + register_counter_modif p_id; + ra_counters.(p_id) <- Some (c, LKappa.Maintained); + pset') + Mods.IntSet.empty counters in - { ra; ra_counters } + { agent = ra; counters = ra_counters } diff --git a/core/grammar/counters_compiler.mli b/core/grammar/counters_compiler.mli index d61537e6ab..66f6b5a0ab 100644 --- a/core/grammar/counters_compiler.mli +++ b/core/grammar/counters_compiler.mli @@ -6,34 +6,40 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) -type 'a rule_agent_counters = { - ra: 'a; - ra_counters: (Ast.counter * LKappa.switching) option array; +type 'a with_agent_counters = { + agent: 'a; + counters: (Ast.counter * LKappa.switching) option array; } +(** [with_agent_counters] annotates a agent type with rule agent counters if relevant. Used mainly with [rule_agent] and [Raw_mixture.agent]. + * + * Usually in the code a trailing underscore in a variable name marks that we have this data added, such as [rule_agent_] with [rule_agent_.agent] being a [rule_agent] *) -val compile : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> - debugMode:bool -> +type rule_mixture_with_agent_counters = + LKappa.rule_agent with_agent_counters list + +type raw_mixture_with_agent_counters = + Raw_mixture.agent with_agent_counters list + +val has_counters : Ast.parsing_compil -> bool + +val split_counter_variables_into_separate_rules : + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> + debug_mode:bool -> Ast.parsing_compil -> - Ast.parsing_compil * bool + Ast.parsing_compil val make_counter : int -> string -> Ast.counter -val remove_counter_rule : +val compile_counter_in_rule : Signature.s -> - LKappa.rule_agent rule_agent_counters list -> - Raw_mixture.agent rule_agent_counters list -> + LKappa.rule_agent with_agent_counters list -> + Raw_mixture.agent with_agent_counters list -> LKappa.rule_agent list * Raw_mixture.agent list val counters_perturbations : Signature.s -> Ast.mixture -> - ( LKappa.rule_mixture, - Raw_mixture.agent list, - int, - LKappa.rule ) - Ast.perturbation - list + (LKappa.rule_mixture, Raw_mixture.t, int, LKappa.rule) Ast.perturbation list val annotate_dropped_counters : Signature.t -> @@ -42,32 +48,32 @@ val annotate_dropped_counters : int -> string -> (int -> unit) option -> - LKappa.rule_agent rule_agent_counters + LKappa.rule_agent with_agent_counters val annotate_edit_counters : Signature.s -> - string * Locality.t -> + string Loc.annoted -> Ast.counter list -> LKappa.rule_agent -> (int -> int -> int -> int -> unit) -> - LKappa.rule_agent rule_agent_counters + LKappa.rule_agent with_agent_counters val annotate_created_counters : Signature.s -> - string * Locality.t -> + string Loc.annoted -> Ast.counter list -> (int -> int -> int -> int -> unit) -> Raw_mixture.agent -> - Raw_mixture.agent rule_agent_counters + Raw_mixture.agent with_agent_counters val annotate_counters_with_diff : Signature.s -> - string Locality.annot -> + string Loc.annoted -> Ast.counter list -> Ast.counter list -> LKappa.rule_agent -> (int -> int -> int -> int -> unit) -> - LKappa.rule_agent rule_agent_counters + LKappa.rule_agent with_agent_counters val add_counter_to_contact_map : Signature.s -> (int -> int -> int -> int -> unit) -> unit diff --git a/core/grammar/dune b/core/grammar/dune index a3a316161d..90d0f3cae5 100644 --- a/core/grammar/dune +++ b/core/grammar/dune @@ -1,12 +1,19 @@ (library - (name kappa_grammar) - (libraries yojson result lwt - kappa-library.generic kappa-library.runtime) - (flags (:standard -w @a - -open Kappa_generic_toolset - -open Kappa_mixtures - -open Kappa_terms - -open Kappa_runtime))) + (name kappa_grammar) + (libraries yojson result lwt kappa-library.generic kappa-library.runtime) + (flags + (:standard + -w + @a-40-42 + -open + Kappa_generic_toolset + -open + Kappa_mixtures + -open + Kappa_terms + -open + Kappa_runtime))) (ocamlyacc kparser4 kappaParser) + (ocamllex klexer4 kappaLexer) diff --git a/core/grammar/eval.ml b/core/grammar/eval.ml index 34fbb5a5d9..197ce498d0 100644 --- a/core/grammar/eval.ml +++ b/core/grammar/eval.ml @@ -8,14 +8,14 @@ open Ast -let rec compile_alg ~debugMode ~compileModeOn domain (alg, pos) = +let rec compile_alg ~debug_mode ~compile_mode_on domain (alg, pos) = match alg with | Alg_expr.KAPPA_INSTANCE ast -> (match domain with | Some (origin, contact_map, domain) -> let domain', ccs = Pattern_compiler.connected_components_sum_of_ambiguous_mixture - ~debugMode ~compileModeOn contact_map domain ?origin ast + ~debug_mode ~compile_mode_on contact_map domain ?origin ast in let out_ccs = List.map (fun (x, _) -> Array.map fst x) ccs in Some (origin, contact_map, domain'), (Alg_expr.KAPPA_INSTANCE out_ccs, pos) @@ -28,74 +28,76 @@ let rec compile_alg ~debugMode ~compileModeOn domain (alg, pos) = | Alg_expr.STATE_ALG_OP op -> domain, (Alg_expr.STATE_ALG_OP op, pos) | Alg_expr.CONST n -> domain, (Alg_expr.CONST n, pos) | Alg_expr.BIN_ALG_OP (op, a, b) -> - let domain', a' = compile_alg ~debugMode ~compileModeOn domain a in - let domain'', b' = compile_alg ~debugMode ~compileModeOn domain' b in + let domain', a' = compile_alg ~debug_mode ~compile_mode_on domain a in + let domain'', b' = compile_alg ~debug_mode ~compile_mode_on domain' b in domain'', (Alg_expr.BIN_ALG_OP (op, a', b'), pos) | Alg_expr.UN_ALG_OP (op, a) -> - let domain', a' = compile_alg ~debugMode ~compileModeOn domain a in + let domain', a' = compile_alg ~debug_mode ~compile_mode_on domain a in domain', (Alg_expr.UN_ALG_OP (op, a'), pos) | Alg_expr.IF (cond, yes, no) -> - let domain', cond' = compile_bool ~debugMode ~compileModeOn domain cond in - let domain'', yes' = compile_alg ~debugMode ~compileModeOn domain' yes in - let domain''', no' = compile_alg ~debugMode ~compileModeOn domain'' no in + let domain', cond' = + compile_bool ~debug_mode ~compile_mode_on domain cond + in + let domain'', yes' = compile_alg ~debug_mode ~compile_mode_on domain' yes in + let domain''', no' = compile_alg ~debug_mode ~compile_mode_on domain'' no in domain''', (Alg_expr.IF (cond', yes', no'), pos) | Alg_expr.DIFF_KAPPA_INSTANCE _ | Alg_expr.DIFF_TOKEN _ -> raise (ExceptionDefn.Internal_Error ("Cannot deal with derivative in expressions", pos)) -and compile_bool ~debugMode ~compileModeOn domain = function +and compile_bool ~debug_mode ~compile_mode_on domain = function | Alg_expr.TRUE, pos -> domain, (Alg_expr.TRUE, pos) | Alg_expr.FALSE, pos -> domain, (Alg_expr.FALSE, pos) | Alg_expr.BIN_BOOL_OP (op, a, b), pos -> - let domain', a' = compile_bool ~debugMode ~compileModeOn domain a in - let domain'', b' = compile_bool ~debugMode ~compileModeOn domain' b in + let domain', a' = compile_bool ~debug_mode ~compile_mode_on domain a in + let domain'', b' = compile_bool ~debug_mode ~compile_mode_on domain' b in domain'', (Alg_expr.BIN_BOOL_OP (op, a', b'), pos) | Alg_expr.UN_BOOL_OP (op, a), pos -> - let domain', a' = compile_bool ~debugMode ~compileModeOn domain a in + let domain', a' = compile_bool ~debug_mode ~compile_mode_on domain a in domain', (Alg_expr.UN_BOOL_OP (op, a'), pos) | Alg_expr.COMPARE_OP (op, a, b), pos -> - let domain', a' = compile_alg ~debugMode ~compileModeOn domain a in - let domain'', b' = compile_alg ~debugMode ~compileModeOn domain' b in + let domain', a' = compile_alg ~debug_mode ~compile_mode_on domain a in + let domain'', b' = compile_alg ~debug_mode ~compile_mode_on domain' b in domain'', (Alg_expr.COMPARE_OP (op, a', b'), pos) -let compile_pure_alg ~debugMode ~compileModeOn (alg, pos) = - snd @@ compile_alg ~debugMode ~compileModeOn None (alg, pos) +let compile_pure_alg ~debug_mode ~compile_mode_on (alg, pos) = + snd @@ compile_alg ~debug_mode ~compile_mode_on None (alg, pos) -let compile_alg ~debugMode ~compileModeOn ?origin contact_map domain (alg, pos) - = +let compile_alg ~debug_mode ~compile_mode_on ?origin contact_map domain + (alg, pos) = match - compile_alg ~debugMode ~compileModeOn + compile_alg ~debug_mode ~compile_mode_on (Some (origin, contact_map, domain)) (alg, pos) with | Some (_, _, domain), alg -> domain, alg | None, _ -> failwith "domain has been lost in Expr.compile_alg" -let compile_bool ~debugMode ~compileModeOn ?origin contact_map domain (alg, pos) - = +let compile_bool ~debug_mode ~compile_mode_on ?origin contact_map domain + (alg, pos) = match - compile_bool ~debugMode ~compileModeOn + compile_bool ~debug_mode ~compile_mode_on (Some (origin, contact_map, domain)) (alg, pos) with | Some (_, _, domain), alg -> domain, alg | None, _ -> failwith "domain has been lost in Expr.compile_alg" -let tokenify ~debugMode ~compileModeOn contact_map domain l = +let tokenify ~debug_mode ~compile_mode_on contact_map domain l = List.fold_right (fun (alg_expr, id) (domain, out) -> let domain', alg = - compile_alg ~debugMode ~compileModeOn contact_map domain alg_expr + compile_alg ~debug_mode ~compile_mode_on contact_map domain alg_expr in domain', (alg, id) :: out) l (domain, []) (* transform an LKappa rule into a Primitives rule *) -let rules_of_ast ~debugMode ~warning ?deps_machinery ~compileModeOn contact_map - domain ~syntax_ref (rule, _) = +let rules_of_ast ~debug_mode ~warning ?deps_machinery ~compile_mode_on + contact_map domain ~syntax_ref (rule, _) = let domain', delta_toks = - tokenify ~debugMode ~compileModeOn contact_map domain + tokenify ~debug_mode ~compile_mode_on contact_map domain rule.LKappa.r_delta_tokens in (* let one_side syntax_ref label (domain,deps_machinery,unary_ccs,acc) @@ -106,7 +108,9 @@ let rules_of_ast ~debugMode ~warning ?deps_machinery ~compileModeOn contact_map | Some (o, d) -> Some o, Some d in let unary_infos = - let crp = compile_pure_alg ~debugMode ~compileModeOn rule.LKappa.r_rate in + let crp = + compile_pure_alg ~debug_mode ~compile_mode_on rule.LKappa.r_rate + in match rule.LKappa.r_un_rate with | None -> fun _ -> crp, None | Some (((_, pos) as rate), dist) -> @@ -114,10 +118,10 @@ let rules_of_ast ~debugMode ~warning ?deps_machinery ~compileModeOn contact_map match dist with | None -> None | Some d -> - let d', _ = compile_pure_alg ~debugMode ~compileModeOn d in + let d', _ = compile_pure_alg ~debug_mode ~compile_mode_on d in Some d' in - let unrate = compile_pure_alg ~debugMode ~compileModeOn rate in + let unrate = compile_pure_alg ~debug_mode ~compile_mode_on rate in fun ccs -> (match Array.length ccs with | 0 | 1 -> @@ -165,8 +169,8 @@ let rules_of_ast ~debugMode ~warning ?deps_machinery ~compileModeOn contact_map } ) in let rule_mixtures, (domain', origin') = - Pattern_compiler.connected_components_sum_of_ambiguous_rule ~debugMode - ~compileModeOn contact_map domain' ?origin rule.LKappa.r_mix + Pattern_compiler.connected_components_sum_of_ambiguous_rule ~debug_mode + ~compile_mode_on contact_map domain' ?origin rule.LKappa.r_mix rule.LKappa.r_created in let deps_algs', rules_l = @@ -187,12 +191,12 @@ let rules_of_ast ~debugMode ~warning ?deps_machinery ~compileModeOn contact_map | None -> failwith "ugly Eval.rule_of_ast" )), rules_l ) -let obs_of_result ~debugMode ~compileModeOn contact_map domain alg_deps res = +let obs_of_result ~debug_mode ~compile_mode_on contact_map domain alg_deps res = let domain, out = List.fold_left (fun (domain, cont) alg_expr -> let domain', alg_pos = - compile_alg ~debugMode ~compileModeOn contact_map domain alg_expr + compile_alg ~debug_mode ~compile_mode_on contact_map domain alg_expr in domain', alg_pos :: cont) (domain, []) res.observables @@ -201,23 +205,23 @@ let obs_of_result ~debugMode ~compileModeOn contact_map domain alg_deps res = domain, List.rev out else ( domain, - Locality.dummy_annot (Alg_expr.STATE_ALG_OP Operator.TIME_VAR) + Loc.annot_with_dummy (Alg_expr.STATE_ALG_OP Operator.TIME_VAR) :: List.rev out ) -let compile_print_expr ~debugMode ~compileModeOn contact_map domain ex = +let compile_print_expr ~debug_mode ~compile_mode_on contact_map domain ex = List.fold_right (fun el (domain, out) -> match el with | Primitives.Str_pexpr s -> domain, Primitives.Str_pexpr s :: out | Primitives.Alg_pexpr ast_alg -> let domain', alg = - compile_alg ~debugMode ~compileModeOn contact_map domain ast_alg + compile_alg ~debug_mode ~compile_mode_on contact_map domain ast_alg in domain', Primitives.Alg_pexpr alg :: out) ex (domain, []) -let cflows_of_label ~debugMode origin ~compileModeOn contact_map domain on algs - rules (label, pos) rev_effects = +let cflows_of_label ~debug_mode origin ~compile_mode_on contact_map domain on + algs rules (label, pos) rev_effects = let adds tests l x = if on then Primitives.CFLOW (Some label, x, tests) :: l @@ -252,21 +256,21 @@ let cflows_of_label ~debugMode origin ~compileModeOn contact_map domain on algs pos ))) in let domain', ccs = - Pattern_compiler.connected_components_sum_of_ambiguous_mixture ~debugMode - ~compileModeOn contact_map domain ~origin mix + Pattern_compiler.connected_components_sum_of_ambiguous_mixture ~debug_mode + ~compile_mode_on contact_map domain ~origin mix in ( domain', List.fold_left (fun x (y, t) -> adds t x (Array.map fst y)) rev_effects ccs ) -let effects_of_modif ~debugMode ~warning ast_algs ast_rules origin - ~compileModeOn contact_map (domain, rev_effects) = function +let effects_of_modif ~debug_mode ~warning ast_algs ast_rules origin + ~compile_mode_on contact_map (domain, rev_effects) = function | APPLY (alg_expr, ((_, pos) as pack)) -> let domain', alg_pos = - compile_alg ~debugMode ~compileModeOn contact_map domain alg_expr + compile_alg ~debug_mode ~compile_mode_on contact_map domain alg_expr in let domain'', _, elem_rules = - rules_of_ast ~debugMode ~warning ~compileModeOn contact_map domain' + rules_of_ast ~debug_mode ~warning ~compile_mode_on contact_map domain' ~syntax_ref:0 pack in let elem_rule = @@ -280,22 +284,22 @@ let effects_of_modif ~debugMode ~warning ast_algs ast_rules origin domain'', Primitives.ITER_RULE (alg_pos, elem_rule) :: rev_effects | UPDATE ((i, _), alg_expr) -> let domain', alg_pos = - compile_alg ~debugMode ~compileModeOn contact_map domain alg_expr + compile_alg ~debug_mode ~compile_mode_on contact_map domain alg_expr in domain', Primitives.UPDATE (i, alg_pos) :: rev_effects | SNAPSHOT (raw, pexpr) -> let domain', pexpr' = - compile_print_expr ~debugMode ~compileModeOn contact_map domain pexpr + compile_print_expr ~debug_mode ~compile_mode_on contact_map domain pexpr in (*when specializing snapshots to particular mixtures, add variables below*) domain', Primitives.SNAPSHOT (raw, pexpr') :: rev_effects | STOP pexpr -> let domain', pexpr' = - compile_print_expr ~debugMode ~compileModeOn contact_map domain pexpr + compile_print_expr ~debug_mode ~compile_mode_on contact_map domain pexpr in domain', Primitives.STOP pexpr' :: rev_effects | CFLOWLABEL (on, lab) -> - cflows_of_label ~debugMode origin ~compileModeOn contact_map domain on + cflows_of_label ~debug_mode origin ~compile_mode_on contact_map domain on ast_algs ast_rules lab rev_effects | CFLOWMIX (on, (ast, _)) -> let adds tests l x = @@ -305,8 +309,8 @@ let effects_of_modif ~debugMode ~warning ast_algs ast_rules origin Primitives.CFLOWOFF (None, x) :: l in let domain', ccs = - Pattern_compiler.connected_components_sum_of_ambiguous_mixture ~debugMode - ~compileModeOn contact_map domain ~origin ast + Pattern_compiler.connected_components_sum_of_ambiguous_mixture ~debug_mode + ~compile_mode_on contact_map domain ~origin ast in ( domain', List.fold_left @@ -314,26 +318,26 @@ let effects_of_modif ~debugMode ~warning ast_algs ast_rules origin rev_effects ccs ) | DIN (rel, pexpr) -> let domain', pexpr' = - compile_print_expr ~debugMode ~compileModeOn contact_map domain pexpr + compile_print_expr ~debug_mode ~compile_mode_on contact_map domain pexpr in domain', Primitives.DIN (rel, pexpr') :: rev_effects | DINOFF pexpr -> let domain', pexpr' = - compile_print_expr ~debugMode ~compileModeOn contact_map domain pexpr + compile_print_expr ~debug_mode ~compile_mode_on contact_map domain pexpr in domain', Primitives.DINOFF pexpr' :: rev_effects | Ast.PRINT (pexpr, print) -> let domain', pexpr' = - compile_print_expr ~debugMode ~compileModeOn contact_map domain pexpr + compile_print_expr ~debug_mode ~compile_mode_on contact_map domain pexpr in let domain'', print' = - compile_print_expr ~debugMode ~compileModeOn contact_map domain' print + compile_print_expr ~debug_mode ~compile_mode_on contact_map domain' print in domain'', Primitives.PRINT (pexpr', print') :: rev_effects | PLOTENTRY -> domain, Primitives.PLOTENTRY :: rev_effects | SPECIES_OF (on, pexpr, (ast, pos)) -> let domain', pexpr' = - compile_print_expr ~debugMode ~compileModeOn contact_map domain pexpr + compile_print_expr ~debug_mode ~compile_mode_on contact_map domain pexpr in let adds tests l x = if on then @@ -342,8 +346,8 @@ let effects_of_modif ~debugMode ~warning ast_algs ast_rules origin Primitives.SPECIES_OFF pexpr' :: l in let domain'', ccs = - Pattern_compiler.connected_components_sum_of_ambiguous_mixture ~debugMode - ~compileModeOn contact_map domain' ~origin ast + Pattern_compiler.connected_components_sum_of_ambiguous_mixture ~debug_mode + ~compile_mode_on contact_map domain' ~origin ast in let () = List.iter @@ -360,12 +364,12 @@ let effects_of_modif ~debugMode ~warning ast_algs ast_rules origin (fun x (y, t) -> adds t x (Array.map fst y)) rev_effects ccs ) -let effects_of_modifs ~debugMode ~warning ast_algs ast_rules origin - ~compileModeOn contact_map domain l = +let effects_of_modifs ~debug_mode ~warning ast_algs ast_rules origin + ~compile_mode_on contact_map domain l = let domain', rev_effects = List.fold_left - (effects_of_modif ~debugMode ~warning ast_algs ast_rules origin - ~compileModeOn contact_map) + (effects_of_modif ~debug_mode ~warning ast_algs ast_rules origin + ~compile_mode_on contact_map) (domain, []) l in domain', List.rev rev_effects @@ -380,16 +384,16 @@ let pert_not_init overwrite_t0 x y z = | _, Some p, _ -> p | Some _, None, None -> let t_var = - Locality.dummy_annot (Alg_expr.STATE_ALG_OP Operator.TIME_VAR) + Loc.annot_with_dummy (Alg_expr.STATE_ALG_OP Operator.TIME_VAR) in let t0 = Option_util.fold (fun _ x -> Nbr.F x) Nbr.zero overwrite_t0 in - let init_t = Locality.dummy_annot (Alg_expr.CONST t0) in - Locality.dummy_annot (Alg_expr.COMPARE_OP (Operator.GREATER, t_var, init_t)) + let init_t = Loc.annot_with_dummy (Alg_expr.CONST t0) in + Loc.annot_with_dummy (Alg_expr.COMPARE_OP (Operator.GREATER, t_var, init_t)) | None, None, None | Some _, None, Some _ | None, None, Some _ -> - Locality.dummy_annot Alg_expr.TRUE + Loc.annot_with_dummy Alg_expr.TRUE -let pert_of_result ~debugMode ~warning ?overwrite_t0 ast_algs ast_rules alg_deps - ~compileModeOn contact_map domain res = +let pert_of_result ~debug_mode ~warning ?overwrite_t0 ast_algs ast_rules + alg_deps ~compile_mode_on contact_map domain res = let domain, out_alg_deps, _, lpert, tracking_enabled = List.fold_left (fun (domain, alg_deps, p_id, lpert, tracking_enabled) @@ -408,7 +412,7 @@ let pert_of_result ~debugMode ~warning ?overwrite_t0 ast_algs ast_rules alg_deps let origin = Operator.MODIF p_id in let pre_expr' = pert_not_init overwrite_t0 alarm pre_expr opt_post in let domain', pre = - compile_bool ~debugMode ~compileModeOn ~origin contact_map domain + compile_bool ~debug_mode ~compile_mode_on ~origin contact_map domain pre_expr' in let alg_deps' = @@ -417,15 +421,15 @@ let pert_of_result ~debugMode ~warning ?overwrite_t0 ast_algs ast_rules alg_deps | None -> Alg_expr.add_dep_bool alg_deps origin pre in let domain, effects = - effects_of_modifs ~debugMode ~warning ast_algs ast_rules origin - ~compileModeOn contact_map domain' modif_expr_list + effects_of_modifs ~debug_mode ~warning ast_algs ast_rules origin + ~compile_mode_on contact_map domain' modif_expr_list in let domain, opt = match opt_post with | None -> domain, None | Some post_expr -> let domain', (post, post_pos) = - compile_bool ~debugMode ~compileModeOn contact_map domain + compile_bool ~debug_mode ~compile_mode_on contact_map domain post_expr in domain', Some (post, post_pos) @@ -458,7 +462,7 @@ let pert_of_result ~debugMode ~warning ?overwrite_t0 ast_algs ast_rules alg_deps in let repeat = match opt with - | None -> Locality.dummy_annot Alg_expr.FALSE + | None -> Loc.annot_with_dummy Alg_expr.FALSE | Some p -> p in let pert = @@ -476,7 +480,7 @@ let pert_of_result ~debugMode ~warning ?overwrite_t0 ast_algs ast_rules alg_deps in domain, out_alg_deps, List.rev lpert, tracking_enabled -let compile_inits ~debugMode ~warning ?rescale ~compileModeOn contact_map env +let compile_inits ~debug_mode ~warning ?rescale ~compile_mode_on contact_map env inits = let init_l, _ = List_util.fold_right_map @@ -497,7 +501,7 @@ let compile_inits ~debugMode ~warning ?rescale ~compileModeOn contact_map env | INIT_MIX (raw_mix, mix_pos) -> let sigs = Model.signatures env in let preenv', alg' = - compile_alg ~debugMode ~compileModeOn contact_map preenv alg + compile_alg ~debug_mode ~compile_mode_on contact_map preenv alg in let fake_rule = { @@ -506,12 +510,12 @@ let compile_inits ~debugMode ~warning ?rescale ~compileModeOn contact_map env LKappa.r_delta_tokens = []; LKappa.r_rate = Alg_expr.const Nbr.zero; LKappa.r_un_rate = None; - LKappa.r_editStyle = true; + LKappa.r_edit_style = true; } in let preenv'', state' = match - rules_of_ast ~debugMode ~warning ~compileModeOn contact_map + rules_of_ast ~debug_mode ~warning ~compile_mode_on contact_map preenv' ~syntax_ref:0 (fake_rule, mix_pos) with | domain'', _, [ compiled_rule ] -> @@ -520,7 +524,7 @@ let compile_inits ~debugMode ~warning ?rescale ~compileModeOn contact_map env raise (ExceptionDefn.Malformed_Decl ( Format.asprintf "initial mixture %a is partially defined" - (Raw_mixture.print ~noCounters:debugMode ~created:true + (Raw_mixture.print ~noCounters:debug_mode ~created:true ~initial_comma:false ~sigs) raw_mix, mix_pos )) @@ -537,13 +541,13 @@ let compile_inits ~debugMode ~warning ?rescale ~compileModeOn contact_map env LKappa.r_delta_tokens; LKappa.r_rate = Alg_expr.const Nbr.zero; LKappa.r_un_rate = None; - LKappa.r_editStyle = false; + LKappa.r_edit_style = false; } in (match - rules_of_ast ~debugMode ~warning ~compileModeOn contact_map preenv - ~syntax_ref:0 - (Locality.dummy_annot fake_rule) + rules_of_ast ~debug_mode ~warning ~compile_mode_on contact_map + preenv ~syntax_ref:0 + (Loc.annot_with_dummy fake_rule) with | domain'', _, [ compiled_rule ] -> (Alg_expr.CONST Nbr.one, compiled_rule), domain'' @@ -553,23 +557,23 @@ let compile_inits ~debugMode ~warning ?rescale ~compileModeOn contact_map env in init_l -let compile_alg_vars ~debugMode ~compileModeOn contact_map domain vars = +let compile_alg_vars ~debug_mode ~compile_mode_on contact_map domain vars = Tools.array_fold_left_mapi (fun i domain (lbl_pos, ast) -> let domain', alg = - compile_alg ~debugMode ~compileModeOn ~origin:(Operator.ALG i) + compile_alg ~debug_mode ~compile_mode_on ~origin:(Operator.ALG i) contact_map domain ast in domain', (lbl_pos, alg)) domain (Array.of_list vars) -let compile_rules ~debugMode ~warning alg_deps ~compileModeOn contact_map domain - rules = +let compile_rules ~debug_mode ~warning alg_deps ~compile_mode_on contact_map + domain rules = match List.fold_left (fun (domain, syntax_ref, deps_machinery, acc) (_, rule) -> let domain', origin', cr = - rules_of_ast ~debugMode ~warning ?deps_machinery ~compileModeOn + rules_of_ast ~debug_mode ~warning ?deps_machinery ~compile_mode_on contact_map domain ~syntax_ref rule in domain', succ syntax_ref, origin', List.append cr acc) @@ -581,7 +585,7 @@ let compile_rules ~debugMode ~warning alg_deps ~compileModeOn contact_map domain | _, _, None, _ -> failwith "The origin of Eval.compile_rules has been lost" (*let translate_contact_map sigs kasa_contact_map = - let wdl = Locality.dummy_annot in + let wdl = Loc.annot_with_dummy in let sol = Array.init (Signature.size sigs) (fun i -> Array.make (Signature.arity sigs i) ([],[])) in @@ -617,7 +621,7 @@ let compile_rules ~debugMode ~warning alg_deps ~compileModeOn contact_map domain translate_contact_map sigs contact_map, Export_to_KaSim.flush_errors kasa_state *) -let compile ~outputs ~pause ~return ~sharing ~debugMode ~compileModeOn +let compile ~outputs ~pause ~return ~sharing ~debug_mode ~compile_mode_on ?overwrite_init ?overwrite_t0 ?rescale_init sigs_nd tk_nd contact_map result = let warning ~pos msg = outputs (Data.Warning (Some pos, msg)) in @@ -625,7 +629,7 @@ let compile ~outputs ~pause ~return ~sharing ~debugMode ~compileModeOn let preenv = Pattern.PreEnv.empty sigs_nd in outputs (Data.Log "\t -variable declarations"); let preenv', alg_a = - compile_alg_vars ~debugMode ~compileModeOn contact_map preenv + compile_alg_vars ~debug_mode ~compile_mode_on contact_map preenv result.Ast.variables in let alg_nd = NamedDecls.create alg_a in @@ -634,7 +638,7 @@ let compile ~outputs ~pause ~return ~sharing ~debugMode ~compileModeOn pause @@ fun () -> outputs (Data.Log "\t -rules"); let preenv', alg_deps', compiled_rules = - compile_rules ~debugMode ~warning alg_deps ~compileModeOn contact_map + compile_rules ~debug_mode ~warning alg_deps ~compile_mode_on contact_map preenv' result.Ast.rules in let rule_nd = Array.of_list compiled_rules in @@ -642,19 +646,20 @@ let compile ~outputs ~pause ~return ~sharing ~debugMode ~compileModeOn pause @@ fun () -> outputs (Data.Log "\t -interventions"); let preenv, alg_deps'', pert, has_tracking = - pert_of_result ~debugMode ~warning ?overwrite_t0 result.variables - result.rules alg_deps' ~compileModeOn contact_map preenv' result + pert_of_result ~debug_mode ~warning ?overwrite_t0 result.variables + result.rules alg_deps' ~compile_mode_on contact_map preenv' result in pause @@ fun () -> outputs (Data.Log "\t -observables"); let preenv, obs = - obs_of_result ~debugMode ~compileModeOn contact_map preenv alg_deps result + obs_of_result ~debug_mode ~compile_mode_on contact_map preenv alg_deps + result in outputs (Data.Log "\t -update_domain construction"); pause @@ fun () -> let domain, dom_stats = - Pattern.finalize ~debugMode ~sharing preenv contact_map + Pattern.finalize ~debug_mode ~sharing preenv contact_map in outputs (Data.Log @@ -673,17 +678,17 @@ let compile ~outputs ~pause ~return ~sharing ~debugMode ~compileModeOn outputs (Data.Log "\t -initial conditions"); pause @@ fun () -> let init_l = - compile_inits ~debugMode ~warning ?rescale:rescale_init ~compileModeOn + compile_inits ~debug_mode ~warning ?rescale:rescale_init ~compile_mode_on contact_map env (Option_util.unsome result.Ast.init overwrite_init) in return (env, has_tracking, init_l) -let build_initial_state ~bind ~return ~debugMode ~outputs counter env +let build_initial_state ~bind ~return ~debug_mode ~outputs counter env ~with_trace ~with_delta_activities random_state init_l = let graph0 = Rule_interpreter.empty ~outputs ~with_trace random_state env counter in let state0 = State_interpreter.empty ~with_delta_activities counter env in - State_interpreter.initialize ~bind ~return ~debugMode ~outputs env counter + State_interpreter.initialize ~bind ~return ~debug_mode ~outputs env counter graph0 state0 init_l diff --git a/core/grammar/eval.mli b/core/grammar/eval.mli index f9df6a89d5..547b83b04f 100644 --- a/core/grammar/eval.mli +++ b/core/grammar/eval.mli @@ -10,37 +10,37 @@ (*val init_kasa : Remanent_parameters_sig.called_from -> Signature.s -> - (string Locality.annot * Ast.port list, Ast.mixture, string, Ast.rule) + (string Loc.annoted * Ast.port list, Ast.mixture, string, Ast.rule) Ast.compil -> Primitives.contact_map * Export_to_KaSim.state *) val compile_bool : - debugMode:bool -> - compileModeOn:bool -> + debug_mode:bool -> + compile_mode_on:bool -> ?origin:Operator.rev_dep -> Contact_map.t -> Pattern.PreEnv.t -> - (LKappa.rule_mixture, int) Alg_expr.bool Locality.annot -> - Pattern.PreEnv.t * (Pattern.id array list, int) Alg_expr.bool Locality.annot + (LKappa.rule_mixture, int) Alg_expr.bool Loc.annoted -> + Pattern.PreEnv.t * (Pattern.id array list, int) Alg_expr.bool Loc.annoted val compile_modifications_no_track : - debugMode:bool -> - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> - compileModeOn:bool -> + debug_mode:bool -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> + compile_mode_on:bool -> Contact_map.t -> Pattern.PreEnv.t -> (LKappa.rule_mixture, Raw_mixture.t, int, LKappa.rule) Ast.modif_expr list -> Pattern.PreEnv.t * Primitives.modification list val compile_inits : - debugMode:bool -> - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> + debug_mode:bool -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> ?rescale:float -> - compileModeOn:bool -> + compile_mode_on:bool -> Contact_map.t -> Model.t -> - (LKappa.rule_mixture, Raw_mixture.t, int) Ast.init_statment list -> + (LKappa.rule_mixture, Raw_mixture.t, int) Ast.init_statement list -> (Primitives.alg_expr * Primitives.elementary_rule) list val compile : @@ -52,10 +52,10 @@ val compile : * (Primitives.alg_expr * Primitives.elementary_rule) list -> 'b) -> sharing:Pattern.sharing_level -> - debugMode:bool -> - compileModeOn:bool -> + debug_mode:bool -> + compile_mode_on:bool -> ?overwrite_init: - (LKappa.rule_mixture, Raw_mixture.t, int) Ast.init_statment list -> + (LKappa.rule_mixture, Raw_mixture.t, int) Ast.init_statement list -> ?overwrite_t0:float -> ?rescale_init:float -> Signature.s -> @@ -67,7 +67,7 @@ val compile : val build_initial_state : bind:('a -> (bool * Rule_interpreter.t * State_interpreter.t -> 'a) -> 'a) -> return:(bool * Rule_interpreter.t * State_interpreter.t -> 'a) -> - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> Counter.t -> Model.t -> diff --git a/core/grammar/evaluator.ml b/core/grammar/evaluator.ml index c58c0774c3..c5c4c3cf52 100644 --- a/core/grammar/evaluator.ml +++ b/core/grammar/evaluator.ml @@ -6,7 +6,7 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) -let do_interactive_directives ~debugMode ~outputs ~sharing ~syntax_version +let do_interactive_directives ~debug_mode ~outputs ~sharing ~syntax_version contact_map env counter graph state e = let warning ~pos msg = outputs (Data.Warning (Some pos, msg)) in let cc_preenv = Pattern.PreEnv.of_env (Model.domain env) in @@ -27,33 +27,33 @@ let do_interactive_directives ~debugMode ~outputs ~sharing ~syntax_version then raise (ExceptionDefn.Malformed_Decl - (Locality.dummy_annot "Creating new link type is forbidden")) + (Loc.annot_with_dummy "Creating new link type is forbidden")) in let cc_preenv', e'' = - Eval.compile_modifications_no_track ~debugMode ~warning ~compileModeOn:false - contact_map cc_preenv e' + Eval.compile_modifications_no_track ~debug_mode ~warning + ~compile_mode_on:false contact_map cc_preenv e' in let env', graph' = if cc_preenv == cc_preenv' then env, graph else ( let fenv, _ = - Pattern.finalize ~debugMode ~sharing cc_preenv' contact_map + Pattern.finalize ~debug_mode ~sharing cc_preenv' contact_map in ( Model.new_domain fenv env, List.fold_left - (Rule_interpreter.incorporate_extra_pattern ~debugMode fenv) + (Rule_interpreter.incorporate_extra_pattern ~debug_mode fenv) graph (Primitives.extract_connected_components_modifications e'') ) ) in let ostop, ograph, ostate, _ = - State_interpreter.do_modifications ~debugMode ~outputs env' counter graph' + State_interpreter.do_modifications ~debug_mode ~outputs env' counter graph' state e'' in e'', (env', (ostop, ograph, ostate)) -let get_pause_criteria ~debugMode ~outputs ~sharing ~syntax_version contact_map +let get_pause_criteria ~debug_mode ~outputs ~sharing ~syntax_version contact_map env graph b = let warning ~pos msg = outputs (Data.Warning (Some pos, msg)) in let cc_preenv = Pattern.PreEnv.of_env (Model.domain env) in @@ -62,18 +62,19 @@ let get_pause_criteria ~debugMode ~outputs ~sharing ~syntax_version contact_map (Model.signatures env) (Model.tokens_finder env) (Model.algs_finder env) b in let cc_preenv', ((b'', pos_b'') as bpos'') = - Eval.compile_bool ~debugMode ~compileModeOn:false contact_map cc_preenv b' + Eval.compile_bool ~debug_mode ~compile_mode_on:false contact_map cc_preenv + b' in let env', graph' = if cc_preenv == cc_preenv' then env, graph else ( let fenv, _ = - Pattern.finalize ~debugMode ~sharing cc_preenv' contact_map + Pattern.finalize ~debug_mode ~sharing cc_preenv' contact_map in ( Model.new_domain fenv env, List.fold_left - (Rule_interpreter.incorporate_extra_pattern ~debugMode fenv) + (Rule_interpreter.incorporate_extra_pattern ~debug_mode fenv) graph (Primitives.extract_connected_components_bool bpos'') ) ) @@ -86,7 +87,7 @@ let get_pause_criteria ~debugMode ~outputs ~sharing ~syntax_version contact_map in env', graph', b'' -let find_all_embeddings ~debugMode env tr = +let find_all_embeddings ~debug_mode env tr = let domain = Model.domain env in let dummy_instances = Instances.empty env in let graph = @@ -97,9 +98,9 @@ let find_all_embeddings ~debugMode env tr = tr in let out, _ = - Rule_interpreter.obs_from_transformations ~debugMode domain graph tr + Rule_interpreter.obs_from_transformations ~debug_mode domain graph tr in List.map (fun (p, (root, _)) -> - p, Matching.reconstruct_renaming ~debugMode domain graph p root) + p, Matching.reconstruct_renaming ~debug_mode domain graph p root) out diff --git a/core/grammar/evaluator.mli b/core/grammar/evaluator.mli index 9acdbe4f95..86e25d8a26 100644 --- a/core/grammar/evaluator.mli +++ b/core/grammar/evaluator.mli @@ -7,7 +7,7 @@ (******************************************************************************) val do_interactive_directives : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> sharing:Pattern.sharing_level -> syntax_version:Ast.syntax_version -> @@ -21,18 +21,18 @@ val do_interactive_directives : * (Model.t * (bool * Rule_interpreter.t * State_interpreter.t)) val get_pause_criteria : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> sharing:Pattern.sharing_level -> syntax_version:Ast.syntax_version -> Contact_map.t -> Model.t -> Rule_interpreter.t -> - (Ast.mixture, string) Alg_expr.bool Locality.annot -> + (Ast.mixture, string) Alg_expr.bool Loc.annoted -> Model.t * Rule_interpreter.t * (Pattern.id array list, int) Alg_expr.bool val find_all_embeddings : - debugMode:bool -> + debug_mode:bool -> Model.t -> Instantiation.concrete Primitives.Transformation.t list -> (Pattern.id * Renaming.t) list diff --git a/core/grammar/kappaLexer.mli b/core/grammar/kappaLexer.mli index 794c89467c..05b5cb6559 100644 --- a/core/grammar/kappaLexer.mli +++ b/core/grammar/kappaLexer.mli @@ -1,7 +1,7 @@ val compile : Format.formatter -> (Ast.agent, Ast.mixture, Ast.mixture, string, Ast.rule) Ast.compil -> - string -> + string (** file *) -> Ast.parsing_compil val position : Lexing.lexbuf -> string * int * int diff --git a/core/grammar/kappaLexer.mll b/core/grammar/kappaLexer.mll index 86dcb5a5ba..f6b2258ff2 100644 --- a/core/grammar/kappaLexer.mll +++ b/core/grammar/kappaLexer.mll @@ -72,7 +72,7 @@ rule token = parse raise (ExceptionDefn.Syntax_Error ("Perturbation effect \""^s^"\" is not defined", - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf))) } | '[' blank* (id as lab) blank* ']' { @@ -102,7 +102,7 @@ rule token = parse | _ as s -> raise (ExceptionDefn.Syntax_Error ("Symbol \""^s^"\" is not defined", - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf))) } | ':' {TYPE} @@ -115,7 +115,7 @@ rule token = parse | integer as n {try INT (int_of_string n) with Failure _ -> raise (ExceptionDefn.Syntax_Error (n^" is a incorrect integer", - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf)))} | real as f {FLOAT (float_of_string f)} @@ -150,7 +150,7 @@ rule token = parse | _ as s -> raise (ExceptionDefn.Syntax_Error ("Instruction \""^s^"\" not recognized", - Locality.of_pos + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf))) } @@ -166,7 +166,7 @@ rule token = parse | _ as c { raise (ExceptionDefn.Syntax_Error ("invalid use of character "^ String.make 1 c, - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf))) } @@ -193,13 +193,13 @@ and inline_comment = parse | '/' '*' {inline_comment lexbuf; inline_comment lexbuf} | _ {inline_comment lexbuf} { - let compile logger compil fic = - let d = open_in fic in + let compile logger compil file = + let d = open_in file in let lexbuf = Lexing.from_channel d in - let () = lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = fic} in - let compil = { compil with Ast.filenames = fic :: compil.Ast.filenames } in + let () = lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = file} in + let compil = { compil with Ast.filenames = file :: compil.Ast.filenames } in try - let () = Format.fprintf logger "Parsing %s...@." fic in + let () = Format.fprintf logger "Parsing %s...@." file in let out = KappaParser.start_rule token lexbuf compil in let () = Format.fprintf logger "done@." in let () = close_in d in out diff --git a/core/grammar/kappaParser.mly b/core/grammar/kappaParser.mly index 651838deb3..ae798518c5 100644 --- a/core/grammar/kappaParser.mly +++ b/core/grammar/kappaParser.mly @@ -8,9 +8,9 @@ %{ let add_pos x = - (x,Locality.of_pos (Parsing.symbol_start_pos ()) (Parsing.symbol_end_pos ())) + (x,Loc.of_pos (Parsing.symbol_start_pos ()) (Parsing.symbol_end_pos ())) let rhs_pos i = - Locality.of_pos (Parsing.rhs_start_pos i) (Parsing.rhs_end_pos i) + Loc.of_pos (Parsing.rhs_start_pos i) (Parsing.rhs_end_pos i) %} %token EOF NEWLINE SEMICOLON COMMA DOT OP_PAR CL_PAR OP_CUR CL_CUR AT TYPE LAR @@ -47,7 +47,7 @@ %type <(Ast.mixture,Ast.mixture,string,Ast.rule) Ast.modif_expr list> standalone_effect_list %start standalone_bool_expr -%type <(Ast.mixture,string) Alg_expr.bool Locality.annot> standalone_bool_expr +%type <(Ast.mixture,string) Alg_expr.bool Loc.annoted> standalone_bool_expr %% /*Grammar rules*/ @@ -402,9 +402,9 @@ rate: | alg_expr OP_PAR alg_with_radius CL_PAR { ($1,Some $3) } | alg_expr {($1,None)} | OP_CUR alg_with_radius CL_CUR - {(Locality.dummy_annot (Alg_expr.CONST Nbr.zero),Some $2)} + {(Loc.annot_with_dummy (Alg_expr.CONST Nbr.zero),Some $2)} | alg_expr OP_CUR CL_CUR - {($1,Some (Locality.dummy_annot (Alg_expr.CONST Nbr.zero),None))} + {($1,Some (Loc.annot_with_dummy (Alg_expr.CONST Nbr.zero),None))} | {raise (ExceptionDefn.Syntax_Error (add_pos "missing rule rate"))} ; @@ -421,15 +421,15 @@ pattern: non_empty_mixture: | ID OP_PAR interface_expression CL_PAR - { [[Ast.Present (($1,rhs_pos 1), $3, None)]] } + { [[Ast.Present (($1,rhs_pos 1), $3, Ast.NoMod)]] } | ID OP_PAR interface_expression CL_PAR COMMA pattern - { [Ast.Present (($1,rhs_pos 1), $3, None) :: $6]} + { [Ast.Present (($1,rhs_pos 1), $3, Ast.NoMod) :: $6]} ; mod_agent: - | { None } - | PLUS { Some Ast.Create } - | MINUS { Some Ast.Erase }; + | { Ast.NoMod } + | PLUS { Ast.Create } + | MINUS { Ast.Erase }; agent_expression: | mod_agent ID OP_PAR interface_expression CL_PAR @@ -453,45 +453,45 @@ counter_test: port_expression: | ID internal_state link_state_mod { Ast.Port - {Ast.port_nme=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_lnk=[]; - Ast.port_int_mod = None; Ast.port_lnk_mod = $3; } } + {Ast.port_name=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_link=[]; + Ast.port_int_mod = None; Ast.port_link_mod = $3; } } | ID internal_state link_state link_state_mod { Ast.Port - {Ast.port_nme=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_lnk=$3; - Ast.port_int_mod = None; Ast.port_lnk_mod = $4; } } + {Ast.port_name=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_link=$3; + Ast.port_int_mod = None; Ast.port_link_mod = $4; } } | ID internal_state DIV KAPPA_MRK link_state_mod { Ast.Port - {Ast.port_nme=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_lnk=[]; - Ast.port_int_mod = Some($4,rhs_pos 4); Ast.port_lnk_mod = $5; } } + {Ast.port_name=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_link=[]; + Ast.port_int_mod = Some($4,rhs_pos 4); Ast.port_link_mod = $5; } } | ID internal_state DIV KAPPA_MRK link_state link_state_mod { Ast.Port - {Ast.port_nme=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_lnk=$5; - Ast.port_int_mod = Some($4,rhs_pos 4); Ast.port_lnk_mod = $6; } } + {Ast.port_name=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_link=$5; + Ast.port_int_mod = Some($4,rhs_pos 4); Ast.port_link_mod = $6; } } | ID PLUS EQUAL INT { Ast.Counter - { Ast.count_nme = ($1,rhs_pos 1); - Ast.count_test = None; - Ast.count_delta = ($4,rhs_pos 4)} } + { Ast.counter_name = ($1,rhs_pos 1); + Ast.counter_test = None; + Ast.counter_delta = ($4,rhs_pos 4)} } | ID PLUS EQUAL MINUS INT { Ast.Counter - { Ast.count_nme = ($1,rhs_pos 1); - Ast.count_test = None; - Ast.count_delta = (-$5,rhs_pos 5)} } + { Ast.counter_name = ($1,rhs_pos 1); + Ast.counter_test = None; + Ast.counter_delta = (-$5,rhs_pos 5)} } | ID counter_test PLUS EQUAL INT { Ast.Counter - { Ast.count_nme = ($1,rhs_pos 1); - Ast.count_test = $2; - Ast.count_delta = ($5,rhs_pos 5)} } + { Ast.counter_name = ($1,rhs_pos 1); + Ast.counter_test = $2; + Ast.counter_delta = ($5,rhs_pos 5)} } | ID counter_test PLUS EQUAL MINUS INT { Ast.Counter - { Ast.count_nme = ($1,rhs_pos 1); - Ast.count_test = $2; - Ast.count_delta = (- $6,rhs_pos 6)} } + { Ast.counter_name = ($1,rhs_pos 1); + Ast.counter_test = $2; + Ast.counter_delta = (- $6,rhs_pos 6)} } | ID counter_test { Ast.Counter - { Ast.count_nme = ($1,rhs_pos 1); - Ast.count_test = $2; - Ast.count_delta = Locality.dummy_annot 0} } + { Ast.counter_name = ($1,rhs_pos 1); + Ast.counter_test = $2; + Ast.counter_delta = Loc.annot_with_dummy 0} } ; internal_state: @@ -528,7 +528,7 @@ link_state: | a_link_state {[$1]}; interactive_command: - | RUN NEWLINE {Ast.RUN (Locality.dummy_annot Alg_expr.FALSE)} + | RUN NEWLINE {Ast.RUN (Loc.annot_with_dummy Alg_expr.FALSE)} | RUN bool_expr NEWLINE {Ast.RUN $2} | effect_list NEWLINE {Ast.MODIFY $1} | EOF {Ast.QUIT} diff --git a/core/grammar/kfiles.ml b/core/grammar/kfiles.ml index 9244f3e81b..36bbd8c2f6 100644 --- a/core/grammar/kfiles.ml +++ b/core/grammar/kfiles.ml @@ -139,10 +139,10 @@ let parse yield catalog = | Invalid_argument error -> Lwt.return ( compile, - Locality.dummy_annot ("Runtime error " ^ error) :: err ) + Loc.annot_with_dummy ("Runtime error " ^ error) :: err ) | exn -> let message = Printexc.to_string exn in - Lwt.return (compile, Locality.dummy_annot message :: err))) + Lwt.return (compile, Loc.annot_with_dummy message :: err))) catalog.index (Lwt.return (Ast.empty_compil, [])) >>= ( function @@ -154,7 +154,7 @@ let parse yield catalog = List.map (fun ((text, p) as x) -> let range = - if Locality.has_dummy_annot x then + if Loc.is_annoted_with_dummy x then None else Some p diff --git a/core/grammar/klexer4.mli b/core/grammar/klexer4.mli index b1abce1e83..45b3d89d75 100644 --- a/core/grammar/klexer4.mli +++ b/core/grammar/klexer4.mli @@ -1,5 +1,5 @@ val model : - Lexing.lexbuf -> Ast.parsing_instruction list * string Locality.annot list + Lexing.lexbuf -> Ast.parsing_instruction list * string Loc.annoted list val compile : Format.formatter -> diff --git a/core/grammar/klexer4.mll b/core/grammar/klexer4.mll index bd31ef53ec..7cdb66a5bd 100644 --- a/core/grammar/klexer4.mll +++ b/core/grammar/klexer4.mll @@ -72,12 +72,12 @@ rule token = parse | '\'' ([^'\n' '\'']+ as s) (eof | '\n') { raise (ExceptionDefn.Syntax_Error ("Unterminated label: "^s, - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf)))} | '\"' ([^'\n' '\"']+ as s) (eof | '\n') { raise (ExceptionDefn.Syntax_Error ("Unterminated string: "^s, - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf)))} | id as str { keyword_or_id str } | '%' (id as lab) ':' { @@ -92,7 +92,7 @@ rule token = parse | "token" -> TOKEN | _ as s -> raise (ExceptionDefn.Syntax_Error ("Unknown directive: "^s, - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf))) } | '[' blank* '?' blank* ']' { THEN } @@ -121,7 +121,7 @@ rule token = parse | "not" -> NOT | _ as s -> raise (ExceptionDefn.Syntax_Error ("Unknown primitive: "^s, - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf))) } | '$' (id as s) { @@ -141,13 +141,13 @@ rule token = parse | "SPECIES_OF" -> SPECIES_OF | s -> raise (ExceptionDefn.Syntax_Error ("Unknown intervention: "^s, - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf))) } | eof { lexbuf.Lexing.lex_eof_reached <- true; EOF } | _ as c { raise (ExceptionDefn.Syntax_Error ("Unknown character: "^String.make 1 c, - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf))) } and inline_comment acc = parse @@ -165,7 +165,7 @@ and inline_comment acc = parse | (('*' | '/')? '\"' [^'\n' '\"']+ (eof | '\n')) as x { raise (ExceptionDefn.Syntax_Error ("Unterminated string in comment: "^x, - Locality.of_pos (Lexing.lexeme_start_p lexbuf) + Loc.of_pos (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf)))} | '/' '*' { inline_comment ("*/"::(inline_comment ["/*"] lexbuf):: acc) lexbuf } diff --git a/core/grammar/kparser4.mly b/core/grammar/kparser4.mly index 890407146d..d3ea9a589c 100644 --- a/core/grammar/kparser4.mly +++ b/core/grammar/kparser4.mly @@ -9,9 +9,9 @@ %{ let add_pos e x = (x, - Locality.of_pos (Parsing.symbol_start_pos ()) (Parsing.rhs_end_pos e)) + Loc.of_pos (Parsing.symbol_start_pos ()) (Parsing.rhs_end_pos e)) let rhs_pos i = - Locality.of_pos (Parsing.rhs_start_pos i) (Parsing.rhs_end_pos i) + Loc.of_pos (Parsing.rhs_start_pos i) (Parsing.rhs_end_pos i) let end_pos = Parsing.rhs_end_pos let start_pos = Parsing.rhs_start_pos @@ -44,15 +44,15 @@ <(Ast.mixture,Ast.mixture,string,Ast.rule) Ast.modif_expr list> standalone_effect_list %start standalone_bool_expr -%type <(Ast.mixture,string) Alg_expr.bool Locality.annot> standalone_bool_expr +%type <(Ast.mixture,string) Alg_expr.bool Loc.annoted> standalone_bool_expr %% -annot: +annoted: | { [] } - | NEWLINE annot { "\n"::$2 } - | SPACE annot { $1::$2 } - | COMMENT annot { $1::$2 } + | NEWLINE annoted { "\n"::$2 } + | SPACE annoted { $1::$2 } + | COMMENT annoted { $1::$2 } ; nbr: @@ -65,24 +65,24 @@ link_state: | DOT { add_pos 1 LKappa.LNK_FREE } | INT { add_pos 1 (LKappa.LNK_VALUE ($1,())) } | UNDERSCORE { add_pos 1 LKappa.LNK_SOME } - | ID annot DOT annot ID + | ID annoted DOT annoted ID { add_pos 5 (LKappa.LNK_TYPE (($1,rhs_pos 1),($5,rhs_pos 5))) } | SHARP { add_pos 1 LKappa.LNK_ANY } - | ID annot error + | ID annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "incomplete link state")) } ; link_states: - | link_state annot { [$1] } - | link_state annot link_states { $1 :: $3 } - | link_state annot COMMA annot link_states { $1 :: $5 } + | link_state annoted { [$1] } + | link_state annoted link_states { $1 :: $3 } + | link_state annoted COMMA annoted link_states { $1 :: $5 } ; link_modif: | { None } - | DIV annot DOT annot { Some None } - | DIV annot INT annot { Some (Some ($3, rhs_pos 3)) } - | DIV annot error + | DIV annoted DOT annoted { Some None } + | DIV annoted INT annoted { Some (Some ($3, rhs_pos 3)) } + | DIV annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "incomplete link modification")) } ; @@ -93,22 +93,22 @@ internal_state: ; internal_states: - | internal_state annot { [$1] } - | internal_state annot internal_states { $1 :: $3 } - | internal_state annot COMMA annot internal_states { $1 :: $5 } + | internal_state annoted { [$1] } + | internal_state annoted internal_states { $1 :: $3 } + | internal_state annoted COMMA annoted internal_states { $1 :: $5 } ; internal_modif: | { None } - | DIV annot ID annot { Some ($3, rhs_pos 3) } - | DIV annot error + | DIV annoted ID annoted { Some ($3, rhs_pos 3) } + | DIV annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "incomplete link modification")) } ; site_link: - | annot link_states link_modif CL_BRA { ($2, $3) } - | annot error + | annoted link_states link_modif CL_BRA { ($2, $3) } + | annoted error { raise (ExceptionDefn.Syntax_Error ("invalid linking state or missing ']'",rhs_pos 2)) } ; @@ -121,55 +121,55 @@ site_internal: ; counter_modif: - | PLUS annot EQUAL annot INT { ($5, rhs_pos 5) } - | PLUS annot EQUAL annot MINUS annot INT { (- $7, rhs_pos 7) } - | MINUS annot EQUAL annot INT { (- $5, rhs_pos 5) } + | PLUS annoted EQUAL annoted INT { ($5, rhs_pos 5) } + | PLUS annoted EQUAL annoted MINUS annoted INT { (- $7, rhs_pos 7) } + | MINUS annoted EQUAL annoted INT { (- $5, rhs_pos 5) } ; counter_test: - | EQUAL annot INT { (Ast.CEQ $3,rhs_pos 3) } - | GREATER annot EQUAL annot INT { (Ast.CGTE $5,rhs_pos 5) } - | EQUAL annot ID { (Ast.CVAR $3,rhs_pos 3) } + | EQUAL annoted INT { (Ast.CEQ $3,rhs_pos 3) } + | GREATER annoted EQUAL annoted INT { (Ast.CGTE $5,rhs_pos 5) } + | EQUAL annoted ID { (Ast.CVAR $3,rhs_pos 3) } ; site_counter: - | counter_modif annot CL_CUR annot { (None, $1) } - | counter_test annot CL_CUR annot { (Some $1, Locality.dummy_annot 0) } - | counter_test annot DIV annot counter_modif annot CL_CUR annot + | counter_modif annoted CL_CUR annoted { (None, $1) } + | counter_test annoted CL_CUR annoted { (Some $1, Loc.annot_with_dummy 0) } + | counter_test annoted DIV annoted counter_modif annoted CL_CUR annoted { (Some $1,$5) } ; site: - | ID annot OP_BRA site_link annot OP_CUR annot site_internal annot - { let (port_lnk, port_lnk_mod) = $4 in + | ID annoted OP_BRA site_link annoted OP_CUR annoted site_internal annoted + { let (port_link, port_link_mod) = $4 in let (port_int, port_int_mod) = $8 in Ast.Port - { Ast.port_nme=($1,rhs_pos 1); Ast.port_int; - Ast.port_lnk; Ast.port_int_mod; Ast.port_lnk_mod; } } - | ID annot OP_CUR annot site_internal annot OP_BRA site_link annot + { Ast.port_name=($1,rhs_pos 1); Ast.port_int; + Ast.port_link; Ast.port_int_mod; Ast.port_link_mod; } } + | ID annoted OP_CUR annoted site_internal annoted OP_BRA site_link annoted { let (port_int, port_int_mod) = $5 in - let (port_lnk, port_lnk_mod) = $8 in + let (port_link, port_link_mod) = $8 in Ast.Port - { Ast.port_nme=($1,rhs_pos 1); Ast.port_int; - Ast.port_lnk; Ast.port_int_mod; Ast.port_lnk_mod; } } - | ID annot OP_BRA site_link annot - { let (port_lnk, port_lnk_mod) = $4 in + { Ast.port_name=($1,rhs_pos 1); Ast.port_int; + Ast.port_link; Ast.port_int_mod; Ast.port_link_mod; } } + | ID annoted OP_BRA site_link annoted + { let (port_link, port_link_mod) = $4 in Ast.Port - { Ast.port_nme=($1,rhs_pos 1); Ast.port_int=[]; - Ast.port_lnk; Ast.port_int_mod=None; Ast.port_lnk_mod; } } - | ID annot OP_CUR annot site_internal annot + { Ast.port_name=($1,rhs_pos 1); Ast.port_int=[]; + Ast.port_link; Ast.port_int_mod=None; Ast.port_link_mod; } } + | ID annoted OP_CUR annoted site_internal annoted { let (port_int, port_int_mod) = $5 in Ast.Port - { Ast.port_nme=($1,rhs_pos 1);Ast.port_lnk=[]; - Ast.port_int; Ast.port_int_mod; Ast.port_lnk_mod=None; } } - | ID annot OP_CUR annot site_counter - { let (count_test,count_delta) = $5 in + { Ast.port_name=($1,rhs_pos 1);Ast.port_link=[]; + Ast.port_int; Ast.port_int_mod; Ast.port_link_mod=None; } } + | ID annoted OP_CUR annoted site_counter + { let (counter_test,counter_delta) = $5 in Ast.Counter - { Ast.count_nme=($1,rhs_pos 1); Ast.count_test; Ast.count_delta } } - | ID annot + { Ast.counter_name=($1,rhs_pos 1); Ast.counter_test; Ast.counter_delta } } + | ID annoted { Ast.Port - { Ast.port_nme=($1,rhs_pos 1);Ast.port_lnk=[]; Ast.port_int=[]; - Ast.port_int_mod=None; Ast.port_lnk_mod=None; } } + { Ast.port_name=($1,rhs_pos 1);Ast.port_link=[]; Ast.port_int=[]; + Ast.port_int_mod=None; Ast.port_link_mod=None; } } ; interface: @@ -178,37 +178,37 @@ interface: { raise (ExceptionDefn.Syntax_Error (add_pos 1 ("Malformed site expression"))) } | site interface { $1 :: $2 } - | site COMMA annot interface { $1 :: $4 } + | site COMMA annoted interface { $1 :: $4 } ; agent_modif: - | annot { None,start_pos 1,$1 } - | annot PLUS annot { Some Ast.Create,end_pos 2,$3 } - | annot MINUS annot { Some Ast.Erase,end_pos 2,$3 } + | annoted { Ast.NoMod,start_pos 1,$1 } + | annoted PLUS annoted { Ast.Create,end_pos 2,$3 } + | annoted MINUS annoted { Ast.Erase,end_pos 2,$3 } ; agent: - | DOT annot { (Ast.Absent (rhs_pos 1),end_pos 1,$2) } - | ID annot OP_PAR annot interface CL_PAR agent_modif + | DOT annoted { (Ast.Absent (rhs_pos 1),end_pos 1,$2) } + | ID annoted OP_PAR annoted interface CL_PAR agent_modif { let modif,pend,an = $7 in (Ast.Present (($1,rhs_pos 1), $5, modif),pend,an) } - | ID annot COLON annot ID annot OP_PAR annot interface CL_PAR agent_modif + | ID annoted COLON annoted ID annoted OP_PAR annoted interface CL_PAR agent_modif { let modif,pend,an = $11 in (Ast.Present (($5,rhs_pos 5), $9, modif),pend,an) } - | ID annot error + | ID annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 ("Malformed agent '"^$1^"'"))) } ; pattern: - | agent COMMA annot pattern + | agent COMMA annoted pattern { let (x,_,_) = $1 in match $4 with | (y::z,pend,p) -> ((x::y)::z,pend,p) | ([],_,_) -> raise (ExceptionDefn.Internal_Error (add_pos 4 ("assertion failure in pattern parsing"))) } - | agent BACKSLASH annot pattern + | agent BACKSLASH annoted pattern { let (x,_,_) = $1 in let (y,pend,p) = $4 in ([x]::y,pend,p) } | agent { let (x,pend,p) = $1 in ([[x]],pend,p) } ; @@ -221,8 +221,8 @@ constant: ; variable: - | PIPE annot ID annot PIPE { add_pos 5 (Alg_expr.TOKEN_ID ($3)) } - | PIPE annot pattern PIPE + | PIPE annoted ID annoted PIPE { add_pos 5 (Alg_expr.TOKEN_ID ($3)) } + | PIPE annoted pattern PIPE { let (p,_,_) = $3 in add_pos 4 (Alg_expr.KAPPA_INSTANCE p) } | ID { add_pos 1 (Alg_expr.ALG_VAR ($1)) } | LABEL { add_pos 1 (Alg_expr.ALG_VAR ($1)) } @@ -233,86 +233,86 @@ variable: ; small_alg_expr: - | OP_PAR annot alg_expr CL_PAR { let (x,_,_) = $3 in x } + | OP_PAR annoted alg_expr CL_PAR { let (x,_,_) = $3 in x } | constant { $1 } | variable { $1 } - | MAX annot small_alg_expr annot small_alg_expr + | MAX annoted small_alg_expr annoted small_alg_expr { add_pos 5 (Alg_expr.BIN_ALG_OP(Operator.MAX,$3,$5)) } - | MIN annot small_alg_expr annot small_alg_expr + | MIN annoted small_alg_expr annoted small_alg_expr { add_pos 5 (Alg_expr.BIN_ALG_OP(Operator.MIN,$3,$5)) } - | EXPONENT annot small_alg_expr + | EXPONENT annoted small_alg_expr { add_pos 3 (Alg_expr.UN_ALG_OP(Operator.EXP,$3)) } - | SINUS annot small_alg_expr + | SINUS annoted small_alg_expr { add_pos 3 (Alg_expr.UN_ALG_OP(Operator.SINUS,$3)) } - | COSINUS annot small_alg_expr + | COSINUS annoted small_alg_expr { add_pos 3 (Alg_expr.UN_ALG_OP(Operator.COSINUS,$3)) } - | TAN annot small_alg_expr + | TAN annoted small_alg_expr { add_pos 3 (Alg_expr.UN_ALG_OP(Operator.TAN,$3)) } - | ABS annot small_alg_expr + | ABS annoted small_alg_expr { add_pos 3 (Alg_expr.UN_ALG_OP(Operator.INT,$3)) } - | SQRT annot small_alg_expr + | SQRT annoted small_alg_expr { add_pos 3 (Alg_expr.UN_ALG_OP(Operator.SQRT,$3)) } - | LOG annot small_alg_expr + | LOG annoted small_alg_expr { add_pos 3 (Alg_expr.UN_ALG_OP(Operator.LOG,$3)) } - | MINUS annot small_alg_expr + | MINUS annoted small_alg_expr { add_pos 3 (Alg_expr.UN_ALG_OP(Operator.UMINUS,$3)) } ; alg_expr_up_to_mod: - | small_alg_expr annot { ($1,end_pos 1,$2) } - | small_alg_expr annot POW annot alg_expr_up_to_mod + | small_alg_expr annoted { ($1,end_pos 1,$2) } + | small_alg_expr annoted POW annoted alg_expr_up_to_mod { let (x,y,z) = $5 in (add_pos 4 (Alg_expr.BIN_ALG_OP(Operator.POW,$1,x)),y,z) } ; alg_expr_up_to_prod: | alg_expr_up_to_mod { $1 } - | alg_expr_up_to_prod MOD annot alg_expr_up_to_mod + | alg_expr_up_to_prod MOD annoted alg_expr_up_to_mod { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.BIN_ALG_OP (Operator.MODULO,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } ; alg_expr_up_to_sum: | alg_expr_up_to_prod { $1 } - | alg_expr_up_to_sum MULT annot alg_expr_up_to_prod + | alg_expr_up_to_sum MULT annoted alg_expr_up_to_prod { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.BIN_ALG_OP(Operator.MULT,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } - | alg_expr_up_to_sum DIV annot alg_expr_up_to_prod + | alg_expr_up_to_sum DIV annoted alg_expr_up_to_prod { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.BIN_ALG_OP(Operator.DIV,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } ; alg_expr_up_to_if: | alg_expr_up_to_sum { $1 } - | alg_expr_up_to_if PLUS annot alg_expr_up_to_sum + | alg_expr_up_to_if PLUS annoted alg_expr_up_to_sum { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.BIN_ALG_OP(Operator.SUM,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } - | alg_expr_up_to_if MINUS annot alg_expr_up_to_sum + | alg_expr_up_to_if MINUS annoted alg_expr_up_to_sum { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.BIN_ALG_OP(Operator.MINUS,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } alg_expr: | alg_expr_up_to_if { $1 } - | bool_expr THEN annot alg_expr ELSE annot small_alg_expr annot + | bool_expr THEN annoted alg_expr ELSE annoted small_alg_expr annoted { let (i,_,_) = $1 in let (t,_,_) = $4 in ((Alg_expr.IF(i,t,$7), - Locality.of_pos (start_pos 1) (end_pos 7)),end_pos 7,$8) } + Loc.of_pos (start_pos 1) (end_pos 7)),end_pos 7,$8) } ; boolean: @@ -321,64 +321,64 @@ boolean: ; small_bool_expr: - | OP_PAR annot bool_expr CL_PAR { let (x,_,_) = $3 in x } + | OP_PAR annoted bool_expr CL_PAR { let (x,_,_) = $3 in x } | TRUE { add_pos 1 Alg_expr.TRUE } | FALSE { add_pos 1 Alg_expr.FALSE } - | NOT annot small_bool_expr + | NOT annoted small_bool_expr { add_pos 3 (Alg_expr.UN_BOOL_OP(Operator.NOT,$3)) } ; bool_expr_comp: - | small_bool_expr annot { ($1,end_pos 1, $2) } - | alg_expr_up_to_if GREATER annot alg_expr + | small_bool_expr annoted { ($1,end_pos 1, $2) } + | alg_expr_up_to_if GREATER annoted alg_expr { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.COMPARE_OP(Operator.GREATER,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } - | alg_expr_up_to_if SMALLER annot alg_expr + | alg_expr_up_to_if SMALLER annoted alg_expr { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.COMPARE_OP(Operator.SMALLER,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } - | alg_expr_up_to_if EQUAL annot alg_expr + | alg_expr_up_to_if EQUAL annoted alg_expr { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.COMPARE_OP(Operator.EQUAL,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } - | alg_expr_up_to_if DIFF annot alg_expr + | alg_expr_up_to_if DIFF annoted alg_expr { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.COMPARE_OP(Operator.DIFF,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } ; bool_expr_no_or: | bool_expr_comp { $1 } - | bool_expr_comp AND annot bool_expr_no_or + | bool_expr_comp AND annoted bool_expr_no_or { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.BIN_BOOL_OP(Operator.AND,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } ; bool_expr: | bool_expr_no_or { $1 } - | bool_expr_no_or OR annot bool_expr + | bool_expr_no_or OR annoted bool_expr { let (y,pend,an) = $4 in let (x,_,_) = $1 in ((Alg_expr.BIN_BOOL_OP(Operator.OR,x,y), - Locality.of_pos (start_pos 1) pend), + Loc.of_pos (start_pos 1) pend), pend,an) } ; standalone_bool_expr: - | annot bool_expr EOF { let (x,_,_) = $2 in x } - | annot error + | annoted bool_expr EOF { let (x,_,_) = $2 in x } + | annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 2 "Problematic boolean expression")) } ; @@ -389,36 +389,36 @@ arrow: ; sum_token: - | small_alg_expr annot ID annot { [($1,($3,rhs_pos 3))],end_pos 3,$4 } - | small_alg_expr annot ID annot COMMA annot sum_token + | small_alg_expr annoted ID annoted { [($1,($3,rhs_pos 3))],end_pos 3,$4 } + | small_alg_expr annoted ID annoted COMMA annoted sum_token { let (l,pend,an) = $7 in ($1,($3,rhs_pos 3)) :: l,pend,an } ; rule_side: | pattern { let (p,pend,an) = $1 in (p,[],pend,an) } - | pattern PIPE annot sum_token + | pattern PIPE annoted sum_token { let (p,_,_) = $1 in let (t,pend,an) = $4 in (p, t, pend, an) } - | PIPE annot sum_token { let (t,pend,an) = $3 in ([], t, pend, an) } - | pattern PIPE annot error + | PIPE annoted sum_token { let (t,pend,an) = $3 in ([], t, pend, an) } + | pattern PIPE annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 4 "Malformed token expression, I was expecting a_0 t_0, ... \ , a_n t_n where t_i are tokens and a_i any algebraic formula")) } - | PIPE annot error + | PIPE annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "Malformed token expression, I was expecting a_0 t_0, ... \ , a_n t_n where t_i are tokens and a_i any algebraic formula")) } ; rule_content: - | rule_side arrow annot rule_side + | rule_side arrow annoted rule_side { let (lhs,rm_token,_,_) = $1 in let (rhs,add_token,pend,an) = $4 in (Ast.Arrow {Ast.lhs; Ast.rm_token; Ast.rhs; Ast.add_token},$2,pend,an) } - | rule_side arrow annot + | rule_side arrow annoted { let (lhs,rm_token,_,_) = $1 in (Ast.Arrow {Ast.lhs; Ast.rm_token; Ast.rhs=[]; Ast.add_token=[]},$2,end_pos 2,$3) } - | arrow annot rule_side + | arrow annoted rule_side { let (rhs,add_token,pend,an) = $3 in (Ast.Arrow {Ast.lhs=[]; Ast.rm_token=[]; Ast.rhs; Ast.add_token},$1,pend,an) } | rule_side @@ -428,21 +428,21 @@ rule_content: alg_with_radius: | alg_expr { let (x,_,_) = $1 in (x,None) } - | alg_expr COLON annot alg_expr + | alg_expr COLON annoted alg_expr { let (x,_,_) = $1 in let (y,_,_) = $4 in (x, Some y) } ; rate: - | OP_CUR annot alg_with_radius CL_CUR annot alg_expr + | OP_CUR annoted alg_with_radius CL_CUR annoted alg_expr { let (b,pend,an) = $6 in (b,Some $3,pend,an) } - | alg_expr OP_CUR annot alg_with_radius CL_CUR annot + | alg_expr OP_CUR annoted alg_with_radius CL_CUR annoted { let (x,_,_) = $1 in (x,Some $4,end_pos 5,$6) } | alg_expr { let (a,pend,an) = $1 in (a,None,pend,an) } ; birate: - | AT annot rate { let (k2,k1,pend,an) = $3 in (k2,k1,None,None,pend,an) } - | AT annot rate COMMA annot rate + | AT annoted rate { let (k2,k1,pend,an) = $3 in (k2,k1,None,None,pend,an) } + | AT annoted rate COMMA annoted rate { let (k2,k1,_,_) = $3 in let (kback,kback1,pend,an) = $6 in (k2,k1,Some kback,kback1,pend,an) } @@ -455,18 +455,18 @@ rule: ({ Ast.rewrite;Ast.bidirectional; Ast.k_def; Ast.k_un; Ast.k_op; Ast.k_op_un; - },Locality.of_pos (start_pos 1) pos_end) } + },Loc.of_pos (start_pos 1) pos_end) } | rule_content error { raise (ExceptionDefn.Syntax_Error (add_pos 2 "rule rate expected")) } ; variable_declaration: - | LABEL annot alg_expr { let (v,pend,an) = $3 in (($1,rhs_pos 1),v,pend,an) } - | ID annot alg_expr { let (v,pend,an) = $3 in (($1,rhs_pos 1),v,pend,an) } - | LABEL annot error + | LABEL annoted alg_expr { let (v,pend,an) = $3 in (($1,rhs_pos 1),v,pend,an) } + | ID annoted alg_expr { let (v,pend,an) = $3 in (($1,rhs_pos 1),v,pend,an) } + | LABEL annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 ("Illegal definition of variable '"^$1^"'"))) } - | ID annot error + | ID annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 ("Illegal definition of variable '"^$1^"'"))) } | error @@ -474,26 +474,26 @@ variable_declaration: ; id_list: - | ID annot { [ $1,rhs_pos 1 ] } - | ID annot COMMA annot id_list { ($1,rhs_pos 1) :: $5 } + | ID annoted { [ $1,rhs_pos 1 ] } + | ID annoted COMMA annoted id_list { ($1,rhs_pos 1) :: $5 } ; init_declaration: | alg_expr pattern { let (v,_,_) = $1 in let (p,pend,_) = $2 in - (v,Ast.INIT_MIX (p,Locality.of_pos (start_pos 2) pend)) } - | alg_expr OP_PAR annot pattern CL_PAR annot + (v,Ast.INIT_MIX (p,Loc.of_pos (start_pos 2) pend)) } + | alg_expr OP_PAR annoted pattern CL_PAR annoted { let (v,_,_) = $1 in let (p,pend,_) = $4 in - (v,Ast.INIT_MIX (p,Locality.of_pos (start_pos 4) pend)) } + (v,Ast.INIT_MIX (p,Loc.of_pos (start_pos 4) pend)) } | alg_expr id_list { let (v,_,_) = $1 in (v,Ast.INIT_TOK $2) } /* - | ID annot OP_CUR annot init_declaration CL_CUR annot + | ID annoted OP_CUR annoted init_declaration CL_CUR annoted { let (_,alg,init) = $5 in (Some ($1,rhs_pos 1),alg,init) } */ - | ID LAR annot alg_expr + | ID LAR annoted alg_expr { let (v,_,_) = $4 in (v,Ast.INIT_TOK [$1,rhs_pos 1])} | error { raise (ExceptionDefn.Syntax_Error @@ -501,49 +501,49 @@ init_declaration: ; value_list: - | STRING annot {[$1, rhs_pos 1]} - | STRING annot value_list {($1,rhs_pos 1)::$3} + | STRING annoted {[$1, rhs_pos 1]} + | STRING annoted value_list {($1,rhs_pos 1)::$3} ; nonempty_print_expr: - | STRING annot + | STRING annoted { ([Primitives.Str_pexpr (add_pos 1 $1)],end_pos 1,$2) } | alg_expr_up_to_if { let (a,pend,p) = $1 in ([Primitives.Alg_pexpr a],pend,p) } | print_expr_list { $1 } - | OP_PAR annot print_expr_list CL_PAR annot + | OP_PAR annoted print_expr_list CL_PAR annoted { let (v,_,an) = $3 in (v,end_pos 4,an @ $5) } ; print_expr_list: - | STRING annot DOT annot nonempty_print_expr + | STRING annoted DOT annoted nonempty_print_expr { let (l,pend,p) = $5 in (Primitives.Str_pexpr ($1, rhs_pos 1)::l,pend,p) } - | alg_expr_up_to_if DOT annot nonempty_print_expr + | alg_expr_up_to_if DOT annoted nonempty_print_expr { let (l,pend,p) = $4 in let (v,_,_) = $1 in (Primitives.Alg_pexpr v::l,pend,p) } ; print_expr: - | annot { ([],start_pos 1,$1) } - | annot nonempty_print_expr { $2 } + | annoted { ([],start_pos 1,$1) } + | annoted nonempty_print_expr { $2 } ; effect: - | ASSIGN annot ID annot alg_expr + | ASSIGN annoted ID annoted alg_expr { let (a,pend,p) = $5 in (Ast.UPDATE (($3,rhs_pos 3),a),pend,p) } - | ASSIGN annot LABEL annot alg_expr + | ASSIGN annoted LABEL annoted alg_expr { let (a,pend,p) = $5 in (Ast.UPDATE (($3,rhs_pos 3),a),pend,p) } - | TRACK annot LABEL annot boolean annot + | TRACK annoted LABEL annoted boolean annoted { (Ast.CFLOWLABEL ($5,($3,rhs_pos 3)),end_pos 5,$6) } - | TRACK annot pattern boolean annot + | TRACK annoted pattern boolean annoted { let (pat,epat,_) = $3 in - (Ast.CFLOWMIX ($4,(pat,Locality.of_pos (start_pos 3) epat)),end_pos 4, $5) } - | FLUX annot nonempty_print_expr boolean annot + (Ast.CFLOWMIX ($4,(pat,Loc.of_pos (start_pos 3) epat)),end_pos 4, $5) } + | FLUX annoted nonempty_print_expr boolean annoted { let (p,_,_) = $3 in ((if $4 then Ast.DIN (Primitives.RELATIVE,p) else Ast.DINOFF p), end_pos 4,$5) } - | FLUX annot nonempty_print_expr STRING annot boolean annot + | FLUX annoted nonempty_print_expr STRING annoted boolean annoted { let (p,_,_) = $3 in if $6 && $4 = "absolute" then (Ast.DIN (Primitives.ABSOLUTE,p),end_pos 6,$7) @@ -553,17 +553,17 @@ effect: (Ast.DIN (Primitives.RELATIVE,p),end_pos 6,$7) else raise (ExceptionDefn.Syntax_Error ("Incorrect DIN expression",rhs_pos 4)) } - | APPLY annot alg_expr rule_content + | APPLY annoted alg_expr rule_content { let (rewrite,_,pend,an) = $4 in let (v,_,_) = $3 in Ast.APPLY(v, ({ Ast.rewrite; Ast.bidirectional = false; Ast.k_def=Alg_expr.const Nbr.zero;Ast.k_un=None; Ast.k_op=None; Ast.k_op_un=None}, - Locality.of_pos (start_pos 3) pend)), + Loc.of_pos (start_pos 3) pend)), pend,an } - | INTRO annot alg_expr pattern + | INTRO annoted alg_expr pattern { let (m,pend,p) = $4 in let (v,_,_) = $3 in (Ast.APPLY(v, @@ -573,13 +573,13 @@ effect: Ast.bidirectional=false; Ast.k_def=Alg_expr.const Nbr.zero; Ast.k_un=None; Ast.k_op=None; Ast.k_op_un=None}, - Locality.of_pos (start_pos 4) pend)), + Loc.of_pos (start_pos 4) pend)), pend,p) } - | INTRO annot error + | INTRO annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "Malformed intervention instruction, I was expecting \ '$ADD alg_expression kappa_expression'")) } - | DELETE annot alg_expr pattern + | DELETE annoted alg_expr pattern { let (m,pend,p) = $4 in let (v,_,_) = $3 in (Ast.APPLY(v, @@ -589,29 +589,29 @@ effect: Ast.bidirectional=false; Ast.k_def=Alg_expr.const Nbr.zero; Ast.k_un=None; Ast.k_op=None; Ast.k_op_un=None}, - Locality.of_pos (start_pos 4) pend)), + Loc.of_pos (start_pos 4) pend)), pend,p) } - | DELETE annot error + | DELETE annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "Malformed intervention instruction, I was \ expecting '$DEL alg_expression kappa_expression'")) } | SNAPSHOT print_expr { let (s,pend,p) = $2 in (Ast.SNAPSHOT (false,s),pend,p) } - | SNAPSHOT print_expr boolean annot { let (s,_,_) = $2 in (Ast.SNAPSHOT ($3,s),end_pos 3,$4) } + | SNAPSHOT print_expr boolean annoted { let (s,_,_) = $2 in (Ast.SNAPSHOT ($3,s),end_pos 3,$4) } | STOP print_expr { let (s,pend,p) = $2 in (Ast.STOP s,pend,p) } | PRINTF print_expr GREATER print_expr { let (f,pend,p) = $4 in let (c,_,_) = $2 in (Ast.PRINT (f,c),pend,p) } | PRINTF print_expr { let (c,pend,p) = $2 in (Ast.PRINT ([],c),pend,p) } - | PLOTENTRY annot { (Ast.PLOTENTRY,end_pos 1,$2) } - | SPECIES_OF annot pattern boolean annot GREATER print_expr + | PLOTENTRY annoted { (Ast.PLOTENTRY,end_pos 1,$2) } + | SPECIES_OF annoted pattern boolean annoted GREATER print_expr { let (file,pend,p) = $7 in let (pat,pendp,_) = $3 in - (Ast.SPECIES_OF ($4,file,(pat, Locality.of_pos (start_pos 3) pendp)), + (Ast.SPECIES_OF ($4,file,(pat, Loc.of_pos (start_pos 3) pendp)), pend,p) } ; idin: -| ID annot LAR annot alg_expr { +| ID annoted LAR annoted alg_expr { let (v,pend,p) = $5 in let tk = ($1,rhs_pos 1) in (Ast.APPLY(Alg_expr.const Nbr.one, @@ -623,9 +623,9 @@ idin: }; Ast.bidirectional=false; Ast.k_def=Alg_expr.const Nbr.zero; Ast.k_un=None; - Ast.k_op=None; Ast.k_op_un=None}, Locality.of_pos (start_pos 4) pend)),pend,p) + Ast.k_op=None; Ast.k_op_un=None}, Loc.of_pos (start_pos 4) pend)),pend,p) } -| ID annot LAR error +| ID annoted LAR error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "Malformed intervention instruction, I was \ expecting 'ID <- alg_expression'")) } @@ -640,41 +640,41 @@ effect_or_idin: | idin {$1} partial_effect_list: - | OP_PAR annot partial_effect_list CL_PAR annot { $3 } - | effect_or_idin SEMICOLON annot { let (e,_,_) = $1 in ([e],end_pos 2,$3) } + | OP_PAR annoted partial_effect_list CL_PAR annoted { $3 } + | effect_or_idin SEMICOLON annoted { let (e,_,_) = $1 in ([e],end_pos 2,$3) } | effect_or_idin { let (e,p,a) = $1 in ([e],p,a) } - | effect_or_idin SEMICOLON annot partial_effect_list + | effect_or_idin SEMICOLON annoted partial_effect_list { let (e,_,_) = $1 in let (l,pend,a) = $4 in (e::l,pend,a) } partial_effect_list_at_least_one_idin: - | idin SEMICOLON annot { let (e,_,_) = $1 in ([e],end_pos 2,$3) } + | idin SEMICOLON annoted { let (e,_,_) = $1 in ([e],end_pos 2,$3) } | idin { let (e,p,a) = $1 in ([e],p,a) } - | idin SEMICOLON annot partial_effect_list + | idin SEMICOLON annoted partial_effect_list { let (e,_,_) = $1 in let (l,pend,a) = $4 in (e::l,pend,a) } effect_list: - | OP_PAR annot partial_effect_list CL_PAR annot { $3 } - | OP_PAR annot partial_effect_list CL_PAR annot SEMICOLON annot {let (e,_,_) = $3 in e,end_pos 6,$7 } - | effect SEMICOLON annot { let (e,_,_) = $1 in ([e],end_pos 2,$3) } - | effect SEMICOLON annot effect_list + | OP_PAR annoted partial_effect_list CL_PAR annoted { $3 } + | OP_PAR annoted partial_effect_list CL_PAR annoted SEMICOLON annoted {let (e,_,_) = $3 in e,end_pos 6,$7 } + | effect SEMICOLON annoted { let (e,_,_) = $1 in ([e],end_pos 2,$3) } + | effect SEMICOLON annoted effect_list { let (e,_,_) = $1 in let (l,pend,a) = $4 in (e::l,pend,a) } ; standalone_effect_list: - | annot partial_effect_list EOF { let (e,_,_) = $2 in e } + | annoted partial_effect_list EOF { let (e,_,_) = $2 in e } | error { raise (ExceptionDefn.Syntax_Error (add_pos 1 "Problematic effect list")) } ; perturbation_alarm: - | annot { None } - | annot ALARM annot nbr annot { Some $4 } - | annot ALARM error + | annoted { None } + | annoted ALARM annoted nbr annoted { Some $4 } + | annoted ALARM error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "alarm takes a number as argument")) } ; perturbation_post_closed: - | REPEAT annot bool_expr { let (b,pend,p) = $3 in (Some b,pend,p) } + | REPEAT annoted bool_expr { let (b,pend,p) = $3 in (Some b,pend,p) } perturbation_post: | { (None, Parsing.symbol_start_pos (),[]) } @@ -682,49 +682,49 @@ perturbation_post: ; perturbation_declaration: - | perturbation_alarm bool_expr DO annot effect_list perturbation_post + | perturbation_alarm bool_expr DO annoted effect_list perturbation_post { let (pre,_,_) = $2 in let (e,_,_) = $5 in let (post,_,_) = $6 in ($1,Some pre,e,post) } - | perturbation_alarm DO annot effect_list perturbation_post + | perturbation_alarm DO annoted effect_list perturbation_post { let (e,_,_) = $4 in let (post,_,_) = $5 in ($1,None,e,post) } - | perturbation_alarm bool_expr DO annot partial_effect_list_at_least_one_idin perturbation_post_closed + | perturbation_alarm bool_expr DO annoted partial_effect_list_at_least_one_idin perturbation_post_closed { let (pre,_,_) = $2 in let (e,_,_) = $5 in let (post,_,_) = $6 in ($1,Some pre,e,post) } - | perturbation_alarm DO annot partial_effect_list_at_least_one_idin perturbation_post_closed + | perturbation_alarm DO annoted partial_effect_list_at_least_one_idin perturbation_post_closed { let (e,_,_) = $4 in let (post,_,_) = $5 in ($1,None,e,post) } ; sentence: - | LABEL annot rule + | LABEL annoted rule { add (Ast.RULE(Some ($1, rhs_pos 1),$3)) } - | LABEL annot EQUAL annot alg_expr + | LABEL annoted EQUAL annoted alg_expr { let (v,_,_) = $5 in add (Ast.DECLARE (($1,rhs_pos 1),v)) } | rule { add (Ast.RULE (None,$1)) } - | SIGNATURE annot agent { let (a,_,_) = $3 in add (Ast.SIG a) } - | SIGNATURE annot error + | SIGNATURE annoted agent { let (a,_,_) = $3 in add (Ast.SIG a) } + | SIGNATURE annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "Malformed agent signature")) } - | TOKEN annot ID annot { add (Ast.TOKENSIG ($3,rhs_pos 3)) } - | PLOT annot alg_expr { let (v,_,_) = $3 in add (Ast.PLOT v) } - | PLOT annot error + | TOKEN annoted ID annoted { add (Ast.TOKENSIG ($3,rhs_pos 3)) } + | PLOT annoted alg_expr { let (v,_,_) = $3 in add (Ast.PLOT v) } + | PLOT annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "Malformed plot instruction, \ an algebraic expression is expected")) } - | LET annot variable_declaration + | LET annoted variable_declaration { let (i,v,_,_) = $3 in add (Ast.DECLARE (i,v)) } - | OBS annot variable_declaration { let (i,v,_,_) = $3 in add (Ast.OBS (i,v)) } - | INIT annot init_declaration + | OBS annoted variable_declaration { let (i,v,_,_) = $3 in add (Ast.OBS (i,v)) } + | INIT annoted init_declaration { let (alg,init) = $3 in add (Ast.INIT (alg,init)) } | PERT perturbation_declaration { add (Ast.PERT ($2, rhs_pos 2)) } - | CONFIG annot STRING annot value_list + | CONFIG annoted STRING annoted value_list { add (Ast.CONFIG (($3,rhs_pos 3),$5)) } ; @@ -734,17 +734,17 @@ model_body: ; model: - | annot model_body { $2 } + | annoted model_body { $2 } | error { raise (ExceptionDefn.Syntax_Error (add_pos 1 "Incorrect beginning of sentence !!!")) } ; interactive_command: - | annot RUN annot SEMICOLON { Ast.RUN (Locality.dummy_annot Alg_expr.FALSE) } - | annot RUN annot bool_expr SEMICOLON { let (pause,_,_) = $4 in Ast.RUN pause } - | annot effect SEMICOLON { let (eff,_,_) = $2 in Ast.MODIFY [eff] } - | annot EOF { Ast.QUIT } + | annoted RUN annoted SEMICOLON { Ast.RUN (Loc.annot_with_dummy Alg_expr.FALSE) } + | annoted RUN annoted bool_expr SEMICOLON { let (pause,_,_) = $4 in Ast.RUN pause } + | annoted effect SEMICOLON { let (eff,_,_) = $2 in Ast.MODIFY [eff] } + | annoted EOF { Ast.QUIT } | error { raise (ExceptionDefn.Syntax_Error (add_pos 1 "Unrecognized command")) } ; diff --git a/core/grammar/lKappa_compiler.ml b/core/grammar/lKappa_compiler.ml index 095768dfe7..f9736a99d8 100644 --- a/core/grammar/lKappa_compiler.ml +++ b/core/grammar/lKappa_compiler.ml @@ -6,6 +6,13 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) +(* TODO originally_from term/lKappa.ml, see if it makes sense here *) +let raise_if_modification_agent (pos : Loc.t) = function + | Ast.NoMod -> () + | Ast.Erase | Ast.Create -> + raise + (ExceptionDefn.Malformed_Decl ("A modification is forbidden here.", pos)) + let build_l_type sigs pos dst_ty dst_p switch = let ty_id = Signature.num_of_agent dst_ty sigs in let p_id = Signature.id_of_site dst_ty dst_p sigs in @@ -41,7 +48,7 @@ let rule_induces_link_permutation ~warning ~pos ?dst_ty sigs sort site = sort) let site_should_made_be_free i sigs ag_ty p_id pos = - LKappa.link_should_be_removed i + LKappa.raise_link_should_be_removed i (let () = Format.fprintf Format.str_formatter "%a" (Signature.print_agent sigs) @@ -125,13 +132,13 @@ let build_link ?warn_on_swap sigs ?contact_map pos i ag_ty p_id switch pos )) ) -let annotate_dropped_agent ~warning ~syntax_version ~r_editStyle sigs +let annotate_dropped_agent ~warning ~syntax_version ~r_edit_style sigs links_annot ((agent_name, _) as ag_ty) intf counts = let ag_id = Signature.num_of_agent ag_ty sigs in let sign = Signature.get sigs ag_id in let arity = Signature.arity sigs ag_id in let ports = - Array.make arity (Locality.dummy_annot LKappa.LNK_ANY, LKappa.Erased) + Array.make arity (Loc.annot_with_dummy LKappa.LNK_ANY, LKappa.Erased) in let internals = Array.init arity (fun i -> @@ -142,20 +149,20 @@ let annotate_dropped_agent ~warning ~syntax_version ~r_editStyle sigs let lannot, _ = List.fold_left (fun (lannot, pset) p -> - let ((_, p_pos) as p_na) = p.Ast.port_nme in - let p_id = Signature.num_of_site ~agent_name p_na sign in + let ((_, p_pos) as port_name) = p.Ast.port_name in + let p_id = Signature.num_of_site ~agent_name port_name sign in let () = - match Signature.counter_of_site p_id sign with - | Some _ -> LKappa.counter_misused agent_name p.Ast.port_nme + match Signature.counter_of_site_id p_id sign with + | Some _ -> LKappa.raise_counter_misused agent_name p.Ast.port_name | None -> () in let pset' = Mods.IntSet.add p_id pset in let () = if pset == pset' then - LKappa.several_occurence_of_site agent_name p.Ast.port_nme + LKappa.raise_several_occurence_of_site agent_name p.Ast.port_name in let () = - match p.Ast.port_lnk_mod, p.Ast.port_lnk with + match p.Ast.port_link_mod, p.Ast.port_link with | None, _ -> () | Some None, [ (LKappa.LNK_VALUE (_, ()), _) ] (* [i/.] is allowed in degraded agent. @@ -172,9 +179,9 @@ let annotate_dropped_agent ~warning ~syntax_version ~r_editStyle sigs | [ (LKappa.LNK_SOME, _) ] | [ (LKappa.LNK_TYPE (_, _), _) ] | _ :: _ :: _ ) ) -> - LKappa.forbid_modification p_pos p.Ast.port_lnk_mod + LKappa.raise_if_modification p_pos p.Ast.port_link_mod in - let () = LKappa.forbid_modification p_pos p.Ast.port_int_mod in + let () = LKappa.raise_if_modification p_pos p.Ast.port_int_mod in let () = match p.Ast.port_int with @@ -183,24 +190,24 @@ let annotate_dropped_agent ~warning ~syntax_version ~r_editStyle sigs internals.(p_id) <- LKappa.I_VAL_ERASED (Signature.num_of_internal_state p_id (va, pos) sign) - | _ :: (_, pos) :: _ -> LKappa.several_internal_states pos + | _ :: (_, pos) :: _ -> LKappa.raise_several_internal_states pos in - match p.Ast.port_lnk with + match p.Ast.port_link with | [ (LKappa.LNK_ANY, pos) ] -> let () = ports.(p_id) <- (LKappa.ANY_FREE, pos), LKappa.Erased in lannot, pset' - | [ (LKappa.LNK_SOME, pos_lnk) ] -> - let na, pos = p.Ast.port_nme in + | [ (LKappa.LNK_SOME, pos_link) ] -> + let na, pos = p.Ast.port_name in let () = warning ~pos (fun f -> Format.fprintf f "breaking a semi-link on site '%s' will induce a side effect" na) in - let () = ports.(p_id) <- (LKappa.LNK_SOME, pos_lnk), LKappa.Erased in + let () = ports.(p_id) <- (LKappa.LNK_SOME, pos_link), LKappa.Erased in lannot, pset' - | [ (LKappa.LNK_TYPE (dst_p, dst_ty), pos_lnk) ] -> - let na, pos = p.Ast.port_nme in + | [ (LKappa.LNK_TYPE (dst_p, dst_ty), pos_link) ] -> + let na, pos = p.Ast.port_name in let () = warning ~pos (fun f -> Format.fprintf f @@ -208,28 +215,29 @@ let annotate_dropped_agent ~warning ~syntax_version ~r_editStyle sigs na) in let () = - ports.(p_id) <- build_l_type sigs pos_lnk dst_ty dst_p LKappa.Erased + ports.(p_id) <- + build_l_type sigs pos_link dst_ty dst_p LKappa.Erased in lannot, pset' | ([ (LKappa.ANY_FREE, _) ] | []) when syntax_version = Ast.V3 -> let () = - ports.(p_id) <- Locality.dummy_annot LKappa.LNK_FREE, LKappa.Erased + ports.(p_id) <- Loc.annot_with_dummy LKappa.LNK_FREE, LKappa.Erased in lannot, pset' | [ (LKappa.ANY_FREE, _) ] | [] -> let () = - ports.(p_id) <- Locality.dummy_annot LKappa.ANY_FREE, LKappa.Erased + ports.(p_id) <- Loc.annot_with_dummy LKappa.ANY_FREE, LKappa.Erased in lannot, pset' | [ (LKappa.LNK_FREE, _) ] -> let () = - ports.(p_id) <- Locality.dummy_annot LKappa.LNK_FREE, LKappa.Erased + ports.(p_id) <- Loc.annot_with_dummy LKappa.LNK_FREE, LKappa.Erased in lannot, pset' | [ (LKappa.LNK_VALUE (i, ()), pos) ] -> let va, lannot' = let warn_on_swap = - if r_editStyle then + if r_edit_style then None else Some warning @@ -258,7 +266,7 @@ let annotate_dropped_agent ~warning ~syntax_version ~r_editStyle sigs None, lannot ) -let annotate_created_agent ~warning ~syntax_version ~r_editStyle sigs +let annotate_created_agent ~warning ~syntax_version ~r_edit_style sigs ?contact_map rannot ((agent_name, _) as ag_ty) intf = let ag_id = Signature.num_of_agent ag_ty sigs in let sign = Signature.get sigs ag_id in @@ -270,46 +278,46 @@ let annotate_created_agent ~warning ~syntax_version ~r_editStyle sigs let _, rannot = List.fold_left (fun (pset, rannot) p -> - let ((_, p_pos) as p_na) = p.Ast.port_nme in - let p_id = Signature.num_of_site ~agent_name p_na sign in + let ((_, p_pos) as port_name) = p.Ast.port_name in + let p_id = Signature.num_of_site ~agent_name port_name sign in let () = - match Signature.counter_of_site p_id sign with - | Some _ -> LKappa.counter_misused agent_name p.Ast.port_nme + match Signature.counter_of_site_id p_id sign with + | Some _ -> LKappa.raise_counter_misused agent_name p.Ast.port_name | None -> () in let pset' = Mods.IntSet.add p_id pset in let () = if pset == pset' then - LKappa.several_occurence_of_site agent_name p.Ast.port_nme + LKappa.raise_several_occurence_of_site agent_name p.Ast.port_name in - let () = LKappa.forbid_modification p_pos p.Ast.port_lnk_mod in - let () = LKappa.forbid_modification p_pos p.Ast.port_int_mod in + let () = LKappa.raise_if_modification p_pos p.Ast.port_link_mod in + let () = LKappa.raise_if_modification p_pos p.Ast.port_int_mod in let () = match p.Ast.port_int with | [] -> () | [ (None, _) ] -> - LKappa.not_enough_specified ~status:"internal" ~side:"left" - agent_name p_na + LKappa.raise_not_enough_specified ~status:"internal" ~side:"left" + agent_name port_name | [ (Some va, pos) ] -> internals.(p_id) <- Some (Signature.num_of_internal_state p_id (va, pos) sign) - | _ :: (_, pos) :: _ -> LKappa.several_internal_states pos + | _ :: (_, pos) :: _ -> LKappa.raise_several_internal_states pos in - match p.Ast.port_lnk with + match p.Ast.port_link with | [ (LKappa.LNK_ANY, _) ] | [ (LKappa.LNK_SOME, _) ] | [ (LKappa.LNK_TYPE _, _) ] | _ :: _ :: _ -> - LKappa.not_enough_specified ~status:"linking" ~side:"left" agent_name - p_na + LKappa.raise_not_enough_specified ~status:"linking" ~side:"left" + agent_name port_name | [ (LKappa.ANY_FREE, _) ] when syntax_version = Ast.V4 -> - LKappa.not_enough_specified ~status:"linking" ~side:"left" agent_name - p_na + LKappa.raise_not_enough_specified ~status:"linking" ~side:"left" + agent_name port_name | [ (LKappa.LNK_VALUE (i, ()), pos) ] -> let () = ports.(p_id) <- Raw_mixture.VAL i in let _, rannot' = let warn_on_swap = - if r_editStyle then + if r_edit_style then None else Some warning @@ -356,67 +364,67 @@ let annotate_edit_agent ~warning ~syntax_version ~is_rule sigs ?contact_map let sign = Signature.get sigs ag_id in let arity = Signature.arity sigs ag_id in let ports = - Array.make arity (Locality.dummy_annot LKappa.LNK_ANY, LKappa.Maintained) + Array.make arity (Loc.annot_with_dummy LKappa.LNK_ANY, LKappa.Maintained) in let internals = Array.make arity LKappa.I_ANY in let scan_port (links_annot, pset) p = - let p_na, _ = p.Ast.port_nme in - let p_id = Signature.num_of_site ~agent_name p.Ast.port_nme sign in + let port_name, _ = p.Ast.port_name in + let p_id = Signature.num_of_site ~agent_name p.Ast.port_name sign in let () = - match Signature.counter_of_site p_id sign with - | Some _ -> LKappa.counter_misused agent_name p.Ast.port_nme + match Signature.counter_of_site_id p_id sign with + | Some _ -> LKappa.raise_counter_misused agent_name p.Ast.port_name | None -> () in let pset' = Mods.IntSet.add p_id pset in let () = if pset == pset' then - LKappa.several_occurence_of_site agent_name p.Ast.port_nme + LKappa.raise_several_occurence_of_site agent_name p.Ast.port_name in let links_annot' = - match p.Ast.port_lnk with + match p.Ast.port_link with | [ ((LKappa.LNK_SOME, pos) as x) ] -> let modif, links_annot' = - translate_modification ~warning ~warn:(p_na, pos) sigs ?contact_map - ag_id p_id links_annot p.Ast.port_lnk_mod + translate_modification ~warning ~warn:(port_name, pos) sigs + ?contact_map ag_id p_id links_annot p.Ast.port_link_mod in let () = ports.(p_id) <- x, modif in links_annot' | [ (LKappa.LNK_ANY, pos) ] -> let modif, links_annot' = - translate_modification ~warning ~warn:(p_na, pos) sigs ?contact_map - ag_id p_id links_annot p.Ast.port_lnk_mod + translate_modification ~warning ~warn:(port_name, pos) sigs + ?contact_map ag_id p_id links_annot p.Ast.port_link_mod in let () = ports.(p_id) <- (LKappa.ANY_FREE, pos), modif in links_annot' | ([] | [ (LKappa.ANY_FREE, _) ]) when syntax_version = Ast.V3 -> let modif, links_annot' = translate_modification ~warning ?warn:None sigs ?contact_map ag_id - p_id links_annot p.Ast.port_lnk_mod + p_id links_annot p.Ast.port_link_mod in - let () = ports.(p_id) <- Locality.dummy_annot LKappa.LNK_FREE, modif in + let () = ports.(p_id) <- Loc.annot_with_dummy LKappa.LNK_FREE, modif in links_annot' - | [] when p.Ast.port_lnk_mod = None -> links_annot + | [] when p.Ast.port_link_mod = None -> links_annot | [ (LKappa.ANY_FREE, _) ] | [] -> - LKappa.not_enough_specified ~status:"linking" ~side:"left" agent_name - p.Ast.port_nme + LKappa.raise_not_enough_specified ~status:"linking" ~side:"left" + agent_name p.Ast.port_name | [ (LKappa.LNK_FREE, _) ] -> let modif, links_annot' = translate_modification ~warning ?warn:None sigs ?contact_map ag_id - p_id links_annot p.Ast.port_lnk_mod + p_id links_annot p.Ast.port_link_mod in - let () = ports.(p_id) <- Locality.dummy_annot LKappa.LNK_FREE, modif in + let () = ports.(p_id) <- Loc.annot_with_dummy LKappa.LNK_FREE, modif in links_annot' | [ (LKappa.LNK_TYPE (dst_p, dst_ty), pos) ] -> let modif, links_annot' = - translate_modification ~warning ~warn:(p_na, pos) sigs ?contact_map - ag_id p_id links_annot p.Ast.port_lnk_mod + translate_modification ~warning ~warn:(port_name, pos) sigs + ?contact_map ag_id p_id links_annot p.Ast.port_link_mod in let () = ports.(p_id) <- build_l_type sigs pos dst_ty dst_p modif in links_annot' | [ (LKappa.LNK_VALUE (i, ()), pos) ] -> let modif, (lhs_links, rhs_links) = translate_modification ~warning ?warn:None sigs ?contact_map ag_id - p_id links_annot p.Ast.port_lnk_mod + p_id links_annot p.Ast.port_link_mod in let va, lhs_links' = build_link sigs @@ -449,7 +457,7 @@ let annotate_edit_agent ~warning ~syntax_version ~is_rule sigs ?contact_map Format.fprintf f "internal state of site '%s' of agent '%s' is modified \ although it is left unpecified in the left hand side" - p_na agent_name) + port_name agent_name) else raise (ExceptionDefn.Malformed_Decl @@ -463,11 +471,11 @@ let annotate_edit_agent ~warning ~syntax_version ~is_rule sigs ?contact_map | [ (Some va, pos) ], None -> let i_id = Signature.num_of_internal_state p_id (va, pos) sign in internals.(p_id) <- LKappa.I_VAL_CHANGED (i_id, i_id) - | _ :: (_, pos) :: _, _ -> LKappa.several_internal_states pos + | _ :: (_, pos) :: _, _ -> LKappa.raise_several_internal_states pos in links_annot', pset' in - let annot', _ = + let annoted', _ = List.fold_left scan_port (links_annot, Mods.IntSet.empty) intf in let ra = @@ -481,7 +489,7 @@ let annotate_edit_agent ~warning ~syntax_version ~is_rule sigs ?contact_map in ( Counters_compiler.annotate_edit_counters sigs ag_ty counts ra (add_link_contact_map ?contact_map), - annot' ) + annoted' ) let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map ((agent_name, _) as ag_ty) links_annot lp rp lc rc = @@ -489,14 +497,16 @@ let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map let sign = Signature.get sigs ag_id in let arity = Signature.arity sigs ag_id in let ports = - Array.make arity (Locality.dummy_annot LKappa.LNK_ANY, LKappa.Maintained) + Array.make arity (Loc.annot_with_dummy LKappa.LNK_ANY, LKappa.Maintained) in let internals = Array.make arity LKappa.I_ANY in let register_port_modif p_id lnk1 p' ((lhs_links, rhs_links) as links_annot) = let () = - LKappa.forbid_modification (snd p'.Ast.port_nme) p'.Ast.port_lnk_mod + LKappa.raise_if_modification + (Loc.get_annot p'.Ast.port_name) + p'.Ast.port_link_mod in - match lnk1, p'.Ast.port_lnk with + match lnk1, p'.Ast.port_link with | [ (LKappa.LNK_ANY, pos) ], [ (LKappa.LNK_ANY, _) ] -> let () = ports.(p_id) <- (LKappa.ANY_FREE, pos), LKappa.Maintained in links_annot @@ -517,73 +527,73 @@ let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map ( [ (LKappa.LNK_ANY, _) ] | [ (LKappa.LNK_SOME, _) ] | [ (LKappa.LNK_TYPE _, _) ] ) ) -> - LKappa.not_enough_specified ~status:"linking" ~side:"right" agent_name - p'.Ast.port_nme + LKappa.raise_not_enough_specified ~status:"linking" ~side:"right" + agent_name p'.Ast.port_name | [ (LKappa.LNK_ANY, pos) ], [] when syntax_version = Ast.V3 -> let () = ports.(p_id) <- (LKappa.LNK_ANY, pos), LKappa.Freed in links_annot | [ (LKappa.LNK_ANY, pos) ], [ ((LKappa.LNK_FREE | LKappa.ANY_FREE), _) ] -> let () = ports.(p_id) <- (LKappa.LNK_ANY, pos), LKappa.Freed in links_annot - | ( [ (LKappa.LNK_SOME, pos_lnk) ], + | ( [ (LKappa.LNK_SOME, pos_link) ], [ ((LKappa.LNK_FREE | LKappa.ANY_FREE), _) ] ) -> - let na, pos = p'.Ast.port_nme in + let na, pos = p'.Ast.port_name in let () = warning ~pos (fun f -> Format.fprintf f "breaking a semi-link on site '%s' will induce a side effect" na) in - let () = ports.(p_id) <- (LKappa.LNK_SOME, pos_lnk), LKappa.Freed in + let () = ports.(p_id) <- (LKappa.LNK_SOME, pos_link), LKappa.Freed in links_annot - | ( [ (LKappa.LNK_TYPE (dst_p, dst_ty), pos_lnk) ], + | ( [ (LKappa.LNK_TYPE (dst_p, dst_ty), pos_link) ], [ ((LKappa.LNK_FREE | LKappa.ANY_FREE), _) ] ) -> - let na, pos = p'.Ast.port_nme in + let na, pos = p'.Ast.port_name in let () = warning ~pos (fun f -> Format.fprintf f "breaking a semi-link on site '%s' will induce a side effect" na) in let () = - ports.(p_id) <- build_l_type sigs pos_lnk dst_ty dst_p LKappa.Freed + ports.(p_id) <- build_l_type sigs pos_link dst_ty dst_p LKappa.Freed in links_annot - | [ (LKappa.LNK_SOME, pos_lnk) ], [] when syntax_version = Ast.V3 -> - let na, pos = p'.Ast.port_nme in + | [ (LKappa.LNK_SOME, pos_link) ], [] when syntax_version = Ast.V3 -> + let na, pos = p'.Ast.port_name in let () = warning ~pos (fun f -> Format.fprintf f "breaking a semi-link on site '%s' will induce a side effect" na) in - let () = ports.(p_id) <- (LKappa.LNK_SOME, pos_lnk), LKappa.Freed in + let () = ports.(p_id) <- (LKappa.LNK_SOME, pos_link), LKappa.Freed in links_annot - | [ (LKappa.LNK_TYPE (dst_p, dst_ty), pos_lnk) ], [] + | [ (LKappa.LNK_TYPE (dst_p, dst_ty), pos_link) ], [] when syntax_version = Ast.V3 -> - let na, pos = p'.Ast.port_nme in + let na, pos = p'.Ast.port_name in let () = warning ~pos (fun f -> Format.fprintf f "breaking a semi-link on site '%s' will induce a side effect" na) in let () = - ports.(p_id) <- build_l_type sigs pos_lnk dst_ty dst_p LKappa.Freed + ports.(p_id) <- build_l_type sigs pos_link dst_ty dst_p LKappa.Freed in links_annot | ( ([ ((LKappa.LNK_FREE | LKappa.ANY_FREE), _) ] | []), ([ ((LKappa.LNK_FREE | LKappa.ANY_FREE), _) ] | []) ) when syntax_version = Ast.V3 -> let () = - ports.(p_id) <- Locality.dummy_annot LKappa.LNK_FREE, LKappa.Maintained + ports.(p_id) <- Loc.annot_with_dummy LKappa.LNK_FREE, LKappa.Maintained in links_annot | ( [ ((LKappa.LNK_FREE | LKappa.ANY_FREE), _) ], [ ((LKappa.LNK_FREE | LKappa.ANY_FREE), _) ] ) -> let () = - ports.(p_id) <- Locality.dummy_annot LKappa.LNK_FREE, LKappa.Maintained + ports.(p_id) <- Loc.annot_with_dummy LKappa.LNK_FREE, LKappa.Maintained in links_annot | [], [] -> let () = - ports.(p_id) <- Locality.dummy_annot LKappa.LNK_ANY, LKappa.Maintained + ports.(p_id) <- Loc.annot_with_dummy LKappa.LNK_ANY, LKappa.Maintained in links_annot | ( [ (LKappa.LNK_VALUE (i, ()), pos) ], @@ -601,36 +611,37 @@ let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map in let () = ports.(p_id) <- va in lhs_links', rhs_links - | [ (LKappa.LNK_ANY, pos_lnk) ], [ (LKappa.LNK_VALUE (i, ()), pos) ] -> - let () = ports.(p_id) <- (LKappa.LNK_ANY, pos_lnk), LKappa.Linked i in + | [ (LKappa.LNK_ANY, pos_link) ], [ (LKappa.LNK_VALUE (i, ()), pos) ] -> + let () = ports.(p_id) <- (LKappa.LNK_ANY, pos_link), LKappa.Linked i in let _, rhs_links' = build_link sigs ~warn_on_swap:warning ?contact_map pos i ag_id p_id LKappa.Freed rhs_links in lhs_links, rhs_links' - | [ (LKappa.LNK_SOME, pos_lnk) ], [ (LKappa.LNK_VALUE (i, ()), pos') ] -> - let na, pos = p'.Ast.port_nme in + | [ (LKappa.LNK_SOME, pos_link) ], [ (LKappa.LNK_VALUE (i, ()), pos') ] -> + let na, pos = p'.Ast.port_name in let () = warning ~pos (fun f -> Format.fprintf f "breaking a semi-link on site '%s' will induce a side effect" na) in - let () = ports.(p_id) <- (LKappa.LNK_SOME, pos_lnk), LKappa.Linked i in + let () = ports.(p_id) <- (LKappa.LNK_SOME, pos_link), LKappa.Linked i in let _, rhs_links' = build_link sigs ~warn_on_swap:warning ?contact_map pos' i ag_id p_id LKappa.Freed rhs_links in lhs_links, rhs_links' - | ( [ (LKappa.LNK_TYPE (dst_p, dst_ty), pos_lnk) ], + | ( [ (LKappa.LNK_TYPE (dst_p, dst_ty), pos_link) ], [ (LKappa.LNK_VALUE (i, ()), pos') ] ) -> - let na, pos = p'.Ast.port_nme in + let na, pos = p'.Ast.port_name in let () = warning ~pos (fun f -> Format.fprintf f "breaking a semi-link on site '%s' will induce a side effect" na) in let () = - ports.(p_id) <- build_l_type sigs pos_lnk dst_ty dst_p (LKappa.Linked i) + ports.(p_id) <- + build_l_type sigs pos_link dst_ty dst_p (LKappa.Linked i) in let _, rhs_links' = build_link sigs ~warn_on_swap:warning ?contact_map pos' i ag_id p_id @@ -640,7 +651,7 @@ let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map | ( [ ((LKappa.LNK_FREE | LKappa.ANY_FREE), _) ], [ (LKappa.LNK_VALUE (i, ()), pos) ] ) -> let () = - ports.(p_id) <- Locality.dummy_annot LKappa.LNK_FREE, LKappa.Linked i + ports.(p_id) <- Loc.annot_with_dummy LKappa.LNK_FREE, LKappa.Linked i in let _, rhs_links' = build_link sigs ~warn_on_swap:warning ?contact_map pos i ag_id p_id @@ -649,7 +660,7 @@ let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map lhs_links, rhs_links' | [], [ (LKappa.LNK_VALUE (i, ()), pos) ] when syntax_version = Ast.V3 -> let () = - ports.(p_id) <- Locality.dummy_annot LKappa.LNK_FREE, LKappa.Linked i + ports.(p_id) <- Loc.annot_with_dummy LKappa.LNK_FREE, LKappa.Linked i in let _, rhs_links' = build_link sigs ~warn_on_swap:warning ?contact_map pos i ag_id p_id @@ -676,12 +687,12 @@ let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map _ ); ], [] ) -> - LKappa.not_enough_specified ~status:"linking" ~side:"right" agent_name - p'.Ast.port_nme + LKappa.raise_not_enough_specified ~status:"linking" ~side:"right" + agent_name p'.Ast.port_name | [], [ ((LKappa.ANY_FREE | LKappa.LNK_FREE | LKappa.LNK_VALUE (_, _)), _) ] -> - LKappa.not_enough_specified ~status:"linking" ~side:"left" agent_name - p'.Ast.port_nme + LKappa.raise_not_enough_specified ~status:"linking" ~side:"left" + agent_name p'.Ast.port_name | _ :: (_, pos) :: _, _ -> raise (ExceptionDefn.Malformed_Decl @@ -693,7 +704,9 @@ let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map in let register_internal_modif p_id int1 p' = let () = - LKappa.forbid_modification (snd p'.Ast.port_nme) p'.Ast.port_int_mod + LKappa.raise_if_modification + (Loc.get_annot p'.Ast.port_name) + p'.Ast.port_int_mod in match int1, p'.Ast.port_int with | [], [] | [ (None, _) ], [ (None, _) ] -> () @@ -703,7 +716,7 @@ let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map ( Signature.num_of_internal_state p_id (va, pos) sign, Signature.num_of_internal_state p_id (va', pos') sign ) | [], [ (Some va, vapos) ] when syntax_version = Ast.V3 -> - let na, pos = p'.Ast.port_nme in + let na, pos = p'.Ast.port_name in let () = warning ~pos (fun f -> Format.fprintf f @@ -719,53 +732,55 @@ let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map LKappa.I_ANY_CHANGED (Signature.num_of_internal_state p_id (va, vapos) sign) | [], [ _ ] -> - LKappa.not_enough_specified ~status:"internal" ~side:"left" agent_name - p'.Ast.port_nme + LKappa.raise_not_enough_specified ~status:"internal" ~side:"left" + agent_name p'.Ast.port_name | [ _ ], ([ (None, _) ] | []) -> - LKappa.not_enough_specified ~status:"internal" ~side:"right" agent_name - p'.Ast.port_nme + LKappa.raise_not_enough_specified ~status:"internal" ~side:"right" + agent_name p'.Ast.port_name | _ :: (_, pos) :: _, _ | _, _ :: (_, pos) :: _ -> - LKappa.several_internal_states pos + LKappa.raise_several_internal_states pos in let find_in_r (na, pos) rp = let p', r = - List.partition (fun p -> String.compare (fst p.Ast.port_nme) na = 0) rp + List.partition (fun p -> String.compare (Loc.v p.Ast.port_name) na = 0) rp in match p' with | [ p' ] -> p', r | [] -> - LKappa.not_enough_specified ~status:"linking" ~side:"right" agent_name - (na, pos) - | _ :: _ -> LKappa.several_occurence_of_site agent_name (na, pos) + LKappa.raise_not_enough_specified ~status:"linking" ~side:"right" + agent_name (na, pos) + | _ :: _ -> LKappa.raise_several_occurence_of_site agent_name (na, pos) in - let rp_r, annot, _ = + let rp_r, annoted, _ = List.fold_left - (fun (rp, annot, pset) p -> - let ((_, p_pos) as p_na) = p.Ast.port_nme in - let p_id = Signature.num_of_site ~agent_name p_na sign in + (fun (rp, annoted, pset) p -> + let ((_, p_pos) as port_name) = p.Ast.port_name in + let p_id = Signature.num_of_site ~agent_name port_name sign in let pset' = Mods.IntSet.add p_id pset in let () = if pset == pset' then - LKappa.several_occurence_of_site agent_name p.Ast.port_nme + LKappa.raise_several_occurence_of_site agent_name p.Ast.port_name in - let () = LKappa.forbid_modification p_pos p.Ast.port_lnk_mod in - let () = LKappa.forbid_modification p_pos p.Ast.port_int_mod in + let () = LKappa.raise_if_modification p_pos p.Ast.port_link_mod in + let () = LKappa.raise_if_modification p_pos p.Ast.port_int_mod in - let p', rp' = find_in_r p_na rp in - let annot' = register_port_modif p_id p.Ast.port_lnk p' annot in + let p', rp' = find_in_r port_name rp in + let annoted' = register_port_modif p_id p.Ast.port_link p' annoted in let () = register_internal_modif p_id p.Ast.port_int p' in - rp', annot', pset') + rp', annoted', pset') (rp, links_annot, Mods.IntSet.empty) lp in - let annot' = + let annoted' = List.fold_left - (fun annot p -> - let p_na = p.Ast.port_nme in - let p_id = Signature.num_of_site ~agent_name p_na sign in + (fun annoted p -> + let port_name = p.Ast.port_name in + let p_id = Signature.num_of_site ~agent_name port_name sign in let () = register_internal_modif p_id [] p in - register_port_modif p_id [ Locality.dummy_annot LKappa.LNK_ANY ] p annot) - annot rp_r + register_port_modif p_id + [ Loc.annot_with_dummy LKappa.LNK_ANY ] + p annoted) + annoted rp_r in let ra = @@ -779,12 +794,12 @@ let annotate_agent_with_diff ~warning ~syntax_version sigs ?contact_map in ( Counters_compiler.annotate_counters_with_diff sigs ag_ty lc rc ra (add_link_contact_map ?contact_map), - annot' ) + annoted' ) let refer_links_annot ?warning sigs links_annot mix = List.iter - (fun r -> - let ra = r.Counters_compiler.ra in + (fun (ra_ : LKappa.rule_agent Counters_compiler.with_agent_counters) -> + let ra = ra_.agent in Array.iteri (fun i -> function | (LKappa.LNK_VALUE (j, (-1, -1)), pos), mods -> @@ -832,12 +847,12 @@ let final_rule_sanity ?warning sigs let () = match Mods.IntMap.root lhs_links_one with | None -> () - | Some (i, (_, _, _, pos, _)) -> LKappa.link_only_one_occurence i pos + | Some (i, (_, _, _, pos, _)) -> LKappa.raise_link_only_one_occurence i pos in let () = refer_links_annot ?warning sigs lhs_links_two mix in match Mods.IntMap.root rhs_links_one with | None -> () - | Some (i, (_, _, _, pos, _)) -> LKappa.link_only_one_occurence i pos + | Some (i, (_, _, _, pos, _)) -> LKappa.raise_link_only_one_occurence i pos (* Is responsible for the check that: @@ -855,12 +870,12 @@ let annotate_lhs_with_diff_v3 ~warning sigs ?contact_map lhs rhs = | Ast.Absent pos :: _, _ | (Ast.Present _ :: _ | []), Ast.Absent pos :: _ -> raise (ExceptionDefn.Malformed_Decl ("Absent agent are KaSim > 3 syntax", pos)) - | ( Ast.Present (((lag_na, lpos) as ag_ty), lag_s, lmod) :: lt, - Ast.Present ((rag_na, rpos), rag_s, rmod) :: rt ) - when String.compare lag_na rag_na = 0 + | ( Ast.Present (((lagent_name, lpos) as ag_ty), lag_s, lmod) :: lt, + Ast.Present ((ragent_name, rpos), rag_s, rmod) :: rt ) + when String.compare lagent_name ragent_name = 0 && Ast.no_more_site_on_right true lag_s rag_s -> - let () = LKappa.forbid_modification lpos lmod in - let () = LKappa.forbid_modification rpos rmod in + raise_if_modification_agent lpos lmod; + raise_if_modification_agent rpos rmod; let lag_p, lag_c = separate_sites lag_s in let rag_p, rag_c = separate_sites rag_s in let ra, links_annot' = @@ -897,11 +912,11 @@ let annotate_lhs_with_diff_v3 ~warning sigs ?contact_map lhs rhs = (ExceptionDefn.Malformed_Decl ("Absent agent are KaSim > 3 syntax", pos)) | Ast.Present (((_, pos) as na), sites, modif) -> - let () = LKappa.forbid_modification pos modif in + raise_if_modification_agent pos modif; let intf, counts = separate_sites sites in let ra, lannot' = annotate_dropped_agent ~warning ~syntax_version - ~r_editStyle:false sigs lannot na intf counts + ~r_edit_style:false sigs lannot na intf counts in ra :: acc, lannot') (acc, fst links_annot) @@ -915,11 +930,11 @@ let annotate_lhs_with_diff_v3 ~warning sigs ?contact_map lhs rhs = (ExceptionDefn.Malformed_Decl ("Absent agent are KaSim > 3 syntax", pos)) | Ast.Present (((_, pos) as na), sites, modif) -> - let () = LKappa.forbid_modification pos modif in + raise_if_modification_agent pos modif; let intf, counts = separate_sites sites in let rannot', x' = annotate_created_agent ~warning ~syntax_version - ~r_editStyle:false sigs ?contact_map rannot na intf + ~r_edit_style:false sigs ?contact_map rannot na intf in let x'' = Counters_compiler.annotate_created_counters sigs na counts @@ -945,18 +960,18 @@ let annotate_lhs_with_diff_v4 ~warning sigs ?contact_map lhs rhs = | [], [] -> links_annot, mix, cmix | Ast.Absent _ :: lt, Ast.Absent _ :: rt -> aux links_annot mix cmix lt rt | Ast.Present (((_, pos) as ty), sites, lmod) :: lt, Ast.Absent _ :: rt -> - let () = LKappa.forbid_modification pos lmod in + raise_if_modification_agent pos lmod; let intf, counts = separate_sites sites in let ra, lannot' = - annotate_dropped_agent ~warning ~syntax_version ~r_editStyle:false sigs + annotate_dropped_agent ~warning ~syntax_version ~r_edit_style:false sigs (fst links_annot) ty intf counts in aux (lannot', snd links_annot) (ra :: mix) cmix lt rt | Ast.Absent _ :: lt, Ast.Present (((_, pos) as ty), sites, rmod) :: rt -> - let () = LKappa.forbid_modification pos rmod in + raise_if_modification_agent pos rmod; let intf, counts = separate_sites sites in let rannot', x' = - annotate_created_agent ~warning ~syntax_version ~r_editStyle:false sigs + annotate_created_agent ~warning ~syntax_version ~r_edit_style:false sigs ?contact_map (snd links_annot) ty intf in let x'' = @@ -965,14 +980,14 @@ let annotate_lhs_with_diff_v4 ~warning sigs ?contact_map lhs rhs = x' in aux (fst links_annot, rannot') mix (x'' :: cmix) lt rt - | ( Ast.Present (((lag_na, lpos) as ag_ty), lag_s, lmod) :: lt, - Ast.Present ((rag_na, rpos), rag_s, rmod) :: rt ) -> + | ( Ast.Present (((lagent_name, lpos) as ag_ty), lag_s, lmod) :: lt, + Ast.Present ((ragent_name, rpos), rag_s, rmod) :: rt ) -> if - String.compare lag_na rag_na = 0 + String.compare lagent_name ragent_name = 0 && Ast.no_more_site_on_right true lag_s rag_s then ( - let () = LKappa.forbid_modification lpos lmod in - let () = LKappa.forbid_modification rpos rmod in + raise_if_modification_agent lpos lmod; + raise_if_modification_agent rpos rmod; let lag_p, lag_c = separate_sites lag_s in let rag_p, rag_c = separate_sites rag_s in let ra, links_annot' = @@ -1006,7 +1021,7 @@ let annotate_lhs_with_diff_v4 ~warning sigs ?contact_map lhs rhs = | [] :: _, [] | [], [] :: _ -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "Invariant violation in annotate_lhs_with...")) + (Loc.annot_with_dummy "Invariant violation in annotate_lhs_with...")) in aux_line ( (Mods.IntMap.empty, Mods.IntMap.empty), @@ -1018,8 +1033,11 @@ let annotate_lhs_with_diff ~warning ~syntax_version sigs ?contact_map lhs rhs = | Ast.V3 -> annotate_lhs_with_diff_v3 ~warning sigs ?contact_map lhs rhs | Ast.V4 -> annotate_lhs_with_diff_v4 ~warning sigs ?contact_map lhs rhs -let annotate_edit_mixture ~warning ~syntax_version ~is_rule sigs ?contact_map m - = +let annotate_edit_mixture ~warning ~syntax_version ~is_rule sigs ?contact_map + (m : Ast.mixture) : + Counters_compiler.rule_mixture_with_agent_counters + * Counters_compiler.raw_mixture_with_agent_counters = + (* mix is the mixture from initial state of the rule, cmix is the mixture after the rule was applied *) let links_annot, mix, cmix = List.fold_left (List.fold_left (fun (lannot, acc, news) -> function @@ -1027,16 +1045,16 @@ let annotate_edit_mixture ~warning ~syntax_version ~is_rule sigs ?contact_map m | Ast.Present (ty, sites, modif) -> let intf, counts = separate_sites sites in (match modif with - | None -> + | Ast.NoMod -> let a, lannot' = annotate_edit_agent ~warning ~syntax_version ~is_rule sigs ?contact_map ty lannot intf counts in lannot', a :: acc, news - | Some Ast.Create -> + | Ast.Create -> let rannot', x' = - annotate_created_agent ~warning ~syntax_version ~r_editStyle:true - sigs ?contact_map (snd lannot) ty intf + annotate_created_agent ~warning ~syntax_version + ~r_edit_style:true sigs ?contact_map (snd lannot) ty intf in let x'' = Counters_compiler.annotate_created_counters sigs ty counts @@ -1044,10 +1062,10 @@ let annotate_edit_mixture ~warning ~syntax_version ~is_rule sigs ?contact_map m x' in (fst lannot, rannot'), acc, x'' :: news - | Some Ast.Erase -> + | Ast.Erase -> let ra, lannot' = - annotate_dropped_agent ~warning ~syntax_version ~r_editStyle:true - sigs (fst lannot) ty intf counts + annotate_dropped_agent ~warning ~syntax_version + ~r_edit_style:true sigs (fst lannot) ty intf counts in (lannot', snd lannot), ra :: acc, news))) ( ( (Mods.IntMap.empty, Mods.IntMap.empty), @@ -1056,10 +1074,12 @@ let annotate_edit_mixture ~warning ~syntax_version ~is_rule sigs ?contact_map m [] ) m in - let () = final_rule_sanity ?warning:None sigs links_annot mix in + final_rule_sanity ?warning:None sigs links_annot mix; List.rev mix, List.rev cmix -let annotate_created_mixture ~warning ~syntax_version sigs ?contact_map m = +let annotate_created_mixture ~warning ~syntax_version sigs ?contact_map + (m : Ast.mixture) : + Raw_mixture.agent Counters_compiler.with_agent_counters list = let (rhs_links_one, _), cmix = List.fold_left (List.fold_left (fun (rannot, news) -> function @@ -1070,7 +1090,7 @@ let annotate_created_mixture ~warning ~syntax_version sigs ?contact_map m = | Ast.Present (ty, sites, _modif) -> let intf, counts = separate_sites sites in let rannot', x' = - annotate_created_agent ~warning ~syntax_version ~r_editStyle:true + annotate_created_agent ~warning ~syntax_version ~r_edit_style:true sigs ?contact_map rannot ty intf in let x'' = @@ -1085,7 +1105,7 @@ let annotate_created_mixture ~warning ~syntax_version sigs ?contact_map m = let () = match Mods.IntMap.root rhs_links_one with | None -> () - | Some (i, (_, _, _, pos, _)) -> LKappa.link_only_one_occurence i pos + | Some (i, (_, _, _, pos, _)) -> LKappa.raise_link_only_one_occurence i pos in List.rev cmix @@ -1108,20 +1128,22 @@ let give_rule_label bidirectional (id, set) printer r = function ) else (id, set'), lab -let mixture_of_ast ~warning ~syntax_version sigs ?contact_map pos mix = +let mixture_of_ast ~warning ~syntax_version sigs ?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.remove_counter_rule sigs r []) + | r, [] -> fst (Counters_compiler.compile_counter_in_rule sigs r []) | _, _ -> raise (ExceptionDefn.Internal_Error ("A mixture cannot create agents", pos)) -let raw_mixture_of_ast ~warning ~syntax_version sigs ?contact_map mix = +let raw_mixture_of_ast ~warning ~syntax_version sigs ?contact_map + (mix : Ast.mixture) = let b = annotate_created_mixture ~warning ~syntax_version sigs ?contact_map mix in - snd (Counters_compiler.remove_counter_rule sigs [] b) + snd (Counters_compiler.compile_counter_in_rule sigs [] b) let convert_alg_var ?max_allowed_var algs lab pos = let i = @@ -1141,12 +1163,12 @@ let convert_alg_var ?max_allowed_var algs lab pos = in i -let convert_token_name tk_nme tok pos = - match Mods.StringMap.find_option tk_nme tok with +let convert_token_name tk_name tok pos = + match Mods.StringMap.find_option tk_name tok with | Some x -> x | None -> raise - (ExceptionDefn.Malformed_Decl (tk_nme ^ " is not a declared token", pos)) + (ExceptionDefn.Malformed_Decl (tk_name ^ " is not a declared token", pos)) let rec alg_expr_of_ast ~warning ~syntax_version sigs tok algs ?max_allowed_var (alg, pos) = @@ -1156,18 +1178,18 @@ let rec alg_expr_of_ast ~warning ~syntax_version sigs tok algs ?max_allowed_var (mixture_of_ast ~warning ~syntax_version sigs pos ast) | Alg_expr.ALG_VAR lab -> Alg_expr.ALG_VAR (convert_alg_var ?max_allowed_var algs lab pos) - | Alg_expr.TOKEN_ID tk_nme -> - Alg_expr.TOKEN_ID (convert_token_name tk_nme tok pos) + | Alg_expr.TOKEN_ID tk_name -> + Alg_expr.TOKEN_ID (convert_token_name tk_name tok pos) | Alg_expr.DIFF_KAPPA_INSTANCE (expr, ast) -> Alg_expr.DIFF_KAPPA_INSTANCE ( alg_expr_of_ast ~warning ~syntax_version sigs tok algs ?max_allowed_var expr, mixture_of_ast ~warning ~syntax_version sigs pos ast ) - | Alg_expr.DIFF_TOKEN (expr, tk_nme) -> + | Alg_expr.DIFF_TOKEN (expr, tk_name) -> Alg_expr.DIFF_TOKEN ( alg_expr_of_ast ~warning ~syntax_version sigs tok algs ?max_allowed_var expr, - convert_token_name tk_nme tok pos ) + convert_token_name tk_name tok pos ) | (Alg_expr.STATE_ALG_OP _ | Alg_expr.CONST _) as x -> x | Alg_expr.BIN_ALG_OP (op, a, b) -> Alg_expr.BIN_ALG_OP @@ -1223,80 +1245,123 @@ let print_expr_of_ast ~warning ~syntax_version sigs tok algs = function Primitives.Alg_pexpr (alg_expr_of_ast ~warning ~syntax_version sigs tok algs x) -let assemble_rule ~warning ~syntax_version ~r_editStyle sigs tok algs r_mix - r_created rm_tk add_tk rate un_rate = - let tks = +type rule_inter_rep = { + label_opt: (string * Loc.t) option; + bidirectional: bool; (* TODO check *) + mixture: LKappa.rule_agent Counters_compiler.with_agent_counters list; + created_mix: Raw_mixture.agent Counters_compiler.with_agent_counters list; + rm_token: + (((Ast.mixture, string) Alg_expr.e * Loc.t) * (string * Loc.t)) list; + add_token: + (((Ast.mixture, string) Alg_expr.e * Loc.t) * (string * Loc.t)) list; + k_def: (Ast.mixture, string) Alg_expr.e * Loc.t; + k_un: + (((Ast.mixture, string) Alg_expr.e * Loc.t) + * ((Ast.mixture, string) Alg_expr.e * Loc.t) option) + option; + pos: Loc.t; +} +(** Intermediate representation for rule type *) + +(** [assemble_rule] translates a rule_inter_rep into a LKappa.rule *) +let assemble_rule ~warning ~syntax_version (rule : rule_inter_rep) + (sigs : Signature.s) (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 rule.mixture rule.created_mix + in + let r_delta_tokens = List.rev_map (fun (al, (tk, pos)) -> ( alg_expr_of_ast ~warning ~syntax_version sigs tok algs - (Locality.dummy_annot (Alg_expr.UN_ALG_OP (Operator.UMINUS, al))), + (Loc.annot_with_dummy (Alg_expr.UN_ALG_OP (Operator.UMINUS, al))), convert_token_name tk tok pos )) - rm_tk + rule.rm_token + |> List_util.rev_map_append + (fun (al, (tk, pos)) -> + ( alg_expr_of_ast ~warning ~syntax_version sigs tok algs al, + convert_token_name tk tok pos )) + rule.add_token + |> List.rev in - let tks' = - List_util.rev_map_append - (fun (al, (tk, pos)) -> - ( alg_expr_of_ast ~warning ~syntax_version sigs tok algs al, - convert_token_name tk tok pos )) - add_tk tks + let r_rate = + alg_expr_of_ast ~warning ~syntax_version sigs tok algs rule.k_def + in + let r_un_rate = + let r_dist d = + alg_expr_of_ast ~warning ~syntax_version sigs tok algs + ?max_allowed_var:None d + in + Option_util.map + (fun (un_rate', dist) -> + let un_rate'' = + alg_expr_of_ast ~warning ~syntax_version sigs tok algs + ?max_allowed_var:None un_rate' + in + match dist with + | Some d -> un_rate'', Some (r_dist d) + | None -> un_rate'', None) + rule.k_un in { LKappa.r_mix; r_created; - r_editStyle; - r_delta_tokens = List.rev tks'; - r_rate = alg_expr_of_ast ~warning ~syntax_version sigs tok algs rate; - r_un_rate = - (let r_dist d = - alg_expr_of_ast ~warning ~syntax_version sigs tok algs - ?max_allowed_var:None d - in - Option_util.map - (fun (un_rate', dist) -> - let un_rate'' = - alg_expr_of_ast ~warning ~syntax_version sigs tok algs - ?max_allowed_var:None un_rate' - in - match dist with - | Some d -> un_rate'', Some (r_dist d) - | None -> un_rate'', None) - un_rate); + r_edit_style = rule.bidirectional; + r_delta_tokens; + r_rate; + r_un_rate; } let modif_expr_of_ast ~warning ~syntax_version sigs tok algs contact_map modif acc = match modif with - | Ast.APPLY (nb, (r, pos)) -> - let (mix, cmix), rm_tok, add_tok, r_editStyle = - match r.Ast.rewrite with - | Ast.Edit e -> - ( annotate_edit_mixture ~warning ~syntax_version:Ast.V4 ~is_rule:true - sigs ~contact_map e.Ast.mix, - [], - e.Ast.delta_token, - true ) - | Ast.Arrow a -> - ( annotate_lhs_with_diff ~warning ~syntax_version sigs ~contact_map - a.Ast.lhs a.Ast.rhs, - a.Ast.rm_token, - a.Ast.add_token, - false ) + | Ast.APPLY (nb, (ast_rule, pos)) -> + let rule : rule_inter_rep = + match ast_rule.Ast.rewrite with + | Ast.Edit rule_content -> + let mixture, created_mix = + annotate_edit_mixture ~warning ~syntax_version:Ast.V4 ~is_rule:true + sigs ~contact_map rule_content.mix + in + { + label_opt = None; + bidirectional = true; + mixture; + created_mix; + rm_token = []; + add_token = rule_content.delta_token; + k_def = ast_rule.k_def; + k_un = ast_rule.k_un; + pos; + } + | Ast.Arrow rule_content -> + let mixture, created_mix = + annotate_lhs_with_diff ~warning ~syntax_version sigs ~contact_map + rule_content.lhs rule_content.rhs + in + { + label_opt = None; + bidirectional = false; + mixture; + created_mix; + rm_token = rule_content.rm_token; + add_token = rule_content.add_token; + k_def = ast_rule.k_def; + k_un = ast_rule.k_un; + pos; + } in - let mix, cmix = Counters_compiler.remove_counter_rule sigs mix cmix in ( Ast.APPLY ( alg_expr_of_ast ~warning ~syntax_version sigs tok algs nb, - ( assemble_rule ~warning ~syntax_version ~r_editStyle sigs tok algs - mix cmix rm_tok add_tok r.Ast.k_def r.Ast.k_un, - pos ) ), + (assemble_rule ~warning ~syntax_version rule sigs tok algs, pos) ), acc ) | Ast.UPDATE ((lab, pos), how) -> let i = - match Mods.StringMap.find_option lab algs with - | Some i -> i - | None -> - raise + Option_util.unsome_or_raise + ~excep: (ExceptionDefn.Malformed_Decl ("Variable " ^ lab ^ " is not defined", pos)) + (Mods.StringMap.find_option lab algs) in ( Ast.UPDATE ((i, pos), alg_expr_of_ast ~warning ~syntax_version sigs tok algs how), @@ -1339,7 +1404,8 @@ let modif_expr_of_ast ~warning ~syntax_version sigs tok algs contact_map modif acc ) let perturbation_of_ast ~warning ~syntax_version sigs tok algs contact_map - ((alarm, pre, mods, post), pos) up_vars = + ((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 tok algs contact_map) @@ -1380,99 +1446,138 @@ let add_un_variable k_un acc rate_var = | None -> acc, None | Some (k, dist) -> let acc_un, k' = - if Alg_expr.has_mix (fst k) then - ( (Locality.dummy_annot rate_var, k) :: acc, - Locality.dummy_annot (Alg_expr.ALG_VAR rate_var) ) + if Alg_expr.has_mix (Loc.v k) then + ( (Loc.annot_with_dummy rate_var, k) :: acc, + Loc.annot_with_dummy (Alg_expr.ALG_VAR rate_var) ) else acc, k in acc_un, Some (k', dist) +type acc_function_rules = { + rule_names: int * Mods.StringSet.t; + extra_vars: + (string Loc.annoted * (Ast.mixture, string) Alg_expr.e Loc.annoted) list; + cleaned_rules: rule_inter_rep list; +} + +(** [name_and_purify] is called in a fold while compiling the rules from Ast.rules into rule_inter_rep *) let name_and_purify_rule ~warning ~syntax_version sigs ~contact_map - (pack, acc, rules) (label_opt, (r, r_pos)) = - let pack', label = - give_rule_label r.Ast.bidirectional pack Ast.print_ast_rule r label_opt + (acc : acc_function_rules) + ((label_opt, (ast_rule, r_pos)) : + string Loc.annoted option * Ast.rule Loc.annoted) : acc_function_rules = + let rule_names', rule_label = + give_rule_label ast_rule.bidirectional acc.rule_names Ast.print_ast_rule + ast_rule label_opt in let acc', k_def = - if Alg_expr.has_mix (fst r.Ast.k_def) then ( - let rate_var = label ^ "_rate" in - ( (Locality.dummy_annot rate_var, r.Ast.k_def) :: acc, - Locality.dummy_annot (Alg_expr.ALG_VAR rate_var) ) + if Alg_expr.has_mix (Loc.v ast_rule.k_def) then ( + let rate_var = rule_label ^ "_rate" in + ( (Loc.annot_with_dummy rate_var, ast_rule.k_def) :: acc.extra_vars, + Loc.annot_with_dummy (Alg_expr.ALG_VAR rate_var) ) ) else - acc, r.Ast.k_def + acc.extra_vars, ast_rule.Ast.k_def in - let acc'', k_un = add_un_variable r.Ast.k_un acc' (label ^ "_un_rate") in - match r.Ast.rewrite with + let acc'', k_un = + add_un_variable ast_rule.k_un acc' (rule_label ^ "_un_rate") + in + match ast_rule.rewrite with | Ast.Edit e -> - let () = - if r.Ast.bidirectional || r.Ast.k_op <> None || r.Ast.k_op_un <> None then - raise - (ExceptionDefn.Malformed_Decl - ("Rules in edit notation cannot be bidirectional", r_pos)) - in - let mix, created = + if + ast_rule.bidirectional || ast_rule.k_op <> None + || ast_rule.k_op_un <> None + then + raise + (ExceptionDefn.Malformed_Decl + ("Rules in edit notation cannot be bidirectional", r_pos)); + let mixture, created_mix = annotate_edit_mixture ~warning ~syntax_version ~is_rule:true sigs ~contact_map e.Ast.mix in - ( pack', - acc'', - (label_opt, true, mix, created, [], e.Ast.delta_token, k_def, k_un, r_pos) - :: rules ) + { + rule_names = rule_names'; + extra_vars = acc''; + cleaned_rules = + { + label_opt; + bidirectional = true; + mixture; + created_mix; + rm_token = []; + add_token = e.Ast.delta_token; + k_def; + k_un; + pos = r_pos; + } + :: acc.cleaned_rules; + } | Ast.Arrow a -> - let mix, created = + let mixture, created_mix = annotate_lhs_with_diff ~warning ~syntax_version sigs ~contact_map a.Ast.lhs a.Ast.rhs in let rules' = - ( label_opt, - false, - mix, - created, - a.Ast.rm_token, - a.Ast.add_token, - k_def, - k_un, - r_pos ) - :: rules + { + label_opt; + bidirectional = false; + mixture; + created_mix; + rm_token = a.Ast.rm_token; + add_token = a.Ast.add_token; + k_def; + k_un; + pos = r_pos; + } + :: acc.cleaned_rules in let acc''', rules'' = - match r.Ast.bidirectional, r.Ast.k_op with - | true, Some k when Alg_expr.has_mix (fst k) -> - let rate_var = Ast.flip_label label ^ "_rate" in - let rate_var_un = Ast.flip_label label ^ "_un_rate" in - let acc_un, k_op_un = add_un_variable r.Ast.k_op_un acc'' rate_var_un in - let mix, created = + match ast_rule.bidirectional, ast_rule.k_op with + | true, Some k when Alg_expr.has_mix (Loc.v k) -> + let rate_var = Ast.flip_label rule_label ^ "_rate" in + let rate_var_un = Ast.flip_label rule_label ^ "_un_rate" in + let acc_un, k_op_un = + add_un_variable ast_rule.k_op_un acc'' rate_var_un + in + let mixture, created_mix = annotate_lhs_with_diff ~warning ~syntax_version sigs ~contact_map a.Ast.rhs a.Ast.lhs in - ( (Locality.dummy_annot rate_var, k) :: acc_un, - ( Option_util.map (fun (l, p) -> Ast.flip_label l, p) label_opt, - false, - mix, - created, - a.Ast.add_token, - a.Ast.rm_token, - Locality.dummy_annot (Alg_expr.ALG_VAR rate_var), - k_op_un, - r_pos ) + ( (Loc.annot_with_dummy rate_var, k) :: acc_un, + { + label_opt = + Option_util.map (fun (l, p) -> Ast.flip_label l, p) label_opt; + bidirectional = false; + mixture; + created_mix; + rm_token = a.Ast.add_token; + add_token = a.Ast.rm_token; + k_def = Loc.annot_with_dummy (Alg_expr.ALG_VAR rate_var); + k_un = k_op_un; + pos = r_pos; + } :: rules' ) | true, Some rate -> - let rate_var_un = Ast.flip_label label ^ "_un_rate" in - let acc_un, k_op_un = add_un_variable r.Ast.k_op_un acc'' rate_var_un in - let mix, created = + let rate_var_un = Ast.flip_label rule_label ^ "_un_rate" in + let acc_un, k_op_un = + add_un_variable ast_rule.k_op_un acc'' rate_var_un + in + let mixture, created_mix = annotate_lhs_with_diff ~warning ~syntax_version sigs ~contact_map a.Ast.rhs a.Ast.lhs in ( acc_un, - ( Option_util.map (fun (l, p) -> Ast.flip_label l, p) label_opt, - false, - mix, - created, - a.Ast.add_token, - a.Ast.rm_token, - rate, - k_op_un, - r_pos ) + { + label_opt = + Option_util.map (fun (l, p) -> Ast.flip_label l, p) label_opt; + bidirectional = false; + mixture; + created_mix; + rm_token = a.Ast.add_token; + add_token = a.Ast.rm_token; + k_def = rate; + k_un = k_op_un; + pos = r_pos; + } :: rules' ) | false, None -> acc'', rules' | false, Some _ | true, None -> @@ -1481,119 +1586,255 @@ let name_and_purify_rule ~warning ~syntax_version sigs ~contact_map ( "Incompatible arrow and kinectic rate for inverse definition", r_pos )) in - pack', acc''', rules'' + { rule_names = rule_names'; extra_vars = acc'''; cleaned_rules = rules'' } + +type site_sig_with_links_as_lists = + (string Loc.annoted * string Loc.annoted) list Signature.site_sig +(** Temporary type to store site signature with list links instead of array array links *) -let create_t sites incr_info = - let aux, counters = +(** [prepare_agent_sig ~sites evaluates to (site_sigs, counter_list) which describe data that can be used to create a Signature.t for a single agent*) +let prepare_agent_sig ~(sites : Ast.site list) : + site_sig_with_links_as_lists NamedDecls.t * string Loc.annoted list = + let ( (site_sigs_pre_nameddecls : + (string Loc.annoted * site_sig_with_links_as_lists) list), + (counter_names : string Loc.annoted list) ) = List.fold_right - (fun site (acc, counts) -> + (fun site (acc_site_sigs, acc_counter_names) -> match site with + (* TODO see if can remove Ast here *) | Ast.Port p -> - ( ( p.Ast.port_nme, - ( NamedDecls.create - (Tools.array_map_of_list - (function - | Some x, pos -> (x, pos), () - | None, pos -> - raise - (ExceptionDefn.Malformed_Decl - ( "Forbidden internal state inside signature \ - definition", - pos ))) - p.Ast.port_int), - List.fold_left - (fun acc' -> function - | (LKappa.LNK_FREE | LKappa.ANY_FREE | LKappa.LNK_ANY), _ -> - acc' - | (LKappa.LNK_SOME | LKappa.LNK_VALUE _), pos -> - raise - (ExceptionDefn.Malformed_Decl - ( "Forbidden link status inside signature definition", - pos )) - | LKappa.LNK_TYPE (a, b), _ -> (a, b) :: acc') - [] p.Ast.port_lnk, - None ) ) - :: acc, - counts ) - | Ast.Counter c -> - (match c.Ast.count_test with + ( ( p.port_name, + { + Signature.internal_state = + NamedDecls.create + (Tools.array_map_of_list + (function + | Some x, pos -> (x, pos), () + | None, pos -> + raise + (ExceptionDefn.Malformed_Decl + ( "Forbidden internal state inside signature \ + definition", + pos ))) + p.port_int); + links = + Some + (List.fold_left + (fun acc_links' -> function + | ( (LKappa.LNK_FREE | LKappa.ANY_FREE | LKappa.LNK_ANY), + _ ) -> + acc_links' + | (LKappa.LNK_SOME | LKappa.LNK_VALUE _), pos -> + raise + (ExceptionDefn.Malformed_Decl + ( "Forbidden link status inside signature \ + definition", + pos )) + | LKappa.LNK_TYPE (a, b), _ -> (a, b) :: acc_links') + [] p.port_link); + counters_info = None; + } ) + :: acc_site_sigs, + acc_counter_names ) + | Counter c -> + (* Here, only CEQ tests are accepted *) + (match c.counter_test with | None -> - let n, pos = c.Ast.count_nme in + let n, pos = c.counter_name in raise (ExceptionDefn.Internal_Error ("Counter " ^ n ^ " should have a test in signature", pos)) | Some (test, pos) -> (match test with - | Ast.CVAR _ -> + | CVAR _ -> raise (ExceptionDefn.Internal_Error ("Counter should not have a var in signature", pos)) - | Ast.CGTE _ -> + | CGTE _ -> raise (ExceptionDefn.Internal_Error ("Counter should not have >= in signature", pos)) - | Ast.CEQ j -> - ( ( c.Ast.count_nme, - ( NamedDecls.create [||], - [ incr_info ], - Some (j, fst c.Ast.count_delta) ) ) - :: acc, - c.Ast.count_nme :: counts )))) + | CEQ j -> + ( ( c.counter_name, + { + internal_state = NamedDecls.create [||]; + (* Agent with counter can link to port [b] on counter agent [__counter_agent] *) + links = + Some + [ + ( Loc.annot_with_dummy "b", + Loc.annot_with_dummy "__counter_agent" ); + ]; + counters_info = Some (j, Loc.v c.counter_delta); + } ) + :: acc_site_sigs, + c.counter_name :: acc_counter_names )))) sites ([], []) in - NamedDecls.create (Array.of_list aux), counters + NamedDecls.create_from_list site_sigs_pre_nameddecls, counter_names + +(** [make_counter_agent_site_sigs counters_per_agent] evaluates to + (counter_agent_name, site_sigs_counter_agent) which describe the counter + agent and its site signatures with possible links to other agents. + [counter_info] associates each agent to a list of counter ports, one for each defined counter *) +let make_counter_agent_site_sigs + (counters_per_agent : ((string * Loc.t) * (string * Loc.t) list) list) : + (string * Loc.t) + * ((string * Loc.t) * (string * Loc.t)) list Signature.site_sig NamedDecls.t + = + let counter_agent_name = "__counter_agent", Loc.dummy in + let a_port_name = "a", Loc.dummy in + (* after port *) + let b_port_name = "b", Loc.dummy in + + (* before port *) + + (* Port [a] can link to port b of agent of type counter agent *) + let a_port_sig = + { + Signature.internal_state = NamedDecls.create [||]; + links = Some [ b_port_name, counter_agent_name ]; + counters_info = None; + } + in + (* Port [b] can link to port a of agent of type counter agent + * OR for each agent [agent_name] with counters, to their ports + * [agent_counter_port_name] *) + let b_links = + List.fold_right + (fun (agent_name, counters_from_agent) acc -> + List.map + (fun agent_counter_port_name -> agent_counter_port_name, agent_name) + counters_from_agent + @ acc) + counters_per_agent + [ a_port_name, counter_agent_name ] + in + let b_port_sig = + { + Signature.internal_state = NamedDecls.create [||]; + links = Some b_links; + counters_info = None; + } + in + let site_sigs_counter_agent = + NamedDecls.create [| a_port_name, a_port_sig; b_port_name, b_port_sig |] + in + counter_agent_name, site_sigs_counter_agent -let create_sig l = - let with_contact_map = +let agent_sigs_of_agent_sigs_with_links_as_lists ~(build_contact_map : bool) + (agent_sigs_pre : site_sig_with_links_as_lists NamedDecls.t NamedDecls.t) : + Signature.t NamedDecls.t = + let size_sigs = NamedDecls.size agent_sigs_pre in + NamedDecls.mapi + (fun ag_id ag_name -> + NamedDecls.map (fun site_name_ag1 site_sig -> + if not build_contact_map then + { site_sig with Signature.links = None } + else ( + (* Update links *) + (* TODO improve comment above *) + let site_links = + Array.init (size_sigs - ag_id) (fun i -> + Array.make + (NamedDecls.size + (NamedDecls.elt_val agent_sigs_pre (i + ag_id))) + false) + in + List.iter + (fun (((site_name_ag2, pos) as site_name), ((ag2_name, _) as ag)) -> + let ag2_id = NamedDecls.elt_id ~kind:"ag" agent_sigs_pre ag in + let site_id = + NamedDecls.elt_id ~kind:"site name" + (NamedDecls.elt_val agent_sigs_pre ag2_id) + site_name + in + if ag2_id >= ag_id then + site_links.(ag2_id - ag_id).(site_id) <- true; + let should_raise_for_missing_link = + not + (List.exists + (fun ((x, _), (y, _)) -> + x = site_name_ag1 && y = ag_name) + ((NamedDecls.elt_val + (NamedDecls.elt_val agent_sigs_pre ag2_id) + site_id) + .links |> Option_util.unsome_or_raise)) + in + if should_raise_for_missing_link then + raise + (ExceptionDefn.Malformed_Decl + ( Format.asprintf "No link to %s.%s from %s.%s." + site_name_ag1 ag_name site_name_ag2 ag2_name, + pos ))) + (Option_util.unsome_or_raise site_sig.links); + { site_sig with Signature.links = Some site_links } + ))) + agent_sigs_pre + +let create_sigs (l : Ast.agent list) : Signature.s = + (* Contact map should be built only if a specific link is described in the definition of signature *) + let build_contact_map : bool = List.fold_left - (fun contact -> function + (fun acc0 -> function | Ast.Absent pos -> raise (ExceptionDefn.Malformed_Decl ("Absent agent are forbidden in signature", pos)) | Ast.Present (_, sites, _) -> List.fold_left - (fun contact' site -> + (fun acc1 site -> match site with - | Ast.Counter _ -> contact' + | Ast.Counter _ -> acc1 | Ast.Port p -> - contact' - || List.fold_left - (fun acc -> function - | (LKappa.LNK_FREE | LKappa.ANY_FREE | LKappa.LNK_ANY), _ - -> - acc - | (LKappa.LNK_SOME | LKappa.LNK_VALUE _), pos -> - raise - (ExceptionDefn.Malformed_Decl - ( "Forbidden link status inside a definition of \ - signature", - pos )) - | LKappa.LNK_TYPE (_, _), _ -> true) - false p.Ast.port_lnk) - contact sites) + List.fold_left + (fun acc2 -> function + | (LKappa.LNK_FREE | LKappa.ANY_FREE | LKappa.LNK_ANY), _ -> + acc2 + | (LKappa.LNK_SOME | LKappa.LNK_VALUE _), pos -> + raise + (ExceptionDefn.Malformed_Decl + ( "Forbidden link status inside a definition of \ + signature", + pos )) + | LKappa.LNK_TYPE (_, _), _ -> true) + acc1 p.Ast.port_link) + acc0 sites) false l in - let annot = Locality.dummy in - let sigs, counters = + + let ( (sigs_with_links_as_lists : + (string Loc.annoted * site_sig_with_links_as_lists NamedDecls.t) list), + (counters_per_agent : + (string Loc.annoted * string Loc.annoted list) list) ) = List.fold_right - (fun ag (acc, counters) -> - match ag with - | Ast.Absent _ -> acc, counters - | Ast.Present (name, sites, _) -> - let lnks, counters_ag = - create_t sites (("b", annot), ("__incr", annot)) - in + (fun agent (acc_sigs, acc_counters_per_agent) -> + match agent with + | Ast.Absent _ -> acc_sigs, acc_counters_per_agent + | Ast.Present (agent_name, sites, _) -> + let site_sigs_nd, counters_agent = prepare_agent_sig ~sites in let counters' = - if counters_ag = [] then - counters + if counters_agent = [] then + acc_counters_per_agent else - (name, counters_ag) :: counters + (agent_name, counters_agent) :: acc_counters_per_agent in - (name, lnks) :: acc, counters') + (agent_name, site_sigs_nd) :: acc_sigs, counters') l ([], []) in - Signature.create ~counters with_contact_map sigs + + let agent_sigs : Signature.t NamedDecls.t = + (if counters_per_agent = [] then + sigs_with_links_as_lists + else + make_counter_agent_site_sigs counters_per_agent + :: sigs_with_links_as_lists) + |> NamedDecls.create_from_list + |> agent_sigs_of_agent_sigs_with_links_as_lists ~build_contact_map + in + + (* TODO see agent_sigs namings *) + Signature.create ~counters_per_agent agent_sigs let init_of_ast ~warning ~syntax_version sigs contact_map tok algs inits = List.map @@ -1602,129 +1843,180 @@ let init_of_ast ~warning ~syntax_version sigs contact_map tok algs inits = init_of_ast ~warning ~syntax_version sigs tok contact_map ini )) inits -let compil_of_ast ~warning ~debugMode ~syntax_version overwrite c = - let c, with_counters = Counters_compiler.compile ~warning ~debugMode c in - let c = - if c.Ast.signatures = [] && c.Ast.tokens = [] then - if with_counters then - raise - (ExceptionDefn.Malformed_Decl - ("implicit signature is incompatible with counters", Locality.dummy)) - else - Ast.implicit_signature c +type ast_compiled_data = { + agents_sig: Signature.s; + contact_map: Contact_map.t; + token_names: unit NamedDecls.t; + alg_vars_finder: int Mods.StringMap.t; + updated_alg_vars: int list; + result: + (Ast.agent, LKappa.rule_mixture, Raw_mixture.t, int, LKappa.rule) Ast.compil; + (** Compiled data where identifiers are i Ast.compil where identifiers + * are integers and not string, syntactic sugar on rules are expansed + * (syntactic sugar on mixture are not) *) +} + +let compil_of_ast ~warning ~debug_mode ~syntax_version ~var_overwrite ast_compil + = + let has_counters = Counters_compiler.has_counters ast_compil in + let agent_sig_is_implicit = + ast_compil.Ast.signatures = [] && ast_compil.Ast.tokens = [] + in + (* Infer agent signatures if the signature is implicit *) + let ast_compil = + if agent_sig_is_implicit && has_counters then + raise + (ExceptionDefn.Malformed_Decl + ("implicit signature is incompatible with counters", Loc.dummy)) + else if agent_sig_is_implicit then + Ast.infer_agent_signatures ast_compil + else + ast_compil + in + (* Remove counter variable definition by splitting in several rules *) + let ast_compil = + if has_counters then + Counters_compiler.split_counter_variables_into_separate_rules ~warning + ~debug_mode ast_compil else - c + ast_compil in - let sigs = create_sig c.Ast.signatures in - let contact_map = - Array.init (Signature.size sigs) (fun i -> - Array.init (Signature.arity sigs i) (fun s -> + + let agents_sig : Signature.s = create_sigs ast_compil.Ast.signatures in + (* Set an empty contact map *) + let contact_map : (Mods.IntSet.t * Mods.Int2Set.t) array array = + Array.init (Signature.size agents_sig) (fun i -> + Array.init (Signature.arity agents_sig i) (fun s -> ( Tools.recti (fun a k -> Mods.IntSet.add k a) Mods.IntSet.empty - (Signature.internal_states_number i s sigs), + (Signature.internal_states_number i s agents_sig), Mods.Int2Set.empty ))) in - let (_, rule_names), extra_vars, cleaned_rules = - List.fold_left - (name_and_purify_rule ~warning ~syntax_version sigs ~contact_map) - ((0, Mods.StringSet.empty), [], []) - c.Ast.rules + let rule_names, extra_vars, cleaned_rules = + let acc = + List.fold_left + (name_and_purify_rule ~warning ~syntax_version agents_sig ~contact_map) + { + rule_names = 0, Mods.StringSet.empty; + extra_vars = []; + cleaned_rules = []; + } + ast_compil.Ast.rules + in + snd acc.rule_names, acc.extra_vars, acc.cleaned_rules in - let overwrite_overwritten = - List.fold_left (fun (over, acc) (((x, _), _) as e) -> - match List.partition (fun (x', _) -> x = x') over with - | [], over' -> over', e :: acc - | [ (x, v) ], over' -> - over', (Locality.dummy_annot x, Alg_expr.const v) :: acc - | (x, _) :: _ :: _, _ -> - raise - (ExceptionDefn.Malformed_Decl - ( "variable '" ^ x ^ "' is overwritten more than once", - Locality.dummy ))) + let overwrite_vars (var_overwrite : (string * Nbr.t) list) + (vars : (Ast.mixture, string) Ast.variable_def list) : + (string * Nbr.t) list * (Ast.mixture, string) Ast.variable_def list = + List.fold_left + (fun (overwrite_vars_remaining, acc_vars) (((x, _), _) as var) -> + let matchs, other_overwrite_vars = + List.partition (fun (x', _) -> x = x') overwrite_vars_remaining + in + let acc_vars_with_x_rewritten_if_present = + match matchs with + | [] -> var :: acc_vars + | [ (x, v) ] -> (Loc.annot_with_dummy x, Alg_expr.const v) :: acc_vars + | (x, _) :: _ :: _ -> + raise + (ExceptionDefn.Malformed_Decl + ( "variable '" ^ x ^ "' is overwritten more than once", + Loc.dummy )) + in + + other_overwrite_vars, acc_vars_with_x_rewritten_if_present) + (var_overwrite, []) vars + |> fun (var_overwrite_not_applied, rev_alg_vars) -> + var_overwrite_not_applied, List.rev rev_alg_vars in - let overwrite', rev_algs = - overwrite_overwritten - (overwrite_overwritten (overwrite, []) c.Ast.variables) - extra_vars + let var_overwrite_not_applied, alg_vars_with_rewritten_vars = + overwrite_vars var_overwrite (ast_compil.Ast.variables @ extra_vars) in - let alg_vars_over = + let alg_vars_array = List_util.rev_map_append - (fun (x, v) -> Locality.dummy_annot x, Alg_expr.const v) - overwrite' (List.rev rev_algs) - in - let alg_vars_array = Array.of_list alg_vars_over in - let algs = - (NamedDecls.create ~forbidden:rule_names alg_vars_array).NamedDecls.finder + (fun (x, v) -> Loc.annot_with_dummy x, Alg_expr.const v) + var_overwrite_not_applied alg_vars_with_rewritten_vars + |> Array.of_list in - let tk_nd = - NamedDecls.create (Tools.array_map_of_list (fun x -> x, ()) c.Ast.tokens) + let alg_vars_finder = + alg_vars_array |> NamedDecls.create ~forbidden:rule_names |> fun nd -> + nd.NamedDecls.finder in - let tok = tk_nd.NamedDecls.finder in - let () = - if with_counters then - Counters_compiler.add_counter_to_contact_map sigs - (add_link_contact_map ~contact_map) + let token_names = + ast_compil.Ast.tokens + |> Tools.array_map_of_list (fun x -> x, ()) + |> NamedDecls.create in - let perts', updated_vars = + let tokens_finder = token_names.NamedDecls.finder in + + if has_counters then + Counters_compiler.add_counter_to_contact_map agents_sig + (add_link_contact_map ~contact_map); + + let pertubations_without_counters, updated_alg_vars = List_util.fold_right_map - (perturbation_of_ast ~warning ~syntax_version sigs tok algs contact_map) - c.Ast.perturbations [] + (perturbation_of_ast ~warning ~syntax_version agents_sig tokens_finder + alg_vars_finder contact_map) + ast_compil.Ast.perturbations [] in - let perts'' = - if with_counters then - Counters_compiler.counters_perturbations sigs [ c.Ast.signatures ] - @ perts' + let perturbations = + if has_counters then + Counters_compiler.counters_perturbations agents_sig + [ ast_compil.Ast.signatures ] + @ pertubations_without_counters else - perts' + pertubations_without_counters in + let rules = List.rev_map - (fun ( label, - r_editStyle, - mix, - created, - rm_tk, - add_tk, - rate, - un_rate, - r_pos ) -> - let mix, created = - Counters_compiler.remove_counter_rule sigs mix created - in - ( label, - ( assemble_rule ~warning ~syntax_version ~r_editStyle sigs tok algs - mix created rm_tk add_tk rate un_rate, - r_pos ) )) + (fun (rule : rule_inter_rep) -> + ( rule.label_opt, + ( assemble_rule ~warning ~syntax_version rule agents_sig tokens_finder + alg_vars_finder, + rule.pos ) )) cleaned_rules in - ( sigs, - contact_map, - tk_nd, - algs, - updated_vars, - { - Ast.filenames = c.Ast.filenames; - Ast.variables = - Tools.array_fold_righti - (fun i (lab, expr) acc -> - ( lab, - alg_expr_of_ast ~warning ~syntax_version ~max_allowed_var:(pred i) - sigs tok algs expr ) - :: acc) - alg_vars_array []; - Ast.rules; - Ast.observables = - List.rev_map - (fun expr -> - alg_expr_of_ast ~warning ~syntax_version sigs tok algs expr) - (List.rev c.Ast.observables); - Ast.init = - init_of_ast ~warning ~syntax_version sigs contact_map tok algs - c.Ast.init; - Ast.perturbations = perts''; - Ast.volumes = c.Ast.volumes; - Ast.tokens = c.Ast.tokens; - Ast.signatures = c.Ast.signatures; - Ast.configurations = c.Ast.configurations; - } ) + + let variables = + Tools.array_fold_righti + (fun i (lab, expr) acc -> + ( lab, + alg_expr_of_ast ~warning ~syntax_version ~max_allowed_var:(pred i) + agents_sig tokens_finder alg_vars_finder expr ) + :: acc) + alg_vars_array [] + in + let observables = + List.rev_map + (fun expr -> + alg_expr_of_ast ~warning ~syntax_version agents_sig tokens_finder + alg_vars_finder expr) + (List.rev ast_compil.observables) + in + let init = + init_of_ast ~warning ~syntax_version agents_sig contact_map tokens_finder + alg_vars_finder ast_compil.init + in + + { + agents_sig; + contact_map; + token_names; + alg_vars_finder; + updated_alg_vars; + result = + { + filenames = ast_compil.filenames; + variables; + rules; + observables; + init; + perturbations; + volumes = ast_compil.volumes; + tokens = ast_compil.tokens; + signatures = ast_compil.signatures; + configurations = ast_compil.configurations; + }; + } diff --git a/core/grammar/lKappa_compiler.mli b/core/grammar/lKappa_compiler.mli index 88b2dcd956..2bda341612 100644 --- a/core/grammar/lKappa_compiler.mli +++ b/core/grammar/lKappa_compiler.mli @@ -7,17 +7,17 @@ (******************************************************************************) val bool_expr_of_ast : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> syntax_version:Ast.syntax_version -> Signature.s -> int Mods.StringMap.t -> int Mods.StringMap.t -> ?max_allowed_var:int -> - (Ast.mixture, string) Alg_expr.bool Locality.annot -> - (LKappa.rule_agent list, int) Alg_expr.bool Locality.annot + (Ast.mixture, string) Alg_expr.bool Loc.annoted -> + (LKappa.rule_agent list, int) Alg_expr.bool Loc.annoted val modif_expr_of_ast : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> syntax_version:Ast.syntax_version -> Signature.s -> int Mods.StringMap.t -> @@ -29,39 +29,43 @@ val modif_expr_of_ast : * int list val init_of_ast : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> syntax_version:Ast.syntax_version -> Signature.s -> Contact_map.t -> int Mods.StringMap.t -> int Mods.StringMap.t -> - (Ast.mixture, Ast.mixture, string) Ast.init_statment list -> - (LKappa.rule_agent list, Raw_mixture.t, int) Ast.init_statment list + (Ast.mixture, Ast.mixture, string) Ast.init_statement list -> + (LKappa.rule_agent list, Raw_mixture.t, int) Ast.init_statement list -val compil_of_ast : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> - debugMode:bool -> - syntax_version:Ast.syntax_version -> - (string * Nbr.t) list -> - Ast.parsing_compil -> - Signature.s - * Contact_map.t - * unit NamedDecls.t - * int Mods.StringMap.t - * int list - * ( Ast.agent, +type ast_compiled_data = { + agents_sig: Signature.s; + contact_map: Contact_map.t; + token_names: unit NamedDecls.t; + alg_vars_finder: int Mods.StringMap.t; + updated_alg_vars: int list; (** alg vars with forbidden constant prop *) + result: + ( Ast.agent, LKappa.rule_agent list, Raw_mixture.t, int, LKappa.rule ) - Ast.compil + Ast.compil; + (** Compiled data where identifiers are i Ast.compil where identifiers + * are integers and not string, syntactic sugar on rules are expansed + * (syntactic sugar on mixture are not) *) +} + +val compil_of_ast : + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> + debug_mode:bool -> + syntax_version:Ast.syntax_version -> + var_overwrite:(string * Nbr.t) list -> + Ast.parsing_compil -> + ast_compiled_data (** [compil_of_ast variable_overwrite ast] - @return the signature of agent, the contact map, the signature of - tokens, an algebraic variable finder, algebraic variable on which - constant propagation is forbidden, and an Ast.compil where identifiers - are integers and not string, syntactic sugar on rules are expansed - (syntactic sugar on mixture are not) + @return a [ast_compiled_data] instance: This function sorts out longest prefix convention as well as ensure a lot of sanity on mixtures: @@ -80,3 +84,15 @@ val compil_of_ast : After this step, [Ast.ANY_FREE] is a synonym of "an [Ast.LNK_ANY] explicitely given by the user". *) + +(** {2 Utils to build signatures} *) + +type site_sig_with_links_as_lists = + (string Loc.annoted * string Loc.annoted) list Signature.site_sig +(** Util type to store site signature with list links instead of array array links *) + +val agent_sigs_of_agent_sigs_with_links_as_lists : + build_contact_map:bool -> + site_sig_with_links_as_lists NamedDecls.t NamedDecls.t -> + Signature.t NamedDecls.t +(** Helper to build signatures: for each entry, translate [(string Loc.annoted * string Loc.annoted) list] into [bool array array option] *) diff --git a/core/logging/dune b/core/logging/dune index 8429d351c2..501e0308dc 100644 --- a/core/logging/dune +++ b/core/logging/dune @@ -1,8 +1,17 @@ (library - (name kappa_logging) - (libraries yojson - kappa-library.mixtures kappa_cli kappa_kasa_type_interface) - (flags (:standard -w @a - -open Kappa_generic_toolset - -open Kappa_cli - -open Kappa_kasa_type_interface))) + (name kappa_logging) + (libraries + yojson + kappa-library.mixtures + kappa_cli + kappa_kasa_type_interface) + (flags + (:standard + -w + @a + -open + Kappa_generic_toolset + -open + Kappa_cli + -open + Kappa_kasa_type_interface))) diff --git a/core/main/KaSim.ml b/core/main/KaSim.ml index b29901ad80..d43f97162f 100644 --- a/core/main/KaSim.ml +++ b/core/main/KaSim.ml @@ -19,11 +19,11 @@ let remove_trace () = | None -> () | Some d -> Sys.remove d -let batch_loop ~debugMode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash +let batch_loop ~debug_mode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash ~efficiency progress env counter graph state = let rec iter graph state = Lwt.wrap4 - (State_interpreter.a_loop ~debugMode ~outputs ~dumpIfDeadlocked + (State_interpreter.a_loop ~debug_mode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash) env counter graph state >>= fun (stop, graph', state') -> @@ -44,7 +44,7 @@ let batch_loop ~debugMode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash in iter graph state -let interactive_loop ~debugMode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash +let interactive_loop ~debug_mode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash ~efficiency progress pause_criteria env counter graph state = let user_interrupted = ref false in let old_sigint_behavior = @@ -66,7 +66,7 @@ let interactive_loop ~debugMode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash Lwt.return (false, graph, state) ) else Lwt.wrap4 - (State_interpreter.a_loop ~debugMode ~outputs ~dumpIfDeadlocked + (State_interpreter.a_loop ~debug_mode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash) env counter graph state >>= fun ((stop, graph', state') as out) -> @@ -166,7 +166,7 @@ let finalize ~outputs dotFormat cflow_file trace_file progress env counter graph | Unix.WEXITED 127 -> Lwt.fail (ExceptionDefn.Malformed_Decl - (Locality.dummy_annot + (Loc.annot_with_dummy ("Executable '" ^ prog ^ "' can not be found to compute stories."))) | Unix.WEXITED n -> if n <> 0 then exit n; @@ -216,8 +216,8 @@ let () = | None -> () | Some marshalizeOutFile -> Kappa_files.set_marshalized marshalizeOutFile in - let () = Parameter.debugModeOn := common_args.Common_args.debug in - let debugMode = common_args.Common_args.debug in + let () = Parameter.debug_modeOn := common_args.Common_args.debug in + let debug_mode = common_args.Common_args.debug in let () = Parameter.time_independent := kasim_args.Kasim_args.timeIndependent in @@ -232,30 +232,30 @@ let () = exit 1 ); let () = Sys.catch_break true in - Printexc.record_backtrace (debugMode || common_args.Common_args.backtrace); + Printexc.record_backtrace (debug_mode || common_args.Common_args.backtrace); (*Possible backtrace*) let cpu_time = Sys.time () in - let ( (( conf, - env, - contact_map, - _, - story_compression, - formatCflows, - cflowFile, - init_l ) as init_result), - counter ) = + (* TODO: init_result here didn't contain counter option before change, should we change rep? *) + let init_result : Cli_init.compilation_result = let warning ~pos msg = Outputs.go (Data.Warning (Some pos, msg)) in - Cli_init.get_compilation ~warning ~debugMode - ~compileModeOn:kasim_args.Kasim_args.compileMode ~kasim_args cli_args + Cli_init.get_compilation ~warning ~debug_mode + ~compile_mode_on:kasim_args.Kasim_args.compile_mode ~kasim_args cli_args + in + let counter = + match init_result.counter_opt with + | None -> failwith "compilation_result here should contain counter info" + | Some c -> c in let () = if kasim_args.Kasim_args.showEfficiency then Format.printf " All that took %fs@." (Sys.time () -. cpu_time) in - let theSeed, seed_arg = - match kasim_args.Kasim_args.seedValue, conf.Configuration.seed with + let the_seed, seed_arg = + match + kasim_args.Kasim_args.seedValue, init_result.conf.Configuration.seed + with | Some seed, _ | None, Some seed -> seed, [||] | None, None -> let () = Format.printf "+ Self seeding...@." in @@ -263,8 +263,8 @@ let () = let out = Random.bits () in out, [| "-seed"; string_of_int out |] in - let () = Random.init theSeed (*for reproducible colors in dot snaphot*) in - let random_state = Random.State.make [| theSeed |] in + let () = Random.init the_seed (*for reproducible colors in dot snaphot*) in + let random_state = Random.State.make [| the_seed |] in let () = if @@ -272,7 +272,7 @@ let () = && Counter.max_time counter = None && Counter.max_events counter = None then - Model.check_if_counter_is_filled_enough env + Model.check_if_counter_is_filled_enough init_result.env in let command_line = @@ -291,12 +291,13 @@ let () = let trace_file, user_trace_file = match - kasim_args.Kasim_args.traceFile, conf.Configuration.traceFileName + ( kasim_args.Kasim_args.traceFile, + init_result.conf.Configuration.traceFileName ) with | (Some _ as x), _ -> x, x | _, (Some _ as x) -> x, x | None, None -> - (match story_compression with + (match init_result.story_compression with | None -> None, None | Some _ -> let () = tmp_trace := Some (Filename.temp_file "trace" ".json") in @@ -304,7 +305,8 @@ let () = in let plot_file = Option_util.unsome - (Option_util.unsome "data.csv" conf.Configuration.outputFileName) + (Option_util.unsome "data.csv" + init_result.conf.Configuration.outputFileName) cli_args.Run_cli_args.outputDataFile in let plotPack = @@ -312,9 +314,10 @@ let () = Model.map_observables (fun o -> Format.asprintf "@[%a@]" - (Kappa_printer.alg_expr ~noCounters:debugMode ~env) + (Kappa_printer.alg_expr ~noCounters:debug_mode + ~env:init_result.env) o) - env + init_result.env in if Array.length head > 1 then ( let title = "Output of " ^ command_line in @@ -322,19 +325,25 @@ let () = ) else None in - let dumpIfDeadlocked = conf.Configuration.dumpIfDeadlocked in - let maxConsecutiveClash = conf.Configuration.maxConsecutiveClash in - let deltaActivitiesFileName = conf.Configuration.deltaActivitiesFileName in + let dumpIfDeadlocked = init_result.conf.Configuration.dumpIfDeadlocked in + let maxConsecutiveClash = + init_result.conf.Configuration.maxConsecutiveClash + in + let deltaActivitiesFileName = + init_result.conf.Configuration.deltaActivitiesFileName + in let () = - if not kasim_args.Kasim_args.compileMode then ( + if not kasim_args.Kasim_args.compile_mode then ( match kasim_args.Kasim_args.logFile with | None -> () | Some filename -> Outputs.initial_inputs { - Configuration.seed = Some theSeed; - Configuration.progressChar = conf.Configuration.progressChar; - Configuration.progressSize = conf.Configuration.progressSize; + Configuration.seed = Some the_seed; + Configuration.progressChar = + init_result.conf.Configuration.progressChar; + Configuration.progressSize = + init_result.conf.Configuration.progressSize; Configuration.dumpIfDeadlocked; Configuration.maxConsecutiveClash; Configuration.deltaActivitiesFileName; @@ -347,13 +356,14 @@ let () = Configuration.plotPeriod = Some (Counter.plot_period counter); Configuration.outputFileName = Some plot_file; } - env init_l ~filename + init_result.env init_result.init_l ~filename ) in Kappa_files.setCheckFileExists ~batchmode:cli_args.Run_cli_args.batchmode plot_file; - if not kasim_args.Kasim_args.compileMode then - Outputs.initialize deltaActivitiesFileName trace_file plotPack env; + if not kasim_args.Kasim_args.compile_mode then + Outputs.initialize deltaActivitiesFileName trace_file plotPack + init_result.env; let outputs = Outputs.go in let () = @@ -366,9 +376,10 @@ let () = Eval.build_initial_state ~bind:(fun x f -> f x) ~return:(fun x -> x) - ~debugMode ~outputs counter env ~with_trace:(trace_file <> None) + ~debug_mode ~outputs counter init_result.env + ~with_trace:(trace_file <> None) ~with_delta_activities:(deltaActivitiesFileName <> None) - random_state init_l + random_state init_result.init_l in let () = Format.printf " (%a)" Rule_interpreter.print_stats graph in let () = @@ -379,7 +390,7 @@ let () = Format.printf "@.Done@.+ Command line to rerun is: %s@." command_line; let () = - if kasim_args.Kasim_args.compileMode || debugMode then + if kasim_args.Kasim_args.compile_mode || debug_mode then Format.eprintf "@[@[Environment:@,\ %a@]@,\ @@ -389,13 +400,13 @@ let () = %a@]@,\ @[Intial graph;@,\ %a@]@]@." - (Kappa_printer.env ~noCounters:debugMode) - env - (Contact_map.print_cycles (Model.signatures env)) - contact_map - (Pattern.Env.print ~noCounters:debugMode) - (Model.domain env) - (Rule_interpreter.print env) + (Kappa_printer.env ~noCounters:debug_mode) + init_result.env + (Contact_map.print_cycles (Model.signatures init_result.env)) + init_result.contact_map + (Pattern.Env.print ~noCounters:debug_mode) + (Model.domain init_result.env) + (Rule_interpreter.print init_result.env) graph in (*------------------------------------------------------------*) @@ -405,10 +416,10 @@ let () = | Some domainOutputFile -> Yojson.Basic.to_file (Kappa_files.path domainOutputFile) - (Pattern.Env.to_yojson (Model.domain env)) + (Pattern.Env.to_yojson (Model.domain init_result.env)) in Outputs.flush_warning (); - if kasim_args.Kasim_args.compileMode then ( + if kasim_args.Kasim_args.compile_mode then ( let () = remove_trace () in exit 0 ) else @@ -419,24 +430,29 @@ let () = | Some _ -> if Counter.positive_plot_period counter then Outputs.go - (Data.Plot (State_interpreter.observables_values env graph counter)) + (Data.Plot + (State_interpreter.observables_values init_result.env graph + counter)) | _ -> () in let progress = - Progress_report.create conf.Configuration.progressSize - conf.Configuration.progressChar + Progress_report.create init_result.conf.Configuration.progressSize + init_result.conf.Configuration.progressChar in Lwt_main.run ( (if stop then - finalize ~outputs formatCflows cflowFile trace_file progress env - counter graph state story_compression + finalize ~outputs init_result.formatCflow init_result.cflowFile + trace_file progress init_result.env counter graph state + init_result.story_compression else if cli_args.Run_cli_args.batchmode then - batch_loop ~debugMode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash - ~efficiency:kasim_args.Kasim_args.showEfficiency progress env - counter graph state + batch_loop ~debug_mode ~outputs ~dumpIfDeadlocked + ~maxConsecutiveClash + ~efficiency:kasim_args.Kasim_args.showEfficiency progress + init_result.env counter graph state >>= fun (graph', state') -> - finalize ~outputs formatCflows cflowFile trace_file progress env - counter graph' state' story_compression + finalize ~outputs init_result.formatCflow init_result.cflowFile + trace_file progress init_result.env counter graph' state' + init_result.story_compression else ( let rec toplevel env graph state = let () = Outputs.flush_warning () in @@ -459,16 +475,17 @@ let () = >>= function | Ast.RUN b -> Lwt.wrap4 - (Evaluator.get_pause_criteria ~debugMode ~outputs + (Evaluator.get_pause_criteria ~debug_mode ~outputs ~sharing:kasim_args.Kasim_args.sharing ~syntax_version:cli_args.Run_cli_args.syntaxVersion) - contact_map env graph b + init_result.contact_map init_result.env graph b >>= fun (env', graph', b'') -> let progress = - Progress_report.create conf.Configuration.progressSize - conf.Configuration.progressChar + Progress_report.create + init_result.conf.Configuration.progressSize + init_result.conf.Configuration.progressChar in - interactive_loop ~debugMode ~outputs ~dumpIfDeadlocked + interactive_loop ~debug_mode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash ~efficiency:kasim_args.Kasim_args.showEfficiency progress b'' env' counter graph' state @@ -476,10 +493,11 @@ let () = | Ast.QUIT -> Lwt.return (env, (true, graph, state)) | Ast.MODIFY e -> Lwt.wrap6 - (Evaluator.do_interactive_directives ~debugMode ~outputs + (Evaluator.do_interactive_directives ~debug_mode ~outputs ~sharing:kasim_args.Kasim_args.sharing ~syntax_version:cli_args.Run_cli_args.syntaxVersion) - contact_map env counter graph state e + init_result.contact_map init_result.env counter graph state + e >>= fun (e', ((env', _) as o)) -> Lwt_io.print "\xE2\x9C\x94 " >>= fun () -> let () = @@ -498,8 +516,9 @@ let () = | e -> Lwt.fail e) >>= fun (env', (stop, graph', state')) -> if stop then - finalize ~outputs formatCflows cflowFile trace_file progress env - counter graph' state' story_compression + finalize ~outputs init_result.formatCflow init_result.cflowFile + trace_file progress init_result.env counter graph' state' + init_result.story_compression else toplevel env' graph' state' in @@ -511,18 +530,21 @@ let () = > " in if cli_args.Run_cli_args.interactive then - toplevel_intro () >>= fun () -> toplevel env graph state + toplevel_intro () >>= fun () -> + toplevel init_result.env graph state else - interactive_loop ~debugMode ~outputs ~dumpIfDeadlocked + interactive_loop ~debug_mode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash ~efficiency:kasim_args.Kasim_args.showEfficiency progress - Alg_expr.FALSE env counter graph state + Alg_expr.FALSE init_result.env counter graph state >>= fun (stop, graph', state') -> if stop then - finalize ~outputs formatCflows cflowFile trace_file progress env - counter graph' state' story_compression + finalize ~outputs init_result.formatCflow init_result.cflowFile + trace_file progress init_result.env counter graph' state' + init_result.story_compression else - toplevel_intro () >>= fun () -> toplevel env graph' state' + toplevel_intro () >>= fun () -> + toplevel init_result.env graph' state' )) >>= fun () -> Lwt_io.printl "Simulation ended" >>= fun () -> diff --git a/core/main/dune b/core/main/dune index 7b4e7fe2f0..072922ef7c 100644 --- a/core/main/dune +++ b/core/main/dune @@ -1,15 +1,34 @@ (executable - (name KaSim) - (libraries lwt.unix fmt num yojson - kappa-library.generic kappa-library.mixtures kappa-library.terms kappa-library.runtime - kappa_version kappa_grammar kappa_cli) - (public_name KaSim) - (package kappa-binaries) -(flags (:standard -w @a - -open Kappa_version - -open Kappa_generic_toolset - -open Kappa_mixtures - -open Kappa_terms - -open Kappa_runtime - -open Kappa_grammar - -open Kappa_cli))) + (name KaSim) + (libraries + lwt.unix + fmt + num + yojson + kappa-library.generic + kappa-library.mixtures + kappa-library.terms + kappa-library.runtime + kappa_version + kappa_grammar + kappa_cli) + (public_name KaSim) + (package kappa-binaries) + (flags + (:standard + -w + @a-40-42 + -open + Kappa_version + -open + Kappa_generic_toolset + -open + Kappa_mixtures + -open + Kappa_terms + -open + Kappa_runtime + -open + Kappa_grammar + -open + Kappa_cli))) diff --git a/core/odes/KaDE.ml b/core/odes/KaDE.ml index c1585c917a..a806318281 100644 --- a/core/odes/KaDE.ml +++ b/core/odes/KaDE.ml @@ -37,7 +37,7 @@ let main ?(called_from = Remanent_parameters_sig.Server) () = let () = Run_cli_args.copy_from_gui cli_args_gui cli_args in let () = cli_args.Run_cli_args.inputKappaFileNames <- files in let () = Kappa_files.set_dir cli_args.Run_cli_args.outputDirectory in - let () = Parameter.debugModeOn := common_args.Common_args.debug in + let () = Parameter.debug_modeOn := common_args.Common_args.debug in let backend = match Tools.lowercase !(ode_args.Ode_args.backend) with | "octave" -> Loggers.Octave @@ -216,7 +216,7 @@ let main ?(called_from = Remanent_parameters_sig.Server) () = (Remanent_parameters.get_trace parameters') in let compil = - A.get_compil ~debugMode:common_args.Common_args.debug ~dotnet + A.get_compil ~debug_mode:common_args.Common_args.debug ~dotnet ~reaction_rate_convention ~rule_rate_convention ~show_reactions ~count ~internal_meaning ~compute_jacobian cli_args preprocessed_ast in @@ -234,7 +234,7 @@ let main ?(called_from = Remanent_parameters_sig.Server) () = algebraic expressions... @." in let compil = - A.get_compil ~debugMode:common_args.Common_args.debug ~dotnet + A.get_compil ~debug_mode:common_args.Common_args.debug ~dotnet ?bwd_bisim ~reaction_rate_convention ~rule_rate_convention ~show_reactions ~count ~internal_meaning ~compute_jacobian cli_args preprocessed_ast @@ -254,7 +254,7 @@ let main ?(called_from = Remanent_parameters_sig.Server) () = network, compil else ( let compil = - A.get_compil ~debugMode:common_args.Common_args.debug ~dotnet + A.get_compil ~debug_mode:common_args.Common_args.debug ~dotnet ~reaction_rate_convention ~rule_rate_convention ~show_reactions ~count ~internal_meaning ~compute_jacobian cli_args preprocessed_ast in diff --git a/core/odes/dune b/core/odes/dune index b4344fea64..43e27d2eff 100644 --- a/core/odes/dune +++ b/core/odes/dune @@ -1,19 +1,41 @@ (executable - (name KaDE) - (libraries num yojson str kappa-library.runtime kappa_grammar kappa_cli kappa_staticanalyses kappa_kasa_export ) - (public_name KaDE) - (package kappa-binaries) - (flags (:standard - -open Kappa_generic_toolset - -open Kappa_mixtures - -open Kappa_terms - -open Kappa_runtime - -open Kappa_grammar - -open Kappa_cli - -open Kappa_logging - -open Kappa_parameters - -open Kappa_staticanalyses - -open Kappa_symmetries - -open Kappa_reachability - -open Kappa_kasa_export - -open Kappa_kasa_type_interface))) + (name KaDE) + (libraries + num + yojson + str + kappa-library.runtime + kappa_grammar + kappa_cli + kappa_staticanalyses + kappa_kasa_export) + (public_name KaDE) + (package kappa-binaries) + (flags + (:standard + -open + Kappa_generic_toolset + -open + Kappa_mixtures + -open + Kappa_terms + -open + Kappa_runtime + -open + Kappa_grammar + -open + Kappa_cli + -open + Kappa_logging + -open + Kappa_parameters + -open + Kappa_staticanalyses + -open + Kappa_symmetries + -open + Kappa_reachability + -open + Kappa_kasa_export + -open + Kappa_kasa_type_interface))) diff --git a/core/odes/lin_comb.ml b/core/odes/lin_comb.ml index 425ff2ba81..e07d4e6fb7 100644 --- a/core/odes/lin_comb.ml +++ b/core/odes/lin_comb.ml @@ -12,8 +12,8 @@ module type Lin_comb = sig type t val of_expr : - (id -> (mix, id) Alg_expr.e Locality.annot option) -> - (mix, id) Alg_expr.e Locality.annot -> + (id -> (mix, id) Alg_expr.e Loc.annoted option) -> + (mix, id) Alg_expr.e Loc.annoted -> t option val print : diff --git a/core/odes/lin_comb.mli b/core/odes/lin_comb.mli index 5186bf83c1..548799c4de 100644 --- a/core/odes/lin_comb.mli +++ b/core/odes/lin_comb.mli @@ -5,8 +5,8 @@ module type Lin_comb = sig type t val of_expr : - (id -> (mix, id) Alg_expr.e Locality.annot option) -> - (mix, id) Alg_expr.e Locality.annot -> + (id -> (mix, id) Alg_expr.e Loc.annoted option) -> + (mix, id) Alg_expr.e Loc.annoted -> t option val print : diff --git a/core/odes/ode_loggers.mli b/core/odes/ode_loggers.mli index 66ea0de04e..b8c98f2c1b 100644 --- a/core/odes/ode_loggers.mli +++ b/core/odes/ode_loggers.mli @@ -64,7 +64,7 @@ val associate : Loggers.t -> Ode_loggers_sig.variable -> (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Alg_expr.e - Locality.annot -> + Loc.annoted -> (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Network_handler.t -> unit @@ -76,7 +76,7 @@ val increment : Loggers.t -> Ode_loggers_sig.variable -> (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Alg_expr.e - Locality.annot -> + Loc.annoted -> (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Network_handler.t -> unit @@ -179,11 +179,11 @@ val print_alg_expr_few_parenthesis : Ode_loggers_sig.t -> Loggers.t -> (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Alg_expr.e - Locality.annot -> + Loc.annoted -> (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Network_handler.t -> unit val is_time : (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Alg_expr.e - Locality.annot -> + Loc.annoted -> bool diff --git a/core/odes/ode_loggers_sig.ml b/core/odes/ode_loggers_sig.ml index bffca6fc56..085d3bea6e 100644 --- a/core/odes/ode_loggers_sig.ml +++ b/core/odes/ode_loggers_sig.ml @@ -94,7 +94,7 @@ module VarSet = Set.Make (VarOrd) type t = { logger: Loggers.t; - env: (ode_var_id, ode_var_id) Alg_expr.e Locality.annot VarMap.t ref; + env: (ode_var_id, ode_var_id) Alg_expr.e Loc.annoted VarMap.t ref; id_map: int StringMap.t ref; fresh_meta_id: int ref; fresh_reaction_id: int ref; diff --git a/core/odes/ode_loggers_sig.mli b/core/odes/ode_loggers_sig.mli index 375d88181a..f129e4fed3 100644 --- a/core/odes/ode_loggers_sig.mli +++ b/core/odes/ode_loggers_sig.mli @@ -59,10 +59,10 @@ val string_of_un_bool_op : t -> Operator.un_bool_op -> string val string_of_bin_bool_op : t -> Operator.bin_bool_op -> string val get_expr : - t -> variable -> (ode_var_id, ode_var_id) Alg_expr.e Locality.annot option + t -> variable -> (ode_var_id, ode_var_id) Alg_expr.e Loc.annoted option val set_expr : - t -> variable -> (ode_var_id, ode_var_id) Alg_expr.e Locality.annot -> unit + t -> variable -> (ode_var_id, ode_var_id) Alg_expr.e Loc.annoted -> unit val is_const : t -> variable -> bool val get_fresh_obs_id : t -> int diff --git a/core/odes/odes.ml b/core/odes/odes.ml index 8454f6e605..1d2dc79965 100644 --- a/core/odes/odes.ml +++ b/core/odes/odes.ml @@ -5,8 +5,8 @@ let local_trace = false -let debug ~debugMode s = - if local_trace || debugMode then +let debug ~debug_mode s = + if local_trace || debug_mode then Format.kfprintf (fun f -> Format.pp_print_break f 0 0) Format.err_formatter s @@ -83,9 +83,8 @@ module Make (I : Symmetry_interface_sig.Interface) = struct module VarMap = VarSetMap.Map type 'a decl = - | Var of var_id * string option * ('a, int) Alg_expr.e Locality.annot - | Init_expr of - var_id * ('a, int) Alg_expr.e Locality.annot * ode_var_id list + | Var of var_id * string option * ('a, int) Alg_expr.e Loc.annoted + | Init_expr of var_id * ('a, int) Alg_expr.e Loc.annoted * ode_var_id list | Dummy_decl let var_id_of_decl decl = @@ -144,7 +143,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct updated_cc_to_embedding_to_current_species: I.connected_component list; ode_variables: VarSet.t; reactions: - ((id list * id list * id Locality.annot list * enriched_rule) * int) list; + ((id list * id list * id Loc.annoted list * enriched_rule) * int) list; ode_vars_tab: ode_var Mods.DynArray.t; id_of_ode_var: ode_var_id VarMap.t; fresh_ode_var_id: ode_var_id; @@ -155,7 +154,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct fresh_var_id: var_id; var_declaration: 'a decl list; n_rules: int; - obs: (obs_id * ('a, 'b) Alg_expr.e Locality.annot) list; + obs: (obs_id * ('a, 'b) Alg_expr.e Loc.annoted) list; n_obs: int; time_homogeneous_obs: bool option; time_homogeneous_vars: bool option; @@ -393,11 +392,11 @@ module Make (I : Symmetry_interface_sig.Interface) = struct let network = inc_fresh_ode_var_id network in network - let add_new_canonic_species ~debugMode compil canonic species network = + let add_new_canonic_species ~debug_mode compil canonic species network = let () = Mods.DynArray.set network.species_tab (get_fresh_ode_var_id network) - (species, I.nbr_automorphisms_in_chemical_species ~debugMode species) + (species, I.nbr_automorphisms_in_chemical_species ~debug_mode species) in let var = species_to_var compil canonic in add_new_var var network @@ -434,36 +433,36 @@ module Make (I : Symmetry_interface_sig.Interface) = struct StoreMap.add key new_list store let translate_canonic_species compil canonic species remanent = - let debugMode = I.debug_mode compil in + let debug_mode = I.debug_mode compil in let var = species_to_var compil canonic in let id_opt = VarMap.find_option var (snd remanent).id_of_ode_var in match id_opt with | None -> - let () = debug ~debugMode "A NEW SPECIES IS DISCOVERED @." in + let () = debug ~debug_mode "A NEW SPECIES IS DISCOVERED @." in let () = - debug ~debugMode "canonic form: %a@." + debug ~debug_mode "canonic form: %a@." (fun x -> I.print_canonic_species ~compil x) canonic in let () = - debug ~debugMode "species: %a@.@." + debug ~debug_mode "species: %a@.@." (fun x -> I.print_chemical_species ~compil x) species in let to_be_visited, network = remanent in let network, id = - add_new_canonic_species ~debugMode compil canonic species network + add_new_canonic_species ~debug_mode compil canonic species network in (species :: to_be_visited, network), id | Some i -> - let () = debug ~debugMode "ALREADY SEEN SPECIES @." in + let () = debug ~debug_mode "ALREADY SEEN SPECIES @." in let () = - debug ~debugMode "canonic form: %a@." + debug ~debug_mode "canonic form: %a@." (fun x -> I.print_canonic_species ~compil x) canonic in let () = - debug ~debugMode "species: %a@.@." + debug ~debug_mode "species: %a@.@." (fun x -> I.print_chemical_species ~compil x) species in @@ -550,7 +549,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct if n_embs = 0 then alg else ( - let species = Locality.dummy_annot (Alg_expr.KAPPA_INSTANCE id) in + let species = Loc.annot_with_dummy (Alg_expr.KAPPA_INSTANCE id) in let term = target compil (from (Alg_expr.mult (Alg_expr.int n_embs) species) nauto) @@ -672,13 +671,13 @@ module Make (I : Symmetry_interface_sig.Interface) = struct let add_reaction ?max_size parameters compil enriched_rule embedding_forest mixture remanent = - let debugMode = I.debug_mode compil in + let debug_mode = I.debug_mode compil in let rule = enriched_rule.rule in - let _ = debug ~debugMode "REACTANTS\n" in + let _ = debug ~debug_mode "REACTANTS\n" in let remanent, reactants = petrify_mixture parameters compil mixture remanent in - let _ = debug ~debugMode "PRODUCT\n" in + let _ = debug ~debug_mode "PRODUCT\n" in let products = I.apply compil rule embedding_forest mixture in let list, network = remanent in let cache, bool = I.valid_mixture compil network.cache ?max_size products in @@ -693,7 +692,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct List.fold_left (fun (remanent, tokens) (_, b) -> let remanent, id = translate_token b remanent in - remanent, Locality.dummy_annot id :: tokens) + remanent, Loc.annot_with_dummy id :: tokens) (remanent, []) tokens in let to_be_visited, network = remanent in @@ -715,14 +714,14 @@ module Make (I : Symmetry_interface_sig.Interface) = struct let initial_network ?max_size parameters compil network initial_states rules = let network = { network with has_empty_lhs = Some false } in - let debugMode = I.debug_mode compil in + let debug_mode = I.debug_mode compil in let l, network = List.fold_left (fun remanent enriched_rule -> match enriched_rule.lhs_cc with | [] -> let _, embed, mixture = I.disjoint_union compil [] in - let () = debug ~debugMode "add new reaction" in + let () = debug ~debug_mode "add new reaction" in let l, network = remanent in let remanent = l, { network with has_empty_lhs = Some true } in add_reaction ?max_size parameters compil enriched_rule embed mixture @@ -763,7 +762,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct let compute_reactions ?max_size ~smash_reactions parameters compil network rules initial_states = (* Let us annotate the rules with cc decomposition *) - let debugMode = I.debug_mode compil in + let debug_mode = I.debug_mode compil in let n_rules = List.length rules in let cache = network.cache in let cache, max_coef, rules_rev = @@ -809,7 +808,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct | new_species :: to_be_visited -> let network = clean_embed_to_current_species network in let () = - debug ~debugMode "@[@[test for the new species:@ %a@]" + debug ~debug_mode "@[@[test for the new species:@ %a@]" (fun x -> I.print_chemical_species ~compil x) new_species in @@ -828,7 +827,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct (* regular application of tules, we store the embeddings*) let () = - debug ~debugMode + debug ~debug_mode "@[test for rule %i at pos %i (Aut:%i)@[%a@]" (rule_id_of enriched_rule) pos enriched_rule.divide_rate_by (I.print_rule ~compil) @@ -836,11 +835,11 @@ module Make (I : Symmetry_interface_sig.Interface) = struct in match arity_of enriched_rule with | Rule_modes.Usual | Rule_modes.Unary_refinement -> - let () = debug ~debugMode "regular case" in + let () = debug ~debug_mode "regular case" in let store_new_embeddings = (*List.fold_left (fun store (cc_id,cc) -> - let () = debug ~debugMode "find embeddings" in + let () = debug ~debug_mode "find embeddings" in let lembed = I.find_embeddings compil cc new_species in @@ -869,11 +868,11 @@ module Make (I : Symmetry_interface_sig.Interface) = struct species that contain at least one occurence of new_species *) let dump_store store = - if local_trace || debugMode then + if local_trace || debug_mode then StoreMap.iter (fun ((a, ar, dir), id, b) c -> let () = - debug ~debugMode + debug ~debug_mode "@[* rule:%i %s %s cc:%i:@[%a@]:" a (match ar with | Rule_modes.Usual -> "@" @@ -890,17 +889,17 @@ module Make (I : Symmetry_interface_sig.Interface) = struct let () = List.iter (fun (_, b) -> - debug ~debugMode "%a" + debug ~debug_mode "%a" (fun x -> I.print_chemical_species ~compil x) b) c in - let () = debug ~debugMode "@]" in + let () = debug ~debug_mode "@]" in ()) store in - let () = debug ~debugMode "new embeddings" in + let () = debug ~debug_mode "new embeddings" in let () = dump_store store_new_embeddings in let _, new_embedding_list = List.fold_left @@ -931,9 +930,9 @@ module Make (I : Symmetry_interface_sig.Interface) = struct let to_be_visited, network = List.fold_left (fun remanent list -> - let () = debug ~debugMode "compute one refinement" in + let () = debug ~debug_mode "compute one refinement" in let () = - debug ~debugMode "disjoint union @[%a@]" + debug ~debug_mode "disjoint union @[%a@]" (Pp.list Pp.space (fun f (_, _, s) -> I.print_chemical_species ~compil f s)) list @@ -941,16 +940,16 @@ module Make (I : Symmetry_interface_sig.Interface) = struct let _, embed, mixture = I.disjoint_union compil list in - let () = debug ~debugMode "add new reaction" in + let () = debug ~debug_mode "add new reaction" in add_reaction ?max_size parameters compil enriched_rule embed mixture remanent) (to_be_visited, network) new_embedding_list in - let () = debug ~debugMode "@]" in + let () = debug ~debug_mode "@]" in store_all_embeddings, to_be_visited, network | Rule_modes.Unary -> (* unary application of binary rules *) - let () = debug ~debugMode "unary case" in + let () = debug ~debug_mode "unary case" in let network = add_embed_to_current_species cc embed network in @@ -981,27 +980,27 @@ module Make (I : Symmetry_interface_sig.Interface) = struct fold_left_swap (fun embed remanent -> let () = - debug ~debugMode "add new reaction (unary)" + debug ~debug_mode "add new reaction (unary)" in let embed = add_reaction ?max_size parameters compil enriched_rule embed mix remanent in let () = - debug ~debugMode "end new reaction (unary)" + debug ~debug_mode "end new reaction (unary)" in embed) lembed (to_be_visited, network) | None -> to_be_visited, network in - let () = debug ~debugMode "@]" in + let () = debug ~debug_mode "@]" in store_old_embeddings, to_be_visited, network) (store_old_embeddings, to_be_visited, network) pairs_rule_pos) (store, to_be_visited, network) all_ccs in - let () = debug ~debugMode "@]" in + let () = debug ~debug_mode "@]" in aux to_be_visited network store in let network = aux to_be_visited network store in @@ -1069,7 +1068,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct in { network with reactions } in - let () = debug ~debugMode "@]@." in + let () = debug ~debug_mode "@]@." in network let convert_tokens compil network = @@ -1083,7 +1082,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct let convert_initial_state parameters compil intro network = let b, c = intro in let network, expr_init = - convert_alg_expr parameters compil network (Locality.dummy_annot b) + convert_alg_expr parameters compil network (Loc.annot_with_dummy b) in ( expr_init, match I.token_vector_of_init c with @@ -1263,7 +1262,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct (fun network obs -> let network, expr_obs = convert_alg_expr parameters compil network - (Locality.dummy_annot obs) + (Loc.annot_with_dummy obs) in inc_fresh_obs_id { @@ -1292,8 +1291,8 @@ module Make (I : Symmetry_interface_sig.Interface) = struct in { network with cache }, list - type ('a, 'b) rate = ('a, 'b) Alg_expr.e Locality.annot - type ('a, 'b) stoc = int * ('a, 'b) Alg_expr.e Locality.annot + type ('a, 'b) rate = ('a, 'b) Alg_expr.e Loc.annoted + type ('a, 'b) stoc = int * ('a, 'b) Alg_expr.e Loc.annoted type ('a, 'b) coef = R of ('a, 'b) rate | S of ('a, 'b) stoc type ('a, 'b) sort_rules_and_decl = { @@ -1565,7 +1564,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct let expr = to_var compil (from_nocc compil - (Locality.dummy_annot (Alg_expr.ALG_VAR id')) + (Loc.annot_with_dummy (Alg_expr.ALG_VAR id')) n) n in @@ -1975,7 +1974,7 @@ module Make (I : Symmetry_interface_sig.Interface) = struct (string_of_var_id ~compil logger) logger logger_buffer logger_err (Ode_loggers_sig.Init (get_last_ode_var_id network)) - (Locality.dummy_annot + (Loc.annot_with_dummy (Alg_expr.STATE_ALG_OP Operator.TIME_VAR)) handler_init in diff --git a/core/odes/odes.mli b/core/odes/odes.mli index 958114072a..d194476da5 100644 --- a/core/odes/odes.mli +++ b/core/odes/odes.mli @@ -15,7 +15,7 @@ module Make (I : Symmetry_interface_sig.Interface) : sig val preprocess : Run_cli_args.t -> I.ast -> I.preprocessed_ast val get_compil : - debugMode:bool -> + debug_mode:bool -> dotnet:bool -> ?bwd_bisim:LKappa_group_action.bwd_bisim_info -> rule_rate_convention:Remanent_parameters_sig.rate_convention -> @@ -46,10 +46,7 @@ module Make (I : Symmetry_interface_sig.Interface) : sig val get_reactions : ('a, 'b) network -> - ((ode_var_id list - * ode_var_id list - * ode_var_id Locality.annot list - * I.rule) + ((ode_var_id list * ode_var_id list * ode_var_id Loc.annoted list * I.rule) * int) list diff --git a/core/odes/sbml_backend.ml b/core/odes/sbml_backend.ml index 9808ef2fba..9456673af5 100644 --- a/core/odes/sbml_backend.ml +++ b/core/odes/sbml_backend.ml @@ -33,7 +33,7 @@ let warn ?pos loc m logger logger_err = | Some pos -> warn_with_pos pos loc m logger logger_err let warn_expr ?pos expr m logger logger_err = - let loc = Locality.to_string (snd expr) in + let loc = Loc.to_string (snd expr) in warn ?pos loc m logger logger_err let do_sbml logger logger_err f = @@ -263,7 +263,7 @@ let string_of_variable logger string_of_var_id variable = | Ode_loggers_sig.Jacobian_rateun _ | Ode_loggers_sig.Jacobian_rateund _ -> raise (ExceptionDefn.Internal_Error - ("SBML does not support differentiation", Locality.dummy)) + ("SBML does not support differentiation", Loc.dummy)) let unit_of_variable variable = match variable with @@ -576,7 +576,7 @@ let print_ci_with_id logger logger_err ci id = let rec print_alg_expr_in_sbml string_of_var_id logger logger_err (alg_expr : (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Alg_expr.e - Locality.annot) + Loc.annoted) (network : (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Network_handler.t) = @@ -814,7 +814,7 @@ and print_bool_expr_in_sbml string_of_var_id logger logger_err cond network = let rec substance_expr_in_sbml logger (alg_expr : (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Alg_expr.e - Locality.annot) + Loc.annoted) (network : (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Network_handler.t) = @@ -880,7 +880,7 @@ and substance_bool_expr_in_sbml logger cond network = let rec maybe_time_dependent_alg_expr_in_sbml logger (alg_expr : (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Alg_expr.e - Locality.annot) + Loc.annoted) (network : (Ode_loggers_sig.ode_var_id, Ode_loggers_sig.ode_var_id) Network_handler.t) = @@ -1284,19 +1284,19 @@ let dump_kinetic_law ~propagate_constants string_of_var_id logger logger_err aux reactants)) let negative_part expr = - Locality.dummy_annot + Loc.annot_with_dummy (Alg_expr.UN_ALG_OP ( Operator.UMINUS, - Locality.dummy_annot + Loc.annot_with_dummy (Alg_expr.BIN_ALG_OP ( Operator.MIN, - Locality.dummy_annot (Alg_expr.CONST Nbr.zero), + Loc.annot_with_dummy (Alg_expr.CONST Nbr.zero), expr )) )) let positive_part expr = - Locality.dummy_annot + Loc.annot_with_dummy (Alg_expr.BIN_ALG_OP - (Operator.MAX, Locality.dummy_annot (Alg_expr.CONST Nbr.zero), expr)) + (Operator.MAX, Loc.annot_with_dummy (Alg_expr.CONST Nbr.zero), expr)) let dump_token_vector convert logger logger_err network_handler rule_id token_vector = diff --git a/core/parameters/dune b/core/parameters/dune index 6e7ec7b12d..e68cd57f1c 100644 --- a/core/parameters/dune +++ b/core/parameters/dune @@ -1,10 +1,23 @@ (library - (name kappa_parameters) - (libraries yojson result kappa_version kappa_cli kappa-library.generic kappa_classical_graphs) - (flags (:standard) - -open Kappa_cli - -open Kappa_version - -open Kappa_grammar - -open Kappa_generic_toolset - -open Kappa_logging - -open Kappa_classical_graphs)) + (name kappa_parameters) + (libraries + yojson + result + kappa_version + kappa_cli + kappa-library.generic + kappa_classical_graphs) + (flags + (:standard) + -open + Kappa_cli + -open + Kappa_version + -open + Kappa_grammar + -open + Kappa_generic_toolset + -open + Kappa_logging + -open + Kappa_classical_graphs)) diff --git a/core/profiling/dune b/core/profiling/dune index f021c6cd44..4b31924b7d 100644 --- a/core/profiling/dune +++ b/core/profiling/dune @@ -1,7 +1,5 @@ (library - (name kappa_profiling) - (libraries yojson result kappa_logging kappa_parameters kappa_errors) - (flags (:standard - -open Kappa_logging - -open Kappa_parameters - -open Kappa_errors ))) + (name kappa_profiling) + (libraries yojson result kappa_logging kappa_parameters kappa_errors) + (flags + (:standard -open Kappa_logging -open Kappa_parameters -open Kappa_errors))) diff --git a/core/simulation/data.ml b/core/simulation/data.ml index ec36962f8e..d0ed1f9703 100644 --- a/core/simulation/data.ml +++ b/core/simulation/data.ml @@ -41,7 +41,7 @@ let print_initial_inputs ?uuid conf env inputs_form init = (fun f (nb, tk) -> Format.fprintf f "@[%%init:@ @[%a@]@ %a@]" (Kappa_printer.alg_expr ~noCounters ~env) - (fst (Alg_expr.mult (Locality.dummy_annot n) nb)) + (fst (Alg_expr.mult (Loc.annot_with_dummy n) nb)) (Model.print_token ~env) tk) f r.Primitives.delta_tokens)) init @@ -448,8 +448,7 @@ let export_plot ~is_tsv plot = let print_warning ?pos f msg = let pr f () = Format.fprintf f "Warning: @[%t@]" msg in match pos with - | Some pos -> - Format.fprintf f "@[%a@]@." (Locality.print_annot pr) ((), pos) + | Some pos -> Format.fprintf f "@[%a@]@." (Loc.print_annoted pr) ((), pos) | None -> Format.fprintf f "@[%a@]@." pr () type file_line = { file_line_name: string option; file_line_text: string } @@ -463,4 +462,4 @@ type t = | Snapshot of string * snapshot | Log of string | Species of string * float * User_graph.connected_component - | Warning of Locality.t option * (Format.formatter -> unit) + | Warning of Loc.t option * (Format.formatter -> unit) diff --git a/core/simulation/data.mli b/core/simulation/data.mli index 7f0b48d8dc..971ccc8f01 100644 --- a/core/simulation/data.mli +++ b/core/simulation/data.mli @@ -32,7 +32,7 @@ type t = | Snapshot of string * snapshot | Log of string | Species of string * float * User_graph.connected_component - | Warning of Locality.t option * (Format.formatter -> unit) + | Warning of Loc.t option * (Format.formatter -> unit) val print_snapshot : ?uuid:int -> Format.formatter -> snapshot -> unit val print_dot_snapshot : ?uuid:int -> Format.formatter -> snapshot -> unit @@ -113,4 +113,4 @@ val print_initial_inputs : unit val print_warning : - ?pos:Locality.t -> Format.formatter -> (Format.formatter -> unit) -> unit + ?pos:Loc.t -> Format.formatter -> (Format.formatter -> unit) -> unit diff --git a/core/simulation/dune b/core/simulation/dune index f4f9545372..3be459f1d9 100644 --- a/core/simulation/dune +++ b/core/simulation/dune @@ -2,12 +2,21 @@ (name kappa_runtime) (libraries kappa_terms) (public_name kappa-library.runtime) - (flags (:standard -w @a - -open Kappa_generic_toolset - -open Kappa_mixtures - -open Kappa_terms))) + (flags + (:standard + -w + @a + -open + Kappa_generic_toolset + -open + Kappa_mixtures + -open + Kappa_terms))) (rule (targets resource_strings.ml) (deps ../../dev/generate-string.sh ../../shared/flux.js ../../viz/common.js) - (action (with-stdout-to %{targets} (run ocaml %{deps})))) + (action + (with-stdout-to + %{targets} + (run ocaml %{deps})))) diff --git a/core/simulation/expr_interpreter.ml b/core/simulation/expr_interpreter.ml index cec17b2927..3e148110d2 100644 --- a/core/simulation/expr_interpreter.ml +++ b/core/simulation/expr_interpreter.ml @@ -79,7 +79,7 @@ let rec exec_alg : | Alg_expr.DIFF_TOKEN _ | Alg_expr.DIFF_KAPPA_INSTANCE _ -> raise (ExceptionDefn.Internal_Error - ("Cannot evalutate derivatives in expression", Locality.dummy)) + ("Cannot evalutate derivatives in expression", Loc.dummy)) and exec_bool : type a. diff --git a/core/simulation/generic_rule_interpreter.ml b/core/simulation/generic_rule_interpreter.ml index 40ab5dce58..a7204a1fd2 100644 --- a/core/simulation/generic_rule_interpreter.ml +++ b/core/simulation/generic_rule_interpreter.ml @@ -170,30 +170,30 @@ module Make (Instances : Instances_sig.S) = struct let () = initial_activity ~outputs env counter cand in cand - let concrete_actions_for_incomplete_inj ~debugMode rule matching = + let concrete_actions_for_incomplete_inj ~debug_mode rule matching = let abstract_actions = rule.Primitives.instantiations.Instantiation.actions in let inj = matching, Mods.IntMap.empty in List_util.map_option - (Instantiation.try_concretize_action ~debugMode inj) + (Instantiation.try_concretize_action ~debug_mode inj) abstract_actions - let concrete_tests ~debugMode rule matching = + let concrete_tests ~debug_mode rule matching = let abstract_tests = rule.Primitives.instantiations.Instantiation.tests |> List.concat in let inj = matching, Mods.IntMap.empty in - List.map (Instantiation.concretize_test ~debugMode inj) abstract_tests + List.map (Instantiation.concretize_test ~debug_mode inj) abstract_tests - let is_blocked ~debugMode state ?rule_id rule matching = + let is_blocked ~debug_mode state ?rule_id rule matching = match state.events_to_block with | None -> false | Some to_block -> let actions = - concrete_actions_for_incomplete_inj ~debugMode rule matching + concrete_actions_for_incomplete_inj ~debug_mode rule matching in - let tests = concrete_tests ~debugMode rule matching in + let tests = concrete_tests ~debug_mode rule matching in to_block rule_id matching tests actions let set_events_to_block predicate state = @@ -204,23 +204,23 @@ module Make (Instances : Instances_sig.S) = struct unary_candidates = Mods.IntMap.empty; } - let instance_to_matching ~debugMode domain edges instance patterns = + let instance_to_matching ~debug_mode domain edges instance patterns = Tools.array_fold_lefti (fun i matching root -> match matching with | None -> None | Some matching -> - Matching.reconstruct ~debugMode domain edges matching i patterns.(i) + Matching.reconstruct ~debug_mode domain edges matching i patterns.(i) root) (Some Matching.empty) instance - let all_injections ~debugMode ?excp ?unary_rate ?rule_id state_insts domain + let all_injections ~debug_mode ?excp ?unary_rate ?rule_id state_insts domain edges patterna = let out = Instances.fold_instances ?excp ?rule_id state_insts patterna ~init:[] (fun instance acc -> match - instance_to_matching ~debugMode domain edges instance patterna + instance_to_matching ~debug_mode domain edges instance patterna with | None -> acc | Some matching -> @@ -245,7 +245,7 @@ module Make (Instances : Instances_sig.S) = struct let pop_exact_matchings matchings_of_rule rule = snd (Mods.IntMap.pop rule matchings_of_rule) - let pick_a_rule_instance ~debugMode state random_state domain edges ?rule_id + let pick_a_rule_instance ~debug_mode state random_state domain edges ?rule_id rule = let from_patterns () = let pats = rule.Primitives.connected_components in @@ -253,7 +253,7 @@ module Make (Instances : Instances_sig.S) = struct pats ~init:(Matching.empty, [], None) (fun id pattern root (inj, rev_roots, _) -> match - Matching.reconstruct ~debugMode domain edges inj id pattern root + Matching.reconstruct ~debug_mode domain edges inj id pattern root with | None -> None | Some inj' -> Some (inj', root :: rev_roots, None)) @@ -268,10 +268,10 @@ module Make (Instances : Instances_sig.S) = struct Some (a, b, None) | None -> from_patterns ()) - let adjust_rule_instances ~debugMode ~rule_id ?unary_rate state domain edges + let adjust_rule_instances ~debug_mode ~rule_id ?unary_rate state domain edges ccs rule = let matches = - all_injections ~debugMode ?unary_rate ~rule_id state.imp.instances domain + all_injections ~debug_mode ?unary_rate ~rule_id state.imp.instances domain edges ccs in let matches = @@ -280,7 +280,7 @@ module Make (Instances : Instances_sig.S) = struct else matches |> List.filter (fun (matching, _) -> - not (is_blocked ~debugMode state ~rule_id rule matching)) + not (is_blocked ~debug_mode state ~rule_id rule matching)) in ( List.length matches, { @@ -327,7 +327,7 @@ module Make (Instances : Instances_sig.S) = struct in va, (nb_rectangular_instances_by_cc', unary_candidates') - let pick_a_unary_rule_instance ~debugMode state random_state domain edges + let pick_a_unary_rule_instance ~debug_mode state random_state domain edges ~rule_id rule = match Mods.IntMap.find_option rule_id state.unary_candidates with | Some l -> @@ -348,25 +348,25 @@ module Make (Instances : Instances_sig.S) = struct let root1, root2 = pick_unary_instance_in_cc cc_id in let () = - if debugMode then Format.printf "@[On roots:@ %i@ %i@]@." root1 root2 + if debug_mode then Format.printf "@[On roots:@ %i@ %i@]@." root1 root2 in let pattern1 = rule.Primitives.connected_components.(0) in let pattern2 = rule.Primitives.connected_components.(1) in let inj1 = - Matching.reconstruct ~debugMode domain edges Matching.empty 0 pattern1 + Matching.reconstruct ~debug_mode domain edges Matching.empty 0 pattern1 root1 in (match inj1 with | None -> None | Some inj -> (match - Matching.reconstruct ~debugMode domain edges inj 1 pattern2 root2 + Matching.reconstruct ~debug_mode domain edges inj 1 pattern2 root2 with | None -> None | Some inj_out -> Some (inj_out, [ root2; root1 ], None))) - let adjust_unary_rule_instances ~debugMode ~rule_id ?max_distance state domain - graph pats rule = + let adjust_unary_rule_instances ~debug_mode ~rule_id ?max_distance state + domain graph pats rule = let pattern1 = pats.(0) in let pattern2 = pats.(1) in let cands, len = @@ -374,14 +374,15 @@ module Make (Instances : Instances_sig.S) = struct (pattern1, pattern2) ~init:([], 0) (fun (root1, root2) ((list, len) as out) -> let inj1 = - Matching.reconstruct ~debugMode domain graph Matching.empty 0 + Matching.reconstruct ~debug_mode domain graph Matching.empty 0 pattern1 root1 in match inj1 with | None -> out | Some inj -> (match - Matching.reconstruct ~debugMode domain graph inj 1 pattern2 root2 + Matching.reconstruct ~debug_mode domain graph inj 1 pattern2 + root2 with | None -> out | Some inj' -> @@ -394,7 +395,7 @@ module Make (Instances : Instances_sig.S) = struct with | None -> out | Some _ as p -> - if is_blocked ~debugMode state ~rule_id rule inj' then + if is_blocked ~debug_mode state ~rule_id rule inj' then out else (inj', [ root2; root1 ], p) :: list, succ len)))) @@ -412,7 +413,7 @@ module Make (Instances : Instances_sig.S) = struct Format.fprintf f "@[%a@,%a@]" (Pp.list Pp.space (fun f (i, mix) -> Format.fprintf f "%%init: %i @[%a@]" i User_graph.print_cc mix)) - (Edges.build_user_snapshot ~debugMode:false ~raw:false sigs state.edges) + (Edges.build_user_snapshot ~debug_mode:false ~raw:false sigs state.edges) (Pp.array Pp.space (fun i f el -> Format.fprintf f "%%init: %a %a" Nbr.print el (Model.print_token ~env) i)) @@ -468,12 +469,12 @@ module Make (Instances : Instances_sig.S) = struct | Primitives.Transformation.PositiveInternalized _ -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "PositiveInternalized in negative update")) + (Loc.annot_with_dummy "PositiveInternalized in negative update")) | Primitives.Transformation.NegativeInternalized ((id, _), s) -> let _, edges' = Edges.remove_internal id s edges in side_effects, edges' - let apply_positive_transformation ~debugMode sigs ?mod_connectivity_store + let apply_positive_transformation ~debug_mode sigs ?mod_connectivity_store instances (inj2graph, side_effects, edges) = function | Primitives.Transformation.Agent n -> let nc, inj2graph', edges' = @@ -484,7 +485,7 @@ module Make (Instances : Instances_sig.S) = struct (inj2graph', side_effects, edges'), Primitives.Transformation.Agent nc | Primitives.Transformation.Freed (n, s) -> (*(n,s)-bottom*) - let ((id, _) as nc) = Matching.Agent.concretize ~debugMode inj2graph n in + let ((id, _) as nc) = Matching.Agent.concretize ~debug_mode inj2graph n in (*(A,23)*) let edges' = Edges.add_free id s edges in let side_effects' = @@ -492,8 +493,8 @@ module Make (Instances : Instances_sig.S) = struct in (inj2graph, side_effects', edges'), Primitives.Transformation.Freed (nc, s) | Primitives.Transformation.Linked ((n, s), (n', s')) -> - let nc = Matching.Agent.concretize ~debugMode inj2graph n in - let nc' = Matching.Agent.concretize ~debugMode inj2graph n' in + let nc = Matching.Agent.concretize ~debug_mode inj2graph n in + let nc' = Matching.Agent.concretize ~debug_mode inj2graph n' in let edges', modif_cc = Edges.add_link nc s nc' s' edges in let side_effects' = List_util.smart_filter @@ -506,16 +507,16 @@ module Make (Instances : Instances_sig.S) = struct | Primitives.Transformation.NegativeWhatEver _ -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "NegativeWhatEver in positive update")) + (Loc.annot_with_dummy "NegativeWhatEver in positive update")) | Primitives.Transformation.PositiveInternalized (n, s, i) -> - let ((id, _) as nc) = Matching.Agent.concretize ~debugMode inj2graph n in + let ((id, _) as nc) = Matching.Agent.concretize ~debug_mode inj2graph n in let edges' = Edges.add_internal id s i edges in ( (inj2graph, side_effects, edges'), Primitives.Transformation.PositiveInternalized (nc, s, i) ) | Primitives.Transformation.NegativeInternalized _ -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "NegativeInternalized in positive update")) + (Loc.annot_with_dummy "NegativeInternalized in positive update")) let apply_concrete_positive_transformation sigs ?mod_connectivity_store instances edges = function @@ -533,37 +534,37 @@ module Make (Instances : Instances_sig.S) = struct | Primitives.Transformation.NegativeWhatEver _ -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "NegativeWhatEver in positive update")) + (Loc.annot_with_dummy "NegativeWhatEver in positive update")) | Primitives.Transformation.PositiveInternalized ((id, _), s, i) -> let edges' = Edges.add_internal id s i edges in edges' | Primitives.Transformation.NegativeInternalized _ -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "NegativeInternalized in positive update")) + (Loc.annot_with_dummy "NegativeInternalized in positive update")) - let obs_from_transformation ~debugMode domain edges acc = function + let obs_from_transformation ~debug_mode domain edges acc = function | Primitives.Transformation.Agent nc -> Matching.observables_from_agent domain edges acc nc | Primitives.Transformation.Freed (nc, s) -> (*(n,s)-bottom*) - Matching.observables_from_free ~debugMode domain edges acc nc s + Matching.observables_from_free ~debug_mode domain edges acc nc s | Primitives.Transformation.Linked ((nc, s), (nc', s')) -> - Matching.observables_from_link ~debugMode domain edges acc nc s nc' s' + Matching.observables_from_link ~debug_mode domain edges acc nc s nc' s' | Primitives.Transformation.PositiveInternalized (nc, s, i) -> - Matching.observables_from_internal ~debugMode domain edges acc nc s i + Matching.observables_from_internal ~debug_mode domain edges acc nc s i | Primitives.Transformation.NegativeInternalized (((id, _) as nc), s) -> let i = Edges.get_internal id s edges in - Matching.observables_from_internal ~debugMode domain edges acc nc s i + Matching.observables_from_internal ~debug_mode domain edges acc nc s i | Primitives.Transformation.NegativeWhatEver (((id, _) as nc), s) -> (match Edges.link_destination id s edges with - | None -> Matching.observables_from_free ~debugMode domain edges acc nc s + | None -> Matching.observables_from_free ~debug_mode domain edges acc nc s | Some (nc', s') -> - Matching.observables_from_link ~debugMode domain edges acc nc s nc' s') + Matching.observables_from_link ~debug_mode domain edges acc nc s nc' s') - let obs_from_transformations ~debugMode domain edges trans = + let obs_from_transformations ~debug_mode domain edges trans = List.fold_left - (obs_from_transformation ~debugMode domain edges) + (obs_from_transformation ~debug_mode domain edges) (([], Operator.DepSet.empty), Matching.empty_cache) trans |> fst @@ -622,12 +623,12 @@ module Make (Instances : Instances_sig.S) = struct | Trace.PERT p, x -> Trace.Pert (p, x, Counter.current_simulation_info counter) - let store_event ~debugMode counter inj2graph new_tracked_obs_instances + let store_event ~debug_mode counter inj2graph new_tracked_obs_instances event_kind ?path extra_side_effects rule outputs = function | None -> () | Some _ -> let cevent = - Instantiation.concretize_event ~debugMode inj2graph + Instantiation.concretize_event ~debug_mode inj2graph rule.Primitives.instantiations in let full_concrete_event = @@ -656,7 +657,7 @@ module Make (Instances : Instances_sig.S) = struct (Data.TraceStep (Trace.Obs (i, x, Counter.next_story counter)))) new_tracked_obs_instances - let get_species_obs ~debugMode sigs edges obs acc tracked = + let get_species_obs ~debug_mode sigs edges obs acc tracked = List.fold_left (fun acc (pattern, (root, _)) -> try @@ -668,7 +669,7 @@ module Make (Instances : Instances_sig.S) = struct Pattern.compare_canonicals pid pattern = 0 || ok) false patterns then ( - let spec = Edges.species ~debugMode sigs root edges in + let spec = Edges.species ~debug_mode sigs root edges in (fn, patterns, spec) :: acc ) else acc) @@ -677,7 +678,7 @@ module Make (Instances : Instances_sig.S) = struct with Not_found -> acc) acc obs - let store_obs ~debugMode domain edges instances obs acc = function + let store_obs ~debug_mode domain edges instances obs acc = function | None -> acc | Some tracked -> List.fold_left @@ -690,20 +691,20 @@ module Make (Instances : Instances_sig.S) = struct let tests' = List.map (List.map - (Instantiation.concretize_test ~debugMode + (Instantiation.concretize_test ~debug_mode (inj, Mods.IntMap.empty))) tests in (ev, tests') :: acc) acc - (all_injections ~debugMode instances ~excp:(pattern, root) + (all_injections ~debug_mode instances ~excp:(pattern, root) domain edges patterns)) acc (Pattern.ObsMap.get tracked pattern) with Not_found -> acc) acc obs - let update_edges ~debugMode outputs counter domain inj_nodes state event_kind + let update_edges ~debug_mode outputs counter domain inj_nodes state event_kind ?path rule sigs = let () = assert (not state.outdated) in let () = state.outdated <- true in @@ -711,13 +712,13 @@ module Make (Instances : Instances_sig.S) = struct (*Negative update*) let concrete_removed = List.map - (Primitives.Transformation.concretize ~debugMode + (Primitives.Transformation.concretize ~debug_mode (inj_nodes, Mods.IntMap.empty)) rule.Primitives.removed in let (del_obs, del_deps), _ = List.fold_left - (obs_from_transformation ~debugMode domain state.edges) + (obs_from_transformation ~debug_mode domain state.edges) (([], Operator.DepSet.empty), Matching.empty_cache) concrete_removed in @@ -740,7 +741,7 @@ module Make (Instances : Instances_sig.S) = struct List.fold_left (fun (x, p) h -> let x', h' = - apply_positive_transformation ~debugMode + apply_positive_transformation ~debug_mode (Pattern.Env.signatures domain) ~mod_connectivity_store state.imp.instances x h in @@ -757,7 +758,7 @@ module Make (Instances : Instances_sig.S) = struct in let (new_obs, new_deps), _ = List.fold_left - (obs_from_transformation ~debugMode domain edges'') + (obs_from_transformation ~debug_mode domain edges'') (([], Operator.DepSet.empty), Matching.empty_cache) concrete_inserted' in @@ -771,17 +772,17 @@ module Make (Instances : Instances_sig.S) = struct in (*Store event*) let new_tracked_obs_instances = - store_obs ~debugMode domain edges'' state.imp.instances new_obs [] + store_obs ~debug_mode domain edges'' state.imp.instances new_obs [] state.imp.story_machinery in let () = - store_event ~debugMode counter final_inj2graph new_tracked_obs_instances + store_event ~debug_mode counter final_inj2graph new_tracked_obs_instances event_kind ?path remaining_side_effects rule outputs state.imp.story_machinery in (*Print species*) let species = - get_species_obs ~debugMode sigs edges'' new_obs [] state.imp.species + get_species_obs ~debug_mode sigs edges'' new_obs [] state.imp.species in let () = List.iter @@ -804,7 +805,7 @@ module Make (Instances : Instances_sig.S) = struct events_to_block = state.events_to_block; } - let update_edges_from_actions ~debugMode ~outputs sigs counter domain state + let update_edges_from_actions ~debug_mode ~outputs sigs counter domain state (actions, side_effect_dst) = let () = assert (not state.outdated) in let () = state.outdated <- true in @@ -817,7 +818,7 @@ module Make (Instances : Instances_sig.S) = struct in let (del_obs, del_deps), _ = List.fold_left - (obs_from_transformation ~debugMode domain state.edges) + (obs_from_transformation ~debug_mode domain state.edges) (([], Operator.DepSet.empty), Matching.empty_cache) concrete_removed in @@ -850,7 +851,7 @@ module Make (Instances : Instances_sig.S) = struct in let (new_obs, new_deps), _ = List.fold_left - (obs_from_transformation ~debugMode domain edges') + (obs_from_transformation ~debug_mode domain edges') (([], Operator.DepSet.empty), Matching.empty_cache) concrete_inserted in @@ -864,7 +865,7 @@ module Make (Instances : Instances_sig.S) = struct in (*Print species*) let species = - get_species_obs ~debugMode sigs edges' new_obs [] state.imp.species + get_species_obs ~debug_mode sigs edges' new_obs [] state.imp.species in let () = List.iter @@ -891,10 +892,10 @@ module Make (Instances : Instances_sig.S) = struct (* cc_va is the number of embeddings. It only has to be multiplied by the rate constant of the rule *) - let store_activity ~debugMode store env counter state id syntax_id rate cc_va + let store_activity ~debug_mode store env counter state id syntax_id rate cc_va = let () = - if debugMode then + if debug_mode then Format.printf "@[%sule %a has now %i instances.@]@." (if id mod 2 = 1 then "Unary r" @@ -924,7 +925,7 @@ module Make (Instances : Instances_sig.S) = struct "Unary " else "") - (Model.print_rule ~noCounters:debugMode ~env) + (Model.print_rule ~noCounters:debug_mode ~env) id act, Model.get_ast_rule_rate_pos ~unary env syntax_id )) ) @@ -933,7 +934,7 @@ module Make (Instances : Instances_sig.S) = struct let () = set_activity id act state in store syntax_id old_act act - let update_outdated_activities ~debugMode store env counter state known_perts + let update_outdated_activities ~debug_mode store env counter state known_perts = let () = assert (not state.outdated) in let unary_rule_update modified_cc instances i pack rule = @@ -944,7 +945,7 @@ module Make (Instances : Instances_sig.S) = struct compute_unary_number instances pack modified_cc rule i in let () = - store_activity ~debugMode store env counter state + store_activity ~debug_mode store env counter state ((2 * i) + 1) rule.Primitives.syntactic_rule (fst unrate) (Int64.to_int va) in @@ -965,7 +966,7 @@ module Make (Instances : Instances_sig.S) = struct rule.Primitives.connected_components in let () = - store_activity ~debugMode store env counter state (2 * i) + store_activity ~debug_mode store env counter state (2 * i) rule.Primitives.syntactic_rule (fst rule.Primitives.rate) pattern_va in @@ -1033,22 +1034,22 @@ module Make (Instances : Instances_sig.S) = struct state.outdated_elements injected'; } - let transform_by_a_rule ~debugMode outputs env counter state event_kind ?path + let transform_by_a_rule ~debug_mode outputs env counter state event_kind ?path rule ?rule_id inj = - if is_blocked ~debugMode state ?rule_id rule inj then + if is_blocked ~debug_mode state ?rule_id rule inj then Blocked else ( let state = update_tokens env counter state rule.Primitives.delta_tokens in let state = - update_edges ~debugMode outputs counter (Model.domain env) inj state + update_edges ~debug_mode outputs counter (Model.domain env) inj state event_kind ?path rule (Model.signatures env) in Success state ) - let apply_given_unary_instance ~debugMode ~outputs ~rule_id env counter state + let apply_given_unary_instance ~debug_mode ~outputs ~rule_id env counter state event_kind rule = function | None -> Clash | Some (inj, _rev_roots, path) -> @@ -1062,7 +1063,7 @@ module Make (Instances : Instances_sig.S) = struct in (match path with | Some _ -> - transform_by_a_rule ~debugMode outputs env counter state' event_kind + transform_by_a_rule ~debug_mode outputs env counter state' event_kind ~path rule ~rule_id inj | None -> let max_distance = @@ -1085,8 +1086,8 @@ module Make (Instances : Instances_sig.S) = struct (fst (List.hd nodes.(1))) state.edges then - transform_by_a_rule ~debugMode outputs env counter state' event_kind - ~path:None rule ~rule_id inj + transform_by_a_rule ~debug_mode outputs env counter state' + event_kind ~path:None rule ~rule_id inj else Corrected else ( @@ -1095,17 +1096,17 @@ module Make (Instances : Instances_sig.S) = struct with | None -> Corrected | Some _ as path -> - transform_by_a_rule ~debugMode outputs env counter state' event_kind - ~path rule ~rule_id inj + transform_by_a_rule ~debug_mode outputs env counter state' + event_kind ~path rule ~rule_id inj )) - let apply_given_instance ~debugMode ~outputs ?rule_id env counter state + let apply_given_instance ~debug_mode ~outputs ?rule_id env counter state event_kind rule = function | None -> Clash | Some (inj, rev_roots, _path) -> let () = assert (not state.outdated) in let () = - if debugMode then ( + if debug_mode then ( let roots = Tools.array_rev_of_list rev_roots in Format.printf "@[On roots:@ @[%a@]@]@." (Pp.array Pp.space (fun _ -> Format.pp_print_int)) @@ -1114,8 +1115,8 @@ module Make (Instances : Instances_sig.S) = struct in (match rule.Primitives.unary_rate with | None -> - transform_by_a_rule ~debugMode outputs env counter state event_kind rule - ?rule_id inj + transform_by_a_rule ~debug_mode outputs env counter state event_kind + rule ?rule_id inj | Some (_, max_distance) -> (match max_distance with | None -> @@ -1124,7 +1125,7 @@ module Make (Instances : Instances_sig.S) = struct if Edges.in_same_connected_component root0 root1 state.edges then Corrected else - transform_by_a_rule ~debugMode outputs env counter state + transform_by_a_rule ~debug_mode outputs env counter state event_kind rule ?rule_id inj | _ -> failwith "apply_given_rule unary rule without 2 patterns") | Some dist -> @@ -1139,25 +1140,25 @@ module Make (Instances : Instances_sig.S) = struct nodes.(1) with | None -> - transform_by_a_rule ~debugMode outputs env counter state event_kind + transform_by_a_rule ~debug_mode outputs env counter state event_kind rule ?rule_id inj | Some _ -> Corrected))) - let apply_given_rule ~debugMode ~outputs ?rule_id env counter state event_kind - rule = + let apply_given_rule ~debug_mode ~outputs ?rule_id env counter state + event_kind rule = let domain = Model.domain env in let inst = - pick_a_rule_instance ~debugMode state state.imp.random_state domain + pick_a_rule_instance ~debug_mode state state.imp.random_state domain state.edges ?rule_id rule in - apply_given_instance ~debugMode ~outputs ?rule_id env counter state + apply_given_instance ~debug_mode ~outputs ?rule_id env counter state event_kind rule inst - let force_rule ~debugMode ~outputs env counter state event_kind ?rule_id rule + let force_rule ~debug_mode ~outputs env counter state event_kind ?rule_id rule = match - apply_given_rule ~debugMode ~outputs ?rule_id env counter state event_kind - rule + apply_given_rule ~debug_mode ~outputs ?rule_id env counter state + event_kind rule with | Success out -> Some out | Corrected | Blocked | Clash -> @@ -1171,7 +1172,7 @@ module Make (Instances : Instances_sig.S) = struct | Some d -> Some (loc, Some (max_dist_to_int counter state d))) in (match - all_injections ~debugMode ?rule_id ?unary_rate state.imp.instances + all_injections ~debug_mode ?rule_id ?unary_rate state.imp.instances (Model.domain env) state.edges rule.Primitives.connected_components with | [] -> @@ -1189,7 +1190,7 @@ module Make (Instances : Instances_sig.S) = struct | l -> let h, _ = List_util.random state.imp.random_state l in let out = - transform_by_a_rule ~debugMode outputs env counter state event_kind + transform_by_a_rule ~debug_mode outputs env counter state event_kind rule ?rule_id h in (match out with @@ -1197,7 +1198,7 @@ module Make (Instances : Instances_sig.S) = struct | Blocked -> None | Clash | Corrected -> assert false)) - let adjust_rule_instances ~debugMode ~rule_id env counter state rule = + let adjust_rule_instances ~debug_mode ~rule_id env counter state rule = let () = assert (not state.outdated) in let domain = Model.domain env in let unary_rate = @@ -1209,11 +1210,11 @@ module Make (Instances : Instances_sig.S) = struct | Some d -> Some (loc, Some (max_dist_to_int counter state d))) in let act, state = - adjust_rule_instances ~debugMode ~rule_id ?unary_rate state domain + adjust_rule_instances ~debug_mode ~rule_id ?unary_rate state domain state.edges rule.Primitives.connected_components rule in let () = - store_activity ~debugMode + store_activity ~debug_mode (fun _ _ _ -> ()) env counter state (2 * rule_id) rule.Primitives.syntactic_rule (fst rule.Primitives.rate) act @@ -1221,7 +1222,7 @@ module Make (Instances : Instances_sig.S) = struct state (* Redefines `adjust_unary_rule_instances` *) - let adjust_unary_rule_instances ~debugMode ~rule_id env counter state rule = + let adjust_unary_rule_instances ~debug_mode ~rule_id env counter state rule = let () = assert (not state.outdated) in let domain = Model.domain env in let max_distance = @@ -1231,14 +1232,14 @@ module Make (Instances : Instances_sig.S) = struct rule.Primitives.unary_rate in let act, state = - adjust_unary_rule_instances ~debugMode ~rule_id ?max_distance state domain - state.edges rule.Primitives.connected_components rule + adjust_unary_rule_instances ~debug_mode ~rule_id ?max_distance state + domain state.edges rule.Primitives.connected_components rule in let () = match rule.Primitives.unary_rate with | None -> assert false | Some (unrate, _) -> - store_activity ~debugMode + store_activity ~debug_mode (fun _ _ _ -> ()) env counter state ((2 * rule_id) + 1) @@ -1246,20 +1247,20 @@ module Make (Instances : Instances_sig.S) = struct in state - let incorporate_extra_pattern ~debugMode domain state pattern = + let incorporate_extra_pattern ~debug_mode domain state pattern = let () = assert (not state.outdated) in let () = Instances.incorporate_extra_pattern state.imp.instances pattern - (Matching.roots_of ~debugMode domain state.edges pattern) + (Matching.roots_of ~debug_mode domain state.edges pattern) in { state with outdated = false } - let snapshot ~debugMode ~raw env counter state = + let snapshot ~debug_mode ~raw env counter state = { Data.snapshot_event = Counter.current_event counter; Data.snapshot_time = Counter.current_time counter; Data.snapshot_agents = - Edges.build_user_snapshot ~debugMode ~raw (Model.signatures env) + Edges.build_user_snapshot ~debug_mode ~raw (Model.signatures env) state.edges; Data.snapshot_tokens = Array.mapi @@ -1267,7 +1268,7 @@ module Make (Instances : Instances_sig.S) = struct state.imp.tokens; } - let pick_an_instance ~debugMode env state = + let pick_an_instance ~debug_mode env state = let choice = pick_rule state.imp.random_state state in let rule_id = choice / 2 in let rule = Model.get_rule env rule_id in @@ -1275,10 +1276,10 @@ module Make (Instances : Instances_sig.S) = struct ( choice mod 2 = 1, rule_id, if choice mod 2 = 1 then - pick_a_unary_rule_instance ~debugMode state state.imp.random_state + pick_a_unary_rule_instance ~debug_mode state state.imp.random_state domain state.edges ~rule_id rule else - pick_a_rule_instance ~debugMode state state.imp.random_state domain + pick_a_rule_instance ~debug_mode state state.imp.random_state domain state.edges ~rule_id rule ) let is_correct_instance env graph (is_unary, rule_id, instance) = @@ -1300,12 +1301,12 @@ module Make (Instances : Instances_sig.S) = struct | [ x; y ] -> Edges.in_same_connected_component x y graph.edges | _ -> assert false)) - let apply_instance ~debugMode ~outputs ?maxConsecutiveBlocked + let apply_instance ~debug_mode ~outputs ?maxConsecutiveBlocked ~maxConsecutiveClash env counter graph (is_unary, rule_id, instance) = let cause = Trace.RULE rule_id in let rule = Model.get_rule env rule_id in let () = - if debugMode then + if debug_mode then Format.printf "@[@[Applied@ %t%i:@]@ @[%a@]@]@." (fun f -> if is_unary then Format.fprintf f "unary@ ") rule_id @@ -1315,9 +1316,9 @@ module Make (Instances : Instances_sig.S) = struct in let apply_given = if is_unary then - apply_given_unary_instance ~debugMode ~outputs ~rule_id + apply_given_unary_instance ~debug_mode ~outputs ~rule_id else - apply_given_instance ~debugMode ~outputs ~rule_id + apply_given_instance ~debug_mode ~outputs ~rule_id in match apply_given env counter graph cause rule instance with | Success graph' -> @@ -1346,10 +1347,10 @@ module Make (Instances : Instances_sig.S) = struct ( None, not continue, if is_unary then - adjust_unary_rule_instances ~debugMode ~rule_id env counter graph + adjust_unary_rule_instances ~debug_mode ~rule_id env counter graph rule else - adjust_rule_instances ~debugMode ~rule_id env counter graph rule ) + adjust_rule_instances ~debug_mode ~rule_id env counter graph rule ) let aux_add_tracked patterns name tests state tpattern = let () = state.outdated <- true in diff --git a/core/simulation/generic_rule_interpreter.mli b/core/simulation/generic_rule_interpreter.mli index 4cc7a4ffc1..cb613b2c33 100644 --- a/core/simulation/generic_rule_interpreter.mli +++ b/core/simulation/generic_rule_interpreter.mli @@ -48,7 +48,7 @@ module Make (Instances : Instances_sig.S) : sig (** {2 Core} *) val apply_given_rule : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> ?rule_id:int -> Model.t -> @@ -60,11 +60,11 @@ module Make (Instances : Instances_sig.S) : sig (** Returns the graph obtained by applying the rule. [rule_id] is mandatory if the rule has an unary rate.*) - val pick_an_instance : debugMode:bool -> Kappa_terms.Model.t -> t -> instance + val pick_an_instance : debug_mode:bool -> Kappa_terms.Model.t -> t -> instance val is_correct_instance : Model.t -> t -> instance -> bool val apply_instance : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> ?maxConsecutiveBlocked:int -> maxConsecutiveClash:int -> @@ -80,7 +80,7 @@ module Make (Instances : Instances_sig.S) : sig a null event occured *) val force_rule : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> Model.t -> Counter.t -> @@ -94,12 +94,12 @@ module Make (Instances : Instances_sig.S) : sig side to do apply the rule and returns the remaining exact injections. *) val incorporate_extra_pattern : - debugMode:bool -> Pattern.Env.t -> t -> Pattern.id -> t + debug_mode:bool -> Pattern.Env.t -> t -> Pattern.id -> t val overwrite_var : int -> Counter.t -> t -> Primitives.alg_expr -> t val update_outdated_activities : - debugMode:bool -> + debug_mode:bool -> (int -> float -> float -> unit) -> Model.t -> Counter.t -> @@ -118,13 +118,13 @@ module Make (Instances : Instances_sig.S) : sig takes the list of perturbations to be tried and returns it updated *) val snapshot : - debugMode:bool -> raw:bool -> Model.t -> Counter.t -> t -> Data.snapshot + debug_mode:bool -> raw:bool -> Model.t -> Counter.t -> t -> Data.snapshot val print : Model.t -> Format.formatter -> t -> unit val get_random_state : t -> Random.State.t val update_edges_from_actions : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> Signature.s -> Counter.t -> @@ -187,7 +187,7 @@ module Make (Instances : Instances_sig.S) : sig (** {2 Internals } *) val apply_positive_transformation : - debugMode:bool -> + debug_mode:bool -> Signature.s -> ?mod_connectivity_store:Roots.mod_ccs_cache -> Instances.t -> @@ -209,7 +209,7 @@ module Make (Instances : Instances_sig.S) : sig Edges.t val obs_from_transformations : - debugMode:bool -> + debug_mode:bool -> Pattern.Env.t -> Edges.t -> Instantiation.concrete Primitives.Transformation.t list -> diff --git a/core/simulation/replay.ml b/core/simulation/replay.ml index 8e5c193e0c..2b668a667a 100644 --- a/core/simulation/replay.ml +++ b/core/simulation/replay.ml @@ -91,11 +91,11 @@ let cc_of_agent ag e work = let _, w, m, t = add_agent ag e (work, [], []) in working_todo (w, m, t) -let cc_of_state ~debugMode s env = +let cc_of_state ~debug_mode s env = let cc_of_root agent e' = let work = Pattern.begin_new e' in let morphism, work' = cc_of_agent agent s.graph work in - let en, _, c, i = Pattern.finish_new ~debugMode work' in + let en, _, c, i = Pattern.finish_new ~debug_mode work' in en, List.map (fun (cid, (aid, _)) -> cid, aid) morphism, c, i in match s.connected_components with diff --git a/core/simulation/replay.mli b/core/simulation/replay.mli index 062ec3bf3d..16e4121978 100644 --- a/core/simulation/replay.mli +++ b/core/simulation/replay.mli @@ -36,7 +36,7 @@ val tests_pass_on : (** exported for convenience. *) val cc_of_state : - debugMode:bool -> + debug_mode:bool -> state -> Pattern.PreEnv.t -> Pattern.PreEnv.t * ((int * int) list * Pattern.cc * Pattern.id) list diff --git a/core/simulation/rule_interpreter.mli b/core/simulation/rule_interpreter.mli index f8e56b52f9..2b052d1f59 100644 --- a/core/simulation/rule_interpreter.mli +++ b/core/simulation/rule_interpreter.mli @@ -13,7 +13,7 @@ val empty : t val force_rule : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> Model.t -> Counter.t -> @@ -24,7 +24,7 @@ val force_rule : t option val update_outdated_activities : - debugMode:bool -> + debug_mode:bool -> (int -> float -> float -> unit) -> Model.t -> Counter.t -> @@ -35,7 +35,7 @@ val update_outdated_activities : val overwrite_var : int -> Counter.t -> t -> Primitives.alg_expr -> t val snapshot : - debugMode:bool -> raw:bool -> Model.t -> Counter.t -> t -> Data.snapshot + debug_mode:bool -> raw:bool -> Model.t -> Counter.t -> t -> Data.snapshot val add_tracked : outputs:(Data.t -> unit) -> @@ -60,7 +60,7 @@ val value_bool : Counter.t -> t -> (Pattern.id array list, int) Alg_expr.bool -> bool val apply_given_rule : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> ?rule_id:int -> Model.t -> @@ -71,12 +71,12 @@ val apply_given_rule : result val incorporate_extra_pattern : - debugMode:bool -> Pattern.Env.t -> t -> Pattern.id -> t + debug_mode:bool -> Pattern.Env.t -> t -> Pattern.id -> t val activity : t -> float val apply_instance : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> ?maxConsecutiveBlocked:int -> maxConsecutiveClash:int -> @@ -95,12 +95,12 @@ val apply_concrete_positive_transformation : Edges.t val print : Model.t -> Format.formatter -> t -> unit -val pick_an_instance : debugMode:bool -> Kappa_terms.Model.t -> t -> instance +val pick_an_instance : debug_mode:bool -> Kappa_terms.Model.t -> t -> instance val is_correct_instance : Kappa_terms.Model.t -> t -> instance -> bool val get_random_state : t -> Random.State.t val obs_from_transformations : - debugMode:bool -> + debug_mode:bool -> Kappa_terms.Pattern.Env.t -> Kappa_mixtures.Edges.t -> Instantiation.concrete Primitives.Transformation.t list -> @@ -117,7 +117,7 @@ val apply_negative_transformation : Agent.t Instantiation.site list * Kappa_mixtures.Edges.t val apply_positive_transformation : - debugMode:bool -> + debug_mode:bool -> Kappa_mixtures.Signature.s -> ?mod_connectivity_store:Roots.mod_ccs_cache -> Instances.t -> diff --git a/core/simulation/state_interpreter.ml b/core/simulation/state_interpreter.ml index dde36350f4..027adbd53f 100644 --- a/core/simulation/state_interpreter.ml +++ b/core/simulation/state_interpreter.ml @@ -90,7 +90,7 @@ let empty ~with_delta_activities counter env = let observables_values env graph counter = Model.map_observables (Rule_interpreter.value_alg counter graph) env -let do_modification ~debugMode ~outputs env counter graph state extra +let do_modification ~debug_mode ~outputs env counter graph state extra modification = let print_expr_val = Kappa_printer.print_expr_val (Rule_interpreter.value_alg counter graph) @@ -99,19 +99,19 @@ let do_modification ~debugMode ~outputs env counter graph state extra | Primitives.ITER_RULE ((v, _), r) -> let text = Format.asprintf "@[%a@]" - (Kappa_printer.modification ~noCounters:debugMode ~env) + (Kappa_printer.modification ~noCounters:debug_mode ~env) modification in let graph' = Nbr.maybe_iteri (fun _ g -> - Rule_interpreter.force_rule ~debugMode ~outputs env counter g + Rule_interpreter.force_rule ~debug_mode ~outputs env counter g (Trace.PERT text) r) graph (Rule_interpreter.value_alg counter graph v) in let graph'', extra' = - Rule_interpreter.update_outdated_activities ~debugMode + Rule_interpreter.update_outdated_activities ~debug_mode (fun _ _ _ -> ()) env counter graph' extra in @@ -119,7 +119,7 @@ let do_modification ~debugMode ~outputs env counter graph state extra | Primitives.UPDATE (i, (expr, _)) -> let graph' = Rule_interpreter.overwrite_var i counter graph expr in let graph'', extra' = - Rule_interpreter.update_outdated_activities ~debugMode + Rule_interpreter.update_outdated_activities ~debug_mode (fun _ _ _ -> ()) env counter graph' extra in @@ -131,8 +131,8 @@ let do_modification ~debugMode ~outputs env counter graph state extra outputs (Data.Snapshot ( file, - Rule_interpreter.snapshot ~debugMode ~raw:false env counter graph - )) + Rule_interpreter.snapshot ~debug_mode ~raw:false env counter + graph )) ) in true, graph, state, extra @@ -162,7 +162,7 @@ let do_modification ~debugMode ~outputs env counter graph state extra let () = outputs (Data.Snapshot - (file, Rule_interpreter.snapshot ~debugMode ~raw env counter graph)) + (file, Rule_interpreter.snapshot ~debug_mode ~raw env counter graph)) in false, graph, state, extra | Primitives.CFLOW (name, cc, tests) -> @@ -173,7 +173,7 @@ let do_modification ~debugMode ~outputs env counter graph state extra let domain = Model.domain env in Format.asprintf "@[%a@]" (Pp.array Pp.comma (fun _ -> - Pattern.print ~noCounters:debugMode ~domain ~with_id:false)) + Pattern.print ~noCounters:debug_mode ~domain ~with_id:false)) cc in ( false, @@ -227,7 +227,7 @@ let do_modification ~debugMode ~outputs env counter graph state extra state, extra ) -let rec perturbate ~debugMode ~outputs ~is_alarm env counter graph state +let rec perturbate ~debug_mode ~outputs ~is_alarm env counter graph state mix_changed = function | [] -> false, graph, state, mix_changed | i :: tail -> @@ -251,7 +251,7 @@ let rec perturbate ~debugMode ~outputs ~is_alarm env counter graph state if stop then acc else - do_modification ~debugMode ~outputs env counter graph state extra + do_modification ~debug_mode ~outputs env counter graph state extra effect) (false, graph, state, tail) pert.Primitives.effect @@ -269,30 +269,30 @@ let rec perturbate ~debugMode ~outputs ~is_alarm env counter graph state if stop then stop, graph, state, mix_changed' else - perturbate ~debugMode ~outputs ~is_alarm:false env counter graph state + perturbate ~debug_mode ~outputs ~is_alarm:false env counter graph state mix_changed' tail' ) else - perturbate ~debugMode ~outputs ~is_alarm:false env counter graph state + perturbate ~debug_mode ~outputs ~is_alarm:false env counter graph state mix_changed tail -let do_modifications ~debugMode ~outputs env counter graph state list = +let do_modifications ~debug_mode ~outputs env counter graph state list = let stop, graph, state, extra = List.fold_left (fun ((stop, graph, state, extra) as acc) effect -> if stop then acc else - do_modification ~debugMode ~outputs env counter graph state extra + do_modification ~debug_mode ~outputs env counter graph state extra effect) (false, graph, state, []) list in if stop then stop, graph, state, false else - perturbate ~debugMode ~outputs ~is_alarm:false env counter graph state false - extra + perturbate ~debug_mode ~outputs ~is_alarm:false env counter graph state + false extra -let initialize ~bind ~return ~debugMode ~outputs env counter graph0 state0 +let initialize ~bind ~return ~debug_mode ~outputs env counter graph0 state0 init_l = let mgraph = List.fold_left @@ -318,7 +318,7 @@ let initialize ~bind ~return ~debugMode ~outputs env counter graph0 state0 Nbr.iteri (fun _ s -> match - Rule_interpreter.apply_given_rule ~debugMode ~outputs env + Rule_interpreter.apply_given_rule ~debug_mode ~outputs env counter s (Trace.INIT creations_sort) compiled_rule with | Rule_interpreter.Success s -> s @@ -326,7 +326,7 @@ let initialize ~bind ~return ~debugMode ~outputs env counter graph0 state0 | Rule_interpreter.Blocked -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "Bugged initial rule"))) + (Loc.annot_with_dummy "Bugged initial rule"))) state value, state0 ))) (return (false, graph0, state0)) @@ -334,7 +334,7 @@ let initialize ~bind ~return ~debugMode ~outputs env counter graph0 state0 in bind mgraph (fun (_, graph, state0) -> let mid_graph, _ = - Rule_interpreter.update_outdated_activities ~debugMode + Rule_interpreter.update_outdated_activities ~debug_mode (fun _ _ _ -> ()) env counter graph [] in @@ -344,7 +344,7 @@ let initialize ~bind ~return ~debugMode ~outputs env counter graph0 state0 if stop then acc else - perturbate ~debugMode ~outputs ~is_alarm:true env counter graph + perturbate ~debug_mode ~outputs ~is_alarm:true env counter graph state mix_changed [ i ]) (false, mid_graph, state0, false) state0.perturbations_alive @@ -356,7 +356,7 @@ let initialize ~bind ~return ~debugMode ~outputs env counter graph0 state0 in return (stop, graph, state)) -let one_rule ~debugMode ~outputs ~maxConsecutiveClash env counter graph state +let one_rule ~debug_mode ~outputs ~maxConsecutiveClash env counter graph state instance = let prev_activity = Rule_interpreter.activity graph in let act_stack = ref [] in @@ -404,8 +404,8 @@ let one_rule ~debugMode ~outputs ~maxConsecutiveClash env counter graph state (* let () = *) (* Format.eprintf "%a@." (Rule_interpreter.print_injections env) graph in *) let applied_rid_syntax, final_step, graph' = - Rule_interpreter.apply_instance ~debugMode ~outputs ~maxConsecutiveClash env - counter graph instance + Rule_interpreter.apply_instance ~debug_mode ~outputs ~maxConsecutiveClash + env counter graph instance in match applied_rid_syntax with | None -> final_step, graph', state @@ -455,12 +455,12 @@ let one_rule ~debugMode ~outputs ~maxConsecutiveClash env counter graph state let force_tested = state.force_test_perturbations in let () = state.force_test_perturbations <- [] in let graph'', extra_pert = - Rule_interpreter.update_outdated_activities ~debugMode + Rule_interpreter.update_outdated_activities ~debug_mode register_new_activity env counter graph' force_tested in let () = finalize_registration syntax_rid in let stop, graph''', state', _mix_changed = - perturbate ~debugMode ~outputs ~is_alarm:false env counter graph'' state + perturbate ~debug_mode ~outputs ~is_alarm:false env counter graph'' state false extra_pert in let () = @@ -469,14 +469,14 @@ let one_rule ~debugMode ~outputs ~maxConsecutiveClash env counter graph state state.perturbations_not_done_yet in let () = - if debugMode then + if debug_mode then Format.printf "@[Obtained@ %a@]@." (Rule_interpreter.print env) graph''' in final_step || stop, graph''', state' -let rec perturbate_until_first_backtrack ~debugMode env counter ~outputs +let rec perturbate_until_first_backtrack ~debug_mode env counter ~outputs (stop, graph, state, dt) = match state.stopping_times with | [] -> stop, graph, state, dt, false @@ -494,7 +494,7 @@ let rec perturbate_until_first_backtrack ~debugMode env counter ~outputs (*set time for perturbate *) if Counter.one_time_advance counter dti then ( let stop', graph', state', _ = - perturbate ~debugMode ~outputs ~is_alarm:true env counter graph + perturbate ~debug_mode ~outputs ~is_alarm:true env counter graph state false [ pe ] in let tail' = @@ -516,7 +516,7 @@ let rec perturbate_until_first_backtrack ~debugMode env counter ~outputs true, graph, state, dt' in - perturbate_until_first_backtrack ~debugMode env counter ~outputs + perturbate_until_first_backtrack ~debug_mode env counter ~outputs (stop', graph', state', dt') (* if some perturbation needs backtrack, return the perturbation *) ) else @@ -524,7 +524,7 @@ let rec perturbate_until_first_backtrack ~debugMode env counter ~outputs ) else stop, graph, state, dt, false -let perturbate_with_backtrack ~debugMode ~outputs env counter graph state = +let perturbate_with_backtrack ~debug_mode ~outputs env counter graph state = function | [] -> assert false | (ti, pe) :: tail -> @@ -545,7 +545,7 @@ let perturbate_with_backtrack ~debugMode ~outputs env counter graph state = Counter.fill ~outputs counter ~dt:0. in let stop, graph', state', _ = - perturbate ~debugMode ~outputs ~is_alarm:true env counter graph state + perturbate ~debug_mode ~outputs ~is_alarm:true env counter graph state false [ pe ] in let () = @@ -557,8 +557,8 @@ let perturbate_with_backtrack ~debugMode ~outputs env counter graph state = ) else true, graph, state -let regular_loop_body ~debugMode ~outputs ~maxConsecutiveClash env counter graph - state dt = +let regular_loop_body ~debug_mode ~outputs ~maxConsecutiveClash env counter + graph state dt = let () = let outputs counter' time = let cand = @@ -570,11 +570,11 @@ let regular_loop_body ~debugMode ~outputs ~maxConsecutiveClash env counter graph in let continue = Counter.one_time_advance counter dt in let picked_instance = - Rule_interpreter.pick_an_instance ~debugMode env graph + Rule_interpreter.pick_an_instance ~debug_mode env graph in let stop, graph', state', mix_changed = - perturbate ~debugMode ~outputs ~is_alarm:false env counter graph state false - state.time_dependent_perts + perturbate ~debug_mode ~outputs ~is_alarm:false env counter graph state + false state.time_dependent_perts in if (not continue) || stop then true, graph', state' @@ -582,12 +582,12 @@ let regular_loop_body ~debugMode ~outputs ~maxConsecutiveClash env counter graph (not mix_changed) || Rule_interpreter.is_correct_instance env graph' picked_instance then - one_rule ~debugMode ~outputs ~maxConsecutiveClash env counter graph' state' + one_rule ~debug_mode ~outputs ~maxConsecutiveClash env counter graph' state' picked_instance else Counter.one_time_correction_event counter, graph', state' -let a_loop ~debugMode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash env +let a_loop ~debug_mode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash env counter graph state = let activity = Rule_interpreter.activity graph in let rd = Random.State.float (Rule_interpreter.get_random_state graph) 1.0 in @@ -602,7 +602,7 @@ let a_loop ~debugMode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash env (Model.get_perturbation env pe).Primitives.needs_backtrack) state.stopping_times then - perturbate_with_backtrack ~debugMode ~outputs env counter graph state + perturbate_with_backtrack ~debug_mode ~outputs env counter graph state state.stopping_times else ( let () = @@ -610,7 +610,7 @@ let a_loop ~debugMode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash env outputs (Data.Snapshot ( "deadlock.ka", - Rule_interpreter.snapshot ~debugMode ~raw:false env counter + Rule_interpreter.snapshot ~debug_mode ~raw:false env counter graph )) in let () = @@ -633,19 +633,19 @@ let a_loop ~debugMode ~outputs ~dumpIfDeadlocked ~maxConsecutiveClash env | (ti, _) :: _ when Nbr.is_smaller ti (Nbr.F (Counter.current_time counter +. dt)) -> let stop, graph', state', dt', needs_backtrack = - perturbate_until_first_backtrack ~debugMode env counter ~outputs + perturbate_until_first_backtrack ~debug_mode env counter ~outputs (false, graph, state, dt) in if needs_backtrack then - perturbate_with_backtrack ~debugMode ~outputs env counter graph' + perturbate_with_backtrack ~debug_mode ~outputs env counter graph' state' state'.stopping_times else if stop then stop, graph', state' else - regular_loop_body ~debugMode ~outputs ~maxConsecutiveClash env counter - graph' state' dt' + regular_loop_body ~debug_mode ~outputs ~maxConsecutiveClash env + counter graph' state' dt' | _ -> - regular_loop_body ~debugMode ~outputs ~maxConsecutiveClash env counter + regular_loop_body ~debug_mode ~outputs ~maxConsecutiveClash env counter graph state dt ) in diff --git a/core/simulation/state_interpreter.mli b/core/simulation/state_interpreter.mli index 44fda8c3e0..589eea56d1 100644 --- a/core/simulation/state_interpreter.mli +++ b/core/simulation/state_interpreter.mli @@ -17,7 +17,7 @@ val empty : with_delta_activities:bool -> Counter.t -> Model.t -> t val initialize : bind:('a -> (bool * Rule_interpreter.t * t -> 'a) -> 'a) -> return:(bool * Rule_interpreter.t * t -> 'a) -> - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> Model.t -> Counter.t -> @@ -33,7 +33,7 @@ val observables_values : values of observables) *) val do_modifications : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> Model.t -> Counter.t -> @@ -43,7 +43,7 @@ val do_modifications : bool * Rule_interpreter.t * t * bool val a_loop : - debugMode:bool -> + debug_mode:bool -> outputs:(Data.t -> unit) -> dumpIfDeadlocked:bool -> maxConsecutiveClash:int -> diff --git a/core/siteGraphs/agent.ml b/core/siteGraphs/agent.ml index 410a39afc3..83bad7565c 100644 --- a/core/siteGraphs/agent.ml +++ b/core/siteGraphs/agent.ml @@ -35,8 +35,8 @@ let print_raw_internal ?sigs (i, agent) site f id = | Some sigs -> Signature.print_internal_state sigs agent site f id | None -> Format.fprintf f "n%is%i~%i" i site id -let rename ~debugMode inj (n_id, n_ty) = - Renaming.apply ~debugMode inj n_id, n_ty +let rename ~debug_mode inj (n_id, n_ty) = + Renaming.apply ~debug_mode inj n_id, n_ty let sort (_, ty) = ty let id (id, _) = id diff --git a/core/siteGraphs/agent.mli b/core/siteGraphs/agent.mli index e0acf7640f..f835a77f6b 100644 --- a/core/siteGraphs/agent.mli +++ b/core/siteGraphs/agent.mli @@ -24,7 +24,7 @@ val print_internal : val print_raw_internal : ?sigs:Signature.s -> t -> int -> Format.formatter -> int -> unit -val rename : debugMode:bool -> Renaming.t -> t -> t +val rename : debug_mode:bool -> Renaming.t -> t -> t val json_dictionnary : string val write_json : Buffer.t -> t -> unit val read_json : Yojson.Basic.lexer_state -> Lexing.lexbuf -> t diff --git a/core/siteGraphs/dune b/core/siteGraphs/dune index 0cab04640f..6f08d4e32a 100644 --- a/core/siteGraphs/dune +++ b/core/siteGraphs/dune @@ -2,4 +2,5 @@ (name kappa_mixtures) (libraries kappa_generic_toolset) (public_name kappa-library.mixtures) - (flags (:standard -w @a -open Kappa_generic_toolset))) + (flags + (:standard -w @a-40-42 -open Kappa_generic_toolset))) diff --git a/core/siteGraphs/edges.ml b/core/siteGraphs/edges.ml index 96fe83db8b..f1d3d0325d 100644 --- a/core/siteGraphs/edges.ml +++ b/core/siteGraphs/edges.ml @@ -265,7 +265,7 @@ let add_agent ?id sigs ty graph = | _, _ -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot + (Loc.annot_with_dummy ("Try to add an agent with a the free id " ^ string_of_int id))) ) else @@ -550,7 +550,7 @@ let in_same_connected_component ag ag' graph = | None -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot + (Loc.annot_with_dummy "in_same_connected_component while not tracking ccs")) | Some ccs -> Mods.DynArray.get ccs ag = Mods.DynArray.get ccs ag') @@ -562,7 +562,7 @@ let get_connected_component ag graph = | None -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot + (Loc.annot_with_dummy "get_connected_component while not tracking ccs")) | Some ccs -> Mods.DynArray.get ccs ag) @@ -618,7 +618,7 @@ let one_connected_component sigs ty node graph = in build 0 [] Mods.IntMap.empty [ node, ty ] -let species ~debugMode sigs root graph = +let species ~debug_mode sigs root graph = match graph.tables with | None -> assert false | Some tables -> @@ -627,10 +627,10 @@ let species ~debugMode sigs root graph = | None -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot + (Loc.annot_with_dummy ("Sort of node unavailable " ^ string_of_int root))) | Some ty -> - Snapshot.cc_to_user_cc ~debugMode ~raw:true sigs + Snapshot.cc_to_user_cc ~debug_mode ~raw:true sigs (one_connected_component sigs ty root tables) in let () = Cache.reset (fst tables.caches) in @@ -657,8 +657,8 @@ let build_snapshot ~raw sigs graph = | None -> assert false | Some tables -> aux_build_snapshot raw sigs tables Snapshot.empty 0 -let build_user_snapshot ~debugMode ~raw sigs graph = - Snapshot.export ~debugMode ~raw sigs (build_snapshot ~raw sigs graph) +let build_user_snapshot ~debug_mode ~raw sigs graph = + Snapshot.export ~debug_mode ~raw sigs (build_snapshot ~raw sigs graph) let debug_print f graph = match graph.tables with diff --git a/core/siteGraphs/edges.mli b/core/siteGraphs/edges.mli index 57bf43b410..c94499df57 100644 --- a/core/siteGraphs/edges.mli +++ b/core/siteGraphs/edges.mli @@ -87,12 +87,12 @@ val are_connected : (** [are_connected ?max_distance graph nodes_x nodes_y] *) val species : - debugMode:bool -> Signature.s -> int -> t -> User_graph.connected_component + debug_mode:bool -> Signature.s -> int -> t -> User_graph.connected_component val build_snapshot : raw:bool -> Signature.s -> t -> Snapshot.t val build_user_snapshot : - debugMode:bool -> + debug_mode:bool -> raw:bool -> Signature.s -> t -> diff --git a/core/siteGraphs/navigation.ml b/core/siteGraphs/navigation.ml index bf74635b60..3c187009b3 100644 --- a/core/siteGraphs/navigation.ml +++ b/core/siteGraphs/navigation.ml @@ -102,18 +102,18 @@ let rec print sigs find_ty f = function (print sigs (extend find_ty source)) t -let compatible_fresh_point ~debugMode e (sid, sty) ssite arrow = +let compatible_fresh_point ~debug_mode e (sid, sty) ssite arrow = match e, arrow with | _, ToNode (Existing _, _) -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot + (Loc.annot_with_dummy "Navigation.compatible_fresh_point does not deal with existing \ arrow")) | ((Fresh (id, ty), site), x), ToNothing -> if ty = sty && site = ssite && x = ToNothing then ( let inj = Renaming.empty () in - if Renaming.imperative_add ~debugMode id sid inj then + if Renaming.imperative_add ~debug_mode id sid inj then Some inj else None @@ -122,7 +122,7 @@ let compatible_fresh_point ~debugMode e (sid, sty) ssite arrow = | ((Fresh (id, ty), site), x), ToInternal i -> if ty = sty && site = ssite && x = ToInternal i then ( let inj = Renaming.empty () in - if Renaming.imperative_add ~debugMode id sid inj then + if Renaming.imperative_add ~debug_mode id sid inj then Some inj else None @@ -133,8 +133,8 @@ let compatible_fresh_point ~debugMode e (sid, sty) ssite arrow = (* link between 2 agents *) if ty = sty && site = ssite && ty' = sty' && site' = ssite' then ( let inj = Renaming.empty () in - if Renaming.imperative_add ~debugMode id sid inj then - if Renaming.imperative_add ~debugMode id' sid' inj then + if Renaming.imperative_add ~debug_mode id sid inj then + if Renaming.imperative_add ~debug_mode id' sid' inj then Some inj else None @@ -142,8 +142,8 @@ let compatible_fresh_point ~debugMode e (sid, sty) ssite arrow = None ) else if ty = sty' && site = ssite' && ty' = sty && site' = ssite then ( let inj = Renaming.empty () in - if Renaming.imperative_add ~debugMode id sid' inj then - if Renaming.imperative_add ~debugMode id' sid inj then + if Renaming.imperative_add ~debug_mode id sid' inj then + if Renaming.imperative_add ~debug_mode id' sid inj then Some inj else None @@ -160,7 +160,7 @@ let compatible_fresh_point ~debugMode e (sid, sty) ssite arrow = && id = id' && sid = sid' && ty = sty && sty = sty' then ( let inj = Renaming.empty () in - if Renaming.imperative_add ~debugMode id sid inj then + if Renaming.imperative_add ~debug_mode id sid inj then Some inj else None @@ -169,12 +169,12 @@ let compatible_fresh_point ~debugMode e (sid, sty) ssite arrow = | ((Existing _, _), _), _ -> None | ((Fresh _, _), (ToNothing | ToInternal _)), ToNode _ -> None -let compatible_point ~debugMode inj e e' = +let compatible_point ~debug_mode inj e e' = match e, e' with | ((Existing id, site), ToNothing), e -> if Renaming.mem id inj - && e = ((Existing (Renaming.apply ~debugMode inj id), site), ToNothing) + && e = ((Existing (Renaming.apply ~debug_mode inj id), site), ToNothing) then Some inj else @@ -182,7 +182,7 @@ let compatible_point ~debugMode inj e e' = | ((Existing id, site), ToInternal i), e -> if Renaming.mem id inj - && e = ((Existing (Renaming.apply ~debugMode inj id), site), ToInternal i) + && e = ((Existing (Renaming.apply ~debug_mode inj id), site), ToInternal i) then Some inj else @@ -191,11 +191,11 @@ let compatible_point ~debugMode inj e e' = if Renaming.mem id inj && Renaming.mem id' inj && (e - = ( (Existing (Renaming.apply ~debugMode inj id), site), - ToNode (Existing (Renaming.apply ~debugMode inj id'), site') ) + = ( (Existing (Renaming.apply ~debug_mode inj id), site), + ToNode (Existing (Renaming.apply ~debug_mode inj id'), site') ) || e - = ( (Existing (Renaming.apply ~debugMode inj id'), site'), - ToNode (Existing (Renaming.apply ~debugMode inj id), site) )) + = ( (Existing (Renaming.apply ~debug_mode inj id'), site'), + ToNode (Existing (Renaming.apply ~debug_mode inj id), site) )) then Some inj else @@ -214,9 +214,9 @@ let compatible_point ~debugMode inj e e' = && ((ssite = site && ssite' = site') || (id = id' && ssite = site' && ssite' = site)) then ( - match Renaming.add ~debugMode id' sid' inj with + match Renaming.add ~debug_mode id' sid' inj with | Some inj' - when Renaming.mem id inj' && sid = Renaming.apply ~debugMode inj' id -> + when Renaming.mem id inj' && sid = Renaming.apply ~debug_mode inj' id -> Some inj' | _ -> None ) else @@ -226,30 +226,30 @@ let compatible_point ~debugMode inj e e' = | ((Fresh (id, ty), site), ToNothing), ((Fresh (id', ty'), site'), x) -> if ty = ty' && site = site' && x = ToNothing && not (Renaming.mem id inj) then - Renaming.add ~debugMode id id' inj + Renaming.add ~debug_mode id id' inj else None | ((Fresh (id, ty), site), ToInternal i), ((Fresh (id', ty'), site'), x) -> if ty = ty' && site = site' && x = ToInternal i && not (Renaming.mem id inj) then - Renaming.add ~debugMode id id' inj + Renaming.add ~debug_mode id id' inj else None | ( ((Fresh (id, ty), site), ToNode (Fresh (id', ty'), site')), ((Fresh (sid, sty), ssite), ToNode (Fresh (sid', sty'), ssite')) ) -> if (not (Renaming.mem id inj)) && not (Renaming.mem id' inj) then if ty = sty && site = ssite && ty' = sty' && site' = ssite' then ( - match Renaming.add ~debugMode id sid inj with + match Renaming.add ~debug_mode id sid inj with | None -> None | Some inj' -> - (match Renaming.add ~debugMode id' sid' inj' with + (match Renaming.add ~debug_mode id' sid' inj' with | None -> None | Some inj'' -> Some inj'') ) else if ty = sty' && site = ssite' && ty' = sty && site' = ssite then ( - match Renaming.add ~debugMode id sid' inj with + match Renaming.add ~debug_mode id sid' inj with | None -> None | Some inj' -> - (match Renaming.add ~debugMode id' sid inj' with + (match Renaming.add ~debug_mode id' sid inj' with | None -> None | Some inj'' -> Some inj'') ) else @@ -259,22 +259,22 @@ let compatible_point ~debugMode inj e e' = | ((Fresh _, _), _), ((Fresh _, _), _) -> None | ((Fresh _, _), _), ((Existing _, _), _) -> None -let rec aux_sub ~debugMode inj goal acc = function +let rec aux_sub ~debug_mode inj goal acc = function | [] -> None | h :: t -> - (match compatible_point ~debugMode inj h goal with - | None -> aux_sub ~debugMode inj goal (h :: acc) t + (match compatible_point ~debug_mode inj h goal with + | None -> aux_sub ~debug_mode inj goal (h :: acc) t | Some inj' -> Some (inj', List.rev_append acc t)) -let rec is_subnavigation ~debugMode inj nav = function +let rec is_subnavigation ~debug_mode inj nav = function | [] -> Some (inj, nav) | h :: t -> - (match aux_sub ~debugMode inj h [] nav with + (match aux_sub ~debug_mode inj h [] nav with | None -> None - | Some (inj', nav') -> is_subnavigation ~debugMode inj' nav' t) + | Some (inj', nav') -> is_subnavigation ~debug_mode inj' nav' t) -let rename_id ~debugMode inj2cc = function - | Existing n -> inj2cc, Existing (Renaming.apply ~debugMode inj2cc n) +let rename_id ~debug_mode inj2cc = function + | Existing n -> inj2cc, Existing (Renaming.apply ~debug_mode inj2cc n) | Fresh (id, ty) -> let img = Renaming.image inj2cc in let id' = @@ -285,20 +285,20 @@ let rename_id ~debugMode inj2cc = function ) else id in - (match Renaming.add ~debugMode id id' inj2cc with + (match Renaming.add ~debug_mode id id' inj2cc with | None -> assert false | Some inj' -> inj', Fresh (id', ty)) -let rec rename ~debugMode inj2cc = function +let rec rename ~debug_mode inj2cc = function | [] -> inj2cc, [] | ((x, i), ((ToNothing | ToInternal _) as a)) :: t -> - let inj, x' = rename_id ~debugMode inj2cc x in - let inj', t' = rename ~debugMode inj t in + let inj, x' = rename_id ~debug_mode inj2cc x in + let inj', t' = rename ~debug_mode inj t in inj', ((x', i), a) :: t' | ((x, i), ToNode (y, j)) :: t -> - let inj, x' = rename_id ~debugMode inj2cc x in - let inj', y' = rename_id ~debugMode inj y in - let inj'', t' = rename ~debugMode inj' t in + let inj, x' = rename_id ~debug_mode inj2cc x in + let inj', y' = rename_id ~debug_mode inj y in + let inj'', t' = rename ~debug_mode inj' t in inj'', ((x', i), ToNode (y', j)) :: t' let check_edge graph = function @@ -316,7 +316,7 @@ let check_edge graph = function Edges.link_exists id site id' site' graph (*inj is the partial injection built so far: inj:abs->concrete*) -let dst_is_okay ~debugMode inj' graph root site = function +let dst_is_okay ~debug_mode inj' graph root site = function | ToNothing -> if Edges.is_free root site graph then Some inj' @@ -330,7 +330,7 @@ let dst_is_okay ~debugMode inj' graph root site = function | ToNode (Existing id', site') -> if Edges.link_exists root site - (Renaming.apply ~debugMode inj' id') + (Renaming.apply ~debug_mode inj' id') site' graph then Some inj' @@ -339,50 +339,54 @@ let dst_is_okay ~debugMode inj' graph root site = function | ToNode (Fresh (id', ty), site') -> (match Edges.exists_fresh root site ty site' graph with | None -> None - | Some node -> Renaming.add ~debugMode id' node inj') + | Some node -> Renaming.add ~debug_mode id' node inj') -let injection_for_one_more_edge ~debugMode ?root inj graph = function +let injection_for_one_more_edge ~debug_mode ?root inj graph = function | (Existing id, site), dst -> - dst_is_okay ~debugMode inj graph (Renaming.apply ~debugMode inj id) site dst + dst_is_okay ~debug_mode inj graph + (Renaming.apply ~debug_mode inj id) + site dst | (Fresh (id, rty), site), dst -> (match root with | Some (root, rty') when rty = rty' -> - (match Renaming.add ~debugMode id root inj with + (match Renaming.add ~debug_mode id root inj with | None -> None - | Some inj' -> dst_is_okay ~debugMode inj' graph root site dst) + | Some inj' -> dst_is_okay ~debug_mode inj' graph root site dst) | _ -> None) -let imperative_dst_is_okay ~debugMode inj' graph root site = function +let imperative_dst_is_okay ~debug_mode inj' graph root site = function | ToNothing -> Edges.is_free root site graph | ToInternal i -> Edges.is_internal i root site graph | ToNode (Existing id', site') -> - Edges.link_exists root site (Renaming.apply ~debugMode inj' id') site' graph + Edges.link_exists root site + (Renaming.apply ~debug_mode inj' id') + site' graph | ToNode (Fresh (id', ty), site') -> (match Edges.exists_fresh root site ty site' graph with | None -> false - | Some node -> Renaming.imperative_add ~debugMode id' node inj') + | Some node -> Renaming.imperative_add ~debug_mode id' node inj') -let imperative_edge_is_valid ~debugMode ?root inj graph = function +let imperative_edge_is_valid ~debug_mode ?root inj graph = function | (Existing id, site), dst -> - imperative_dst_is_okay ~debugMode inj graph - (Renaming.apply ~debugMode inj id) + imperative_dst_is_okay ~debug_mode inj graph + (Renaming.apply ~debug_mode inj id) site dst | (Fresh (id, rty), site), dst -> (match root with | Some (root, rty') when rty = rty' -> - Renaming.imperative_add ~debugMode id root inj - && imperative_dst_is_okay ~debugMode inj graph root site dst + Renaming.imperative_add ~debug_mode id root inj + && imperative_dst_is_okay ~debug_mode inj graph root site dst | _ -> false) -let concretize_port ~debugMode inj = function - | Existing id, site -> Renaming.apply ~debugMode inj id, site - | Fresh (id, _), site -> Renaming.apply ~debugMode inj id, site +let concretize_port ~debug_mode inj = function + | Existing id, site -> Renaming.apply ~debug_mode inj id, site + | Fresh (id, _), site -> Renaming.apply ~debug_mode inj id, site -let concretize_arrow ~debugMode inj = function +let concretize_arrow ~debug_mode inj = function | (ToNothing | ToInternal _) as x -> x - | ToNode x -> ToNode (concretize_port ~debugMode inj x) + | ToNode x -> ToNode (concretize_port ~debug_mode inj x) -let concretize ~debugMode root graph nav = +let concretize ~debug_mode root graph nav = let inj = Renaming.empty () in let out = List.fold_left @@ -390,10 +394,10 @@ let concretize ~debugMode root graph nav = match out with | None -> out | Some (root, acc) -> - if imperative_edge_is_valid ~debugMode ?root inj graph step then ( + if imperative_edge_is_valid ~debug_mode ?root inj graph step then ( let st = - ( concretize_port ~debugMode inj p, - concretize_arrow ~debugMode inj dst ) + ( concretize_port ~debug_mode inj p, + concretize_arrow ~debug_mode inj dst ) in Some (None, st :: acc) ) else diff --git a/core/siteGraphs/navigation.mli b/core/siteGraphs/navigation.mli index 8e11c901a2..a5a4f38c99 100644 --- a/core/siteGraphs/navigation.mli +++ b/core/siteGraphs/navigation.mli @@ -24,10 +24,10 @@ val to_yojson : abstract t -> Yojson.Basic.t val of_yojson : Yojson.Basic.t -> abstract t val rename : - debugMode:bool -> Renaming.t -> abstract t -> Renaming.t * abstract t + debug_mode:bool -> Renaming.t -> abstract t -> Renaming.t * abstract t val compatible_fresh_point : - debugMode:bool -> + debug_mode:bool -> abstract step -> Agent.t -> int -> @@ -37,7 +37,7 @@ val compatible_fresh_point : is the image of the first *) val is_subnavigation : - debugMode:bool -> + debug_mode:bool -> Renaming.t -> abstract t -> abstract t -> @@ -47,7 +47,7 @@ val is_subnavigation : val check_edge : Edges.t -> abstract step -> bool val injection_for_one_more_edge : - debugMode:bool -> + debug_mode:bool -> ?root:Agent.t -> Renaming.t -> Edges.t -> @@ -55,7 +55,7 @@ val injection_for_one_more_edge : Renaming.t option val imperative_edge_is_valid : - debugMode:bool -> + debug_mode:bool -> ?root:Agent.t -> Renaming.t -> Edges.t -> @@ -63,4 +63,4 @@ val imperative_edge_is_valid : bool val concretize : - debugMode:bool -> Agent.t -> Edges.t -> abstract t -> int t option + debug_mode:bool -> Agent.t -> Edges.t -> abstract t -> int t option diff --git a/core/siteGraphs/signature.ml b/core/siteGraphs/signature.ml index 392be8ae85..96e4ef077e 100644 --- a/core/siteGraphs/signature.ml +++ b/core/siteGraphs/signature.ml @@ -6,121 +6,159 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) -type t = - (unit NamedDecls.t * bool array array option * (int * int) option) - NamedDecls.t +type 'links site_sig = { + internal_state: unit NamedDecls.t; + links: 'links option; + counters_info: (int * int) option; + (** If relevant: counter CEQ value * counter delta *) +} + +type t = bool array array site_sig NamedDecls.t let fold f = NamedDecls.fold (fun i n o _ -> f i n o) -let num_of_site ?agent_name site_name sign = +let num_of_site ?agent_name site_name signature = let kind = match agent_name with | None -> "site name" | Some agent_name -> "site name for agent " ^ agent_name in - NamedDecls.elt_id ~kind sign site_name + NamedDecls.elt_id ~kind signature site_name -let site_of_num addr sign = - try NamedDecls.elt_name sign addr with Invalid_argument _ -> raise Not_found +let site_of_num addr signature = + try NamedDecls.elt_name signature addr + with Invalid_argument _ -> raise Not_found -let num_of_internal_state site_id state sign = +let num_of_internal_state site_id state signature = try - let na, (nd, _, _) = sign.NamedDecls.decls.(site_id) in - NamedDecls.elt_id ~kind:("internal state for site " ^ na) nd state + let site_name, site_sig = signature.NamedDecls.decls.(site_id) in + NamedDecls.elt_id + ~kind:("internal state for site " ^ site_name) + site_sig.internal_state state with Invalid_argument _ -> raise Not_found -let internal_state_of_num site_num val_num sign = +let internal_state_of_site_id site_id val_id signature = try - let _, (nd, _, _) = sign.NamedDecls.decls.(site_num) in - fst nd.NamedDecls.decls.(val_num) + let site_sig = NamedDecls.elt_val signature site_id in + NamedDecls.elt_name site_sig.internal_state val_id with Invalid_argument _ -> raise Not_found -let counter_of_site site_id sign = - try - let _, (_, _, c) = sign.NamedDecls.decls.(site_id) in - c +let counter_of_site_id site_id signature = + try (NamedDecls.elt_val signature site_id).counters_info with Invalid_argument _ -> raise Not_found -let has_counter sign = +let has_counter signature = fold (fun p_id _ ok -> try - let _, (_, _, c) = sign.NamedDecls.decls.(p_id) in - ok || not (c = None) + let site_sig = NamedDecls.elt_val signature p_id in + ok || not (site_sig.counters_info = None) with Invalid_argument _ -> raise Not_found) - false sign + false signature + +(* +let read_position p lb = + match Yojson.Basic.from_lexbuf ~stream:true p lb with + | `Assoc [ ("line", `Int line); ("chr", `Int chr) ] + | `Assoc [ ("chr", `Int chr); ("line", `Int line) ] -> + { line; chr } + | x -> raise (Yojson.Basic.Util.Type_error ("Invalid position", x)) + +let write_position ob { line; chr } = + Yojson.write_assoc ob [ "line", `Int line; "chr", `Int chr ] +*) let one_to_json = - NamedDecls.to_json (fun (a, b, c) -> - `List + NamedDecls.to_json (fun signature -> + `Assoc [ - NamedDecls.to_json (fun () -> `Null) a; - JsonUtil.of_option - (fun links -> - `List - (Array.fold_right - (fun a acc -> - `List (Array.fold_right (fun b c -> `Bool b :: c) a []) - :: acc) - links [])) - b; - JsonUtil.of_option (fun (c1, c2) -> `List [ `Int c1; `Int c2 ]) c; + ( "internal_state", + NamedDecls.to_json (fun () -> `Null) signature.internal_state ); + ( "links", + JsonUtil.of_option + (fun links -> + `List + (Array.fold_right + (fun a acc -> + `List (Array.fold_right (fun b c -> `Bool b :: c) a []) + :: acc) + links [])) + signature.links ); + ( "counters_info", + JsonUtil.of_option + (fun (c1, c2) -> `List [ `Int c1; `Int c2 ]) + signature.counters_info ); ]) -let one_of_json = +let one_of_json : Yojson.Basic.t -> bool array array site_sig NamedDecls.t = NamedDecls.of_json (function - | `List [ a; b; c ] -> - ( NamedDecls.of_json - (function - | `Null -> () - | x -> - raise - (Yojson.Basic.Util.Type_error ("Problematic agent signature", x))) - a, - Yojson.Basic.Util.to_option - (function - | `List l -> - Tools.array_map_of_list - (function - | `List l' -> - Tools.array_map_of_list - (function - | `Bool b -> b - | x -> - raise - (Yojson.Basic.Util.Type_error - ("Problematic agent signature", x))) - l' - | x -> - raise - (Yojson.Basic.Util.Type_error - ("Problematic agent signature", x))) - l - | x -> - raise - (Yojson.Basic.Util.Type_error ("Problematic agent signature", x))) - b, - Yojson.Basic.Util.to_option - (function - | `List [ `Int c1; `Int c2 ] -> c1, c2 - | x -> - raise - (Yojson.Basic.Util.Type_error ("Problematic agent signature", x))) - c ) + | `Assoc [ ("internal_state", a); ("links", b); ("counters_info", c) ] -> + { + internal_state = + NamedDecls.of_json + (function + | `Null -> () + | x -> + raise + (Yojson.Basic.Util.Type_error + ("Problematic agent signature", x))) + a; + links = + Yojson.Basic.Util.to_option + (function + | `List l -> + Tools.array_map_of_list + (function + | `List l' -> + Tools.array_map_of_list + (function + | `Bool b -> b + | x -> + raise + (Yojson.Basic.Util.Type_error + ("Problematic agent signature", x))) + l' + | x -> + raise + (Yojson.Basic.Util.Type_error + ("Problematic agent signature", x))) + l + | x -> + raise + (Yojson.Basic.Util.Type_error + ("Problematic agent signature", x))) + b; + counters_info = + Yojson.Basic.Util.to_option + (function + | `List [ `Int c1; `Int c2 ] -> c1, c2 + | x -> + raise + (Yojson.Basic.Util.Type_error + ("Problematic agent signature", x))) + c; + } | x -> raise (Yojson.Basic.Util.Type_error ("Problematic agent signature", x))) -type s = { t: t NamedDecls.t; incr: int option; incr_sites: (int * int) option } +type counter_agent_info = { id: int; arity: int; ports: int * int } -let size sigs = NamedDecls.size sigs.t -let get sigs agent_id = snd sigs.t.NamedDecls.decls.(agent_id) +type s = { + agent_sigs: t NamedDecls.t; + counter_agent_info: counter_agent_info option; +} + +let size sigs = NamedDecls.size sigs.agent_sigs +let get sigs agent_id = NamedDecls.elt_val sigs.agent_sigs agent_id let arity sigs agent_id = NamedDecls.size (get sigs agent_id) let max_arity sigs = - NamedDecls.fold (fun _ _ x a -> max x (NamedDecls.size a)) 0 sigs.t + NamedDecls.fold (fun _ _ x a -> max x (NamedDecls.size a)) 0 sigs.agent_sigs + +let agent_of_num i sigs = NamedDecls.elt_name sigs.agent_sigs i -let agent_of_num i sigs = NamedDecls.elt_name sigs.t i -let num_of_agent name sigs = NamedDecls.elt_id ~kind:"agent" sigs.t name +let num_of_agent name sigs = + NamedDecls.elt_id ~kind:"agent" sigs.agent_sigs name let id_of_site ((agent_name, _) as agent_ty) site_name sigs = let n = num_of_agent agent_ty sigs in @@ -130,23 +168,23 @@ let site_of_id agent_id site_id sigs = site_of_num site_id (get sigs agent_id) let id_of_internal_state ((agent_name, _) as agent_ty) site_name state sigs = let n = num_of_agent agent_ty sigs in - let sign = get sigs n in - let site_id = num_of_site ~agent_name site_name sign in - num_of_internal_state site_id state sign + let signature = get sigs n in + let site_id = num_of_site ~agent_name site_name signature in + num_of_internal_state site_id state signature let internal_state_of_id agent_id id_site id_state sigs = - internal_state_of_num id_site id_state (get sigs agent_id) + internal_state_of_site_id id_site id_state (get sigs agent_id) -let internal_states_number agent_id site_num sigs = +let internal_states_number agent_id site_id sigs = try - let _, (nd, _, _) = (get sigs agent_id).NamedDecls.decls.(site_num) in - NamedDecls.size nd + let site_sig = NamedDecls.elt_val (get sigs agent_id) site_id in + NamedDecls.size site_sig.internal_state with Invalid_argument _ -> raise Not_found let default_internal_state agent_id site_id sigs = try - let _, (nd, _, _) = (get sigs agent_id).NamedDecls.decls.(site_id) in - if nd.NamedDecls.decls = [||] then + let site_sig = NamedDecls.elt_val (get sigs agent_id) site_id in + if NamedDecls.size site_sig.internal_state = 0 then None else Some 0 @@ -158,96 +196,46 @@ let rec allowed_link ag1 s1 ag2 s2 sigs = allowed_link ag2 s2 ag1 s1 sigs else ( try - match (get sigs ag1).NamedDecls.decls.(s1) with - | _, (_, None, _) -> true - | _, (_, Some l, _) -> l.(ag2 - ag1).(s2) + match (NamedDecls.elt_val (get sigs ag1) s1).links with + | None -> true + | Some l -> l.(ag2 - ag1).(s2) with Invalid_argument _ -> invalid_arg "Signature.allowed_link: invalid site identifier" ) -let add_incr counters = - let annot = Locality.dummy in - let a_port = "a", annot in - let b_port = "b", annot in - let incr = "__incr", Locality.dummy in - let after = a_port, (NamedDecls.create [||], [ b_port, incr ], None) in - let before_lnks = - List.fold_right - (fun (ag, counts) acc -> List.map (fun c -> c, ag) counts @ acc) - counters - [ a_port, incr ] - in - let before = b_port, (NamedDecls.create [||], before_lnks, None) in - let lnks = NamedDecls.create [| after; before |] in - let counter_agent = incr, lnks in - counter_agent - -let create ~counters contact_map sigs = - let sigs' = - if counters <> [] then - add_incr counters :: sigs - else - sigs - in - let t = Array.of_list sigs' in - let raw = NamedDecls.create t in - let s = Array.length t in - let snd_of_third (_, a, _) = a in +let create ~counters_per_agent agent_sigs = { - t = - NamedDecls.mapi - (fun ag ag_na -> - NamedDecls.mapi (fun _ si_na (ints, links, counts) -> - if not contact_map then - ints, None, counts - else ( - let out = - Array.init (s - ag) (fun i -> - Array.make - (NamedDecls.size (snd raw.NamedDecls.decls.(i + ag))) - false) - in - let () = - List.iter - (fun (((site_name, pos) as site), ((agent_name, _) as agent)) -> - let a = NamedDecls.elt_id ~kind:"agent" raw agent in - let s = - num_of_site ~agent_name site - (snd raw.NamedDecls.decls.(a)) - in - let () = if a >= ag then out.(a - ag).(s) <- true in - if - List.exists - (fun ((x, _), (y, _)) -> x = si_na && y = ag_na) - (snd_of_third - (snd - (snd raw.NamedDecls.decls.(a)).NamedDecls.decls.( - s))) - then - () - else - raise - (ExceptionDefn.Malformed_Decl - ( Format.asprintf "No link to %s.%s from %s.%s." - si_na ag_na site_name agent_name, - pos ))) - links - in - ints, Some out, counts - ))) - raw; - incr = - (if counters = [] then - None - else - Some 0); - incr_sites = - (if counters = [] then + agent_sigs; + counter_agent_info = + (if counters_per_agent = [] then None else - Some (0, 1)); + (* If there is a counter agent, we choose 0 for its agent id and 0 and 1 as its port ids *) + Some { id = 0; arity = 2; ports = 0, 1 }); } +let is_counter_agent sigs n_id = + match sigs.counter_agent_info with + | None -> false + | Some agent_info -> n_id = agent_info.id + +let ports_if_counter_agent sigs n_id = + match sigs.counter_agent_info with + | None -> None + | Some agent_info -> + if n_id = agent_info.id then + Some agent_info.ports + else + None + +let site_is_counter sigs ag_ty id = + counter_of_site_id id (get sigs ag_ty) <> None + +let get_counter_agent_info sigs = + match sigs.counter_agent_info with + | None -> failwith "No counter agent" + | Some counter_agent_info -> counter_agent_info + let print_agent sigs f ag_ty = Format.pp_print_string f @@ agent_of_num ag_ty sigs @@ -265,11 +253,12 @@ let print_site_internal_state sigs ag_ty site f = function (internal_state_of_id ag_ty site id sigs) let print_counter sigs ag_ty f id = - match counter_of_site id (get sigs ag_ty) with + match counter_of_site_id id (get sigs ag_ty) with | None -> () | Some (c1, c2) -> Format.fprintf f "{=%d/+=%d}" c1 c2 -let print_one ?sigs i f sign = +let print_one ?(sigs : s option) (i : int) (f : Format.formatter) + (signature : t) = let pp_int f x = if NamedDecls.size x > 0 then Format.fprintf f "{%a}" @@ -299,53 +288,31 @@ let print_one ?sigs i f sign = in (NamedDecls.print ~sep:(fun f -> Format.fprintf f ",@,") - (fun _ name f (ints, links, counts) -> - Format.fprintf f "%s%a%a%a" name pp_int ints (pp_link i) links pp_counts - counts)) - f sign + (fun _ name f site_sig -> + Format.fprintf f "%s%a%a%a" name pp_int site_sig.internal_state + (pp_link i) site_sig.links pp_counts site_sig.counters_info)) + f signature let print f sigs = Format.fprintf f "@[%a@]" (NamedDecls.print ~sep:Pp.space (fun i n f si -> Format.fprintf f "@[%%agent: %s(%a)@]" n (print_one ~sigs i) si)) - sigs.t + sigs.agent_sigs -let to_json sigs = NamedDecls.to_json one_to_json sigs.t +let to_json sigs = NamedDecls.to_json one_to_json sigs.agent_sigs let of_json v = - let t = NamedDecls.of_json one_of_json v in - let incr, incr_sites = - match Mods.StringMap.find_option "__incr" t.NamedDecls.finder with - | Some incr_id -> - let incr = snd t.NamedDecls.decls.(incr_id) in - let after = num_of_site ("a", Locality.dummy) incr in - let before = num_of_site ("b", Locality.dummy) incr in - Some incr_id, Some (before, after) - | None -> None, None + let agent_sigs : 'a site_sig NamedDecls.t NamedDecls.t = + NamedDecls.of_json one_of_json v in - { t; incr; incr_sites } - -let is_counter_agent sigs n_id = - match sigs.incr with - | None -> false - | Some incr_id -> n_id = incr_id - -let ports_if_counter_agent sigs n_id = - if - match sigs.incr with - | None -> false - | Some incr_id -> n_id = incr_id - then - sigs.incr_sites - else - None - -let site_is_counter sigs ag_ty id = counter_of_site id (get sigs ag_ty) <> None - -let incr_agent sigs = - match sigs.incr with - | None -> failwith "No incr agent" + match + Mods.StringMap.find_option "__counter_agent" agent_sigs.NamedDecls.finder + with | Some id -> - (match sigs.incr_sites with - | None -> failwith "Signature of counter inconsistent" - | Some (before, after) -> id, 2, before, after) + let agent_signature = NamedDecls.elt_val agent_sigs id in + let ports = + ( num_of_site ("a", Loc.dummy) agent_signature, + num_of_site ("b", Loc.dummy) agent_signature ) + in + { agent_sigs; counter_agent_info = Some { id; arity = 2; ports } } + | None -> { agent_sigs; counter_agent_info = None } diff --git a/core/siteGraphs/signature.mli b/core/siteGraphs/signature.mli index a5f0e06382..da2a872a2e 100644 --- a/core/siteGraphs/signature.mli +++ b/core/siteGraphs/signature.mli @@ -8,32 +8,41 @@ (** Store definitions of agents *) -type t -(** Store of one agent *) - -val num_of_site : ?agent_name:string -> string Locality.annot -> t -> int +(* TODO: here, we talk about agents, but is it actually agent signatures/definitions ? while instances are in siteGraphs/agent.mli *) +(* TODO document what is internal state *) + +(* TODO *) +type 'links site_sig = { + internal_state: unit NamedDecls.t; + links: 'links option; + counters_info: (int * int) option; + (** If relevant: counter CEQ value * counter delta *) +} + +type t = bool array array site_sig NamedDecls.t +(** Store of one agent signature *) + +(* TODO remove Loc annotations here ? *) +val num_of_site : ?agent_name:string -> string Loc.annoted -> t -> int val site_of_num : int -> t -> string val fold : (int -> string -> 'a -> 'a) -> 'a -> t -> 'a -val num_of_internal_state : int -> string Locality.annot -> t -> int -(** [num_of_internal_state site_id state_name sign] *) +val num_of_internal_state : int -> string Loc.annoted -> t -> int +(** [num_of_internal_state site_id state_name signature] *) + +val internal_state_of_site_id : int -> int -> t -> string +(**[internal_state_of_site_id site_id value_id signature] *) -val internal_state_of_num : int -> int -> t -> string -val counter_of_site : int -> t -> (int * int) option +val counter_of_site_id : int -> t -> (int * int) option val has_counter : t -> bool type s -(** Store of all the agents *) +(** Store of all the agents, s as a plural *) +(* TODO See what to be kept here? *) val create : - counters:(string Locality.annot * string Locality.annot list) list -> - bool -> - (string Locality.annot - * (unit NamedDecls.t - * (string Locality.annot * string Locality.annot) list - * (int * int) option) - NamedDecls.t) - list -> + counters_per_agent:(string Loc.annoted * string Loc.annoted list) list -> + t NamedDecls.t -> s val size : s -> int @@ -47,18 +56,14 @@ val arity : s -> int -> int val max_arity : s -> int (** [max_arity sigs] returns max {!arities sigs i} *) -val num_of_agent : string Locality.annot -> s -> int +val num_of_agent : string Loc.annoted -> s -> int val agent_of_num : int -> s -> string -val id_of_site : string Locality.annot -> string Locality.annot -> s -> int +val id_of_site : string Loc.annoted -> string Loc.annoted -> s -> int (** [id_of_site agent_type site_name sigs] *) val id_of_internal_state : - string Locality.annot -> - string Locality.annot -> - string Locality.annot -> - s -> - int + string Loc.annoted -> string Loc.annoted -> string Loc.annoted -> s -> int (** [id_of_internal_state agent_type site_name state_name sigs] *) val internal_states_number : int -> int -> s -> int @@ -67,7 +72,23 @@ val internal_states_number : int -> int -> s -> int val default_internal_state : int -> int -> s -> int option val allowed_link : int -> int -> int -> int -> s -> bool -(** [allowed_link ag1 s1 ag2 s2 sigs] *) +(** [allowed_link ag1 s1 ag2 s2 sigs] evaluates to true if and only if it is allowed to create a link between site [s1] of agent [ag1] and site [s2] of agent [ag2] *) + +(** {2 Counter specific} *) + +(** If there are counters in the signature, we define a single agent as the + * _counter agent_, which will be used as _dummies_ to keep track of the counter value *) + +val is_counter_agent : s -> int -> bool +val ports_if_counter_agent : s -> int -> (int * int) option +val site_is_counter : s -> int -> int -> bool + +type counter_agent_info = { id: int; arity: int; ports: int * int } + +val get_counter_agent_info : s -> counter_agent_info +(** [counter_agent agent_sigs] *) + +(** {2 I/O} *) val print_agent : s -> Format.formatter -> int -> unit val print_site : s -> int -> Format.formatter -> int -> unit @@ -82,9 +103,3 @@ val print_counter : s -> int -> Format.formatter -> int -> unit val print : Format.formatter -> s -> unit val to_json : s -> Yojson.Basic.t val of_json : Yojson.Basic.t -> s -val is_counter_agent : s -> int -> bool -val ports_if_counter_agent : s -> int -> (int * int) option -val site_is_counter : s -> int -> int -> bool - -val incr_agent : s -> int * int * int * int -(** id, arity, before, after *) diff --git a/core/siteGraphs/snapshot.ml b/core/siteGraphs/snapshot.ml index 033c39dd43..1a30e628d7 100644 --- a/core/siteGraphs/snapshot.ml +++ b/core/siteGraphs/snapshot.ml @@ -126,7 +126,7 @@ let rec counter_value cc (nid, sid) count = )) count ag.node_sites -let cc_to_user_cc ~debugMode ~raw sigs cc = +let cc_to_user_cc ~debug_mode ~raw sigs cc = let r = Renaming.empty () in let cc_list, indexes, _ = Tools.array_fold_lefti @@ -137,11 +137,11 @@ let cc_to_user_cc ~debugMode ~raw sigs cc = if i = pos then indexes else ( - match Renaming.add ~debugMode i pos indexes with + match Renaming.add ~debug_mode i pos indexes with | None -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "Injectivity of renaming in snapshot")) + (Loc.annot_with_dummy "Injectivity of renaming in snapshot")) | Some r -> r ) in @@ -192,7 +192,7 @@ let cc_to_user_cc ~debugMode ~raw sigs cc = } | Some (dn_id, s) -> let dn_id' = - try Renaming.apply ~debugMode indexes dn_id + try Renaming.apply ~debug_mode indexes dn_id with Renaming.Undefined | Invalid_argument _ -> dn_id in @@ -220,5 +220,5 @@ let fold f x s = (fun _ l acc -> List.fold_left (fun a (nb, _, cc) -> f a nb cc) acc l) s x -let export ~debugMode ~raw sigs s = - fold (fun a x y -> (x, cc_to_user_cc ~debugMode ~raw sigs y) :: a) [] s +let export ~debug_mode ~raw sigs s = + fold (fun a x y -> (x, cc_to_user_cc ~debug_mode ~raw sigs y) :: a) [] s diff --git a/core/siteGraphs/snapshot.mli b/core/siteGraphs/snapshot.mli index abf7ef29af..71f9c69cf6 100644 --- a/core/siteGraphs/snapshot.mli +++ b/core/siteGraphs/snapshot.mli @@ -21,7 +21,7 @@ type connected_component = cc_node array type t val cc_to_user_cc : - debugMode:bool -> + debug_mode:bool -> raw:bool -> Signature.s -> connected_component -> @@ -33,7 +33,7 @@ val increment_in_snapshot : raw:bool -> Signature.s -> connected_component -> t -> t val export : - debugMode:bool -> + debug_mode:bool -> raw:bool -> Signature.s -> t -> diff --git a/core/symmetries/affine_combinations.ml b/core/symmetries/affine_combinations.ml index e032d032d4..5888a22194 100644 --- a/core/symmetries/affine_combinations.ml +++ b/core/symmetries/affine_combinations.ml @@ -1,8 +1,8 @@ -type ('mix, 'id) anonamised_expr = ('mix, 'id) Alg_expr.e Locality.annot +type ('mix, 'id) anonamised_expr = ('mix, 'id) Alg_expr.e Loc.annoted -let rec anonamise (expr : ('mix, 'id) Alg_expr.e Locality.annot) : +let rec anonamise (expr : ('mix, 'id) Alg_expr.e Loc.annoted) : ('mix, 'id) anonamised_expr = - Locality.dummy_annot + Loc.annot_with_dummy (match fst expr with | Alg_expr.BIN_ALG_OP (op, e1, e2) -> Alg_expr.BIN_ALG_OP (op, anonamise e1, anonamise e2) @@ -17,7 +17,7 @@ let rec anonamise (expr : ('mix, 'id) Alg_expr.e Locality.annot) : Alg_expr.DIFF_KAPPA_INSTANCE (anonamise e, id)) and anonamise_bool bool = - Locality.dummy_annot + Loc.annot_with_dummy (match fst bool with | (Alg_expr.TRUE | Alg_expr.FALSE) as e -> e | Alg_expr.BIN_BOOL_OP (op, b1, b2) -> diff --git a/core/symmetries/dune b/core/symmetries/dune index 25f211256e..0df77fed14 100644 --- a/core/symmetries/dune +++ b/core/symmetries/dune @@ -1,14 +1,23 @@ (library - (name kappa_symmetries) - (libraries kappa_parameters kappa_cli) - (flags (:standard) - -open Kappa_grammar - -open Kappa_terms - -open Kappa_mixtures - -open Kappa_parameters - -open Kappa_generic_toolset - -open Kappa_logging - -open Kappa_cli - -open Kappa_runtime - -open Kappa_kasa_type_interface -)) + (name kappa_symmetries) + (libraries kappa_parameters kappa_cli) + (flags + (:standard) + -open + Kappa_grammar + -open + Kappa_terms + -open + Kappa_mixtures + -open + Kappa_parameters + -open + Kappa_generic_toolset + -open + Kappa_logging + -open + Kappa_cli + -open + Kappa_runtime + -open + Kappa_kasa_type_interface)) diff --git a/core/symmetries/kade_backend.ml b/core/symmetries/kade_backend.ml index e949b4207f..bd549fbbb1 100644 --- a/core/symmetries/kade_backend.ml +++ b/core/symmetries/kade_backend.ml @@ -232,13 +232,13 @@ end module Raw_mixture = struct include Raw_mixture - let print_link ~noCounters symbol_table incr_agents f = function + let print_link ~noCounters symbol_table counter_agents f = function | Raw_mixture.FREE -> Utils.print_free_site f symbol_table | Raw_mixture.VAL i -> (try - let root = Raw_mixture.find incr_agents i in + let root = Raw_mixture.find counter_agents i in let counter, (_, is_counter) = - Mods.DynArray.get incr_agents.Raw_mixture.rank root + Mods.DynArray.get counter_agents.Raw_mixture.rank root in if is_counter && not noCounters then Format.fprintf f "{=%d}" counter @@ -271,8 +271,8 @@ module Raw_mixture = struct | None -> Format.pp_print_int f s) let print_intf ~noCounters with_link ?sigs - ?(symbol_table = Symbol_table.symbol_table_V4) incr_agents (ag_ty : int) f - (ports, ints) = + ?(symbol_table = Symbol_table.symbol_table_V4) counter_agents + (ag_ty : int) f (ports, ints) = let rec aux empty i = if i < Array.length ports then ( let () = @@ -284,7 +284,7 @@ module Raw_mixture = struct (aux_pp_si sigs symbol_table ag_ty i) ints.(i) (if with_link then - print_link ~noCounters symbol_table incr_agents + print_link ~noCounters symbol_table counter_agents else fun _ _ -> ()) @@ -301,10 +301,10 @@ module Raw_mixture = struct | None -> Format.pp_print_int f a let print_agent ~noCounters created link ?sigs - ?(symbol_table = Symbol_table.symbol_table_V4) incr_agents f ag = + ?(symbol_table = Symbol_table.symbol_table_V4) counter_agents f ag = Format.fprintf f "%a%s@[%a@]%s%t" (aux_pp_ag sigs) ag.Raw_mixture.a_type symbol_table.Symbol_table.agent_open - (print_intf ~noCounters link ?sigs ~symbol_table incr_agents + (print_intf ~noCounters link ?sigs ~symbol_table counter_agents ag.Raw_mixture.a_type) (ag.Raw_mixture.a_ports, ag.Raw_mixture.a_ints) symbol_table.Symbol_table.agent_close (fun f -> if created then Format.pp_print_string f "+") @@ -312,7 +312,7 @@ module Raw_mixture = struct let print ~noCounters ~created ?sigs ?(symbol_table = Symbol_table.symbol_table_V4) f mix = - let incr_agents = Raw_mixture.union_find_counters sigs mix in + let counter_agents = Raw_mixture.union_find_counters sigs mix in let rec aux_print some = function | [] -> () | h :: t -> @@ -327,8 +327,8 @@ module Raw_mixture = struct else ( let () = if some then Utils.print_agent_sep_comma symbol_table f in let () = - print_agent ~noCounters created true ?sigs ~symbol_table incr_agents - f h + print_agent ~noCounters created true ?sigs ~symbol_table + counter_agents f h in aux_print true t ) @@ -407,7 +407,7 @@ module LKappa = struct | LKappa.Freed -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "Cannot erase all increment agents")) + (Loc.annot_with_dummy "Cannot erase all increment agents")) | LKappa.Maintained -> () | LKappa.Erased -> () @@ -521,8 +521,8 @@ module LKappa = struct | LKappa.LNK_TYPE _ | LKappa.LNK_SOME -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot - "Port a of __incr agent not well specified"))))) + (Loc.annot_with_dummy + "Port a of __counter_agent agent not well specified"))))) mix in t @@ -767,7 +767,7 @@ module LKappa = struct ?(symbol_table = Symbol_table.symbol_table_V4) pr_tok pr_var f r = Format.fprintf f "@[%t%t%a%t@]" (fun f -> - if full || r.LKappa.r_editStyle then + if full || r.LKappa.r_edit_style then Format.fprintf f "%a%t%a" (print_rule_mixture ~noCounters sigs ~ltypes:false ~symbol_table r.LKappa.r_created) diff --git a/core/symmetries/lKappa_group_action.ml b/core/symmetries/lKappa_group_action.ml index d66bc8b454..0b616d6171 100644 --- a/core/symmetries/lKappa_group_action.ml +++ b/core/symmetries/lKappa_group_action.ml @@ -438,7 +438,7 @@ type bwd_bisim_info = * bool Mods.DynArray.t * LKappa_auto.cache ref -let saturate_domain_with_symmetric_patterns ~debugMode ~compileModeOn env +let saturate_domain_with_symmetric_patterns ~debug_mode ~compile_mode_on env bwd_bisim_info ccs domain = let sigs = Model.signatures env in let contact_map = Model.contact_map env in @@ -475,8 +475,8 @@ let saturate_domain_with_symmetric_patterns ~debugMode ~compileModeOn env let rule_mixture = lkappa_rule.LKappa.r_mix in let domain, _ = Pattern_compiler - .connected_components_sum_of_ambiguous_mixture ~debugMode - ~compileModeOn contact_map domain ?origin:None + .connected_components_sum_of_ambiguous_mixture ~debug_mode + ~compile_mode_on contact_map domain ?origin:None rule_mixture in domain) diff --git a/core/symmetries/lKappa_group_action.mli b/core/symmetries/lKappa_group_action.mli index 74cad59e0a..c918231fb3 100644 --- a/core/symmetries/lKappa_group_action.mli +++ b/core/symmetries/lKappa_group_action.mli @@ -151,8 +151,8 @@ val equiv_class : LKappa_auto.cache * bool Mods.DynArray.t * (LKappa.rule * int) list val saturate_domain_with_symmetric_patterns : - debugMode:bool -> - compileModeOn:bool -> + debug_mode:bool -> + compile_mode_on:bool -> Model.t -> bwd_bisim_info -> Pattern.id array list -> diff --git a/core/symmetries/pattern_group_action.ml b/core/symmetries/pattern_group_action.ml index 584a855d8a..a82de6cc2a 100644 --- a/core/symmetries/pattern_group_action.ml +++ b/core/symmetries/pattern_group_action.ml @@ -70,11 +70,10 @@ let add i j map = let pop i map = match Mods.IntMap.find_option i map with - | None -> raise (ExceptionDefn.Internal_Error ("Illegal map", Locality.dummy)) + | None -> raise (ExceptionDefn.Internal_Error ("Illegal map", Loc.dummy)) | Some [ a; b ] -> Mods.IntMap.add i [ b ] map, a | Some [ a ] -> Mods.IntMap.remove i map, a - | Some _ -> - raise (ExceptionDefn.Internal_Error ("Illegal map", Locality.dummy)) + | Some _ -> raise (ExceptionDefn.Internal_Error ("Illegal map", Loc.dummy)) (* Raw_mixture.agent list -> @@ -114,7 +113,7 @@ let enrich_binding_state raw_mixture = in let () = if not (Mods.IntMap.is_empty map) then - raise (ExceptionDefn.Internal_Error ("Illegal map", Locality.dummy)) + raise (ExceptionDefn.Internal_Error ("Illegal map", Loc.dummy)) in List.rev refined_raw_mixture_rev @@ -211,7 +210,7 @@ let fold_symmetries_over_raw_mixture get set f raw_mixture covering_list accu = (ExceptionDefn.Internal_Error ( "Arguments of fold_symmetries_over_rw_mixture shall have the same \ length", - Locality.dummy )) + Loc.dummy )) | h :: t, h' :: t' -> fold_symmetries_over_agent get set (fun _agent accu -> aux get set f t t' accu) diff --git a/core/symmetries/patterns_extra.ml b/core/symmetries/patterns_extra.ml index ae561b8e46..e0aca73a38 100644 --- a/core/symmetries/patterns_extra.ml +++ b/core/symmetries/patterns_extra.ml @@ -112,7 +112,7 @@ let raw_mixture_to_species ?parameters ?sigs preenv mix unspec = aux (ag_id + 1) tail (work, bond_map) in let work, _bond_map = aux 0 mix (work, Mods.IntMap.empty) in - let a, _, b, c = Pattern.finish_new ~debugMode:noCounters work in + let a, _, b, c = Pattern.finish_new ~debug_mode:noCounters work in let () = match sigs with | None -> () @@ -188,7 +188,7 @@ let mixture_to_pattern ?parameters ?sigs preenv mix unspec = aux (ag_id + 1) tail (work, bond_map) in let work, _bond_map = aux 0 mix (work, Mods.IntMap.empty) in - let a, _, b, c = Pattern.finish_new ~debugMode:noCounters work in + let a, _, b, c = Pattern.finish_new ~debug_mode:noCounters work in let () = match sigs with | None -> () @@ -493,7 +493,7 @@ let pattern_to_mixture ?parameters ~sigs pattern = let (), list = Mods.IntMap.monadic_fold2 () () (fun () () _ agent_type intf agent_list -> - let fst (a, _) = (a, Locality.dummy), LKappa.Maintained in + let fst (a, _) = (a, Loc.dummy), LKappa.Maintained in let snd (_, b) = match b with | None -> LKappa.I_ANY @@ -562,7 +562,7 @@ let lkappa_init = LKappa.r_delta_tokens = []; LKappa.r_rate = Alg_expr.int 0; LKappa.r_un_rate = None; - LKappa.r_editStyle = true; + LKappa.r_edit_style = true; } let raw_mixture_to_lkappa_rule raw_mixture = @@ -572,7 +572,7 @@ let raw_mixture_to_lkappa_rule raw_mixture = LKappa.r_delta_tokens = []; LKappa.r_rate = Alg_expr.int 0; LKappa.r_un_rate = None; - LKappa.r_editStyle = true; + LKappa.r_edit_style = true; } let rule_mixture_to_lkappa_rule rule_mixture = @@ -582,7 +582,7 @@ let rule_mixture_to_lkappa_rule rule_mixture = LKappa.r_delta_tokens = []; LKappa.r_rate = Alg_expr.int 0; LKappa.r_un_rate = None; - LKappa.r_editStyle = true; + LKappa.r_edit_style = true; } (*convert a species into lkappa rule signature*) diff --git a/core/symmetries/symmetries.ml b/core/symmetries/symmetries.ml index 65f8a927f5..d49920464e 100644 --- a/core/symmetries/symmetries.ml +++ b/core/symmetries/symmetries.ml @@ -229,13 +229,13 @@ let translate_to_lkappa_representation env partitioned_contact_map = Mods.StringMap.iter (fun agent_string partition -> let ag_id = - Signature.num_of_agent (Locality.dummy_annot agent_string) signature + Signature.num_of_agent (Loc.annot_with_dummy agent_string) signature in let interface = Signature.get signature ag_id in let partition = Symmetries_sig.map (fun site_string -> - Signature.num_of_site (Locality.dummy_annot site_string) interface) + Signature.num_of_site (Loc.annot_with_dummy site_string) interface) partition in array.(ag_id) <- partition) diff --git a/core/symmetries/symmetry_interface.ml b/core/symmetries/symmetry_interface.ml index dc7a493317..d083614bb4 100644 --- a/core/symmetries/symmetry_interface.ml +++ b/core/symmetries/symmetry_interface.ml @@ -9,7 +9,7 @@ type ast = Ast.parsing_compil type init = (Primitives.alg_expr * rule) list type compil = { - debugMode: bool; + debug_mode: bool; contact_map: Contact_map.t; environment: Model.t; init: init; @@ -23,7 +23,7 @@ type compil = { allow_empty_lhs: bool; } -let debug_mode compil = compil.debugMode +let debug_mode compil = compil.debug_mode let do_we_allow_empty_lhs compil = compil.allow_empty_lhs let to_dotnet compil = @@ -151,7 +151,7 @@ let print_chemical_species ?compil f = ~noCounters: (match compil with | None -> false - | Some c -> c.debugMode) + | Some c -> c.debug_mode) ~full_species:true ?sigs:(Option_util.map Model.signatures (environment_opt compil)) ?cc_id:None ~symbol_table:(symbol_table_opt compil) ~with_id:false) @@ -161,8 +161,8 @@ let print_token ?compil fmt k = let print_canonic_species = print_chemical_species -let nbr_automorphisms_in_chemical_species ~debugMode x = - List.length (Pattern.automorphisms ~debugMode x) +let nbr_automorphisms_in_chemical_species ~debug_mode x = + List.length (Pattern.automorphisms ~debug_mode x) let compare_connected_component = Pattern.compare_canonicals @@ -171,18 +171,18 @@ let print_connected_component ?compil = ~noCounters: (match compil with | None -> false - | Some c -> c.debugMode) + | Some c -> c.debug_mode) ?domain:(domain_opt compil) ~symbol_table:(symbol_table_opt compil) ~with_id:false let canonic_form x = x let connected_components_of_patterns = Array.to_list -let connected_components_of_mixture_sigs ~debugMode sigs cache contact_map_int e - = +let connected_components_of_mixture_sigs ~debug_mode sigs cache contact_map_int + e = let cache, acc = - Pattern_decompiler.patterns_of_mixture ~debugMode contact_map_int sigs cache - e + Pattern_decompiler.patterns_of_mixture ~debug_mode contact_map_int sigs + cache e in cache, acc @@ -191,7 +191,7 @@ let connected_components_of_mixture compil cache e = let contact_map = contact_map compil in let sigs = Pattern.Env.signatures (domain compil) in let cc_cache, acc = - Pattern_decompiler.patterns_of_mixture ~debugMode:compil.debugMode + Pattern_decompiler.patterns_of_mixture ~debug_mode:compil.debug_mode contact_map sigs cc_cache e in set_cc_cache cc_cache cache, acc @@ -206,10 +206,10 @@ let lift_embedding x = let find_all_embeddings compil cc = let tr = Primitives.fully_specified_pattern_to_positive_transformations cc in let env = environment compil in - let l = Evaluator.find_all_embeddings ~debugMode:true env tr in + let l = Evaluator.find_all_embeddings ~debug_mode:true env tr in Tools.remove_double_elements l -let add_fully_specified_to_graph ~debugMode sigs graph cc = +let add_fully_specified_to_graph ~debug_mode sigs graph cc = let e, g = Pattern.fold_by_type (fun ~pos ~agent_type intf (emb, g) -> @@ -237,21 +237,21 @@ let add_fully_specified_to_graph ~debugMode sigs graph cc = let r = Renaming.empty () in let out = Mods.IntMap.fold - (fun i (a, _) acc -> acc && Renaming.imperative_add ~debugMode i a r) + (fun i (a, _) acc -> acc && Renaming.imperative_add ~debug_mode i a r) e true in let () = assert out in g, r let find_embeddings compil = - Pattern.embeddings_to_fully_specified ~debugMode:compil.debugMode + Pattern.embeddings_to_fully_specified ~debug_mode:compil.debug_mode (domain compil) -let f ~debugMode ren acc (i, _cc) em = +let f ~debug_mode ren acc (i, _cc) em = List_util.map_flatten (fun m -> List_util.map_option - (fun r -> Matching.add_cc m i (Renaming.compose ~debugMode true r ren)) + (fun r -> Matching.add_cc m i (Renaming.compose ~debug_mode true r ren)) em) acc @@ -271,7 +271,7 @@ let f ~debugMode ren acc (i, _cc) em = let compose_embeddings_unary_binary compil p emb_list x = let mix, ren = - add_fully_specified_to_graph ~debugMode:compil.debugMode + add_fully_specified_to_graph ~debug_mode:compil.debug_mode (Model.signatures compil.environment) (Edges.empty ~with_connected_components:false) x @@ -279,19 +279,19 @@ let compose_embeddings_unary_binary compil p emb_list x = let cc_list = Tools.array_fold_lefti (fun i acc cc -> (i, cc) :: acc) [] p in let matc = List.fold_left2 - (f ~debugMode:compil.debugMode ren) + (f ~debug_mode:compil.debug_mode ren) [ Matching.empty ] cc_list emb_list in matc, mix -let disjoint_union_sigs ~debugMode sigs l = +let disjoint_union_sigs ~debug_mode sigs l = let pat = Tools.array_map_of_list (fun (x, _, _) -> x) l in let _, em, mix = List.fold_left (fun (i, em, mix) (_, r, cc) -> let i = pred i in - let mix', r' = add_fully_specified_to_graph ~debugMode sigs mix cc in - let r'' = Renaming.compose ~debugMode false r r' in + let mix', r' = add_fully_specified_to_graph ~debug_mode sigs mix cc in + let r'' = Renaming.compose ~debug_mode false r r' in i, Option_util.unsome Matching.empty (Matching.add_cc em i r''), mix') ( List.length l, Matching.empty, @@ -302,7 +302,7 @@ let disjoint_union_sigs ~debugMode sigs l = let disjoint_union compil l = let sigs = Model.signatures compil.environment in - disjoint_union_sigs ~debugMode:compil.debugMode sigs l + disjoint_union_sigs ~debug_mode:compil.debug_mode sigs l type rule_id = int type arity = Rule_modes.arity @@ -392,7 +392,7 @@ let print_rule ?compil = Kade_backend.Kappa_printer.elementary_rule ~noCounters:true ?env:None ?symbol_table:None | Some compil -> - Kade_backend.Kappa_printer.decompiled_rule ~noCounters:compil.debugMode + Kade_backend.Kappa_printer.decompiled_rule ~noCounters:compil.debug_mode ~full:true (environment compil) ~symbol_table:(symbol_table compil) let print_rule_name ?compil f r = @@ -402,7 +402,7 @@ let print_rule_name ?compil f r = ~noCounters: (match compil with | None -> false - | Some c -> c.debugMode) + | Some c -> c.debug_mode) ?env ~symbol_table:(symbol_table_opt compil) f id let string_of_var_id ?compil ?init_mode logger r = @@ -449,10 +449,10 @@ let rate_name compil rule rule_id = Format.asprintf "%a%s%s" (print_rule_name ~compil) rule arity_tag direction_tag -let apply_sigs ~debugMode env rule inj_nodes mix = +let apply_sigs ~debug_mode env rule inj_nodes mix = let concrete_removed = List.map - (Primitives.Transformation.concretize ~debugMode + (Primitives.Transformation.concretize ~debug_mode (inj_nodes, Mods.IntMap.empty)) rule.Primitives.removed in @@ -467,7 +467,7 @@ let apply_sigs ~debugMode env rule inj_nodes mix = List.fold_left (fun (x, p) h -> let x', h' = - Rule_interpreter.apply_positive_transformation ~debugMode + Rule_interpreter.apply_positive_transformation ~debug_mode (Model.signatures env) dummy_instances x h in x', h' :: p) @@ -484,7 +484,7 @@ let apply_sigs ~debugMode env rule inj_nodes mix = edges'' let apply compil rule inj_nodes mix = - apply_sigs ~debugMode:compil.debugMode compil.environment rule inj_nodes mix + apply_sigs ~debug_mode:compil.debug_mode compil.environment rule inj_nodes mix let get_rules compil = Model.fold_rules (fun _ acc r -> r :: acc) [] (environment compil) @@ -509,14 +509,15 @@ let get_obs_titles compil = (fun x -> remove_escape_char (Format.asprintf "%a" - (Kade_backend.Kappa_printer.alg_expr ~noCounters:compil.debugMode + (Kade_backend.Kappa_printer.alg_expr ~noCounters:compil.debug_mode ~env ~symbol_table:(symbol_table compil)) x)) env let get_preprocessed_ast cli_args = let warning ~pos msg = Data.print_warning ~pos Format.err_formatter msg in - Cli_init.get_preprocessed_ast_from_cli_args ~warning ~debugMode:false cli_args + Cli_init.get_preprocessed_ast_from_cli_args ~warning ~debug_mode:false + cli_args let to_preprocessed_ast x = x let get_ast cli_args = Cli_init.get_ast_from_cli_args cli_args @@ -524,42 +525,44 @@ let to_ast x = x let preprocess cli_args ast = let warning ~pos msg = Data.print_warning ~pos Format.err_formatter msg in - Cli_init.preprocess ~warning ~debugMode:false cli_args ast + Cli_init.preprocess_ast ~warning ~debug_mode:false cli_args ast -let saturate_domain_with_symmetric_patterns ~debugMode bwd_bisim_info env = +let saturate_domain_with_symmetric_patterns ~debug_mode bwd_bisim_info env = let contact_map = Model.contact_map env in let preenv' = Model.fold_mixture_in_expr (fun domain ccs -> - LKappa_group_action.saturate_domain_with_symmetric_patterns ~debugMode - ~compileModeOn:false env bwd_bisim_info ccs domain) + LKappa_group_action.saturate_domain_with_symmetric_patterns ~debug_mode + ~compile_mode_on:false env bwd_bisim_info ccs domain) (Pattern.PreEnv.of_env (Model.domain env)) env in let domain, _ = - Pattern.finalize ~debugMode ~sharing:Pattern.No_sharing preenv' contact_map + Pattern.finalize ~debug_mode ~sharing:Pattern.No_sharing preenv' contact_map in Model.new_domain domain env -let get_compil ~debugMode ~dotnet ?bwd_bisim ~rule_rate_convention +let get_compil ~debug_mode ~dotnet ?bwd_bisim ~rule_rate_convention ?reaction_rate_convention ~show_reactions ~count ~internal_meaning ~compute_jacobian cli_args preprocessed_ast = let warning ~pos msg = Data.print_warning ~pos Format.err_formatter msg in - let (_, env, contact_map, _, _, _, _, init), _ = + let compilation_result : Cli_init.compilation_result = Cli_init.get_compilation_from_preprocessed_ast ~warning cli_args preprocessed_ast in let env = match bwd_bisim with - | None -> env - | Some bsi -> saturate_domain_with_symmetric_patterns ~debugMode bsi env + | None -> compilation_result.env + | Some bsi -> + saturate_domain_with_symmetric_patterns ~debug_mode bsi + compilation_result.env in let compil = { - debugMode; + debug_mode; environment = env; - contact_map; - init; + contact_map = compilation_result.contact_map; + init = compilation_result.init_l; rule_rate_convention; reaction_rate_convention; show_reactions; @@ -603,19 +606,19 @@ let mixture_of_init compil c = let m = apply compil c emb m in m -let mixture_of_init_sigs ~debugMode env c = - let _, emb, m = disjoint_union_sigs ~debugMode (Model.signatures env) [] in - let m = apply_sigs ~debugMode env c emb m in +let mixture_of_init_sigs ~debug_mode env c = + let _, emb, m = disjoint_union_sigs ~debug_mode (Model.signatures env) [] in + let m = apply_sigs ~debug_mode env c emb m in m -let species_of_initial_state_env ~debugMode env contact_map_int cache list = +let species_of_initial_state_env ~debug_mode env contact_map_int cache list = let sigs = Model.signatures env in let cache, list = List.fold_left (fun (cache, list) (_, r) -> - let b = mixture_of_init_sigs ~debugMode env r in + let b = mixture_of_init_sigs ~debug_mode env r in let cache', acc = - connected_components_of_mixture_sigs ~debugMode sigs cache + connected_components_of_mixture_sigs ~debug_mode sigs cache contact_map_int b in cache', List.rev_append acc list) @@ -625,8 +628,8 @@ let species_of_initial_state_env ~debugMode env contact_map_int cache list = let species_of_initial_state compil cache list = let cc_cache, list = - species_of_initial_state_env ~debugMode:compil.debugMode compil.environment - (contact_map compil) (get_cc_cache cache) list + species_of_initial_state_env ~debug_mode:compil.debug_mode + compil.environment (contact_map compil) (get_cc_cache cache) list in set_cc_cache cc_cache cache, list diff --git a/core/symmetries/symmetry_interface_sig.ml b/core/symmetries/symmetry_interface_sig.ml index 226dccf4c5..0303c4b699 100644 --- a/core/symmetries/symmetry_interface_sig.ml +++ b/core/symmetries/symmetry_interface_sig.ml @@ -52,7 +52,7 @@ module type Interface = sig val symbol_table : compil -> Symbol_table.symbol_table val nbr_automorphisms_in_chemical_species : - debugMode:bool -> chemical_species -> int + debug_mode:bool -> chemical_species -> int val canonic_form : chemical_species -> canonic_species val connected_components_of_patterns : pattern -> connected_component list @@ -108,11 +108,11 @@ module type Interface = sig val token_vector : rule -> - ((connected_component array list, int) Alg_expr.e Locality.annot * int) list + ((connected_component array list, int) Alg_expr.e Loc.annoted * int) list val token_vector_of_init : rule -> - ((connected_component array list, int) Alg_expr.e Locality.annot * int) list + ((connected_component array list, int) Alg_expr.e Loc.annoted * int) list val print_rule_id : Format.formatter -> rule_id -> unit val print_rule : ?compil:compil -> Format.formatter -> rule -> unit @@ -129,7 +129,7 @@ module type Interface = sig compil -> rule -> rule_id_with_mode -> - (connected_component array list, int) Alg_expr.e Locality.annot option + (connected_component array list, int) Alg_expr.e Loc.annoted option val rate_name : compil -> rule -> rule_id_with_mode -> rule_name val apply : compil -> rule -> embedding_forest -> mixture -> mixture @@ -140,7 +140,7 @@ module type Interface = sig val preprocess : Run_cli_args.t -> ast -> preprocessed_ast val get_compil : - debugMode:bool -> + debug_mode:bool -> dotnet:bool -> ?bwd_bisim:LKappa_group_action.bwd_bisim_info -> rule_rate_convention:Remanent_parameters_sig.rate_convention -> @@ -157,7 +157,7 @@ module type Interface = sig val get_variables : compil -> - (string * (connected_component array list, int) Alg_expr.e Locality.annot) + (string * (connected_component array list, int) Alg_expr.e Loc.annoted) array val get_obs : compil -> (connected_component array list, int) Alg_expr.e list @@ -169,7 +169,7 @@ module type Interface = sig val divide_rule_rate_by : cache -> compil -> rule -> cache * int val species_of_initial_state_env : - debugMode:bool -> + debug_mode:bool -> Model.t -> Contact_map.t -> Pattern.PreEnv.t -> diff --git a/core/symmetries/symmetry_interface_sig.mli b/core/symmetries/symmetry_interface_sig.mli index 372da149e0..96b7d0bfd4 100644 --- a/core/symmetries/symmetry_interface_sig.mli +++ b/core/symmetries/symmetry_interface_sig.mli @@ -52,7 +52,7 @@ module type Interface = sig val symbol_table : compil -> Symbol_table.symbol_table val nbr_automorphisms_in_chemical_species : - debugMode:bool -> chemical_species -> int + debug_mode:bool -> chemical_species -> int val canonic_form : chemical_species -> canonic_species val connected_components_of_patterns : pattern -> connected_component list @@ -108,11 +108,11 @@ module type Interface = sig val token_vector : rule -> - ((connected_component array list, int) Alg_expr.e Locality.annot * int) list + ((connected_component array list, int) Alg_expr.e Loc.annoted * int) list val token_vector_of_init : rule -> - ((connected_component array list, int) Alg_expr.e Locality.annot * int) list + ((connected_component array list, int) Alg_expr.e Loc.annoted * int) list val print_rule_id : Format.formatter -> rule_id -> unit val print_rule : ?compil:compil -> Format.formatter -> rule -> unit @@ -128,7 +128,7 @@ module type Interface = sig compil -> rule -> rule_id_with_mode -> - (connected_component array list, int) Alg_expr.e Locality.annot option + (connected_component array list, int) Alg_expr.e Loc.annoted option val rate_name : compil -> rule -> rule_id_with_mode -> rule_name val apply : compil -> rule -> embedding_forest -> mixture -> mixture @@ -139,7 +139,7 @@ module type Interface = sig val preprocess : Run_cli_args.t -> ast -> preprocessed_ast val get_compil : - debugMode:bool -> + debug_mode:bool -> dotnet:bool -> ?bwd_bisim:LKappa_group_action.bwd_bisim_info -> rule_rate_convention:Remanent_parameters_sig.rate_convention -> @@ -156,7 +156,7 @@ module type Interface = sig val get_variables : compil -> - (string * (connected_component array list, int) Alg_expr.e Locality.annot) + (string * (connected_component array list, int) Alg_expr.e Loc.annoted) array val get_obs : compil -> (connected_component array list, int) Alg_expr.e list @@ -168,7 +168,7 @@ module type Interface = sig val divide_rule_rate_by : cache -> compil -> rule -> cache * int val species_of_initial_state_env : - debugMode:bool -> + debug_mode:bool -> Model.t -> Contact_map.t -> Pattern.PreEnv.t -> diff --git a/core/term/alg_expr.ml b/core/term/alg_expr.ml index df2867a7dd..51bf912ef1 100644 --- a/core/term/alg_expr.ml +++ b/core/term/alg_expr.ml @@ -11,53 +11,47 @@ type pervasives_bool = bool type ('mix, 'id) e = | BIN_ALG_OP of Operator.bin_alg_op - * ('mix, 'id) e Locality.annot - * ('mix, 'id) e Locality.annot - | UN_ALG_OP of Operator.un_alg_op * ('mix, 'id) e Locality.annot + * ('mix, 'id) e Loc.annoted + * ('mix, 'id) e Loc.annoted + | UN_ALG_OP of Operator.un_alg_op * ('mix, 'id) e Loc.annoted | STATE_ALG_OP of Operator.state_alg_op | ALG_VAR of 'id | KAPPA_INSTANCE of 'mix | TOKEN_ID of 'id | CONST of Nbr.t | IF of - ('mix, 'id) bool Locality.annot - * ('mix, 'id) e Locality.annot - * ('mix, 'id) e Locality.annot - | DIFF_TOKEN of (('mix, 'id) e Locality.annot * 'id) - | DIFF_KAPPA_INSTANCE of (('mix, 'id) e Locality.annot * 'mix) + ('mix, 'id) bool Loc.annoted + * ('mix, 'id) e Loc.annoted + * ('mix, 'id) e Loc.annoted + | DIFF_TOKEN of (('mix, 'id) e Loc.annoted * 'id) + | DIFF_KAPPA_INSTANCE of (('mix, 'id) e Loc.annoted * 'mix) and ('mix, 'id) bool = | TRUE | FALSE | BIN_BOOL_OP of Operator.bin_bool_op - * ('mix, 'id) bool Locality.annot - * ('mix, 'id) bool Locality.annot - | UN_BOOL_OP of Operator.un_bool_op * ('mix, 'id) bool Locality.annot + * ('mix, 'id) bool Loc.annoted + * ('mix, 'id) bool Loc.annoted + | UN_BOOL_OP of Operator.un_bool_op * ('mix, 'id) bool Loc.annoted | COMPARE_OP of Operator.compare_op - * ('mix, 'id) e Locality.annot - * ('mix, 'id) e Locality.annot + * ('mix, 'id) e Loc.annoted + * ('mix, 'id) e Loc.annoted let rec e_to_yojson ~filenames f_mix f_id = function | BIN_ALG_OP (op, a, b) -> `List [ Operator.bin_alg_op_to_json op; - Locality.annot_to_yojson ~filenames - (e_to_yojson ~filenames f_mix f_id) - a; - Locality.annot_to_yojson ~filenames - (e_to_yojson ~filenames f_mix f_id) - b; + Loc.yojson_of_annoted ~filenames (e_to_yojson ~filenames f_mix f_id) a; + Loc.yojson_of_annoted ~filenames (e_to_yojson ~filenames f_mix f_id) b; ] | UN_ALG_OP (op, a) -> `List [ Operator.un_alg_op_to_json op; - Locality.annot_to_yojson ~filenames - (e_to_yojson ~filenames f_mix f_id) - a; + Loc.yojson_of_annoted ~filenames (e_to_yojson ~filenames f_mix f_id) a; ] | STATE_ALG_OP op -> Operator.state_alg_op_to_json op | ALG_VAR i -> `List [ `String "VAR"; f_id i ] @@ -68,21 +62,17 @@ let rec e_to_yojson ~filenames f_mix f_id = function `List [ `String "IF"; - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (bool_to_yojson ~filenames f_mix f_id) cond; - Locality.annot_to_yojson ~filenames - (e_to_yojson ~filenames f_mix f_id) - yes; - Locality.annot_to_yojson ~filenames - (e_to_yojson ~filenames f_mix f_id) - no; + Loc.yojson_of_annoted ~filenames (e_to_yojson ~filenames f_mix f_id) yes; + Loc.yojson_of_annoted ~filenames (e_to_yojson ~filenames f_mix f_id) no; ] | DIFF_TOKEN (expr, token) -> `List [ `String "DIFF_TOKEN"; - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (e_to_yojson ~filenames f_mix f_id) expr; f_id token; @@ -91,7 +81,7 @@ let rec e_to_yojson ~filenames f_mix f_id = function `List [ `String "DIFF_MIXTURE"; - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (e_to_yojson ~filenames f_mix f_id) expr; f_mix mixture; @@ -104,7 +94,7 @@ and bool_to_yojson ~filenames f_mix f_id = function `List [ Operator.un_bool_op_to_json op; - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (bool_to_yojson ~filenames f_mix f_id) a; ] @@ -112,10 +102,10 @@ and bool_to_yojson ~filenames f_mix f_id = function `List [ Operator.bin_bool_op_to_json op; - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (bool_to_yojson ~filenames f_mix f_id) a; - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (bool_to_yojson ~filenames f_mix f_id) b; ] @@ -123,56 +113,41 @@ and bool_to_yojson ~filenames f_mix f_id = function `List [ Operator.compare_op_to_json op; - Locality.annot_to_yojson ~filenames - (e_to_yojson ~filenames f_mix f_id) - a; - Locality.annot_to_yojson ~filenames - (e_to_yojson ~filenames f_mix f_id) - b; + Loc.yojson_of_annoted ~filenames (e_to_yojson ~filenames f_mix f_id) a; + Loc.yojson_of_annoted ~filenames (e_to_yojson ~filenames f_mix f_id) b; ] let rec e_of_yojson ~filenames f_mix f_id = function | `List [ `String "DIFF_MIXTURE"; expr; mixture ] -> DIFF_KAPPA_INSTANCE - ( Locality.annot_of_yojson ~filenames - (e_of_yojson ~filenames f_mix f_id) - expr, + ( Loc.annoted_of_yojson ~filenames (e_of_yojson ~filenames f_mix f_id) expr, f_mix mixture ) | `List [ `String "DIFF_TOKEN"; expr; tok ] -> DIFF_TOKEN - ( Locality.annot_of_yojson ~filenames - (e_of_yojson ~filenames f_mix f_id) - expr, + ( Loc.annoted_of_yojson ~filenames (e_of_yojson ~filenames f_mix f_id) expr, f_id tok ) | `List [ op; a; b ] -> BIN_ALG_OP ( Operator.bin_alg_op_of_json op, - Locality.annot_of_yojson ~filenames - (e_of_yojson ~filenames f_mix f_id) - a, - Locality.annot_of_yojson ~filenames - (e_of_yojson ~filenames f_mix f_id) - b ) + Loc.annoted_of_yojson ~filenames (e_of_yojson ~filenames f_mix f_id) a, + Loc.annoted_of_yojson ~filenames (e_of_yojson ~filenames f_mix f_id) b + ) | `List [ `String "VAR"; i ] -> ALG_VAR (f_id i) | `List [ `String "TOKEN"; i ] -> TOKEN_ID (f_id i) | `List [ `String "MIX"; cc ] -> KAPPA_INSTANCE (f_mix cc) | `List [ op; a ] -> UN_ALG_OP ( Operator.un_alg_op_of_json op, - Locality.annot_of_yojson ~filenames - (e_of_yojson ~filenames f_mix f_id) - a ) + Loc.annoted_of_yojson ~filenames (e_of_yojson ~filenames f_mix f_id) a + ) | `List [ `String "IF"; cond; yes; no ] -> IF - ( Locality.annot_of_yojson ~filenames + ( Loc.annoted_of_yojson ~filenames (bool_of_yojson ~filenames f_mix f_id) cond, - Locality.annot_of_yojson ~filenames - (e_of_yojson ~filenames f_mix f_id) - yes, - Locality.annot_of_yojson ~filenames - (e_of_yojson ~filenames f_mix f_id) - no ) + Loc.annoted_of_yojson ~filenames (e_of_yojson ~filenames f_mix f_id) yes, + Loc.annoted_of_yojson ~filenames (e_of_yojson ~filenames f_mix f_id) no + ) | x -> (try STATE_ALG_OP (Operator.state_alg_op_of_json x) with Yojson.Basic.Util.Type_error _ -> @@ -189,27 +164,27 @@ and bool_of_yojson ~filenames f_mix f_id = function | `List [ op; a ] -> UN_BOOL_OP ( Operator.un_bool_op_of_json op, - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (bool_of_yojson ~filenames f_mix f_id) a ) | `List [ op; a; b ] as x -> (try BIN_BOOL_OP ( Operator.bin_bool_op_of_json op, - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (bool_of_yojson ~filenames f_mix f_id) a, - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (bool_of_yojson ~filenames f_mix f_id) b ) with Yojson.Basic.Util.Type_error _ -> (try COMPARE_OP ( Operator.compare_op_of_json op, - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (e_of_yojson ~filenames f_mix f_id) a, - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (e_of_yojson ~filenames f_mix f_id) b ) with Yojson.Basic.Util.Type_error _ -> @@ -267,24 +242,24 @@ and print_bool pr_mix pr_tok pr_var f = function (print pr_mix pr_tok pr_var) b -let const n = Locality.dummy_annot (CONST n) +let const n = Loc.annot_with_dummy (CONST n) let int i = const (Nbr.I i) let float f = const (Nbr.F f) -let add e1 e2 = Locality.dummy_annot (BIN_ALG_OP (Operator.SUM, e1, e2)) -let minus e1 e2 = Locality.dummy_annot (BIN_ALG_OP (Operator.MINUS, e1, e2)) -let mult e1 e2 = Locality.dummy_annot (BIN_ALG_OP (Operator.MULT, e1, e2)) -let div e1 e2 = Locality.dummy_annot (BIN_ALG_OP (Operator.DIV, e1, e2)) -let pow e1 e2 = Locality.dummy_annot (BIN_ALG_OP (Operator.POW, e1, e2)) -let log e1 = Locality.dummy_annot (UN_ALG_OP (Operator.LOG, e1)) +let add e1 e2 = Loc.annot_with_dummy (BIN_ALG_OP (Operator.SUM, e1, e2)) +let minus e1 e2 = Loc.annot_with_dummy (BIN_ALG_OP (Operator.MINUS, e1, e2)) +let mult e1 e2 = Loc.annot_with_dummy (BIN_ALG_OP (Operator.MULT, e1, e2)) +let div e1 e2 = Loc.annot_with_dummy (BIN_ALG_OP (Operator.DIV, e1, e2)) +let pow e1 e2 = Loc.annot_with_dummy (BIN_ALG_OP (Operator.POW, e1, e2)) +let log e1 = Loc.annot_with_dummy (UN_ALG_OP (Operator.LOG, e1)) let ln e1 = (* JF: If I rememnber well *) div (log e1) (log (int 10)) -let sin e1 = Locality.dummy_annot (UN_ALG_OP (Operator.SINUS, e1)) -let cos e1 = Locality.dummy_annot (UN_ALG_OP (Operator.COSINUS, e1)) -let uminus e1 = Locality.dummy_annot (UN_ALG_OP (Operator.UMINUS, e1)) -let sqrt e1 = Locality.dummy_annot (UN_ALG_OP (Operator.SQRT, e1)) +let sin e1 = Loc.annot_with_dummy (UN_ALG_OP (Operator.SINUS, e1)) +let cos e1 = Loc.annot_with_dummy (UN_ALG_OP (Operator.COSINUS, e1)) +let uminus e1 = Loc.annot_with_dummy (UN_ALG_OP (Operator.UMINUS, e1)) +let sqrt e1 = Loc.annot_with_dummy (UN_ALG_OP (Operator.SQRT, e1)) let rec add_dep ((in_t, in_e, toks_d, out) as x) d = function | BIN_ALG_OP (_, a, b), _ -> add_dep (add_dep x d a) d b @@ -409,12 +384,13 @@ let setup_alg_vars_rev_dep toks vars = (fun i x (_, y) -> add_dep x (Operator.ALG i) y) (in_t, in_e, toks_d, out) vars -let rec propagate_constant ~warning ?max_time ?max_events updated_vars vars = +let rec propagate_constant ~warning ?max_time ?max_events ~updated_vars ~vars = function | (BIN_ALG_OP (op, a, b), pos) as x -> (match - ( propagate_constant ~warning ?max_time ?max_events updated_vars vars a, - propagate_constant ~warning ?max_time ?max_events updated_vars vars b ) + ( propagate_constant ~warning ?max_time ?max_events ~updated_vars ~vars a, + propagate_constant ~warning ?max_time ?max_events ~updated_vars ~vars b + ) with | (CONST c1, _), (CONST c2, _) -> CONST (Nbr.of_bin_alg_op op c1 c2), pos | ( (( ( BIN_ALG_OP _ | UN_ALG_OP _ | STATE_ALG_OP _ | KAPPA_INSTANCE _ @@ -431,7 +407,7 @@ let rec propagate_constant ~warning ?max_time ?max_events updated_vars vars = BIN_ALG_OP (op, a', b'), pos) | (UN_ALG_OP (op, a), pos) as x -> (match - propagate_constant ~warning ?max_time ?max_events updated_vars vars a + propagate_constant ~warning ?max_time ?max_events ~updated_vars ~vars a with | CONST c, _ -> CONST (Nbr.of_un_alg_op op c), pos | ( ( DIFF_TOKEN _ | DIFF_KAPPA_INSTANCE _ | BIN_ALG_OP _ | UN_ALG_OP _ @@ -443,7 +419,7 @@ let rec propagate_constant ~warning ?max_time ?max_events updated_vars vars = UN_ALG_OP (op, a'), pos) | (DIFF_TOKEN (a, t), pos) as x -> (match - propagate_constant ~warning ?max_time ?max_events updated_vars vars a + propagate_constant ~warning ?max_time ?max_events ~updated_vars ~vars a with | CONST _, _ -> (* the derivative of a constant is zero *) @@ -457,7 +433,7 @@ let rec propagate_constant ~warning ?max_time ?max_events updated_vars vars = DIFF_TOKEN (a', t), pos) | (DIFF_KAPPA_INSTANCE (a, m), pos) as x -> (match - propagate_constant ~warning ?max_time ?max_events updated_vars vars a + propagate_constant ~warning ?max_time ?max_events ~updated_vars ~vars a with | CONST _, _ -> (* the derivative of a constant is zero *) @@ -513,29 +489,29 @@ let rec propagate_constant ~warning ?max_time ?max_events updated_vars vars = | ((KAPPA_INSTANCE _ | TOKEN_ID _ | CONST _), _) as x -> x | IF (cond, yes, no), pos -> (match - propagate_constant_bool ~warning ?max_time ?max_events updated_vars vars - cond + propagate_constant_bool ~warning ?max_time ?max_events ~updated_vars + ~vars cond with | TRUE, _ -> - propagate_constant ~warning ?max_time ?max_events updated_vars vars yes + propagate_constant ~warning ?max_time ?max_events ~updated_vars ~vars yes | FALSE, _ -> - propagate_constant ~warning ?max_time ?max_events updated_vars vars no + propagate_constant ~warning ?max_time ?max_events ~updated_vars ~vars no | ((BIN_BOOL_OP _ | COMPARE_OP _ | UN_BOOL_OP _), _) as cond' -> ( IF ( cond', - propagate_constant ~warning ?max_time ?max_events updated_vars vars - yes, - propagate_constant ~warning ?max_time ?max_events updated_vars vars - no ), + propagate_constant ~warning ?max_time ?max_events ~updated_vars + ~vars yes, + propagate_constant ~warning ?max_time ?max_events ~updated_vars + ~vars no ), pos )) -and propagate_constant_bool ~warning ?max_time ?max_events updated_vars vars = +and propagate_constant_bool ~warning ?max_time ?max_events ~updated_vars ~vars = function | ((TRUE | FALSE), _) as x -> x | UN_BOOL_OP (op, a), pos -> (match - ( propagate_constant_bool ~warning ?max_time ?max_events updated_vars - vars a, + ( propagate_constant_bool ~warning ?max_time ?max_events ~updated_vars + ~vars a, op ) with | (TRUE, _), Operator.NOT -> FALSE, pos @@ -544,18 +520,19 @@ and propagate_constant_bool ~warning ?max_time ?max_events updated_vars vars = UN_BOOL_OP (op, a'), pos) | BIN_BOOL_OP (op, a, b), pos -> (match - ( propagate_constant_bool ~warning ?max_time ?max_events updated_vars - vars a, + ( propagate_constant_bool ~warning ?max_time ?max_events ~updated_vars + ~vars a, op ) with | (TRUE, _), Operator.OR -> TRUE, pos | (FALSE, _), Operator.AND -> FALSE, pos | (TRUE, _), Operator.AND | (FALSE, _), Operator.OR -> - propagate_constant_bool ~warning ?max_time ?max_events updated_vars vars b + propagate_constant_bool ~warning ?max_time ?max_events ~updated_vars ~vars + b | (((BIN_BOOL_OP _ | COMPARE_OP _ | UN_BOOL_OP _), _) as a'), _ -> (match - ( propagate_constant_bool ~warning ?max_time ?max_events updated_vars - vars b, + ( propagate_constant_bool ~warning ?max_time ?max_events ~updated_vars + ~vars b, op ) with | (TRUE, _), Operator.OR -> TRUE, pos @@ -565,10 +542,10 @@ and propagate_constant_bool ~warning ?max_time ?max_events updated_vars vars = BIN_BOOL_OP (op, a', b'), pos)) | COMPARE_OP (op, a, b), pos -> let a' = - propagate_constant ~warning ?max_time ?max_events updated_vars vars a + propagate_constant ~warning ?max_time ?max_events ~updated_vars ~vars a in let b' = - propagate_constant ~warning ?max_time ?max_events updated_vars vars b + propagate_constant ~warning ?max_time ?max_events ~updated_vars ~vars b in (match a', b' with | (CONST n1, _), (CONST n2, _) -> diff --git a/core/term/alg_expr.mli b/core/term/alg_expr.mli index 845891cd64..6f214f794f 100644 --- a/core/term/alg_expr.mli +++ b/core/term/alg_expr.mli @@ -11,33 +11,33 @@ type pervasives_bool = bool type ('mix, 'id) e = | BIN_ALG_OP of Operator.bin_alg_op - * ('mix, 'id) e Locality.annot - * ('mix, 'id) e Locality.annot - | UN_ALG_OP of Operator.un_alg_op * ('mix, 'id) e Locality.annot + * ('mix, 'id) e Loc.annoted + * ('mix, 'id) e Loc.annoted + | UN_ALG_OP of Operator.un_alg_op * ('mix, 'id) e Loc.annoted | STATE_ALG_OP of Operator.state_alg_op | ALG_VAR of 'id | KAPPA_INSTANCE of 'mix | TOKEN_ID of 'id | CONST of Nbr.t | IF of - ('mix, 'id) bool Locality.annot - * ('mix, 'id) e Locality.annot - * ('mix, 'id) e Locality.annot - | DIFF_TOKEN of (('mix, 'id) e Locality.annot * 'id) - | DIFF_KAPPA_INSTANCE of (('mix, 'id) e Locality.annot * 'mix) + ('mix, 'id) bool Loc.annoted + * ('mix, 'id) e Loc.annoted + * ('mix, 'id) e Loc.annoted + | DIFF_TOKEN of (('mix, 'id) e Loc.annoted * 'id) + | DIFF_KAPPA_INSTANCE of (('mix, 'id) e Loc.annoted * 'mix) and ('mix, 'id) bool = | TRUE | FALSE | BIN_BOOL_OP of Operator.bin_bool_op - * ('mix, 'id) bool Locality.annot - * ('mix, 'id) bool Locality.annot - | UN_BOOL_OP of Operator.un_bool_op * ('mix, 'id) bool Locality.annot + * ('mix, 'id) bool Loc.annoted + * ('mix, 'id) bool Loc.annoted + | UN_BOOL_OP of Operator.un_bool_op * ('mix, 'id) bool Loc.annoted | COMPARE_OP of Operator.compare_op - * ('mix, 'id) e Locality.annot - * ('mix, 'id) e Locality.annot + * ('mix, 'id) e Loc.annoted + * ('mix, 'id) e Loc.annoted val e_to_yojson : filenames:int Mods.StringMap.t -> @@ -83,42 +83,32 @@ val print_bool : ('a, 'b) bool -> unit -val const : Nbr.t -> ('a, 'b) e Locality.annot +val const : Nbr.t -> ('a, 'b) e Loc.annoted (** {2 Smart constructor } *) -val int : int -> ('a, 'b) e Locality.annot -val float : float -> ('a, 'b) e Locality.annot +val int : int -> ('a, 'b) e Loc.annoted +val float : float -> ('a, 'b) e Loc.annoted val add : - ('a, 'b) e Locality.annot -> - ('a, 'b) e Locality.annot -> - ('a, 'b) e Locality.annot + ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted val minus : - ('a, 'b) e Locality.annot -> - ('a, 'b) e Locality.annot -> - ('a, 'b) e Locality.annot + ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted val mult : - ('a, 'b) e Locality.annot -> - ('a, 'b) e Locality.annot -> - ('a, 'b) e Locality.annot + ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted val div : - ('a, 'b) e Locality.annot -> - ('a, 'b) e Locality.annot -> - ('a, 'b) e Locality.annot + ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted val pow : - ('a, 'b) e Locality.annot -> - ('a, 'b) e Locality.annot -> - ('a, 'b) e Locality.annot + ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted -val ln : ('a, 'b) e Locality.annot -> ('a, 'b) e Locality.annot -val uminus : ('a, 'b) e Locality.annot -> ('a, 'b) e Locality.annot -val sin : ('a, 'b) e Locality.annot -> ('a, 'b) e Locality.annot -val cos : ('a, 'b) e Locality.annot -> ('a, 'b) e Locality.annot -val sqrt : ('a, 'b) e Locality.annot -> ('a, 'b) e Locality.annot +val ln : ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted +val uminus : ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted +val sin : ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted +val cos : ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted +val sqrt : ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted val add_dep : Operator.DepSet.t @@ -126,7 +116,7 @@ val add_dep : * Operator.DepSet.t array * Operator.DepSet.t array -> Operator.rev_dep -> - ('a, int) e Locality.annot -> + ('a, int) e Loc.annoted -> Operator.DepSet.t * Operator.DepSet.t * Operator.DepSet.t array @@ -139,7 +129,7 @@ val add_dep_bool : * Operator.DepSet.t array * Operator.DepSet.t array -> Operator.rev_dep -> - ('a, int) bool Locality.annot -> + ('a, int) bool Loc.annoted -> Operator.DepSet.t * Operator.DepSet.t * Operator.DepSet.t array @@ -147,16 +137,16 @@ val add_dep_bool : val setup_alg_vars_rev_dep : unit NamedDecls.t -> - (string Locality.annot * ('a, int) e Locality.annot) array -> + (string Loc.annoted * ('a, int) e Loc.annoted) array -> Operator.DepSet.t * Operator.DepSet.t * Operator.DepSet.t array * Operator.DepSet.t array val has_mix : ?var_decls:('b -> ('c, 'b) e) -> ('a, 'b) e -> pervasives_bool -val is_constant : ('a, 'b) e Locality.annot -> pervasives_bool +val is_constant : ('a, 'b) e Loc.annoted -> pervasives_bool -val is_time_homogeneous : ('a, 'b) e Locality.annot -> pervasives_bool +val is_time_homogeneous : ('a, 'b) e Loc.annoted -> pervasives_bool (** does not take into account symbolic propagation of expression *) val has_progress_dep : @@ -165,29 +155,29 @@ val has_progress_dep : * Operator.DepSet.t * Operator.DepSet.t array * Operator.DepSet.t array -> - ('a, int) e Locality.annot -> + ('a, int) e Loc.annoted -> pervasives_bool -val extract_connected_components : ('a, 'b) e Locality.annot -> 'a list -val extract_connected_components_bool : ('a, 'b) bool Locality.annot -> 'a list +val extract_connected_components : ('a, 'b) e Loc.annoted -> 'a list +val extract_connected_components_bool : ('a, 'b) bool Loc.annoted -> 'a list val propagate_constant : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> ?max_time:float -> ?max_events:int -> - int list -> - (string Locality.annot * ('a, int) e Locality.annot) array -> - ('a, int) e Locality.annot -> - ('a, int) e Locality.annot + updated_vars:int list -> + vars:(string Loc.annoted * ('a, int) e Loc.annoted) array -> + ('a, int) e Loc.annoted -> + ('a, int) e Loc.annoted val propagate_constant_bool : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> ?max_time:float -> ?max_events:int -> - int list -> - (string Locality.annot * ('a, int) e Locality.annot) array -> - ('a, int) bool Locality.annot -> - ('a, int) bool Locality.annot + updated_vars:int list -> + vars:(string Loc.annoted * ('a, int) e Loc.annoted) array -> + ('a, int) bool Loc.annoted -> + ('a, int) bool Loc.annoted val is_equality_test_time : Operator.DepSet.t @@ -198,23 +188,18 @@ val is_equality_test_time : pervasives_bool val map_on_mixture : - ('a -> ('c, 'b) e) -> ('a, 'b) e Locality.annot -> ('c, 'b) e Locality.annot + ('a -> ('c, 'b) e) -> ('a, 'b) e Loc.annoted -> ('c, 'b) e Loc.annoted val map_bool_on_mixture : - ('a -> ('c, 'b) e) -> - ('a, 'b) bool Locality.annot -> - ('c, 'b) bool Locality.annot + ('a -> ('c, 'b) e) -> ('a, 'b) bool Loc.annoted -> ('c, 'b) bool Loc.annoted -val fold_on_mixture : ('a -> 'b -> 'a) -> 'a -> ('b, 'c) e Locality.annot -> 'a +val fold_on_mixture : ('a -> 'b -> 'a) -> 'a -> ('b, 'c) e Loc.annoted -> 'a val fold_bool_on_mixture : - ('a -> 'b -> 'a) -> 'a -> ('b, 'c) bool Locality.annot -> 'a + ('a -> 'b -> 'a) -> 'a -> ('b, 'c) bool Loc.annoted -> 'a -val equal : - ('a, 'b) e Locality.annot -> ('a, 'b) e Locality.annot -> pervasives_bool +val equal : ('a, 'b) e Loc.annoted -> ('a, 'b) e Loc.annoted -> pervasives_bool (** Syntactic equality up to positions but not associativity and comutativity *) val equal_bool : - ('a, 'b) bool Locality.annot -> - ('a, 'b) bool Locality.annot -> - pervasives_bool + ('a, 'b) bool Loc.annoted -> ('a, 'b) bool Loc.annoted -> pervasives_bool diff --git a/core/term/alg_expr_extra.ml b/core/term/alg_expr_extra.ml index 839059a2b1..94b9e5f945 100644 --- a/core/term/alg_expr_extra.ml +++ b/core/term/alg_expr_extra.ml @@ -7,14 +7,14 @@ (******************************************************************************) let divide_expr_by_int e i = - Locality.dummy_annot + Loc.annot_with_dummy (Alg_expr.BIN_ALG_OP - (Operator.DIV, e, Locality.dummy_annot (Alg_expr.CONST (Nbr.I i)))) + (Operator.DIV, e, Loc.annot_with_dummy (Alg_expr.CONST (Nbr.I i)))) type ('a, 'b) corrected_rate_const = { num: Nbr.t; den: Nbr.t; - var: ('a, 'b) Alg_expr.e Locality.annot option; + var: ('a, 'b) Alg_expr.e Loc.annoted option; } let rec simplify ?(root_only = false) expr = @@ -364,29 +364,29 @@ let rec clean expr = let expr = fst expr in match expr with | Alg_expr.BIN_ALG_OP (op, a, b) -> - Locality.dummy_annot (Alg_expr.BIN_ALG_OP (op, clean a, clean b)) + Loc.annot_with_dummy (Alg_expr.BIN_ALG_OP (op, clean a, clean b)) | Alg_expr.UN_ALG_OP (op, a) -> - Locality.dummy_annot (Alg_expr.UN_ALG_OP (op, clean a)) + Loc.annot_with_dummy (Alg_expr.UN_ALG_OP (op, clean a)) | Alg_expr.DIFF_TOKEN (expr, dt) -> - Locality.dummy_annot (Alg_expr.DIFF_TOKEN (clean expr, dt)) + Loc.annot_with_dummy (Alg_expr.DIFF_TOKEN (clean expr, dt)) | Alg_expr.DIFF_KAPPA_INSTANCE (expr, dt) -> - Locality.dummy_annot (Alg_expr.DIFF_KAPPA_INSTANCE (clean expr, dt)) + Loc.annot_with_dummy (Alg_expr.DIFF_KAPPA_INSTANCE (clean expr, dt)) | Alg_expr.STATE_ALG_OP _ | Alg_expr.ALG_VAR _ | Alg_expr.KAPPA_INSTANCE _ | Alg_expr.TOKEN_ID _ | Alg_expr.CONST _ -> - Locality.dummy_annot expr + Loc.annot_with_dummy expr | Alg_expr.IF (cond, yes, no) -> - Locality.dummy_annot (Alg_expr.IF (clean_bool cond, clean yes, clean no)) + Loc.annot_with_dummy (Alg_expr.IF (clean_bool cond, clean yes, clean no)) and clean_bool expr_bool = let expr = fst expr_bool in match expr with - | Alg_expr.TRUE | Alg_expr.FALSE -> Locality.dummy_annot expr + | Alg_expr.TRUE | Alg_expr.FALSE -> Loc.annot_with_dummy expr | Alg_expr.UN_BOOL_OP (op, a) -> - Locality.dummy_annot (Alg_expr.UN_BOOL_OP (op, clean_bool a)) + Loc.annot_with_dummy (Alg_expr.UN_BOOL_OP (op, clean_bool a)) | Alg_expr.BIN_BOOL_OP (op, a, b) -> - Locality.dummy_annot (Alg_expr.BIN_BOOL_OP (op, clean_bool a, clean_bool b)) + Loc.annot_with_dummy (Alg_expr.BIN_BOOL_OP (op, clean_bool a, clean_bool b)) | Alg_expr.COMPARE_OP (op, a, b) -> - Locality.dummy_annot (Alg_expr.COMPARE_OP (op, clean a, clean b)) + Loc.annot_with_dummy (Alg_expr.COMPARE_OP (op, clean a, clean b)) let rec get_corrected_rate e = match e with @@ -491,7 +491,7 @@ let dep empty add_mixture add_token union dep_env ?time_var expr = let rec diff_gen f_mix f_token f_symb f_time expr = match fst expr with | Alg_expr.IF (b, e1, e2) -> - Locality.dummy_annot + Loc.annot_with_dummy (Alg_expr.IF ( b, diff_gen f_mix f_token f_symb f_time e1, @@ -572,7 +572,7 @@ let diff_token expr token = else Alg_expr.int 0 in - let f_symb expr = Alg_expr.DIFF_TOKEN (expr, token), Locality.dummy in + let f_symb expr = Alg_expr.DIFF_TOKEN (expr, token), Loc.dummy in let f_time _ = Alg_expr.int 0 in diff_gen f_mix f_token f_symb f_time expr @@ -584,9 +584,7 @@ let diff_mixture ?time_var expr mixture = Alg_expr.int 0 in let f_token _ = Alg_expr.int 0 in - let f_symb expr = - Alg_expr.DIFF_KAPPA_INSTANCE (expr, mixture), Locality.dummy - in + let f_symb expr = Alg_expr.DIFF_KAPPA_INSTANCE (expr, mixture), Loc.dummy in let f_time () = match time_var with | Some b when mixture = b -> Alg_expr.int 1 @@ -596,7 +594,7 @@ let diff_mixture ?time_var expr mixture = (ExceptionDefn.Internal_Error ( "A time-dependent expression cannot be differentiated without \ specifying a variable for time progress", - Locality.dummy )) + Loc.dummy )) in diff_gen f_mix f_token f_symb f_time expr diff --git a/core/term/alg_expr_extra.mli b/core/term/alg_expr_extra.mli index f97a96e973..8568df06f3 100644 --- a/core/term/alg_expr_extra.mli +++ b/core/term/alg_expr_extra.mli @@ -9,9 +9,9 @@ (** Primitives for handling rule rates when detecting symmetries *) val divide_expr_by_int : - ('mix, 'id) Alg_expr.e Locality.annot -> + ('mix, 'id) Alg_expr.e Loc.annoted -> int -> - ('mix, 'id) Alg_expr.e Locality.annot + ('mix, 'id) Alg_expr.e Loc.annoted (* Partial normal form for expressions *) (* We only deal with constant, single alg_var multiplied/divided by a constant, sum of two expr either both constant or dealing with the same alg_var *) @@ -19,21 +19,20 @@ val divide_expr_by_int : (* We may be more complete later *) val simplify : - ('mix, 'id) Alg_expr.e Locality.annot -> ('mix, 'id) Alg_expr.e Locality.annot + ('mix, 'id) Alg_expr.e Loc.annoted -> ('mix, 'id) Alg_expr.e Loc.annoted type ('mix, 'id) corrected_rate_const (* printer *) val print : - (Format.formatter -> ('mix, 'id) Alg_expr.e Locality.annot option -> unit) -> + (Format.formatter -> ('mix, 'id) Alg_expr.e Loc.annoted option -> unit) -> Format.formatter -> ('mix, 'id) corrected_rate_const option -> unit (* conversion *) val get_corrected_rate : - ('mix, 'id) Alg_expr.e Locality.annot -> - ('mix, 'id) corrected_rate_const option + ('mix, 'id) Alg_expr.e Loc.annoted -> ('mix, 'id) corrected_rate_const option (* partial equality test *) (* true means "yes they are equal" *) @@ -53,19 +52,19 @@ val dep : ('set -> 'set -> 'set) -> ('id -> 'set) -> ?time_var:'mix -> - ('mix, 'id) Alg_expr.e Locality.annot -> + ('mix, 'id) Alg_expr.e Loc.annoted -> 'set val diff_token : - ('mix, 'id) Alg_expr.e Locality.annot -> + ('mix, 'id) Alg_expr.e Loc.annoted -> 'id -> - ('mix, 'id) Alg_expr.e Locality.annot + ('mix, 'id) Alg_expr.e Loc.annoted val diff_mixture : ?time_var:'mix -> - ('mix, 'id) Alg_expr.e Locality.annot -> + ('mix, 'id) Alg_expr.e Loc.annoted -> 'mix -> - ('mix, 'id) Alg_expr.e Locality.annot + ('mix, 'id) Alg_expr.e Loc.annoted val fold_over_mixtures_in_alg_exprs : (Pattern.id -> 'a -> 'a) -> Model.t -> 'a -> 'a diff --git a/core/term/configuration.mli b/core/term/configuration.mli index b24b184b6b..e9b320d3e8 100644 --- a/core/term/configuration.mli +++ b/core/term/configuration.mli @@ -24,7 +24,7 @@ type t = { val empty : t val parse : - ((string * Locality.t) * (string * Locality.t) list) list -> + ((string * Loc.t) * (string * Loc.t) list) list -> t * (bool * bool * bool) * string (*cflowFormat*) diff --git a/core/term/dune b/core/term/dune index 3b7f5a0054..d33e95dcf8 100644 --- a/core/term/dune +++ b/core/term/dune @@ -2,6 +2,5 @@ (name kappa_terms) (libraries kappa_mixtures) (public_name kappa-library.terms) - (flags (:standard -w @a - -open Kappa_generic_toolset - -open Kappa_mixtures))) + (flags + (:standard -w @a -open Kappa_generic_toolset -open Kappa_mixtures))) diff --git a/core/term/instantiation.ml b/core/term/instantiation.ml index c3fcb55e05..895d7e3755 100644 --- a/core/term/instantiation.ml +++ b/core/term/instantiation.ml @@ -77,73 +77,73 @@ let empty_event = connectivity_tests = []; } -let concretize_binding_state ~debugMode inj2graph = function +let concretize_binding_state ~debug_mode inj2graph = function | ANY -> ANY | FREE -> FREE | BOUND -> BOUND | BOUND_TYPE bt -> BOUND_TYPE bt | BOUND_to (pl, s) -> - BOUND_to (Matching.Agent.concretize ~debugMode inj2graph pl, s) + BOUND_to (Matching.Agent.concretize ~debug_mode inj2graph pl, s) -let concretize_test ~debugMode inj2graph = function - | Is_Here pl -> Is_Here (Matching.Agent.concretize ~debugMode inj2graph pl) +let concretize_test ~debug_mode inj2graph = function + | Is_Here pl -> Is_Here (Matching.Agent.concretize ~debug_mode inj2graph pl) | Has_Internal ((pl, s), i) -> - Has_Internal ((Matching.Agent.concretize ~debugMode inj2graph pl, s), i) + Has_Internal ((Matching.Agent.concretize ~debug_mode inj2graph pl, s), i) | Is_Free (pl, s) -> - Is_Free (Matching.Agent.concretize ~debugMode inj2graph pl, s) + Is_Free (Matching.Agent.concretize ~debug_mode inj2graph pl, s) | Is_Bound (pl, s) -> - Is_Bound (Matching.Agent.concretize ~debugMode inj2graph pl, s) + Is_Bound (Matching.Agent.concretize ~debug_mode inj2graph pl, s) | Has_Binding_type ((pl, s), t) -> - Has_Binding_type ((Matching.Agent.concretize ~debugMode inj2graph pl, s), t) + Has_Binding_type ((Matching.Agent.concretize ~debug_mode inj2graph pl, s), t) | Is_Bound_to ((pl, s), (pl', s')) -> Is_Bound_to - ( (Matching.Agent.concretize ~debugMode inj2graph pl, s), - (Matching.Agent.concretize ~debugMode inj2graph pl', s') ) + ( (Matching.Agent.concretize ~debug_mode inj2graph pl, s), + (Matching.Agent.concretize ~debug_mode inj2graph pl', s') ) -let concretize_action ~debugMode inj2graph = function +let concretize_action ~debug_mode inj2graph = function | Create (pl, i) -> - Create (Matching.Agent.concretize ~debugMode inj2graph pl, i) + Create (Matching.Agent.concretize ~debug_mode inj2graph pl, i) | Mod_internal ((pl, s), i) -> - Mod_internal ((Matching.Agent.concretize ~debugMode inj2graph pl, s), i) + Mod_internal ((Matching.Agent.concretize ~debug_mode inj2graph pl, s), i) | Bind ((pl, s), (pl', s')) -> Bind - ( (Matching.Agent.concretize ~debugMode inj2graph pl, s), - (Matching.Agent.concretize ~debugMode inj2graph pl', s') ) + ( (Matching.Agent.concretize ~debug_mode inj2graph pl, s), + (Matching.Agent.concretize ~debug_mode inj2graph pl', s') ) | Bind_to ((pl, s), (pl', s')) -> Bind_to - ( (Matching.Agent.concretize ~debugMode inj2graph pl, s), - (Matching.Agent.concretize ~debugMode inj2graph pl', s') ) - | Free (pl, s) -> Free (Matching.Agent.concretize ~debugMode inj2graph pl, s) - | Remove pl -> Remove (Matching.Agent.concretize ~debugMode inj2graph pl) + ( (Matching.Agent.concretize ~debug_mode inj2graph pl, s), + (Matching.Agent.concretize ~debug_mode inj2graph pl', s') ) + | Free (pl, s) -> Free (Matching.Agent.concretize ~debug_mode inj2graph pl, s) + | Remove pl -> Remove (Matching.Agent.concretize ~debug_mode inj2graph pl) -let try_concretize_action ~debugMode inj2graph actions = - try Some (concretize_action ~debugMode inj2graph actions) +let try_concretize_action ~debug_mode inj2graph actions = + try Some (concretize_action ~debug_mode inj2graph actions) with Not_found -> None (* The action is dealing with a fresh agent *) -let concretize_event ~debugMode inj2graph e = +let concretize_event ~debug_mode inj2graph e = { tests = - List.map (List.rev_map (concretize_test ~debugMode inj2graph)) e.tests; + List.map (List.rev_map (concretize_test ~debug_mode inj2graph)) e.tests; actions = (* actions are reordered the following way: 1) Remove actions 2) Creation actions 3) Anything else.*) sort_abstract_action_list - (List.rev_map (concretize_action ~debugMode inj2graph) e.actions); + (List.rev_map (concretize_action ~debug_mode inj2graph) e.actions); side_effects_src = List.rev_map (fun ((pl, s), b) -> - ( (Matching.Agent.concretize ~debugMode inj2graph pl, s), - concretize_binding_state ~debugMode inj2graph b )) + ( (Matching.Agent.concretize ~debug_mode inj2graph pl, s), + concretize_binding_state ~debug_mode inj2graph b )) e.side_effects_src; side_effects_dst = List.rev_map - (fun (pl, s) -> Matching.Agent.concretize ~debugMode inj2graph pl, s) + (fun (pl, s) -> Matching.Agent.concretize ~debug_mode inj2graph pl, s) e.side_effects_dst; connectivity_tests = - List.rev_map (concretize_test ~debugMode inj2graph) e.connectivity_tests; + List.rev_map (concretize_test ~debug_mode inj2graph) e.connectivity_tests; } let map_test f = function @@ -236,7 +236,7 @@ let rec find_match tests actions ctests cactions = function | [] -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "abstract and concret quarks don't match")) + (Loc.annot_with_dummy "abstract and concret quarks don't match")) | cid :: tl -> let ctests' = List.filter (fun test -> map_test (fun a -> Agent.id a = cid) test) ctests @@ -254,7 +254,7 @@ let rec find_match tests actions ctests cactions = function else find_match tests actions ctests cactions tl -let matching_abstract_concrete ~debugMode ae ce = +let matching_abstract_concrete ~debug_mode ae ce = let ae_tests = List.flatten ae.tests in let ce_tests = List.flatten ce.tests in let abstract_ids = @@ -287,7 +287,7 @@ let matching_abstract_concrete ~debugMode ae ce = let j = find_match tests actions ce_tests ce.actions (available_ids matching) in - Renaming.imperative_add ~debugMode i j matching) + Renaming.imperative_add ~debug_mode i j matching) true abstract_ids in if injective then @@ -361,8 +361,8 @@ let subst_agent_in_concrete_test id id' x = j) x -let rename_abstract_test ~debugMode id inj x = - subst_map_agent_in_test (Matching.Agent.rename ~debugMode id inj) x +let rename_abstract_test ~debug_mode id inj x = + subst_map_agent_in_test (Matching.Agent.rename ~debug_mode id inj) x let subst_map2_agent_in_action f f' = function | Create (agent, list) as x -> @@ -418,8 +418,8 @@ let subst_agent_in_concrete_action id id' x = j) x -let rename_abstract_action ~debugMode id inj x = - subst_map_agent_in_action (Matching.Agent.rename ~debugMode id inj) x +let rename_abstract_action ~debug_mode id inj x = + subst_map_agent_in_action (Matching.Agent.rename ~debug_mode id inj) x let subst_map_binding_state f = function | (ANY | FREE | BOUND | BOUND_TYPE _) as x -> x @@ -450,8 +450,8 @@ let subst_agent_in_concrete_side_effect id id' x = j) x -let rename_abstract_side_effect ~debugMode id inj x = - subst_map_agent_in_side_effect (Matching.Agent.rename ~debugMode id inj) x +let rename_abstract_side_effect ~debug_mode id inj x = + subst_map_agent_in_side_effect (Matching.Agent.rename ~debug_mode id inj) x let subst_map_agent_in_event f e = { @@ -499,8 +499,8 @@ let subst_agent_in_concrete_event id id' x = j) x -let rename_abstract_event ~debugMode id inj x = - subst_map_agent_in_event (Matching.Agent.rename ~debugMode id inj) x +let rename_abstract_event ~debug_mode id inj x = + subst_map_agent_in_event (Matching.Agent.rename ~debug_mode id inj) x let print_concrete_agent_site ?sigs f (agent, id) = Format.fprintf f "%a.%a" diff --git a/core/term/instantiation.mli b/core/term/instantiation.mli index ad41d9f3c4..70dbdc72b1 100644 --- a/core/term/instantiation.mli +++ b/core/term/instantiation.mli @@ -73,35 +73,35 @@ type 'a event = { val empty_event : 'a event val rename_abstract_test : - debugMode:bool -> int -> Renaming.t -> abstract test -> abstract test + debug_mode:bool -> int -> Renaming.t -> abstract test -> abstract test val rename_abstract_action : - debugMode:bool -> int -> Renaming.t -> abstract action -> abstract action + debug_mode:bool -> int -> Renaming.t -> abstract action -> abstract action val rename_abstract_event : - debugMode:bool -> int -> Renaming.t -> abstract event -> abstract event + debug_mode:bool -> int -> Renaming.t -> abstract event -> abstract event val rename_abstract_side_effect : - debugMode:bool -> + debug_mode:bool -> int -> Renaming.t -> (Matching.Agent.t * 'a) * Matching.Agent.t binding_state -> (Matching.Agent.t * 'a) * Matching.Agent.t binding_state val concretize_test : - debugMode:bool -> + debug_mode:bool -> Matching.t * int Mods.IntMap.t -> abstract test -> concrete test val concretize_action : - debugMode:bool -> + debug_mode:bool -> Matching.t * int Mods.IntMap.t -> abstract action -> concrete action val try_concretize_action : - debugMode:bool -> + debug_mode:bool -> Matching.t * int Mods.IntMap.t -> abstract action -> concrete action option @@ -110,13 +110,13 @@ val try_concretize_action : that is involved in the action that is being concretized. *) val concretize_event : - debugMode:bool -> + debug_mode:bool -> Matching.t * int Mods.IntMap.t -> abstract event -> concrete event val matching_abstract_concrete : - debugMode:bool -> abstract event -> concrete event -> Renaming.t option + debug_mode:bool -> abstract event -> concrete event -> Renaming.t option val subst_map_agent_in_concrete_test : (int -> int) -> concrete test -> concrete test diff --git a/core/term/lKappa.ml b/core/term/lKappa.ml index 0b0465af98..4e8f766ca3 100644 --- a/core/term/lKappa.ml +++ b/core/term/lKappa.ml @@ -26,10 +26,10 @@ type rule_internal = type rule_agent = { ra_type: int; ra_erased: bool; - ra_ports: ((int, int * int) link Locality.annot * switching) array; + ra_ports: ((int, int * int) link Loc.annoted * switching) array; ra_ints: rule_internal array; ra_syntax: - (((int, int * int) link Locality.annot * switching) array + (((int, int * int) link Loc.annoted * switching) array * rule_internal array) option; } @@ -39,13 +39,13 @@ type rule_mixture = rule_agent list type rule = { r_mix: rule_mixture; r_created: Raw_mixture.t; - r_delta_tokens: ((rule_mixture, int) Alg_expr.e Locality.annot * int) list; - r_rate: (rule_mixture, int) Alg_expr.e Locality.annot; + r_delta_tokens: ((rule_mixture, int) Alg_expr.e Loc.annoted * int) list; + r_rate: (rule_mixture, int) Alg_expr.e Loc.annoted; r_un_rate: - ((rule_mixture, int) Alg_expr.e Locality.annot - * (rule_mixture, int) Alg_expr.e Locality.annot option) + ((rule_mixture, int) Alg_expr.e Loc.annoted + * (rule_mixture, int) Alg_expr.e Loc.annoted option) option; - r_editStyle: bool; + r_edit_style: bool; } let print_link pr_port pr_type pr_annot f = function @@ -64,7 +64,7 @@ let link_to_json port_to_json type_to_json annot_to_json = function | LNK_SOME -> `String "SOME" | LNK_VALUE (i, a) -> `List (`Int i :: annot_to_json a) -let link_of_json port_of_json type_of_json annot_of_json = function +let link_of_json port_of_json type_of_json annoted_of_json = function | `String "ANY_FREE" -> ANY_FREE | `String "FREE" -> LNK_FREE | `List [ p; a ] -> @@ -72,7 +72,8 @@ let link_of_json port_of_json type_of_json annot_of_json = function LNK_TYPE (port_of_json x p, x) | `Null -> LNK_ANY | `String "SOME" -> LNK_SOME - | `List (`Int i :: (([] | _ :: _ :: _) as a)) -> LNK_VALUE (i, annot_of_json a) + | `List (`Int i :: (([] | _ :: _ :: _) as a)) -> + LNK_VALUE (i, annoted_of_json a) | x -> raise (Yojson.Basic.Util.Type_error ("Uncorrect link", x)) let print_link_annot ~ltypes sigs f (s, a) = @@ -165,7 +166,7 @@ let print_counter_delta counters j f switch = | Freed -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot "Cannot erase all increment agents")) + (Loc.annot_with_dummy "Cannot erase all increment agents")) | Maintained -> () | Erased -> () @@ -259,8 +260,8 @@ let union_find_counters sigs mix = | LNK_TYPE _ | LNK_SOME -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot - "Port a of __incr agent not well specified"))))) + (Loc.annot_with_dummy + "Port a of __counter_agent agent not well specified"))))) mix in t @@ -272,7 +273,7 @@ let print_rule_agent ~noCounters sigs ~ltypes counters created_counters f ag = if ag.ra_erased then Format.pp_print_string f "-") let print_rule_mixture ~noCounters sigs ~ltypes created f mix = - let incr_agents = union_find_counters (Some sigs) mix in + let counter_agents = union_find_counters (Some sigs) mix in let created_incr = Raw_mixture.union_find_counters (Some sigs) created in let rec aux_print some = function | [] -> () @@ -282,7 +283,8 @@ let print_rule_mixture ~noCounters sigs ~ltypes created f mix = else ( let () = if some then Pp.comma f in let () = - print_rule_agent ~noCounters sigs ~ltypes incr_agents created_incr f h + print_rule_agent ~noCounters sigs ~ltypes counter_agents created_incr + f h in aux_print true t ) @@ -471,7 +473,7 @@ let print_rates ~noCounters sigs pr_tok pr_var f r = let print_rule ~noCounters ~full sigs pr_tok pr_var f r = Format.fprintf f "@[%t%t%a%t@]" (fun f -> - if full || r.r_editStyle then + if full || r.r_edit_style then Format.fprintf f "%a%a" (print_rule_mixture ~noCounters sigs ~ltypes:false r.r_created) r.r_mix @@ -513,7 +515,7 @@ let rule_agent_to_json filenames a = (fun (e, s) c -> `List [ - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (link_to_json (fun _ i -> `Int i) (fun i -> `Int i) @@ -540,7 +542,7 @@ let rule_agent_of_json filenames = function Tools.array_map_of_list (function | `List [ e; s ] -> - ( Locality.annot_of_yojson ~filenames + ( Loc.annoted_of_yojson ~filenames (link_of_json (fun _ -> Yojson.Basic.Util.to_int) Yojson.Basic.Util.to_int @@ -593,22 +595,20 @@ let rule_to_json ~filenames r = ( "delta_tokens", JsonUtil.of_list (JsonUtil.of_pair ~lab1:"val" ~lab2:"tok" - (Locality.annot_to_yojson ~filenames (lalg_expr_to_json filenames)) + (Loc.yojson_of_annoted ~filenames (lalg_expr_to_json filenames)) JsonUtil.of_int) r.r_delta_tokens ); ( "rate", - Locality.annot_to_yojson ~filenames - (lalg_expr_to_json filenames) - r.r_rate ); + Loc.yojson_of_annoted ~filenames (lalg_expr_to_json filenames) r.r_rate + ); ( "unary_rate", JsonUtil.of_option (JsonUtil.of_pair - (Locality.annot_to_yojson ~filenames (lalg_expr_to_json filenames)) + (Loc.yojson_of_annoted ~filenames (lalg_expr_to_json filenames)) (JsonUtil.of_option - (Locality.annot_to_yojson ~filenames - (lalg_expr_to_json filenames)))) + (Loc.yojson_of_annoted ~filenames (lalg_expr_to_json filenames)))) r.r_un_rate ); - "editStyle", `Bool r.r_editStyle; + "edit_style", `Bool r.r_edit_style; ] let rule_of_json ~filenames = function @@ -620,70 +620,69 @@ let rule_of_json ~filenames = function r_delta_tokens = JsonUtil.to_list (JsonUtil.to_pair ~lab1:"val" ~lab2:"tok" - (Locality.annot_of_yojson ~filenames - (lalg_expr_of_json filenames)) + (Loc.annoted_of_yojson ~filenames (lalg_expr_of_json filenames)) (JsonUtil.to_int ?error_msg:None)) (List.assoc "delta_tokens" l); r_rate = - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (lalg_expr_of_json filenames) (List.assoc "rate" l); r_un_rate = (try JsonUtil.to_option (JsonUtil.to_pair - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (lalg_expr_of_json filenames)) (JsonUtil.to_option - (Locality.annot_of_yojson (lalg_expr_of_json filenames)))) + (Loc.annoted_of_yojson (lalg_expr_of_json filenames)))) (List.assoc "unary_rate" l) with Not_found -> None); - r_editStyle = Yojson.Basic.Util.to_bool (List.assoc "editStyle" l); + r_edit_style = Yojson.Basic.Util.to_bool (List.assoc "edit_style" l); } with Not_found -> raise (Yojson.Basic.Util.Type_error ("Incorrect rule", x))) | x -> raise (Yojson.Basic.Util.Type_error ("Incorrect rule", x)) -let forbid_modification pos = function +let raise_if_modification pos = function | None -> () - | Some _ -> + | _ -> raise (ExceptionDefn.Malformed_Decl ("A modification is forbidden here.", pos)) -let several_internal_states pos = +let raise_several_internal_states pos = raise (ExceptionDefn.Malformed_Decl ("In a pattern, a site cannot have several internal states.", pos)) -let not_enough_specified ~status ~side agent_name (na, pos) = +let raise_not_enough_specified ~status ~side agent_name (na, pos) = raise (ExceptionDefn.Malformed_Decl ( "The " ^ status ^ " state of agent '" ^ agent_name ^ "', site '" ^ na ^ "' on the " ^ side ^ " hand side is underspecified", pos )) -let several_occurence_of_site agent_name (na, pos) = +let raise_several_occurence_of_site agent_name (na, pos) = raise (ExceptionDefn.Malformed_Decl ( "Site '" ^ na ^ "' occurs more than once in this agent '" ^ agent_name ^ "'", pos )) -let counter_misused agent_name (na, pos) = +let raise_counter_misused agent_name (na, pos) = raise (ExceptionDefn.Malformed_Decl ( "Site '" ^ na ^ "' occurs both as port and as counter in '" ^ agent_name ^ "'", pos )) -let link_only_one_occurence i pos = +let raise_link_only_one_occurence i pos = raise (ExceptionDefn.Malformed_Decl ( "The link '" ^ string_of_int i ^ "' occurs only one time in the mixture.", pos )) -let link_should_be_removed i agent_name (na, pos) = +let raise_link_should_be_removed i agent_name (na, pos) = raise (ExceptionDefn.Malformed_Decl ( "The link '" ^ string_of_int i ^ "' should be made free in the site '" @@ -726,9 +725,10 @@ let agent_to_erased sigs r = | Some _ -> Some (Array.copy ra_ports, Array.copy ra_ints)); } -let to_erased sigs x = List.map (agent_to_erased sigs) x +let to_erased (sigs : Signature.s) (x : rule_mixture) : rule_mixture = + List.map (agent_to_erased sigs) x -let to_maintained x = +let to_maintained (x : rule_mixture) : rule_mixture = List.map (fun r -> let ports = Array.map (fun (a, _) -> a, Maintained) r.ra_ports in @@ -766,14 +766,14 @@ let to_raw_mixture sigs x = Array.mapi (fun j -> function | (LNK_SOME, pos | LNK_TYPE _, pos), _ -> - let ag_na = + let agent_name = Format.asprintf "%a" (Signature.print_agent sigs) r.ra_type in - let p_na = + let port_name = Format.asprintf "%a" (Signature.print_site sigs r.ra_type) j in - not_enough_specified ~status:"linking" ~side:"left" ag_na - (p_na, pos) + raise_not_enough_specified ~status:"linking" ~side:"left" + agent_name (port_name, pos) | (LNK_VALUE (i, _), _), _ -> Raw_mixture.VAL i | ((LNK_ANY | ANY_FREE | LNK_FREE), _), _ -> Raw_mixture.FREE) r.ra_ports diff --git a/core/term/lKappa.mli b/core/term/lKappa.mli index 9883e22d91..d132b2a3c3 100644 --- a/core/term/lKappa.mli +++ b/core/term/lKappa.mli @@ -6,11 +6,11 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) -(** Intermediate representation of model on wich sanity has been checked *) +(** Intermediate representation of model on which sanity has been checked *) -type ('a, 'annot) link = +type ('a, 'annoted) link = | ANY_FREE - | LNK_VALUE of int * 'annot + | LNK_VALUE of int * 'annoted | LNK_FREE | LNK_ANY | LNK_SOME @@ -19,7 +19,7 @@ type ('a, 'annot) link = type switching = Linked of int | Freed | Maintained | Erased type rule_internal = - (*state*) + (* internal state of agent port *) | I_ANY | I_ANY_CHANGED of int | I_ANY_ERASED @@ -29,11 +29,11 @@ type rule_internal = type rule_agent = { ra_type: int; (*agent_id*) ra_erased: bool; - ra_ports: ((int, int * int) link Locality.annot * switching) array; + ra_ports: ((int, int * int) link Loc.annoted * switching) array; (*((link nb, (dst_site,dst_ag_type)), _) , switch*) ra_ints: rule_internal array; ra_syntax: - (((int, int * int) link Locality.annot * switching) array + (((int, int * int) link Loc.annoted * switching) array * rule_internal array) option; } @@ -46,24 +46,40 @@ The field ra_syntax represents how the user describe the agent before compilation. Therefore, [compil_of_ast] in this module generates rule_agent where ra_syntax is [Some (Array.copy ra_ports, Array.copy ra_ints)]. *) +(* TODO Reference to compil_of_ast here is weird *) type rule_mixture = rule_agent list +(** [rule_mixture] is the mixture description from the initial state of a rule *) -val forbid_modification : Locality.t -> 'a option -> unit -val several_internal_states : Locality.t -> 'a - -val not_enough_specified : - status:string -> side:string -> string -> string * Locality.t -> 'a +type rule = { + r_mix: rule_mixture; (** Initial mixture state *) + r_created: Raw_mixture.t; (** Mixture state after rule is applied *) + r_delta_tokens: ((rule_mixture, int) Alg_expr.e Loc.annoted * int) list; + r_rate: (rule_mixture, int) Alg_expr.e Loc.annoted; + r_un_rate: + ((rule_mixture, int) Alg_expr.e Loc.annoted + * (rule_mixture, int) Alg_expr.e Loc.annoted option) + option; + r_edit_style: bool; + (** If rule was written in edit style, else it's rewrite style *) +} -val several_occurence_of_site : string -> string * Locality.t -> 'a -val counter_misused : string -> string * Locality.t -> 'a -val link_only_one_occurence : int -> Locality.t -> 'a -val link_should_be_removed : int -> string -> string * Locality.t -> 'a 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 val to_raw_mixture : Signature.s -> rule_mixture -> Raw_mixture.t val copy_rule_agent : rule_agent -> rule_agent +val max_link_id : rule_mixture -> int +val raise_if_modification : Loc.t -> 'a option -> unit +val raise_several_internal_states : Loc.t -> 'a + +val raise_not_enough_specified : + status:string -> side:string -> string -> string Loc.annoted -> 'a + +val raise_several_occurence_of_site : string -> string Loc.annoted -> 'a +val raise_counter_misused : string -> string Loc.annoted -> 'a +val raise_link_only_one_occurence : int -> Loc.t -> 'a +val raise_link_should_be_removed : int -> string -> string Loc.annoted -> 'a val print_rule_mixture : noCounters:bool -> @@ -74,18 +90,6 @@ val print_rule_mixture : rule_mixture -> unit -type rule = { - r_mix: rule_mixture; - r_created: Raw_mixture.t; - r_delta_tokens: ((rule_mixture, int) Alg_expr.e Locality.annot * int) list; - r_rate: (rule_mixture, int) Alg_expr.e Locality.annot; - r_un_rate: - ((rule_mixture, int) Alg_expr.e Locality.annot - * (rule_mixture, int) Alg_expr.e Locality.annot option) - option; - r_editStyle: bool; -} - val print_link : ('a -> Format.formatter -> 'a -> unit) -> (Format.formatter -> 'a -> unit) -> @@ -130,4 +134,3 @@ val print_rule : val rule_to_json : filenames:int Mods.StringMap.t -> rule -> Yojson.Basic.t val rule_of_json : filenames:string array -> Yojson.Basic.t -> rule -val max_link_id : rule_mixture -> int diff --git a/core/term/matching.ml b/core/term/matching.ml index 8eead2de81..caeb261ace 100644 --- a/core/term/matching.ml +++ b/core/term/matching.ml @@ -29,7 +29,7 @@ let debug_print f (m, _co) = f nm)) m -let reconstruct_renaming ~debugMode domain graph cc_id root = +let reconstruct_renaming ~debug_mode domain graph cc_id root = let point = Pattern.Env.get domain cc_id in match Pattern.Env.roots point with | None -> failwith "Matching.reconstruct cc error" @@ -43,7 +43,7 @@ let reconstruct_renaming ~debugMode domain graph cc_id root = (fun (root, injective) nav -> ( None, injective - && Navigation.imperative_edge_is_valid ~debugMode ?root inj graph + && Navigation.imperative_edge_is_valid ~debug_mode ?root inj graph nav )) (Some (root, rty), true) nav @@ -51,7 +51,7 @@ let reconstruct_renaming ~debugMode domain graph cc_id root = | [] -> ( None, (match rids with - | [ rid ] -> Renaming.imperative_add ~debugMode rid root inj + | [ rid ] -> Renaming.imperative_add ~debug_mode rid root inj | _ -> false) ) in if injective then @@ -62,35 +62,35 @@ let reconstruct_renaming ~debugMode domain graph cc_id root = (* reconstruct: Pattern.Env.t -> Edges.t -> t -> int -> Pattern.id -> int -> t option*) -let reconstruct ~debugMode domain graph inj id cc_id root = - let rename = reconstruct_renaming ~debugMode domain graph cc_id root in +let reconstruct ~debug_mode domain graph inj id cc_id root = + let rename = reconstruct_renaming ~debug_mode domain graph cc_id root in match Mods.IntSet.disjoint_union (Renaming.image rename) (snd inj) with | None -> None | Some co -> Some (Mods.IntMap.add id rename (fst inj), co) -let rec aux_is_root_of ~debugMode graph root inj = function +let rec aux_is_root_of ~debug_mode graph root inj = function | [] -> true | h :: t -> - Navigation.imperative_edge_is_valid ~debugMode ?root inj graph h - && aux_is_root_of ~debugMode graph None inj t + Navigation.imperative_edge_is_valid ~debug_mode ?root inj graph h + && aux_is_root_of ~debug_mode graph None inj t -let is_root_of ~debugMode domain graph ((_, rty) as root) cc_id = +let is_root_of ~debug_mode domain graph ((_, rty) as root) cc_id = let point = Pattern.Env.get domain cc_id in match Pattern.reconstruction_navigation (Pattern.Env.content point) with | [] -> (match Pattern.Env.roots point with | Some (_, rty') -> rty = rty' | None -> false) - | nav -> aux_is_root_of ~debugMode graph (Some root) (Renaming.empty ()) nav + | nav -> aux_is_root_of ~debug_mode graph (Some root) (Renaming.empty ()) nav -let roots_of ~debugMode domain graph cc = +let roots_of ~debug_mode domain graph cc = Edges.all_agents_where - (fun x -> is_root_of ~debugMode domain graph x cc) + (fun x -> is_root_of ~debug_mode domain graph x cc) graph (* get : (ContentAgent.t * int) -> t -> int *) -let get ~debugMode ((node, _), id) (t, _) = - Renaming.apply ~debugMode (Mods.IntMap.find_default Renaming.dummy id t) node +let get ~debug_mode ((node, _), id) (t, _) = + Renaming.apply ~debug_mode (Mods.IntMap.find_default Renaming.dummy id t) node let elements_with_types domain ccs (t, _) = let out = Array.make (Mods.IntMap.size t) [] in @@ -138,18 +138,18 @@ type cache = CacheSetMap.Set.t let empty_cache = CacheSetMap.Set.empty -let survive_nav ~debugMode inj graph = +let survive_nav ~debug_mode inj graph = List.fold_left (fun inj step -> match inj with | None -> inj | Some inj -> - Navigation.injection_for_one_more_edge ~debugMode inj graph step) + Navigation.injection_for_one_more_edge ~debug_mode inj graph step) (Some inj) (*edges: list of concrete edges, returns the roots of observables that are above in the domain*) -let from_edge ~debugMode domain graph ((out, cache) as acc) node site arrow = +let from_edge ~debug_mode domain graph ((out, cache) as acc) node site arrow = let rec aux_from_edges cache ((obs, rev_deps) as acc) = function | [] -> acc, cache | (pid, point, inj_point2graph) :: remains -> @@ -159,7 +159,8 @@ let from_edge ~debugMode domain graph ((out, cache) as acc) node site arrow = | Some (ids, ty) -> ( List.fold_left (fun acc id -> - (pid, (Renaming.apply ~debugMode inj_point2graph id, ty)) :: acc) + (pid, (Renaming.apply ~debug_mode inj_point2graph id, ty)) + :: acc) obs ids, Operator.DepSet.union rev_deps (Pattern.Env.deps point) ) in @@ -167,12 +168,12 @@ let from_edge ~debugMode domain graph ((out, cache) as acc) node site arrow = List.fold_left (fun ((re, ca) as pair) son -> match - survive_nav ~debugMode inj_point2graph graph son.Pattern.Env.next + survive_nav ~debug_mode inj_point2graph graph son.Pattern.Env.next with | None -> pair | Some inj' -> let rename = - Renaming.compose ~debugMode false son.Pattern.Env.inj inj' + Renaming.compose ~debug_mode false son.Pattern.Env.inj inj' in let ca' = CacheSetMap.Set.add @@ -190,7 +191,7 @@ let from_edge ~debugMode domain graph ((out, cache) as acc) node site arrow = in aux_from_edges cache' acc' remains' in - match Pattern.Env.get_elementary ~debugMode domain node site arrow with + match Pattern.Env.get_elementary ~debug_mode domain node site arrow with | None -> acc | Some x -> aux_from_edges @@ -207,25 +208,25 @@ let observables_from_agent domain graph (((obs, rdeps), cache) as acc) ) else acc -let observables_from_free ~debugMode domain graph acc node site = - from_edge ~debugMode domain graph acc node site Navigation.ToNothing +let observables_from_free ~debug_mode domain graph acc node site = + from_edge ~debug_mode domain graph acc node site Navigation.ToNothing -let observables_from_internal ~debugMode domain graph acc node site id = - from_edge ~debugMode domain graph acc node site (Navigation.ToInternal id) +let observables_from_internal ~debug_mode domain graph acc node site id = + from_edge ~debug_mode domain graph acc node site (Navigation.ToInternal id) -let observables_from_link ~debugMode domain graph acc n site n' site' = - from_edge domain ~debugMode graph acc n site +let observables_from_link ~debug_mode domain graph acc n site n' site' = + from_edge domain ~debug_mode graph acc n site (Navigation.ToNode (Navigation.Fresh n', site')) module Agent = struct type t = Existing of Agent.t * int | Fresh of int * int (* type, id *) - let rename ~debugMode id inj = function + let rename ~debug_mode id inj = function | Existing (n, id') as x -> if id <> id' then x else ( - let n' = Agent.rename ~debugMode inj n in + let n' = Agent.rename ~debug_mode inj n in if n == n' then x else @@ -272,8 +273,8 @@ module Agent = struct | Existing _ -> false | Fresh _ -> true - let concretize ~debugMode (inj_nodes, inj_fresh) = function - | Existing (n, id) -> get ~debugMode (n, id) inj_nodes, Agent.sort n + let concretize ~debug_mode (inj_nodes, inj_fresh) = function + | Existing (n, id) -> get ~debug_mode (n, id) inj_nodes, Agent.sort n | Fresh (ty, id) -> (match Mods.IntMap.find_option id inj_fresh with | Some x -> x, ty diff --git a/core/term/matching.mli b/core/term/matching.mli index 9eb978d9af..4b76032801 100644 --- a/core/term/matching.mli +++ b/core/term/matching.mli @@ -13,14 +13,14 @@ type matching = t val empty : t val debug_print : Format.formatter -> t -> unit -val get : debugMode:bool -> Agent.t * int -> t -> int +val get : debug_mode:bool -> Agent.t * int -> t -> int val reconstruct_renaming : - debugMode:bool -> Pattern.Env.t -> Edges.t -> Pattern.id -> int -> Renaming.t + debug_mode:bool -> Pattern.Env.t -> Edges.t -> Pattern.id -> int -> Renaming.t (** [reconstruct_renaming domain graph cc root] *) val reconstruct : - debugMode:bool -> + debug_mode:bool -> Pattern.Env.t -> Edges.t -> t -> @@ -33,10 +33,10 @@ val reconstruct : val add_cc : t -> int -> Renaming.t -> t option val is_root_of : - debugMode:bool -> Pattern.Env.t -> Edges.t -> Agent.t -> Pattern.id -> bool + debug_mode:bool -> Pattern.Env.t -> Edges.t -> Agent.t -> Pattern.id -> bool val roots_of : - debugMode:bool -> Pattern.Env.t -> Edges.t -> Pattern.id -> IntCollection.t + debug_mode:bool -> Pattern.Env.t -> Edges.t -> Pattern.id -> IntCollection.t val elements_with_types : Pattern.Env.t -> Pattern.id array -> t -> Agent.t list array @@ -56,7 +56,7 @@ val observables_from_agent : is a Instantiation.concrete *) val observables_from_free : - debugMode:bool -> + debug_mode:bool -> Pattern.Env.t -> Edges.t -> ((Pattern.id * (int * int)) list * Operator.DepSet.t) * cache -> @@ -66,7 +66,7 @@ val observables_from_free : (** [observables_from_free domain graph sort agent site] *) val observables_from_internal : - debugMode:bool -> + debug_mode:bool -> Pattern.Env.t -> Edges.t -> ((Pattern.id * (int * int)) list * Operator.DepSet.t) * cache -> @@ -77,7 +77,7 @@ val observables_from_internal : (** [observables_from_internal domain graph sort agent site internal_state] *) val observables_from_link : - debugMode:bool -> + debug_mode:bool -> Pattern.Env.t -> Edges.t -> ((Pattern.id * (int * int)) list * Operator.DepSet.t) * cache -> @@ -95,10 +95,10 @@ module Agent : sig | Existing of Agent.t * int (* node, cc_id *) | Fresh of int * int (* type, id *) - val rename : debugMode:bool -> int -> Renaming.t -> t -> t + val rename : debug_mode:bool -> int -> Renaming.t -> t -> t val concretize : - debugMode:bool -> matching * int Mods.IntMap.t -> t -> int * int + debug_mode:bool -> matching * int Mods.IntMap.t -> t -> int * int val get_type : t -> int val get_id : t -> int diff --git a/core/term/model.ml b/core/term/model.ml index caafb17fb9..9722b8161e 100644 --- a/core/term/model.ml +++ b/core/term/model.ml @@ -10,9 +10,9 @@ type t = { filenames: string list; domain: Pattern.Env.t; tokens: unit NamedDecls.t; - algs: Primitives.alg_expr Locality.annot NamedDecls.t; - observables: Primitives.alg_expr Locality.annot array; - ast_rules: (string Locality.annot option * LKappa.rule Locality.annot) array; + algs: Primitives.alg_expr Loc.annoted NamedDecls.t; + observables: Primitives.alg_expr Loc.annoted array; + ast_rules: (string Loc.annoted option * LKappa.rule Loc.annoted) array; rules: Primitives.elementary_rule array; interventions: Primitives.perturbation array; dependencies_in_time: Operator.DepSet.t; @@ -105,7 +105,7 @@ let nums_of_rule name env = let nb_syntactic_rules env = Array.length env.ast_rules let num_of_alg s env = NamedDecls.elt_id ~kind:"variable" env.algs s -let get_alg env i = fst @@ snd env.algs.NamedDecls.decls.(i) +let get_alg env i = fst @@ NamedDecls.elt_val env.algs i let get_algs env = env.algs.NamedDecls.decls let nb_algs env = NamedDecls.size env.algs let num_of_token str env = NamedDecls.elt_id ~kind:"token" env.tokens str @@ -225,17 +225,17 @@ let check_if_counter_is_filled_enough x = then raise (ExceptionDefn.Malformed_Decl - (Locality.dummy_annot "There is no way for the simulation to stop.")) + (Loc.annot_with_dummy "There is no way for the simulation to stop.")) let overwrite_vars alg_overwrite env = let algs' = Array.map - (fun (x, y) -> Locality.dummy_annot x, y) + (fun (x, y) -> Loc.annot_with_dummy x, y) env.algs.NamedDecls.decls in let () = List.iter - (fun (i, v) -> algs'.(i) <- fst algs'.(i), Locality.dummy_annot v) + (fun (i, v) -> algs'.(i) <- fst algs'.(i), Loc.annot_with_dummy v) alg_overwrite in { env with algs = NamedDecls.create algs' } @@ -253,14 +253,14 @@ let fold_alg_expr f_alg f_bool x env = let fold_mixture_in_expr f = fold_alg_expr (Alg_expr.fold_on_mixture f) (Alg_expr.fold_bool_on_mixture f) -let propagate_constant ~warning ?max_time ?max_events updated_vars alg_overwrite - x = +let propagate_constant ~warning ?max_time ?max_events ~updated_vars + ~alg_overwrite x = let algs' = - Array.map (fun (x, y) -> Locality.dummy_annot x, y) x.algs.NamedDecls.decls + Array.map (fun (x, y) -> Loc.annot_with_dummy x, y) x.algs.NamedDecls.decls in let () = List.iter - (fun (i, v) -> algs'.(i) <- fst algs'.(i), Locality.dummy_annot v) + (fun (i, v) -> algs'.(i) <- fst algs'.(i), Loc.annot_with_dummy v) alg_overwrite in let () = @@ -269,7 +269,7 @@ let propagate_constant ~warning ?max_time ?max_events updated_vars alg_overwrite algs'.(i) <- ( na, Alg_expr.propagate_constant ~warning ?max_time ?max_events - updated_vars algs' v )) + ~updated_vars ~vars:algs' v )) algs' in { @@ -279,23 +279,23 @@ let propagate_constant ~warning ?max_time ?max_events updated_vars alg_overwrite algs = NamedDecls.create algs'; observables = Array.map - (Alg_expr.propagate_constant ~warning ?max_time ?max_events updated_vars - algs') + (Alg_expr.propagate_constant ~warning ?max_time ?max_events + ~updated_vars ~vars:algs') x.observables; ast_rules = x.ast_rules; rules = Array.map (Primitives.map_expr_rule (Alg_expr.propagate_constant ~warning ?max_time ?max_events - updated_vars algs')) + ~updated_vars ~vars:algs')) x.rules; interventions = Array.map (Primitives.map_expr_perturbation (Alg_expr.propagate_constant ~warning ?max_time ?max_events - updated_vars algs') + ~updated_vars ~vars:algs') (Alg_expr.propagate_constant_bool ~warning ?max_time ?max_events - updated_vars algs')) + ~updated_vars ~vars:algs')) x.interventions; dependencies_in_time = x.dependencies_in_time; dependencies_in_event = x.dependencies_in_event; @@ -384,7 +384,7 @@ let of_yojson = function algs = NamedDecls.of_json (fun x -> - Locality.dummy_annot + Loc.annot_with_dummy (Alg_expr.e_of_yojson ~filenames kappa_instance_of_yojson (JsonUtil.to_int ?error_msg:None) x)) @@ -394,7 +394,7 @@ let of_yojson = function | `List o -> Tools.array_map_of_list (fun x -> - Locality.dummy_annot + Loc.annot_with_dummy (Alg_expr.e_of_yojson ~filenames kappa_instance_of_yojson (JsonUtil.to_int ?error_msg:None) x)) @@ -407,10 +407,10 @@ let of_yojson = function Tools.array_map_of_list (function | `List [ `Null; r ] -> - None, Locality.dummy_annot (LKappa.rule_of_json ~filenames r) + None, Loc.annot_with_dummy (LKappa.rule_of_json ~filenames r) | `List [ `String n; r ] -> - ( Some (Locality.dummy_annot n), - Locality.dummy_annot (LKappa.rule_of_json ~filenames r) ) + ( Some (Loc.annot_with_dummy n), + Loc.annot_with_dummy (LKappa.rule_of_json ~filenames r) ) | _ -> raise Not_found) o | `Null -> [||] diff --git a/core/term/model.mli b/core/term/model.mli index 3fb5157daf..eb088df0f0 100644 --- a/core/term/model.mli +++ b/core/term/model.mli @@ -14,14 +14,14 @@ val init : filenames:string list -> Pattern.Env.t -> unit NamedDecls.t -> - Primitives.alg_expr Locality.annot NamedDecls.t -> + Primitives.alg_expr Loc.annoted NamedDecls.t -> Operator.DepSet.t * Operator.DepSet.t * Operator.DepSet.t array * Operator.DepSet.t array -> - (string Locality.annot option * LKappa.rule Locality.annot) array + (string Loc.annoted option * LKappa.rule Loc.annoted) array * Primitives.elementary_rule array -> - Primitives.alg_expr Locality.annot array -> + Primitives.alg_expr Loc.annoted array -> Primitives.perturbation array -> Contact_map.t -> t @@ -33,14 +33,14 @@ val deconstruct : string list * Pattern.Env.t * unit NamedDecls.t - * Primitives.alg_expr Locality.annot NamedDecls.t + * Primitives.alg_expr Loc.annoted NamedDecls.t * (Operator.DepSet.t * Operator.DepSet.t * Operator.DepSet.t array * Operator.DepSet.t array) - * ((string Locality.annot option * LKappa.rule Locality.annot) array + * ((string Loc.annoted option * LKappa.rule Loc.annoted) array * Primitives.elementary_rule array) - * Primitives.alg_expr Locality.annot array + * Primitives.alg_expr Loc.annoted array * Primitives.perturbation array * Contact_map.t @@ -50,7 +50,7 @@ val nb_rules : t -> int val nb_syntactic_rules : t -> int val nb_perturbations : t -> int val domain : t -> Pattern.Env.t -val get_obs : t -> Primitives.alg_expr Locality.annot array +val get_obs : t -> Primitives.alg_expr Loc.annoted array val get_rules : t -> Primitives.elementary_rule array val new_domain : Pattern.Env.t -> t -> t val signatures : t -> Signature.s @@ -58,15 +58,15 @@ val tokens_finder : t -> int Mods.StringMap.t val algs_finder : t -> int Mods.StringMap.t val contact_map : t -> Contact_map.t val get_alg : t -> int -> Primitives.alg_expr -val get_algs : t -> (string * Primitives.alg_expr Locality.annot) array +val get_algs : t -> (string * Primitives.alg_expr Loc.annoted) array val get_perturbation : t -> int -> Primitives.perturbation val get_rule : t -> int -> Primitives.elementary_rule val get_ast_rule : t -> int -> LKappa.rule val get_ast_rule_with_label : - t -> int -> string Locality.annot option * LKappa.rule Locality.annot + t -> int -> string Loc.annoted option * LKappa.rule Loc.annoted -val get_ast_rule_rate_pos : unary:bool -> t -> int -> Locality.t +val get_ast_rule_rate_pos : unary:bool -> t -> int -> Loc.t val map_observables : (Primitives.alg_expr -> 'a) -> t -> 'a array val fold_rules : @@ -87,9 +87,9 @@ val all_dependencies : * Operator.DepSet.t array * Operator.DepSet.t array -val num_of_agent : string Locality.annot -> t -> int -val num_of_alg : string Locality.annot -> t -> int -val num_of_token : string Locality.annot -> t -> int +val num_of_agent : string Loc.annoted -> t -> int +val num_of_alg : string Loc.annoted -> t -> int +val num_of_token : string Loc.annoted -> t -> int val nums_of_rule : string -> t -> int list val print_ast_rule : @@ -127,11 +127,11 @@ val check_if_counter_is_filled_enough : t -> unit val overwrite_vars : (int * Primitives.alg_expr) list -> t -> t val propagate_constant : - warning:(pos:Locality.t -> (Format.formatter -> unit) -> unit) -> + warning:(pos:Loc.t -> (Format.formatter -> unit) -> unit) -> ?max_time:float -> ?max_events:int -> - int list -> - (int * Primitives.alg_expr) list -> + updated_vars:int list -> + alg_overwrite:(int * Primitives.alg_expr) list -> t -> t (** [propagate_constant updated_vars overwrite_vars env] *) diff --git a/core/term/pattern.ml b/core/term/pattern.ml index c6ef1c2c88..f664204ee6 100644 --- a/core/term/pattern.ml +++ b/core/term/pattern.ml @@ -121,7 +121,7 @@ let reconstruction_navigation cc = cc.recogn_nav (** Errors *) let already_specified ?sigs x i = ExceptionDefn.Malformed_Decl - (Locality.dummy_annot + (Loc.annot_with_dummy (Format.asprintf "Site %a of agent %a already specified" (Agent.print_site ?sigs x) i (Agent.print ?sigs ~with_id:false) @@ -129,7 +129,7 @@ let already_specified ?sigs x i = let dangling_node ~sigs tys x = ExceptionDefn.Malformed_Decl - (Locality.dummy_annot + (Loc.annot_with_dummy (Format.asprintf "Cannot proceed because last declared agent %a/*%i*/%a" (Signature.print_agent sigs) (raw_find_ty tys x) x Format.pp_print_string @@ -180,7 +180,7 @@ let weight cc = in links - (double / 2) -let are_compatible ~debugMode ?possibilities ~strict root1 cc1 root2 cc2 = +let are_compatible ~debug_mode ?possibilities ~strict root1 cc1 root2 cc2 = let tick x = match possibilities with | None -> () @@ -216,12 +216,12 @@ let are_compatible ~debugMode ?possibilities ~strict root1 cc1 root2 cc2 = | Link (n1, s1), Link (n2, s2) -> if s1 = s2 then if Renaming.mem n1 ren then - if Renaming.apply ~debugMode ren n1 = n2 then + if Renaming.apply ~debug_mode ren n1 = n2 then Some (true, todo, ren), None else None, Some (cc1, o, cc2, p, i, false) else ( - match Renaming.add ~debugMode n1 n2 ren with + match Renaming.add ~debug_mode n1 n2 ren with | None -> None, Some (cc1, o, cc2, p, i, false) | Some r' -> if find_ty cc1 n1 = find_ty cc2 n2 then @@ -240,7 +240,7 @@ let are_compatible ~debugMode ?possibilities ~strict root1 cc1 root2 cc2 = | None, conflict -> None, conflict | Some (one_edges', todos', ren'), _ -> aux one_edges' ren' todos') in - match Renaming.add ~debugMode root1 root2 (Renaming.empty ()) with + match Renaming.add ~debug_mode root1 root2 (Renaming.empty ()) with | None -> assert false | Some r -> let a_single_agent = @@ -256,7 +256,7 @@ let are_compatible ~debugMode ?possibilities ~strict root1 cc1 root2 cc2 = aux a_single_agent r [ root1, root2 ] (** @return injection from a to b *) -let equal ~debugMode a b = +let equal ~debug_mode a b = match Tools.array_min_equal_not_null (Array.map (fun x -> List.length x, x) a.nodes_by_type) @@ -274,11 +274,11 @@ let equal ~debugMode a b = match bool with | Some _ -> bool | None -> - let rename, _ = are_compatible ~debugMode ~strict:true h1 a ag b in + let rename, _ = are_compatible ~debug_mode ~strict:true h1 a ag b in rename) None ags -let automorphisms ~debugMode a = +let automorphisms ~debug_mode a = match Array.fold_left (fun acc x -> Tools.min_pos_int_not_zero acc (List.length x, x)) @@ -288,7 +288,7 @@ let automorphisms ~debugMode a = | _, (h :: _ as l) -> List.fold_left (fun acc ag -> - match are_compatible ~debugMode ~strict:true h a ag a with + match are_compatible ~debug_mode ~strict:true h a ag a with | None, _ -> acc | Some r, _ -> r :: acc) [] l @@ -305,7 +305,7 @@ let potential_pairing sigs = acc lb) Mods.Int2Set.empty -let matchings ~debugMode sigs a b = +let matchings ~debug_mode sigs a b = let possibilities = ref (potential_pairing sigs a.nodes_by_type b.nodes_by_type) in @@ -313,7 +313,9 @@ let matchings ~debugMode sigs a b = match Mods.Int2Set.choose !possibilities with | None -> acc | Some (x, y) -> - (match are_compatible ~debugMode ~possibilities ~strict:false x a y b with + (match + are_compatible ~debug_mode ~possibilities ~strict:false x a y b + with | None, _ -> for_one_root acc | Some r, _ -> for_one_root (r :: acc)) in @@ -395,29 +397,29 @@ let raw_to_navigation (full : bool) nodes_by_type nodes = build_for (true, []) (*wip*) [] (*already_done*) [ x ] (*todo*) -let rec sub_minimize_renaming ~debugMode r = function +let rec sub_minimize_renaming ~debug_mode r = function | [], _ -> r | _ :: _, [] -> assert false | (x :: q as l), y :: q' -> if x = y then ( - match Renaming.add ~debugMode x y r with - | Some r' -> sub_minimize_renaming ~debugMode r' (q, q') + match Renaming.add ~debug_mode x y r with + | Some r' -> sub_minimize_renaming ~debug_mode r' (q, q') | None -> assert false ) else ( let fsts, lst = List_util.pop_last l in - match Renaming.add ~debugMode lst y r with - | Some r' -> sub_minimize_renaming ~debugMode r' (fsts, q') + match Renaming.add ~debug_mode lst y r with + | Some r' -> sub_minimize_renaming ~debug_mode r' (fsts, q') | None -> assert false ) -let minimize_renaming ~debugMode dst_nbt ref_nbt = +let minimize_renaming ~debug_mode dst_nbt ref_nbt = let re = Renaming.empty () in Tools.array_fold_lefti - (fun ty r ids -> sub_minimize_renaming ~debugMode r (ids, ref_nbt.(ty))) + (fun ty r ids -> sub_minimize_renaming ~debug_mode r (ids, ref_nbt.(ty))) re dst_nbt -let minimize ~debugMode cand_nbt cand_nodes ref_nbt = - let re = minimize_renaming ~debugMode cand_nbt ref_nbt in +let minimize ~debug_mode cand_nbt cand_nodes ref_nbt = + let re = minimize_renaming ~debug_mode cand_nbt ref_nbt in let re_img = Renaming.image re in let nodes_by_type = Array.map (List.filter (fun a -> Mods.IntSet.mem a re_img)) ref_nbt @@ -428,11 +430,11 @@ let minimize ~debugMode cand_nbt cand_nodes ref_nbt = let sites' = Array.map (function - | Link (n, s), i -> Link (Renaming.apply ~debugMode re n, s), i + | Link (n, s), i -> Link (Renaming.apply ~debug_mode re n, s), i | ((UnSpec | Free), _) as x -> x) sites in - Mods.IntMap.add (Renaming.apply ~debugMode re id) sites' acc) + Mods.IntMap.add (Renaming.apply ~debug_mode re id) sites' acc) cand_nodes Mods.IntMap.empty in { @@ -442,7 +444,7 @@ let minimize ~debugMode cand_nbt cand_nodes ref_nbt = } (* returns a list of cc where each cc is included in cc1*) -let infs ~debugMode sigs cc1 cc2 = +let infs ~debug_mode sigs cc1 cc2 = let possibilities = ref (potential_pairing sigs cc1.nodes_by_type cc2.nodes_by_type) in @@ -480,7 +482,7 @@ let infs ~debugMode sigs cc1 cc2 = if s1 = s2 then if Renaming.mem n1 ren then ( acc, - ( (if Renaming.apply ~debugMode ren n1 = n2 then + ( (if Renaming.apply ~debug_mode ren n1 = n2 then x else UnSpec), @@ -489,7 +491,7 @@ let infs ~debugMode sigs cc1 cc2 = else -1 ) ) else ( - match Renaming.add ~debugMode n1 n2 ren with + match Renaming.add ~debug_mode n1 n2 ren with | None -> ( acc, ( UnSpec, @@ -534,7 +536,7 @@ let infs ~debugMode sigs cc1 cc2 = match Mods.Int2Set.choose !possibilities with | None -> acc | Some (root1, root2) -> - (match Renaming.add ~debugMode root1 root2 (Renaming.empty ()) with + (match Renaming.add ~debug_mode root1 root2 (Renaming.empty ()) with | None -> assert false | Some r -> let nodes = aux r Mods.IntMap.empty [ root1, root2 ] in @@ -547,7 +549,7 @@ let infs ~debugMode sigs cc1 cc2 = (List.filter (fun a -> Mods.IntMap.mem a nodes)) cc1.nodes_by_type in - minimize ~debugMode nodes_by_type nodes cc1.nodes_by_type :: acc + minimize ~debug_mode nodes_by_type nodes cc1.nodes_by_type :: acc ) in for_one_root acc') @@ -890,7 +892,7 @@ let of_yojson sig_decl = function | `Null -> empty_cc sig_decl | x -> raise (Yojson.Basic.Util.Type_error ("Not a pattern", x)) -let merge_compatible ~debugMode reserved_ids free_id inj1_to_2 cc1 cc2 = +let merge_compatible ~debug_mode reserved_ids free_id inj1_to_2 cc1 cc2 = let img = Renaming.image inj1_to_2 in let available_ids = Array.map @@ -901,7 +903,7 @@ let merge_compatible ~debugMode reserved_ids free_id inj1_to_2 cc1 cc2 = Array.map (List_util.map_option (fun id -> if Renaming.mem id inj1_to_2 then - Some (Renaming.apply ~debugMode inj1_to_2 id) + Some (Renaming.apply ~debug_mode inj1_to_2 id) else None)) cc1.nodes_by_type @@ -916,7 +918,7 @@ let merge_compatible ~debugMode reserved_ids free_id inj1_to_2 cc1 cc2 = let get_cc2 j (((inj1, free_id), inj2, (todos1, todos2)) as pack) = if Renaming.mem j inj2 then - Renaming.apply ~debugMode inj2 j, pack + Renaming.apply ~debug_mode inj2 j, pack else ( let ty = find_ty cc2 j in let img, free_id' = @@ -938,11 +940,11 @@ let merge_compatible ~debugMode reserved_ids free_id inj1_to_2 cc1 cc2 = h in ( img, - ( ( (match Renaming.add ~debugMode o img inj1 with + ( ( (match Renaming.add ~debug_mode o img inj1 with | Some x -> x | None -> assert false), free_id' ), - (match Renaming.add ~debugMode j img inj2 with + (match Renaming.add ~debug_mode j img inj2 with | Some x -> x | None -> assert false), (todos1, (j, img) :: todos2) ) ) @@ -951,7 +953,7 @@ let merge_compatible ~debugMode reserved_ids free_id inj1_to_2 cc1 cc2 = let get_cc1 i (((inj1, free_id), inj2, (todos1, todos2)) as pack) = if Renaming.mem i inj1 then - Renaming.apply ~debugMode inj1 i, pack + Renaming.apply ~debug_mode inj1 i, pack else ( let ty = find_ty cc1 i in let img, free_id' = @@ -963,7 +965,7 @@ let merge_compatible ~debugMode reserved_ids free_id inj1_to_2 cc1 cc2 = in let () = used_ids.(ty) <- img :: used_ids.(ty) in ( img, - ( ( (match Renaming.add ~debugMode i img inj1 with + ( ( (match Renaming.add ~debug_mode i img inj1 with | Some x -> x | None -> assert false), free_id' ), @@ -1072,7 +1074,7 @@ let merge_compatible ~debugMode reserved_ids free_id inj1_to_2 cc1 cc2 = recogn_nav = raw_to_navigation false nodes_by_type nodes; } ) -let build_navigation_between ~debugMode inj_d_to_o cc_o cc_d = +let build_navigation_between ~debug_mode inj_d_to_o cc_o cc_d = let rec handle_links discovered next_round recogn intern = function | [] -> if next_round = [] then @@ -1080,7 +1082,7 @@ let build_navigation_between ~debugMode inj_d_to_o cc_o cc_d = else handle_links discovered [] recogn intern next_round | (((i, j, s), (n', s')) as h) :: todos -> - let n = Renaming.apply ~debugMode inj_d_to_o n' in + let n = Renaming.apply ~debug_mode inj_d_to_o n' in (match Mods.IntSet.mem j discovered, Mods.IntSet.mem n' discovered with | false, false -> handle_links discovered (h :: next_round) recogn intern todos @@ -1184,7 +1186,7 @@ module Env : sig val to_navigation : t -> id -> Navigation.abstract Navigation.t val get_elementary : - debugMode:bool -> + debug_mode:bool -> t -> Agent.t -> int -> @@ -1412,13 +1414,15 @@ end = struct let new_obs_map env f = Mods.DynArray.init env.max_obs f - let get_elementary ~debugMode domain ((_, ty) as node) s arrow = + let get_elementary ~debug_mode domain ((_, ty) as node) s arrow = let sa = domain.elementaries.(ty) in let rec find_good_edge = function (*one should use a hash here*) | [] -> None | (st, cc_id) :: tail -> - (match Navigation.compatible_fresh_point ~debugMode st node s arrow with + (match + Navigation.compatible_fresh_point ~debug_mode st node s arrow + with | None -> find_good_edge tail | Some inj' -> let dst = get domain cc_id in @@ -1440,14 +1444,14 @@ let print ~noCounters ?domain ~with_id f id = print_cc ~noCounters ~sigs:(Env.signatures env) ?cc_id ~with_id f env.Env.domain.(id).Env.content -let embeddings_to_fully_specified ~debugMode domain a_id b = +let embeddings_to_fully_specified ~debug_mode domain a_id b = let a = domain.Env.domain.(a_id).Env.content in match find_root a with | None -> [ Renaming.empty () ] | Some (h, ty) -> List.fold_left (fun acc ag -> - match are_compatible ~debugMode ~strict:false h a ag b with + match are_compatible ~debug_mode ~strict:false h a ag b with | None, _ -> acc | Some r, _ -> r :: acc) [] b.nodes_by_type.(ty) @@ -1542,13 +1546,15 @@ module PreEnv = struct in elementaries - let present_in_dst ~debugMode dst inj2dst nav = + let present_in_dst ~debug_mode dst inj2dst nav = let rec aux_present_in_dst inj' = function | [] -> Some inj' | ((Navigation.Fresh _, _), _) :: _ -> assert false | ((Navigation.Existing ag, si), Navigation.ToNothing) :: t -> (match - Mods.IntMap.find_option (Renaming.apply ~debugMode inj' ag) dst.nodes + Mods.IntMap.find_option + (Renaming.apply ~debug_mode inj' ag) + dst.nodes with | None -> assert false | Some n -> @@ -1558,7 +1564,9 @@ module PreEnv = struct None) | ((Navigation.Existing ag, si), Navigation.ToInternal i) :: t -> (match - Mods.IntMap.find_option (Renaming.apply ~debugMode inj' ag) dst.nodes + Mods.IntMap.find_option + (Renaming.apply ~debug_mode inj' ag) + dst.nodes with | None -> assert false | Some n -> @@ -1570,11 +1578,13 @@ module PreEnv = struct Navigation.ToNode (Navigation.Existing ag', si') ) :: t -> (match - Mods.IntMap.find_option (Renaming.apply ~debugMode inj' ag) dst.nodes + Mods.IntMap.find_option + (Renaming.apply ~debug_mode inj' ag) + dst.nodes with | None -> assert false | Some n -> - if fst n.(si) = Link (Renaming.apply ~debugMode inj' ag', si') then + if fst n.(si) = Link (Renaming.apply ~debug_mode inj' ag', si') then aux_present_in_dst inj' t else None) @@ -1582,14 +1592,16 @@ module PreEnv = struct Navigation.ToNode (Navigation.Fresh (ag', ty'), si') ) :: t -> (match - Mods.IntMap.find_option (Renaming.apply ~debugMode inj' ag) dst.nodes + Mods.IntMap.find_option + (Renaming.apply ~debug_mode inj' ag) + dst.nodes with | None -> assert false | Some n -> (match n.(si) with | Link (agl, sil), _ -> if List.mem agl dst.nodes_by_type.(ty') && si' = sil then ( - match Renaming.add ~debugMode ag' agl inj' with + match Renaming.add ~debug_mode ag' agl inj' with | None -> None | Some inj' -> aux_present_in_dst inj' t ) else @@ -1598,7 +1610,7 @@ module PreEnv = struct in aux_present_in_dst inj2dst nav - let rec insert_navigation ~debugMode id_by_type nb_id domain dst_id dst + let rec insert_navigation ~debug_mode id_by_type nb_id domain dst_id dst inj2dst p_id = if p_id = dst_id then 0 @@ -1607,18 +1619,18 @@ module PreEnv = struct let rec insert_nav_sons = function | [] -> let (inj_e2sup, _), sup = - merge_compatible ~debugMode id_by_type nb_id inj2dst + merge_compatible ~debug_mode id_by_type nb_id inj2dst point.Env.content dst in - (match equal ~debugMode sup dst with + (match equal ~debug_mode sup dst with | None -> assert false | Some inj_sup2dst -> let inj_dst2p = Renaming.inverse - (Renaming.compose ~debugMode false inj_e2sup inj_sup2dst) + (Renaming.compose ~debug_mode false inj_e2sup inj_sup2dst) in let nav = - build_navigation_between ~debugMode inj_dst2p point.Env.content + build_navigation_between ~debug_mode inj_dst2p point.Env.content dst in let () = @@ -1628,17 +1640,17 @@ module PreEnv = struct in List.length nav) | h :: t -> - (match present_in_dst ~debugMode dst inj2dst h.Env.next with + (match present_in_dst ~debug_mode dst inj2dst h.Env.next with | None -> insert_nav_sons t | Some inj_p'2dst -> - insert_navigation ~debugMode id_by_type nb_id domain dst_id dst - (Renaming.compose ~debugMode false h.Env.inj inj_p'2dst) + insert_navigation ~debug_mode id_by_type nb_id domain dst_id dst + (Renaming.compose ~debug_mode false h.Env.inj inj_p'2dst) h.Env.dst) in insert_nav_sons point.Env.sons ) - let add_cc ~debugMode ~toplevel ?origin env p_id element = + let add_cc ~debug_mode ~toplevel ?origin env p_id element = let w = weight element in let hash = coarse_hash element in let rec aux = function @@ -1651,8 +1663,8 @@ module PreEnv = struct Some ( List.sort Mods.int_compare (List.map - (fun r -> Renaming.apply ~debugMode r rid) - (automorphisms ~debugMode element)), + (fun r -> Renaming.apply ~debug_mode r rid) + (automorphisms ~debug_mode element)), rty ) ) else None @@ -1669,7 +1681,7 @@ module PreEnv = struct element, p_id ) | h :: t -> - (match equal ~debugMode element h.element with + (match equal ~debug_mode element h.element with | None -> let a, b, c, d = aux t in h :: a, b, c, d @@ -1684,8 +1696,8 @@ module PreEnv = struct Some ( List.sort Mods.int_compare (List.map - (fun r -> Renaming.apply ~debugMode r rid) - (automorphisms ~debugMode element)), + (fun r -> Renaming.apply ~debug_mode r rid) + (automorphisms ~debug_mode element)), rty ) ) in @@ -1706,11 +1718,11 @@ module PreEnv = struct in Mods.IntMap.add w (Mods.IntMap.add hash env_w_h env_w) env, r, out, out_id - let rec saturate_one ~debugMode ~sharing sigs this max_l level + let rec saturate_one ~debug_mode ~sharing sigs this max_l level ((_, domain) as acc) = function | [] -> if level < max_l then - saturate_one ~debugMode ~sharing sigs this max_l (succ level) acc + saturate_one ~debug_mode ~sharing sigs this max_l (succ level) acc (Mods.IntMap.fold (fun _ -> List.rev_append) (Mods.IntMap.find_default Mods.IntMap.empty (succ level) domain) @@ -1721,17 +1733,17 @@ module PreEnv = struct let news = match sharing with | No_sharing -> assert false - | Max_sharing -> infs sigs ~debugMode this.element h.element + | Max_sharing -> infs sigs ~debug_mode this.element h.element | Compatible_patterns -> List.rev_map (fun r -> intersection r this.element h.element) - (matchings ~debugMode sigs this.element h.element) + (matchings ~debug_mode sigs this.element h.element) in let acc' = List.fold_left (fun (mid, acc) cc -> let id' = succ mid in - let x, _, _, id = add_cc ~debugMode ~toplevel:false acc id' cc in + let x, _, _, id = add_cc ~debug_mode ~toplevel:false acc id' cc in ( (if id = id' then id else @@ -1739,25 +1751,26 @@ module PreEnv = struct x )) acc news in - saturate_one ~debugMode ~sharing sigs this max_l level acc' t + saturate_one ~debug_mode ~sharing sigs this max_l level acc' t - let rec saturate_level ~debugMode ~sharing sigs max_l level + let rec saturate_level ~debug_mode ~sharing sigs max_l level ((_, domain) as acc) = if level < 2 then acc else ( match Mods.IntMap.find_option level domain with - | None -> saturate_level ~debugMode ~sharing sigs max_l (pred level) acc + | None -> saturate_level ~debug_mode ~sharing sigs max_l (pred level) acc | Some list -> let rec aux acc = function - | [] -> saturate_level ~debugMode ~sharing sigs max_l (pred level) acc + | [] -> + saturate_level ~debug_mode ~sharing sigs max_l (pred level) acc | h :: t -> - aux (saturate_one ~debugMode ~sharing sigs h max_l level acc t) t + aux (saturate_one ~debug_mode ~sharing sigs h max_l level acc t) t in aux acc (Mods.IntMap.fold (fun _ -> List.rev_append) list []) ) - let saturate ~debugMode ~sharing sigs domain = + let saturate ~debug_mode ~sharing sigs domain = match Mods.IntMap.max_key domain with | None -> 0, domain | Some l -> @@ -1771,7 +1784,7 @@ module PreEnv = struct (match sharing with | No_sharing -> si, domain | Compatible_patterns | Max_sharing -> - saturate_level ~debugMode ~sharing sigs l l (si, domain)) + saturate_level ~debug_mode ~sharing sigs l l (si, domain)) let of_env env = let add_cc acc p = @@ -1830,7 +1843,7 @@ let fresh_cc_id domain = List.fold_left (fun acc p -> max acc p.p_id) acc x)) domain 0) -let raw_finish_new ~debugMode ~toplevel ?origin wk = +let raw_finish_new ~debug_mode ~toplevel ?origin wk = let () = check_dangling wk in (* rebuild env *) let () = @@ -1848,13 +1861,13 @@ let raw_finish_new ~debugMode ~toplevel ?origin wk = } in let preenv, r, out, out_id = - PreEnv.add_cc ~debugMode ~toplevel ?origin wk.cc_env (fresh_cc_id wk.cc_env) - cc_candidate + PreEnv.add_cc ~debug_mode ~toplevel ?origin wk.cc_env + (fresh_cc_id wk.cc_env) cc_candidate in PreEnv.fresh wk.sigs wk.reserved_id wk.free_id preenv, r, out, out_id -let finish_new ~debugMode ?origin wk = - raw_finish_new ~debugMode ~toplevel:true ?origin wk +let finish_new ~debug_mode ?origin wk = + raw_finish_new ~debug_mode ~toplevel:true ?origin wk let new_link wk (((x, _) as n1), i) (((y, _) as n2), j) = let x_n = Mods.IntMap.find_default [||] x wk.cc_nodes in @@ -1929,14 +1942,14 @@ let new_node wk type_id = Mods.IntMap.add wk.free_id (Array.make arity (UnSpec, -1)) wk.cc_nodes; } ) -let minimal_env ~debugMode env contact_map = +let minimal_env ~debug_mode env contact_map = Tools.array_fold_lefti (fun ty -> Tools.array_fold_lefti (fun s acc (ints, links) -> let w = begin_new acc in let n, w = new_node w ty in let w = new_free w (n, s) in - let acc', _, _, _ = raw_finish_new ~debugMode ~toplevel:false w in + let acc', _, _, _ = raw_finish_new ~debug_mode ~toplevel:false w in let acc'' = Mods.IntSet.fold (fun i acc -> @@ -1944,7 +1957,7 @@ let minimal_env ~debugMode env contact_map = let n, w = new_node w ty in let w = new_internal_state w (n, s) i in let out, _, _, _ = - raw_finish_new ~debugMode ~toplevel:false w + raw_finish_new ~debug_mode ~toplevel:false w in out) ints acc' @@ -1955,13 +1968,13 @@ let minimal_env ~debugMode env contact_map = let n, w = new_node w ty in let n', w = new_node w ty' in let w = new_link w (n, s) (n', s') in - let out, _, _, _ = raw_finish_new ~debugMode ~toplevel:false w in + let out, _, _, _ = raw_finish_new ~debug_mode ~toplevel:false w in if ty = ty' && s < s' then ( let w = begin_new out in let n, w = new_node w ty in let w = new_link w (n, s) (n, s') in let out', _, _, _ = - raw_finish_new ~debugMode ~toplevel:false w + raw_finish_new ~debug_mode ~toplevel:false w in out' ) else @@ -1981,11 +1994,11 @@ let fold_by_type f cc acc = let fold f cc acc = Mods.IntMap.fold f cc.nodes acc -let finalize ~debugMode ~sharing env contact_map = +let finalize ~debug_mode ~sharing env contact_map = let sigs = PreEnv.sigs env in - let env = minimal_env ~debugMode env contact_map in + let env = minimal_env ~debug_mode env contact_map in let si, complete_domain = - PreEnv.saturate ~debugMode ~sharing sigs env.PreEnv.domain + PreEnv.saturate ~debug_mode ~sharing sigs env.PreEnv.domain in let domain = Array.make (succ si) (PreEnv.empty_point env.PreEnv.sig_decl) in let singles = Mods.IntMap.find_default Mods.IntMap.empty 1 complete_domain in @@ -2027,13 +2040,13 @@ let finalize ~debugMode ~sharing env contact_map = List.fold_left (fun acc e -> match - matchings ~debugMode sigs e.element x.element + matchings ~debug_mode sigs e.element x.element with | [] -> acc | injs -> List.fold_left (fun acc inj_e_x -> - PreEnv.insert_navigation ~debugMode + PreEnv.insert_navigation ~debug_mode env.PreEnv.id_by_type env.PreEnv.nb_id domain x.p_id x.element inj_e_x e.p_id + acc) @@ -2077,7 +2090,7 @@ let finalize ~debugMode ~sharing env contact_map = }, { stat_nodes = si; PreEnv.stat_nav_steps } ) -let merge_on_inf ~debugMode env m g1 g2 = +let merge_on_inf ~debug_mode env m g1 g2 = let m_list = Renaming.to_list m in let root1, root2 = List.hd m_list in let pairing = @@ -2087,11 +2100,11 @@ let merge_on_inf ~debugMode env m g1 g2 = in let possibilities = ref pairing in match - are_compatible ~debugMode ~possibilities ~strict:false root1 g1 root2 g2 + are_compatible ~debug_mode ~possibilities ~strict:false root1 g1 root2 g2 with | Some m', _ -> let _, pushout = - merge_compatible ~debugMode env.PreEnv.id_by_type env.PreEnv.nb_id m' g1 + merge_compatible ~debug_mode env.PreEnv.id_by_type env.PreEnv.nb_id m' g1 g2 in Some pushout, None diff --git a/core/term/pattern.mli b/core/term/pattern.mli index 676d21dd7e..78b115ed57 100644 --- a/core/term/pattern.mli +++ b/core/term/pattern.mli @@ -62,7 +62,7 @@ module Env : sig val get_single_agent : int -> t -> (id * Operator.DepSet.t) option val get_elementary : - debugMode:bool -> + debug_mode:bool -> t -> Agent.t -> int -> @@ -108,7 +108,7 @@ val new_internal_state : work -> Agent.t * int -> int -> work (** [new_link_type work (node,site) type] *) val finish_new : - debugMode:bool -> + debug_mode:bool -> ?origin:Operator.rev_dep -> work -> PreEnv.t * Renaming.t * cc * id @@ -147,10 +147,10 @@ val reconstruction_navigation : t -> Navigation.abstract Navigation.t val find_ty : cc -> int -> int (** Abstraction leak, please do not use *) -val automorphisms : debugMode:bool -> t -> Renaming.t list +val automorphisms : debug_mode:bool -> t -> Renaming.t list val embeddings_to_fully_specified : - debugMode:bool -> Env.t -> id -> cc -> Renaming.t list + debug_mode:bool -> Env.t -> id -> cc -> Renaming.t list val size_of_cc : cc -> int @@ -189,17 +189,17 @@ val sharing_level_of_string : string -> sharing_level (** Deserialize JSON data of type {!sharing_level}. *) val finalize : - debugMode:bool -> + debug_mode:bool -> sharing:sharing_level -> PreEnv.t -> Contact_map.t -> Env.t * PreEnv.stat -val infs : debugMode:bool -> Signature.s -> t -> t -> t list -val matchings : debugMode:bool -> Signature.s -> t -> t -> Renaming.t list +val infs : debug_mode:bool -> Signature.s -> t -> t -> t list +val matchings : debug_mode:bool -> Signature.s -> t -> t -> Renaming.t list val merge_on_inf : - debugMode:bool -> + debug_mode:bool -> PreEnv.t -> Renaming.t -> t -> diff --git a/core/term/pattern_compiler.ml b/core/term/pattern_compiler.ml index 2115495451..7b8f114bfe 100644 --- a/core/term/pattern_compiler.ml +++ b/core/term/pattern_compiler.ml @@ -42,7 +42,7 @@ let find_implicit_infos contact_map ags = let or_ty = i, ty_id in let () = ports.(i) <- - Locality.dummy_annot (LKappa.LNK_VALUE (free_id, (p, a))), s + Loc.annot_with_dummy (LKappa.LNK_VALUE (free_id, (p, a))), s in aux_one (succ free_id) previous current ((free_id, (p, a), or_ty, new_switch s) :: todos) @@ -54,7 +54,7 @@ let find_implicit_infos contact_map ags = let ports' = Array.copy ports in let () = ports'.(i) <- - Locality.dummy_annot (LKappa.LNK_VALUE (free_id, (p, a))), s + Loc.annot_with_dummy (LKappa.LNK_VALUE (free_id, (p, a))), s in let todos' = (free_id, (p, a), or_ty, new_switch s) :: todos in aux_one (succ free_id) prev' current todos' ag_tail ag ports' @@ -111,7 +111,7 @@ let complete_with_candidate outs prevs ag ag_tail id todo p_id dst_info p_switch let ports' = Array.copy ag.LKappa.ra_ports in let () = ports'.(i) <- - Locality.dummy_annot (LKappa.LNK_VALUE (id, dst_info)), p_switch + Loc.annot_with_dummy (LKappa.LNK_VALUE (id, dst_info)), p_switch in ( List.rev_append prevs ({ @@ -128,7 +128,7 @@ let complete_with_candidate outs prevs ag ag_tail id todo p_id dst_info p_switch let ports' = Array.copy ag.LKappa.ra_ports in let () = ports'.(i) <- - Locality.dummy_annot (LKappa.LNK_VALUE (id, dst_info)), s + Loc.annot_with_dummy (LKappa.LNK_VALUE (id, dst_info)), s in ( List.rev_append prevs ({ @@ -154,7 +154,7 @@ let complete_with_candidate outs prevs ag ag_tail id todo p_id dst_info p_switch | [ _ ], todo' -> let ports' = Array.copy ag.LKappa.ra_ports in let () = - ports'.(i) <- Locality.dummy_annot (LKappa.LNK_VALUE (id, x)), s + ports'.(i) <- Loc.annot_with_dummy (LKappa.LNK_VALUE (id, x)), s in ( List.rev_append prevs ({ @@ -178,12 +178,12 @@ let complete_with_candidate outs prevs ag ag_tail id todo p_id dst_info p_switch let new_agent_with_one_link sigs ty_id port link dst_info switch = let arity = Signature.arity sigs ty_id in let ports = - Array.make arity (Locality.dummy_annot LKappa.LNK_ANY, LKappa.Maintained) + Array.make arity (Loc.annot_with_dummy LKappa.LNK_ANY, LKappa.Maintained) in let internals = Array.make arity LKappa.I_ANY in let () = ports.(port) <- - Locality.dummy_annot (LKappa.LNK_VALUE (link, dst_info)), switch + Loc.annot_with_dummy (LKappa.LNK_VALUE (link, dst_info)), switch in { LKappa.ra_type = ty_id; @@ -410,7 +410,7 @@ let rec add_agents_in_cc sigs id wk registered_links | [] -> (match Mods.IntMap.root registered_links with | None -> wk, transf, links_transf, instantiations, remains - | Some (key, _) -> link_occurence_failure key Locality.dummy) + | Some (key, _) -> link_occurence_failure key Loc.dummy) | ag :: ag_l -> let node, wk = Pattern.new_node wk ag.LKappa.ra_type in let place = Matching.Agent.Existing (node, id) in @@ -481,7 +481,7 @@ let rec add_agents_in_cc sigs id wk registered_links | ((LKappa.LNK_SOME | LKappa.LNK_TYPE _), _), _ -> raise (ExceptionDefn.Internal_Error - (Locality.dummy_annot + (Loc.annot_with_dummy "Try to create the connected components of an ambiguous \ mixture.")) | (LKappa.LNK_VALUE (i, _), pos), s -> @@ -559,7 +559,7 @@ let rec complete_with_creation sigs (removed, added) links_transf create_actions (match Mods.IntMap.root links_transf with | None -> List.rev_append actions create_actions, (List.rev removed, List.rev added) - | Some (i, _) -> link_occurence_failure i Locality.dummy) + | Some (i, _) -> link_occurence_failure i Loc.dummy) | ag :: ag_l -> let place = Matching.Agent.Fresh (ag.Raw_mixture.a_type, fresh) in let rec handle_ports added l_t actions intf site_id = @@ -609,7 +609,7 @@ let incr_origin = function | (Operator.ALG _ | Operator.MODIF _) as x -> x | Operator.RULE i -> Operator.RULE (succ i) -let connected_components_of_mixture ~debugMode created mix (env, origin) = +let connected_components_of_mixture ~debug_mode created mix (env, origin) = let sigs = Pattern.PreEnv.sigs env in let rec aux env transformations instantiations links_transf acc id = function | [] -> @@ -658,24 +658,26 @@ let connected_components_of_mixture ~debugMode created mix (env, origin) = add_agents_in_cc sigs id wk Mods.IntMap.empty transformations links_transf instantiations' t [ h ] in - let env', inj, cc, cc_id = Pattern.finish_new ~debugMode ?origin wk_out in + let env', inj, cc, cc_id = + Pattern.finish_new ~debug_mode ?origin wk_out + in let added' = List_util.smart_map - (Primitives.Transformation.rename ~debugMode id inj) + (Primitives.Transformation.rename ~debug_mode id inj) added in let removed' = List_util.smart_map - (Primitives.Transformation.rename ~debugMode id inj) + (Primitives.Transformation.rename ~debug_mode id inj) removed in let event' = - Instantiation.rename_abstract_event ~debugMode id inj event + Instantiation.rename_abstract_event ~debug_mode id inj event in let l_t' = Mods.IntMap.map (fun ((p, s) as x) -> - let p' = Matching.Agent.rename ~debugMode id inj p in + let p' = Matching.Agent.rename ~debug_mode id inj p in if p == p' then x else @@ -692,15 +694,15 @@ let rule_mixtures_of_ambiguous_rule contact_map sigs precomp_mixs = (find_implicit_infos contact_map (List.rev (List.rev_map LKappa.copy_rule_agent precomp_mixs))) -let connected_components_sum_of_ambiguous_rule ~debugMode ~compileModeOn +let connected_components_sum_of_ambiguous_rule ~debug_mode ~compile_mode_on contact_map env ?origin precomp_mixs created = - let noCounters = debugMode in + let noCounters = debug_mode in let sigs = Pattern.PreEnv.sigs env in let all_mixs = rule_mixtures_of_ambiguous_rule contact_map sigs precomp_mixs in let () = - if compileModeOn then + if compile_mode_on then Format.eprintf "@[_____(%i)@,%a@]@." (List.length all_mixs) (Pp.list Pp.cut (fun f x -> Format.fprintf f "@[%a%a@]" @@ -712,13 +714,13 @@ let connected_components_sum_of_ambiguous_rule ~debugMode ~compileModeOn all_mixs in List_util.fold_right_map - (connected_components_of_mixture ~debugMode created) + (connected_components_of_mixture ~debug_mode created) all_mixs (env, origin) -let connected_components_sum_of_ambiguous_mixture ~debugMode ~compileModeOn +let connected_components_sum_of_ambiguous_mixture ~debug_mode ~compile_mode_on contact_map env ?origin mix = let rules, (cc_env, _) = - connected_components_sum_of_ambiguous_rule ~debugMode ~compileModeOn + connected_components_sum_of_ambiguous_rule ~debug_mode ~compile_mode_on contact_map env ?origin mix [] in ( cc_env, @@ -733,7 +735,7 @@ let aux_lkappa_of_pattern free_id p = (fun ~pos ~agent_type intf (acc, lnk_pack) -> let ra_ports = Array.make (Array.length intf) - (Locality.dummy_annot LKappa.LNK_ANY, LKappa.Maintained) + (Loc.annot_with_dummy LKappa.LNK_ANY, LKappa.Maintained) in let ra_ints = Array.make (Array.length intf) LKappa.I_ANY in let out = @@ -757,7 +759,7 @@ let aux_lkappa_of_pattern free_id p = | Pattern.Free -> let () = ra_ports.(site) <- - Locality.dummy_annot LKappa.LNK_FREE, LKappa.Maintained + Loc.annot_with_dummy LKappa.LNK_FREE, LKappa.Maintained in pack | Pattern.Link (dst_a, dst_s) -> @@ -766,12 +768,12 @@ let aux_lkappa_of_pattern free_id p = | Some (id, dst_info) -> let () = ra_ports.(site) <- - ( Locality.dummy_annot (LKappa.LNK_VALUE (id, dst_info)), + ( Loc.annot_with_dummy (LKappa.LNK_VALUE (id, dst_info)), LKappa.Maintained ) in let () = (Mods.IntMap.find_default out dst_a acc').LKappa.ra_ports.(dst_s) <- - ( Locality.dummy_annot (LKappa.LNK_VALUE (id, src_info)), + ( Loc.annot_with_dummy (LKappa.LNK_VALUE (id, src_info)), LKappa.Maintained ) in pack @@ -953,7 +955,7 @@ let lkappa_of_elementary_rule sigs domain r = in r_mix, r_created (*{ - LKappa.r_mix; LKappa.r_created; LKappa.r_editStyle = true; + LKappa.r_mix; LKappa.r_created; LKappa.r_edit_style = true; LKappa.r_rate = r.Primitives.rate; LKappa.r_un_rate = r.Primitives.unary_rate; LKappa.r_delta_tokens = r.Primitives.delta_tokens; diff --git a/core/term/pattern_compiler.mli b/core/term/pattern_compiler.mli index 1ad503b006..5e116f4bfb 100644 --- a/core/term/pattern_compiler.mli +++ b/core/term/pattern_compiler.mli @@ -9,8 +9,8 @@ (** Kappa pattern compiler *) val connected_components_sum_of_ambiguous_mixture : - debugMode:bool -> - compileModeOn:bool -> + debug_mode:bool -> + compile_mode_on:bool -> Contact_map.t -> Pattern.PreEnv.t -> ?origin:Operator.rev_dep -> @@ -21,8 +21,8 @@ val connected_components_sum_of_ambiguous_mixture : list val connected_components_sum_of_ambiguous_rule : - debugMode:bool -> - compileModeOn:bool -> + debug_mode:bool -> + compile_mode_on:bool -> Contact_map.t -> Pattern.PreEnv.t -> ?origin:Operator.rev_dep -> diff --git a/core/term/pattern_decompiler.ml b/core/term/pattern_decompiler.ml index 712225b209..05c78c7bb9 100644 --- a/core/term/pattern_decompiler.ml +++ b/core/term/pattern_decompiler.ml @@ -13,7 +13,7 @@ let of_snapshot g = let ra_type = ag.Snapshot.node_type in let ar = Array.length ag.Snapshot.node_sites in let ra_ports = - Array.make ar (Locality.dummy_annot LKappa.LNK_FREE, LKappa.Maintained) + Array.make ar (Loc.annot_with_dummy LKappa.LNK_FREE, LKappa.Maintained) in let ra_ints = Array.make ar LKappa.I_ANY in let pack' = @@ -31,14 +31,14 @@ let of_snapshot g = | Some va, dangling' -> let () = ra_ports.(id) <- - ( Locality.dummy_annot (LKappa.LNK_VALUE (va, (-1, -1))), + ( Loc.annot_with_dummy (LKappa.LNK_VALUE (va, (-1, -1))), LKappa.Maintained ) in dangling', free_id | None, dangling' -> let () = ra_ports.(id) <- - ( Locality.dummy_annot + ( Loc.annot_with_dummy (LKappa.LNK_VALUE (free_id, (-1, -1))), LKappa.Maintained ) in @@ -60,14 +60,15 @@ let of_snapshot g = in out -let patterns_of_mixture ~debugMode contact_map sigs pre_env e = +let patterns_of_mixture ~debug_mode contact_map sigs pre_env e = let snap = Edges.build_snapshot ~raw:false sigs e in let pre_env', acc = Snapshot.fold (fun (cc_cache, acc) i m -> match Pattern_compiler.connected_components_sum_of_ambiguous_mixture - ~debugMode ~compileModeOn:false contact_map cc_cache (of_snapshot m) + ~debug_mode ~compile_mode_on:false contact_map cc_cache + (of_snapshot m) with | cc_cache', [ ([| (_, x) |], _) ] -> cc_cache', Tools.recti (fun a _ -> x :: a) acc i diff --git a/core/term/pattern_decompiler.mli b/core/term/pattern_decompiler.mli index 3311f06bce..368c24abb3 100644 --- a/core/term/pattern_decompiler.mli +++ b/core/term/pattern_decompiler.mli @@ -7,7 +7,7 @@ (******************************************************************************) val patterns_of_mixture : - debugMode:bool -> + debug_mode:bool -> Contact_map.t -> Signature.s -> Pattern.PreEnv.t -> diff --git a/core/term/primitives.ml b/core/term/primitives.ml index fb21bc1a6d..38c3e2c936 100644 --- a/core/term/primitives.ml +++ b/core/term/primitives.ml @@ -59,59 +59,60 @@ module Transformation = struct NegativeInternalized (Matching.Agent.of_yojson a, s) | x -> raise (Yojson.Basic.Util.Type_error ("Invalid agent", x)) - let rename ~debugMode id inj = function + let rename ~debug_mode id inj = function | Freed (p, s) as x -> - let p' = Matching.Agent.rename ~debugMode id inj p in + let p' = Matching.Agent.rename ~debug_mode id inj p in if p == p' then x else Freed (p', s) | NegativeWhatEver (p, s) as x -> - let p' = Matching.Agent.rename ~debugMode id inj p in + let p' = Matching.Agent.rename ~debug_mode id inj p in if p == p' then x else NegativeWhatEver (p', s) | Linked ((p1, s1), (p2, s2)) as x -> - let p1' = Matching.Agent.rename ~debugMode id inj p1 in - let p2' = Matching.Agent.rename ~debugMode id inj p2 in + let p1' = Matching.Agent.rename ~debug_mode id inj p1 in + let p2' = Matching.Agent.rename ~debug_mode id inj p2 in if p1 == p1' && p2 == p2' then x else Linked ((p1', s1), (p2', s2)) | PositiveInternalized (p, s, i) as x -> - let p' = Matching.Agent.rename ~debugMode id inj p in + let p' = Matching.Agent.rename ~debug_mode id inj p in if p == p' then x else PositiveInternalized (p', s, i) | NegativeInternalized (p, s) as x -> - let p' = Matching.Agent.rename ~debugMode id inj p in + let p' = Matching.Agent.rename ~debug_mode id inj p in if p == p' then x else NegativeInternalized (p', s) | Agent p as x -> - let p' = Matching.Agent.rename ~debugMode id inj p in + let p' = Matching.Agent.rename ~debug_mode id inj p in if p == p' then x else Agent p' - let concretize ~debugMode inj2graph = function - | Agent n -> Agent (Matching.Agent.concretize ~debugMode inj2graph n) - | Freed (n, s) -> Freed (Matching.Agent.concretize ~debugMode inj2graph n, s) + let concretize ~debug_mode inj2graph = function + | Agent n -> Agent (Matching.Agent.concretize ~debug_mode inj2graph n) + | Freed (n, s) -> + Freed (Matching.Agent.concretize ~debug_mode inj2graph n, s) | Linked ((n, s), (n', s')) -> Linked - ( (Matching.Agent.concretize ~debugMode inj2graph n, s), - (Matching.Agent.concretize ~debugMode inj2graph n', s') ) + ( (Matching.Agent.concretize ~debug_mode inj2graph n, s), + (Matching.Agent.concretize ~debug_mode inj2graph n', s') ) | NegativeWhatEver (n, s) -> - NegativeWhatEver (Matching.Agent.concretize ~debugMode inj2graph n, s) + NegativeWhatEver (Matching.Agent.concretize ~debug_mode inj2graph n, s) | PositiveInternalized (n, s, i) -> PositiveInternalized - (Matching.Agent.concretize ~debugMode inj2graph n, s, i) + (Matching.Agent.concretize ~debug_mode inj2graph n, s, i) | NegativeInternalized (n, s) -> - NegativeInternalized (Matching.Agent.concretize ~debugMode inj2graph n, s) + NegativeInternalized (Matching.Agent.concretize ~debug_mode inj2graph n, s) let map_fold_agent f x acc = match x with @@ -292,12 +293,12 @@ end type alg_expr = (Pattern.id array list, int) Alg_expr.e type elementary_rule = { - rate: alg_expr Locality.annot; - unary_rate: (alg_expr Locality.annot * alg_expr option) option; + rate: alg_expr Loc.annoted; + unary_rate: (alg_expr Loc.annoted * alg_expr option) option; connected_components: Pattern.id array; (*id -> cc*) removed: Instantiation.abstract Transformation.t list; inserted: Instantiation.abstract Transformation.t list; - delta_tokens: (alg_expr Locality.annot * int) list; + delta_tokens: (alg_expr Loc.annoted * int) list; syntactic_rule: int; (** [0] means generated for perturbation. *) instantiations: Instantiation.abstract Instantiation.event; } @@ -319,14 +320,12 @@ let rule_to_yojson ~filenames r = JsonUtil.smart_assoc [ ( "rate", - Locality.annot_to_yojson ~filenames - (alg_expr_to_yojson ~filenames) - r.rate ); + Loc.yojson_of_annoted ~filenames (alg_expr_to_yojson ~filenames) r.rate + ); ( "unary_rate", JsonUtil.of_option (JsonUtil.of_pair - (Locality.annot_to_yojson ~filenames - (alg_expr_to_yojson ~filenames)) + (Loc.yojson_of_annoted ~filenames (alg_expr_to_yojson ~filenames)) (JsonUtil.of_option (alg_expr_to_yojson ~filenames))) r.unary_rate ); ( "connected_components", @@ -336,8 +335,7 @@ let rule_to_yojson ~filenames r = ( "delta_tokens", JsonUtil.of_list (JsonUtil.of_pair ~lab1:"val" ~lab2:"tok" - (Locality.annot_to_yojson ~filenames - (alg_expr_to_yojson ~filenames)) + (Loc.yojson_of_annoted ~filenames (alg_expr_to_yojson ~filenames)) JsonUtil.of_int) r.delta_tokens ); "syntactic_rule", `Int r.syntactic_rule; @@ -351,13 +349,13 @@ let rule_of_yojson ~filenames r = (try { rate = - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (alg_expr_of_yojson ~filenames) (List.assoc "rate" l); unary_rate = JsonUtil.to_option (JsonUtil.to_pair - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (alg_expr_of_yojson ~filenames)) (JsonUtil.to_option (alg_expr_of_yojson ~filenames))) (Yojson.Basic.Util.member "unary_rate" x); @@ -373,7 +371,7 @@ let rule_of_yojson ~filenames r = delta_tokens = JsonUtil.to_list (JsonUtil.to_pair ~lab1:"val" ~lab2:"tok" - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (alg_expr_of_yojson ~filenames)) (JsonUtil.to_int ?error_msg:None)) (Yojson.Basic.Util.member "delta_tokens" x); @@ -417,16 +415,16 @@ let fully_specified_pattern_to_positive_transformations cc = List.rev tr type 'alg_expr print_expr = - | Str_pexpr of string Locality.annot - | Alg_pexpr of 'alg_expr Locality.annot + | Str_pexpr of string Loc.annoted + | Alg_pexpr of 'alg_expr Loc.annoted let print_expr_to_yojson ~filenames f_mix f_var = function - | Str_pexpr s -> Locality.annot_to_yojson ~filenames JsonUtil.of_string s + | Str_pexpr s -> Loc.yojson_of_annoted ~filenames JsonUtil.of_string s | Alg_pexpr a -> `Assoc [ ( "A", - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (Alg_expr.e_to_yojson ~filenames f_mix f_var) a ); ] @@ -436,7 +434,7 @@ let print_expr_of_yojson ~filenames f_mix f_var x = | `Assoc [ ("A", x) ] -> (try Alg_pexpr - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (Alg_expr.e_of_yojson ~filenames f_mix f_var) x) with Yojson.Basic.Util.Type_error _ -> @@ -444,7 +442,7 @@ let print_expr_of_yojson ~filenames f_mix f_var x = | x -> (try Str_pexpr - (Locality.annot_of_yojson ~filenames + (Loc.annoted_of_yojson ~filenames (JsonUtil.to_string ?error_msg:None) x) with Yojson.Basic.Util.Type_error _ -> @@ -491,8 +489,8 @@ let din_kind_of_string s = read_din_kind (Yojson.Safe.init_lexer ()) (Lexing.from_string s) type modification = - | ITER_RULE of alg_expr Locality.annot * elementary_rule - | UPDATE of int * alg_expr Locality.annot + | ITER_RULE of alg_expr Loc.annoted * elementary_rule + | UPDATE of int * alg_expr Loc.annoted | SNAPSHOT of bool * alg_expr print_expr list | STOP of alg_expr print_expr list | CFLOW of @@ -526,8 +524,7 @@ let modification_to_yojson ~filenames = function [ "action", `String "ITER"; ( "repeats", - Locality.annot_to_yojson ~filenames (alg_expr_to_yojson ~filenames) n - ); + Loc.yojson_of_annoted ~filenames (alg_expr_to_yojson ~filenames) n ); "rule", rule_to_yojson ~filenames r; ] | UPDATE (v, e) -> @@ -536,8 +533,7 @@ let modification_to_yojson ~filenames = function "action", `String "UPDATE"; "var", `Int v; ( "value", - Locality.annot_to_yojson ~filenames (alg_expr_to_yojson ~filenames) e - ); + Loc.yojson_of_annoted ~filenames (alg_expr_to_yojson ~filenames) e ); ] | SNAPSHOT (raw, f) -> JsonUtil.smart_assoc @@ -645,7 +641,7 @@ let modification_of_yojson ~filenames = function | `Assoc [ ("value", e); ("action", `String "UPDATE"); ("var", `Int v) ] | `Assoc [ ("value", e); ("var", `Int v); ("action", `String "UPDATE") ] -> UPDATE - (v, Locality.annot_of_yojson ~filenames (alg_expr_of_yojson ~filenames) e) + (v, Loc.annoted_of_yojson ~filenames (alg_expr_of_yojson ~filenames) e) | `Assoc [ ("action", `String "ITER"); ("repeats", n); ("rule", r) ] | `Assoc [ ("action", `String "ITER"); ("rule", r); ("repeats", n) ] | `Assoc [ ("repeats", n); ("action", `String "ITER"); ("rule", r) ] @@ -653,7 +649,7 @@ let modification_of_yojson ~filenames = function | `Assoc [ ("repeats", n); ("rule", r); ("action", `String "ITER") ] | `Assoc [ ("rule", r); ("repeats", n); ("action", `String "ITER") ] -> ITER_RULE - ( Locality.annot_of_yojson ~filenames (alg_expr_of_yojson ~filenames) n, + ( Loc.annoted_of_yojson ~filenames (alg_expr_of_yojson ~filenames) n, rule_of_yojson ~filenames r ) | `Assoc [ ("action", `String "PLOTNOW") ] -> PLOTENTRY | `Assoc [ ("action", `String "DINOFF"); ("file", `List l) ] @@ -744,9 +740,9 @@ let modification_of_yojson ~filenames = function type perturbation = { alarm: Nbr.t option; - precondition: (Pattern.id array list, int) Alg_expr.bool Locality.annot; + precondition: (Pattern.id array list, int) Alg_expr.bool Loc.annoted; effect: modification list; - repeat: (Pattern.id array list, int) Alg_expr.bool Locality.annot; + repeat: (Pattern.id array list, int) Alg_expr.bool Loc.annoted; needs_backtrack: bool; } @@ -765,12 +761,12 @@ let perturbation_to_yojson ~filenames p = [ "alarm", JsonUtil.of_option (fun n -> Nbr.to_yojson n) p.alarm; ( "condition", - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (bool_expr_to_yojson ~filenames) p.precondition ); "effect", JsonUtil.of_list (modification_to_yojson ~filenames) p.effect; ( "repeat", - Locality.annot_to_yojson ~filenames + Loc.yojson_of_annoted ~filenames (bool_expr_to_yojson ~filenames) p.repeat ); "needs_backtrack", `Bool p.needs_backtrack; @@ -782,7 +778,7 @@ let perturbation_of_yojson ~filenames = function { alarm = JsonUtil.to_option Nbr.of_yojson (List.assoc "alarm" l); precondition = - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (bool_expr_of_yojson ~filenames) (List.assoc "condition" l); effect = @@ -790,7 +786,7 @@ let perturbation_of_yojson ~filenames = function (modification_of_yojson ~filenames) (List.assoc "effect" l); repeat = - Locality.annot_of_yojson ~filenames + Loc.annoted_of_yojson ~filenames (bool_expr_of_yojson ~filenames) (List.assoc "repeat" l); needs_backtrack = diff --git a/core/term/primitives.mli b/core/term/primitives.mli index 206f3c2b5a..f21d777b63 100644 --- a/core/term/primitives.mli +++ b/core/term/primitives.mli @@ -25,14 +25,14 @@ module Transformation : sig val equal : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool val rename : - debugMode:bool -> + debug_mode:bool -> int -> Renaming.t -> Instantiation.abstract t -> Instantiation.abstract t val concretize : - debugMode:bool -> + debug_mode:bool -> Matching.t * int Mods.IntMap.t -> Instantiation.abstract t -> Instantiation.concrete t @@ -59,12 +59,12 @@ end type alg_expr = (Pattern.id array list, int) Alg_expr.e type elementary_rule = { - rate: alg_expr Locality.annot; - unary_rate: (alg_expr Locality.annot * alg_expr option) option; + rate: alg_expr Loc.annoted; + unary_rate: (alg_expr Loc.annoted * alg_expr option) option; connected_components: Pattern.id array; removed: Instantiation.abstract Transformation.t list; inserted: Instantiation.abstract Transformation.t list; - delta_tokens: (alg_expr Locality.annot * int) list; + delta_tokens: (alg_expr Loc.annoted * int) list; syntactic_rule: int; (** [0] means generated for perturbation. *) instantiations: Instantiation.abstract Instantiation.event; (** In the reverse order on purpose so that we rev_map when we @@ -87,8 +87,8 @@ val fully_specified_pattern_to_positive_transformations : Pattern.cc -> Instantiation.concrete Transformation.t list type 'alg_expr print_expr = - | Str_pexpr of string Locality.annot - | Alg_pexpr of 'alg_expr Locality.annot + | Str_pexpr of string Loc.annoted + | Alg_pexpr of 'alg_expr Loc.annoted val print_expr_to_yojson : filenames:int Mods.StringMap.t -> @@ -126,8 +126,8 @@ val din_kind_of_string : string -> din_kind (** Deserialize JSON data of type {!din_kind}. *) type modification = - | ITER_RULE of alg_expr Locality.annot * elementary_rule - | UPDATE of int * alg_expr Locality.annot + | ITER_RULE of alg_expr Loc.annoted * elementary_rule + | UPDATE of int * alg_expr Loc.annoted | SNAPSHOT of bool * alg_expr print_expr list | STOP of alg_expr print_expr list | CFLOW of @@ -148,9 +148,9 @@ type modification = type perturbation = { alarm: Nbr.t option; - precondition: (Pattern.id array list, int) Alg_expr.bool Locality.annot; + precondition: (Pattern.id array list, int) Alg_expr.bool Loc.annoted; effect: modification list; - repeat: (Pattern.id array list, int) Alg_expr.bool Locality.annot; + repeat: (Pattern.id array list, int) Alg_expr.bool Loc.annoted; needs_backtrack: bool; } @@ -166,26 +166,26 @@ val extract_connected_components_modifications : modification list -> Pattern.id list val extract_connected_components_bool : - (Pattern.id array list, int) Alg_expr.bool Locality.annot -> Pattern.id list + (Pattern.id array list, int) Alg_expr.bool Loc.annoted -> Pattern.id list val map_expr_rule : - (alg_expr Locality.annot -> alg_expr Locality.annot) -> + (alg_expr Loc.annoted -> alg_expr Loc.annoted) -> elementary_rule -> elementary_rule val map_expr_perturbation : - (alg_expr Locality.annot -> alg_expr Locality.annot) -> - ((Pattern.id array list, int) Alg_expr.bool Locality.annot -> - (Pattern.id array list, int) Alg_expr.bool Locality.annot) -> + (alg_expr Loc.annoted -> alg_expr Loc.annoted) -> + ((Pattern.id array list, int) Alg_expr.bool Loc.annoted -> + (Pattern.id array list, int) Alg_expr.bool Loc.annoted) -> perturbation -> perturbation val fold_expr_rule : - ('a -> alg_expr Locality.annot -> 'a) -> 'a -> elementary_rule -> 'a + ('a -> alg_expr Loc.annoted -> 'a) -> 'a -> elementary_rule -> 'a val fold_expr_perturbation : - ('a -> alg_expr Locality.annot -> 'a) -> - ('a -> (Pattern.id array list, int) Alg_expr.bool Locality.annot -> 'a) -> + ('a -> alg_expr Loc.annoted -> 'a) -> + ('a -> (Pattern.id array list, int) Alg_expr.bool Loc.annoted -> 'a) -> 'a -> perturbation -> 'a diff --git a/core/term/raw_mixture.ml b/core/term/raw_mixture.ml index 8cc857fc69..fda0907e08 100644 --- a/core/term/raw_mixture.ml +++ b/core/term/raw_mixture.ml @@ -95,12 +95,14 @@ let union_find_counters sigs mix = in t -let print_link ~noCounters incr_agents f = function +let print_link ~noCounters counter_agents f = function | FREE -> Format.pp_print_string f "[.]" | VAL i -> (try - let root = find incr_agents i in - let counter, (_, is_counter) = Mods.DynArray.get incr_agents.rank root in + let root = find counter_agents i in + let counter, (_, is_counter) = + Mods.DynArray.get counter_agents.rank root + in if is_counter && not noCounters then Format.fprintf f "{=%d}" counter else @@ -115,7 +117,8 @@ 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 incr_agents ag_ty f (ports, ints) = +let print_intf ~noCounters with_link ?sigs counter_agents ag_ty f (ports, ints) + = let rec aux empty i = if i < Array.length ports then ( let () = @@ -126,7 +129,7 @@ let print_intf ~noCounters with_link ?sigs incr_agents ag_ty f (ports, ints) = Pp.space) (aux_pp_si sigs ag_ty i) ints.(i) (if with_link then - print_link ~noCounters incr_agents + print_link ~noCounters counter_agents else fun _ _ -> ()) @@ -142,14 +145,14 @@ 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 incr_agents f ag = +let print_agent ~noCounters created link ?sigs counter_agents f ag = Format.fprintf f "%a(@[%a@])%t" (aux_pp_ag sigs) ag.a_type - (print_intf ~noCounters link ?sigs incr_agents ag.a_type) + (print_intf ~noCounters link ?sigs counter_agents ag.a_type) (ag.a_ports, ag.a_ints) (fun f -> if created then Format.pp_print_string f "+") let print ~noCounters ~created ~initial_comma ?sigs f mix = - let incr_agents = union_find_counters sigs mix in + let counter_agents = union_find_counters sigs mix in let rec aux_print some = function | [] -> () | h :: t -> @@ -162,7 +165,9 @@ let print ~noCounters ~created ~initial_comma ?sigs f mix = aux_print some t else ( let () = if some then Pp.comma f in - let () = print_agent ~noCounters created true ?sigs incr_agents f h in + let () = + print_agent ~noCounters created true ?sigs counter_agents f h + in aux_print true t ) in diff --git a/core/term/raw_mixture.mli b/core/term/raw_mixture.mli index c3cc73cda0..16b1f609d5 100644 --- a/core/term/raw_mixture.mli +++ b/core/term/raw_mixture.mli @@ -9,7 +9,9 @@ type internal = int option type link = FREE | VAL of int type agent = { a_type: int; a_ports: link array; a_ints: internal array } + type t = agent list +(** This is a simple `raw` type of mixture, used as the mixture state after a rule was applied *) val copy_agent : agent -> agent diff --git a/core/version/dune b/core/version/dune index 23150d8783..26a85ab059 100644 --- a/core/version/dune +++ b/core/version/dune @@ -1,9 +1,12 @@ (library - (name kappa_version) - (libraries yojson result re) - (flags (:standard))) + (name kappa_version) + (libraries yojson result re) + (flags (:standard))) (rule - (targets git_version.ml) - (deps ../../dev/get-git-version.ml) - (action (with-stdout-to %{targets} (run ocaml unix.cma %{deps})))) + (targets git_version.ml) + (deps ../../dev/get-git-version.ml) + (action + (with-stdout-to + %{targets} + (run ocaml unix.cma %{deps})))) diff --git a/gui/panel_settings.ml b/gui/panel_settings.ml index 642dc99993..b7723450b5 100644 --- a/gui/panel_settings.ml +++ b/gui/panel_settings.ml @@ -252,7 +252,7 @@ module DivErrorMessage : Ui_common.Div = struct in match range with | None -> "" - | Some range -> Format.sprintf "[%s]" range.Locality.file) + | Some range -> Format.sprintf "[%s]" range.Loc.file) error_index State_error.errors let file_label = diff --git a/gui/panel_settings_controller.ml b/gui/panel_settings_controller.ml index 96156f5990..1d849f7ffd 100644 --- a/gui/panel_settings_controller.ml +++ b/gui/panel_settings_controller.ml @@ -69,9 +69,9 @@ let intervene_simulation () = Lwt.return_unit) ~error:(fun _ -> Lwt.return_unit)) -let focus_range (range : Locality.t) : unit = - let file_id = range.Locality.file in - let line = range.Locality.from_position.Locality.line in +let focus_range (range : Loc.t) : unit = + let file_id = range.Loc.file in + let line = range.Loc.from_position.Loc.line in Common.async __LOC__ (fun () -> State_error.wrap ~append:true __LOC__ (State_file.select_file file_id (Some line)) diff --git a/gui/panel_settings_controller.mli b/gui/panel_settings_controller.mli index afc31c3994..615ec0c3a2 100644 --- a/gui/panel_settings_controller.mli +++ b/gui/panel_settings_controller.mli @@ -13,4 +13,4 @@ val start_simulation : unit -> unit val intervene_simulation : unit -> unit val simulation_trace : unit -> unit val simulation_outputs : unit -> unit -val focus_range : Locality.range -> unit +val focus_range : Loc.t -> unit diff --git a/gui/rest_api.ml b/gui/rest_api.ml index 88e1beb09c..4ceee843d5 100644 --- a/gui/rest_api.ml +++ b/gui/rest_api.ml @@ -435,7 +435,7 @@ class manager ~(timeout : float option) ~url ~project_id : Api.rest_manager = JsonUtil.to_option Public_data.refined_influence_node_of_json (Yojson.Basic.from_string x)) - method get_influence_map_node_at ~filename { Locality.line; Locality.chr } = + method get_influence_map_node_at ~filename { Loc.line; Loc.chr } = send ?timeout request_count (Format.sprintf "%s/v2/projects/%s/analyses/influence_map/node_at?file=%s&line=%i&chr=%i" diff --git a/gui/state_file.ml b/gui/state_file.ml index 7d2e83f401..3df9547793 100644 --- a/gui/state_file.ml +++ b/gui/state_file.ml @@ -9,10 +9,10 @@ open Lwt.Infix type slot = { local: string option; name: string } -type active = { rank: int; cursor_pos: Locality.position; out_of_sync: bool } +type active = { rank: int; cursor_pos: Loc.position; out_of_sync: bool } type model = { current: active option; directory: slot Mods.IntMap.t } -let dummy_cursor_pos = { Locality.line = -1; Locality.chr = 0 } +let dummy_cursor_pos = { Loc.line = -1; Loc.chr = 0 } let blank_state = { current = None; directory = Mods.IntMap.empty } let model, set_directory_state = React.S.create blank_state @@ -323,7 +323,7 @@ let cursor_activity ~line ~ch = Some { rank; - cursor_pos = { Locality.line = succ line; chr = ch }; + cursor_pos = { Loc.line = succ line; chr = ch }; out_of_sync; }; directory = v.directory; diff --git a/gui/state_file.mli b/gui/state_file.mli index 8cb6df4733..84e19c017d 100644 --- a/gui/state_file.mli +++ b/gui/state_file.mli @@ -39,7 +39,7 @@ val cursor_activity : line:int -> ch:int -> unit val out_of_sync : bool -> unit type slot = { local: string option; name: string } -type active = { rank: int; cursor_pos: Locality.position; out_of_sync: bool } +type active = { rank: int; cursor_pos: Loc.position; out_of_sync: bool } type model = { current: active option; directory: slot Mods.IntMap.t } val model : model React.signal @@ -48,7 +48,7 @@ val current_filename : string option React.signal val with_current_pos : ?eq:('a -> 'a -> bool) -> ?on:bool React.signal -> - (string -> Locality.position -> 'a option) -> + (string -> Loc.position -> 'a option) -> 'a -> 'a React.signal diff --git a/gui/state_project.ml b/gui/state_project.ml index c8bdb7acb3..d047cfddc1 100644 --- a/gui/state_project.ml +++ b/gui/state_project.ml @@ -236,6 +236,7 @@ let computing_watcher manager setter = let add_project is_new project_id : unit Api.result Lwt.t = let state_va = React.S.value state in + (* TODO: Is it ok to get the value like this ? *) let catalog = state_va.project_catalog in (try Lwt.return diff --git a/gui/state_project.mli b/gui/state_project.mli index f7d4f5abd4..03fcd699bf 100644 --- a/gui/state_project.mli +++ b/gui/state_project.mli @@ -46,7 +46,7 @@ val init : string list -> unit Lwt.t (* run on application init *) val sync : unit -> unit Api.result Lwt.t -(* to synch state of application with runtime *) +(* to sync state of application with runtime *) val with_project : label:string -> diff --git a/gui/state_runtime.ml b/gui/state_runtime.ml index 5ebfc04c40..e8c685a81e 100644 --- a/gui/state_runtime.ml +++ b/gui/state_runtime.ml @@ -181,7 +181,7 @@ class embedded () : Api.concrete_manager = method get_influence_map_node_at ~filename pos : _ Api.result Lwt.t = List.find_opt - (fun (_, x) -> Locality.is_included_in filename pos x) + (fun (_, x) -> Loc.is_included_in filename pos x) kasa_locator |> Option_util.map fst |> Result_util.ok ?status:None diff --git a/gui/subpanel_editor.ml b/gui/subpanel_editor.ml index bf6843ac73..ad34dddb67 100644 --- a/gui/subpanel_editor.ml +++ b/gui/subpanel_editor.ml @@ -76,9 +76,7 @@ let content () = ] let error_lint errors : Codemirror.lint Js.t Js.js_array Js.t = - let position p = - new%js Codemirror.position (p.Locality.line - 1) p.Locality.chr - in + let position p = new%js Codemirror.position (p.Loc.line - 1) p.Loc.chr in let hydrate (error : Api_types_j.message) : lint Js.t option = match error.Result_util.range with | None -> None @@ -86,7 +84,7 @@ let error_lint errors : Codemirror.lint Js.t Js.js_array Js.t = (match React.S.value State_file.current_filename with | None -> None | Some file_id -> - if range.Locality.file = file_id then + if range.Loc.file = file_id then Some (Codemirror.create_lint ~message:error.Result_util.text @@ -100,8 +98,8 @@ let error_lint errors : Codemirror.lint Js.t Js.js_array Js.t = | Logs.Warning -> Codemirror.Warning | Logs.Info -> Codemirror.Warning | Logs.Debug -> Codemirror.Warning) - ~from:(position range.Locality.from_position) - ~to_:(position range.Locality.to_position)) + ~from:(position range.Loc.from_position) + ~to_:(position range.Loc.to_position)) else None) in @@ -245,16 +243,14 @@ let onload () : unit = [ React.E.map (fun pos -> - if Some pos.Locality.file = React.S.value filename then ( - let beg = pos.Locality.from_position in + if Some pos.Loc.file = React.S.value filename then ( + let beg = pos.Loc.from_position in let first = - new%js Codemirror.position - (beg.Locality.line - 1) beg.Locality.chr + new%js Codemirror.position (beg.Loc.line - 1) beg.Loc.chr in - let en = pos.Locality.from_position in + let en = pos.Loc.from_position in let last = - new%js Codemirror.position - (en.Locality.line - 1) en.Locality.chr + new%js Codemirror.position (en.Loc.line - 1) en.Loc.chr in codemirror##setSelection first last )) diff --git a/gui/subpanel_editor.mli b/gui/subpanel_editor.mli index 8b5ca2b280..a3f5ee8733 100644 --- a/gui/subpanel_editor.mli +++ b/gui/subpanel_editor.mli @@ -7,6 +7,6 @@ (******************************************************************************) val editor_full : bool React.signal -val set_move_cursor : ?step:React.step -> Locality.t -> unit +val set_move_cursor : ?step:React.step -> Loc.t -> unit include Ui_common.Panel diff --git a/gui/tab_influences.ml b/gui/tab_influences.ml index bce34eb47e..7072f21ce6 100644 --- a/gui/tab_influences.ml +++ b/gui/tab_influences.ml @@ -276,9 +276,7 @@ let json_to_graph logger (_, _, _, _, origin, influence_map) = match node with | Public_data.Rule r -> let pos = r.Public_data.rule_position in - let contextual_help = - Locality.to_string pos ^ " " ^ r.Public_data.rule_ast - in + let contextual_help = Loc.to_string pos ^ " " ^ r.Public_data.rule_ast in let fillcolor = if is_center origin_short_opt node then !Config.center_color @@ -296,7 +294,7 @@ let json_to_graph logger (_, _, _, _, origin, influence_map) = ] | Public_data.Var r -> let pos = r.Public_data.var_position in - let contextual_help = Locality.to_string pos ^ r.Public_data.var_ast in + let contextual_help = Loc.to_string pos ^ r.Public_data.var_ast in let fillcolor = if is_center origin_short_opt node then !Config.center_color diff --git a/gui/web_worker_api.ml b/gui/web_worker_api.ml index 2c7cdceeb9..a53059e7c1 100644 --- a/gui/web_worker_api.ml +++ b/gui/web_worker_api.ml @@ -136,7 +136,7 @@ class manager () = method get_influence_map_node_at ~filename pos : _ Api.result Lwt.t = List.find_opt - (fun (_, x) -> Locality.is_included_in filename pos x) + (fun (_, x) -> Loc.is_included_in filename pos x) kasa_locator |> Option_util.map fst |> Result_util.ok ?status:None diff --git a/man/KaSim_manual.tex b/man/KaSim_manual.tex index 013e7f3ae1..0b906f1c64 100644 --- a/man/KaSim_manual.tex +++ b/man/KaSim_manual.tex @@ -77,7 +77,7 @@ \input{generated_img/version} \title{Kappa tools reference manual\\ \small (release \version)} -\author{Pierre Boutillier, J\'er\^ome Feret, Jean Krivine\thanks{corresponding author: jean.krivine@irif.fr} and L\'y Kim Quy\^en \\\href{http://www.kappalanguage.org}{KappaLanguage.org}} +\author{Pierre Boutillier, J\'er\^ome Feret, Jean Krivine\thanks{corresponding author: jean.krivine@irif.fr}, Antoine Pouille and L\'y Kim Quy\^en \\\href{http://www.kappalanguage.org}{KappaLanguage.org}} \date{} % Activate to display a given date or no date @@ -305,15 +305,15 @@ \section{General structure} $\_\ [a\sep z\ A \sep Z\ 0\sep 9\ \_\ -\ +]^+ | [ a\sep z\ A\sep Z][a\sep z\ A \sep Z\ 0\sep 9\ \_\ -\ +]^*$. -\section{Sited-graph pattern: Kappa expression} +\section{Site graph pattern: Kappa expression} -The state of the system is represented in Kappa as a sited graph: a +The state of the system is represented in Kappa as a site graph: a graph where edges use sites in nodes. One must think sites as resources. At most one edge of the graph can use a site of a node (representing an agent in our case). Moreover, all the sites of an agent must have different names. -This leads to the property that an embedding between 2 sited graphs is +This leads to the property that an embedding between 2 site graphs is completely defined by the image of one node. This is absolutely critical for the efficiency and we call this concept the \emph{rigidity of \Kappa{}}. @@ -332,13 +332,13 @@ \section{Sited-graph pattern: Kappa expression} \end{table} \subsection{Graphs} -The ASCII syntax we use to represent sited graphs follows the +The ASCII syntax we use to represent site graphs follows the skeletons (describe formally in Table \ref{tab:patterns}): \begin{itemize} -\item We write the type of the agent and then its interface (the space - separated list its sites) between parenthesis. +\item We write the type of the agent and then its interface (the + space-separated list of its sites) between parenthesis. \item The state of a site is written after its name. Sites can have 2 - kind of states: a linking state and an internal states. The order in + kind of states: a linking state and an internal state. The order in which they are specified does not matter. \item The linking state of a site is written in between squared brackets: \ttt{[]} @@ -432,7 +432,7 @@ \section{Agent signatures}\index{agent signature}\label{sec:sig} KF\index{Kappa file} by the following line: \ITE{ \item[] \ttt{\%agent: } \textit{signature\_expression} } according to an extention of the grammar given in Table~\ref{tab:patterns}. Linking -states and internal states are space separated lists instead of being +states and internal states are space-separated lists instead of being singleton. Site binding capabilities are specified by giving a list typed semi-links. diff --git a/tests/integration/cflows/cflows_json/output/cflow_Weakly_env.json.ref b/tests/integration/cflows/cflows_json/output/cflow_Weakly_env.json.ref index bdf0d0dd03..f7547a3309 100644 --- a/tests/integration/cflows/cflows_json/output/cflow_Weakly_env.json.ref +++ b/tests/integration/cflows/cflows_json/output/cflow_Weakly_env.json.ref @@ -1 +1 @@ -{"filenames":["","json.ka"],"update":{"signatures":[{"name":"A","decl":[{"name":"a","decl":[[{"name":"u","decl":null},{"name":"p","decl":null}],null,null]}]},{"name":"B","decl":[{"name":"a","decl":[[{"name":"u","decl":null},{"name":"p","decl":null}],null,null]},{"name":"b","decl":[[],null,null]}]}],"single_agents":[null,null],"elementaries":[[[[[[[1,0],0],[[2,1],1]],12],[[[[1,0],0],[[2,1],0]],11],[[[[1,0],0],1],10],[[[[1,0],0],0],9],[[[[1,0],0],null],8]]],[[[[[[1,0],0],[[2,1],0]],11],[[[[2,1],0],1],15],[[[[2,1],0],0],14],[[[[2,1],0],null],13]],[[[[[1,0],0],[[2,1],1]],12],[[[[2,1],1],null],16]]]],"dag":[{"content":null,"roots":null,"deps":[],"sons":[]},{"content":{"sorts":[null,0],"nodes":[null,[[true,1]]]},"roots":[[1],0],"deps":[["MODIF",0],["RULE",4],["RULE",2],["ALG",0]],"sons":[]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[true,1],[false,null]]]},"roots":[[2],1],"deps":[["MODIF",0],["RULE",2],["ALG",0]],"sons":[{"dst":7,"inj":[[2,2]],"nav":[[[2,1],null]]}]},{"content":{"sorts":[null,0,1,0],"nodes":[null,[[{"node":2,"site":0},1]],[[{"node":1,"site":0},1],[{"node":3,"site":0},null]],[[{"node":2,"site":1},1]]]},"roots":[[1],0],"deps":[["MODIF",1],["ALG",1]],"sons":[]},{"content":{"sorts":[null,0],"nodes":[null,[[true,0]]]},"roots":[[1],0],"deps":[["RULE",0]],"sons":[]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[true,0],[false,null]]]},"roots":[[2],1],"deps":[["RULE",1]],"sons":[]},{"content":{"sorts":[null,0,1],"nodes":[null,[[{"node":2,"site":0},1]],[[{"node":1,"site":0},1],[false,null]]]},"roots":[[1],0],"deps":[["RULE",3]],"sons":[{"dst":3,"inj":[[3,3],[2,2],[1,1]],"nav":[[[2,1],[[3,0],0]],[[3,0],1]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[true,1],[true,null]]]},"roots":[[2],1],"deps":[["RULE",4]],"sons":[]},{"content":{"sorts":[null,0],"nodes":[null,[[true,null]]]},"roots":null,"deps":[],"sons":[{"dst":1,"inj":[[1,1]],"nav":[[[1,0],1]]},{"dst":4,"inj":[[1,1]],"nav":[[[1,0],0]]}]},{"content":{"sorts":[null,0],"nodes":[null,[[false,0]]]},"roots":null,"deps":[],"sons":[{"dst":4,"inj":[[1,1]],"nav":[[[1,0],null]]}]},{"content":{"sorts":[null,0],"nodes":[null,[[false,1]]]},"roots":null,"deps":[],"sons":[{"dst":3,"inj":[[3,1],[2,2],[1,3]],"nav":[[[1,0],[[2,1],1]],[[2,0],[[3,0],0]],[[2,0],1],[[3,0],1]]},{"dst":6,"inj":[[2,2],[1,1]],"nav":[[[1,0],[[2,1],0]],[[2,0],1]]},{"dst":1,"inj":[[1,1]],"nav":[[[1,0],null]]}]},{"content":{"sorts":[null,0,1],"nodes":[null,[[{"node":2,"site":0},null]],[[{"node":1,"site":0},null],[false,null]]]},"roots":null,"deps":[],"sons":[{"dst":6,"inj":[[2,2],[1,1]],"nav":[[[2,0],1],[[1,0],1]]}]},{"content":{"sorts":[null,0,1],"nodes":[null,[[{"node":2,"site":1},null]],[[false,null],[{"node":1,"site":0},null]]]},"roots":null,"deps":[],"sons":[{"dst":3,"inj":[[3,1],[2,2],[1,3]],"nav":[[[2,0],[[3,0],0]],[[1,0],1],[[2,0],1],[[3,0],1]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[true,null],[false,null]]]},"roots":null,"deps":[],"sons":[{"dst":2,"inj":[[2,2]],"nav":[[[2,0],1]]},{"dst":5,"inj":[[2,2]],"nav":[[[2,0],0]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[false,0],[false,null]]]},"roots":null,"deps":[],"sons":[{"dst":5,"inj":[[2,2]],"nav":[[[2,0],null]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[false,1],[false,null]]]},"roots":null,"deps":[],"sons":[{"dst":6,"inj":[[2,2],[1,1]],"nav":[[[2,0],[[1,0],0]],[[1,0],1]]},{"dst":2,"inj":[[2,2]],"nav":[[[2,0],null]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[false,null],[true,null]]]},"roots":null,"deps":[],"sons":[{"dst":7,"inj":[[2,2]],"nav":[[[2,0],null],[[2,0],1]]}]}],"id_by_type":[[1,3],[2]],"max_obs":17},"tokens":[],"algs":[{"name":"ApBp","decl":["MIX",[[1,2]]]},{"name":"ABA","decl":["MIX",[[3]]]}],"observables":["[T]",["VAR",0],["VAR",1]],"ast_rules":[["Ap",{"mixture":[{"type":0,"bindings":[[{"val":"FREE"},"Maintained"]],"states":[[0,1]],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":0.01,"loc":{"file":1,"bline":4,"bchr":32,"echr":36}},"unary_rate":null,"editStyle":false}],["Bp",{"mixture":[{"type":1,"bindings":[[{"val":"FREE"},"Maintained"],[{"val":null},"Maintained"]],"states":[[0,1],null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":0.01,"loc":{"file":1,"bline":5,"bchr":32,"echr":36}},"unary_rate":null,"editStyle":false}],["A.B",{"mixture":[{"type":0,"bindings":[[{"val":"FREE"},1]],"states":[[1,1]],"erased":false},{"type":1,"bindings":[[{"val":"FREE"},1],[{"val":null},"Maintained"]],"states":[[1,1],null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":0.01,"loc":{"file":1,"bline":7,"bchr":57,"echr":61}},"unary_rate":null,"editStyle":false}],["A..B",{"mixture":[{"type":0,"bindings":[[{"val":[1,0,1],"loc":{"file":1,"bline":8,"bchr":14,"echr":15}},"Freed"]],"states":[[1,1]],"erased":false},{"type":1,"bindings":[[{"val":[1,0,0],"loc":{"file":1,"bline":8,"bchr":26,"echr":27}},"Freed"],[{"val":null},"Maintained"]],"states":[[1,1],null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":0.01,"loc":{"file":1,"bline":8,"bchr":58,"echr":62}},"unary_rate":null,"editStyle":false}],["A.B.A",{"mixture":[{"type":0,"bindings":[[{"val":"FREE"},1]],"states":[[1,1]],"erased":false},{"type":1,"bindings":[[{"val":"FREE"},1],[{"val":"FREE"},2]],"states":[[1,1],null],"erased":false},{"type":0,"bindings":[[{"val":"FREE"},2]],"states":[[1,1]],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":0.01,"loc":{"file":1,"bline":9,"bchr":93,"echr":97}},"unary_rate":null,"editStyle":false}]],"elementary_rules":[{"rate":{"val":0.01,"loc":{"file":1,"bline":4,"bchr":32,"echr":36}},"connected_components":[4],"removed":[{"NegativeInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"PositiveInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0,1]}],"syntactic_rule":1,"instantiations":[[[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],0],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1]],[],[],[]]},{"rate":{"val":0.01,"loc":{"file":1,"bline":5,"bchr":32,"echr":36}},"connected_components":[5],"removed":[{"NegativeInternalized":[{"Existing":[{"agent":[2,1]},{"type":0}]},0]}],"inserted":[{"PositiveInternalized":[{"Existing":[{"agent":[2,1]},{"type":0}]},0,1]}],"syntactic_rule":2,"instantiations":[[[[2,[{"Existing":[{"agent":[2,1]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],0],[0,{"Existing":[{"agent":[2,1]},{"type":0}]}]]],[[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],1]],[],[],[]]},{"rate":{"val":0.01,"loc":{"file":1,"bline":7,"bchr":57,"echr":61}},"connected_components":[1,2],"removed":[{"Freed":[{"Existing":[{"agent":[2,1]},{"type":1}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":1}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"syntactic_rule":3,"instantiations":[[[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":1}]}]],[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]]],[],[],[]]},{"rate":{"val":0.01,"loc":{"file":1,"bline":8,"bchr":58,"echr":62}},"connected_components":[6],"removed":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":0}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Freed":[{"Existing":[{"agent":[2,1]},{"type":0}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"syntactic_rule":4,"instantiations":[[[[5,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":0}]}],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[4,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[4,[{"Existing":[{"agent":[2,1]},{"type":0}]},0]]],[],[],[]]},{"rate":{"val":0.01,"loc":{"file":1,"bline":9,"bchr":93,"echr":97}},"connected_components":[1,7,1],"removed":[{"Freed":[{"Existing":[{"agent":[1,0]},{"type":2}]},0]},{"Freed":[{"Existing":[{"agent":[2,1]},{"type":1}]},1]},{"Freed":[{"Existing":[{"agent":[2,1]},{"type":1}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Linked":[{"Existing":[{"agent":[1,0]},{"type":2}]},0,{"Existing":[{"agent":[2,1]},{"type":1}]},1]},{"Linked":[{"Existing":[{"agent":[2,1]},{"type":1}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"syntactic_rule":5,"instantiations":[[[[2,[{"Existing":[{"agent":[1,0]},{"type":2}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":2}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":2}]}]],[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},1]],[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":1}]}]],[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[2,[{"Existing":[{"agent":[1,0]},{"type":2}]},0],[{"Existing":[{"agent":[2,1]},{"type":1}]},1]],[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]]],[],[],[]]}],"contact_map":[[[[1,0],[[1,1],[1,0]]]],[[[1,0],[[0,0]]],[[],[[0,0]]]]],"interventions":[{"alarm":null,"condition":{"val":true,"loc":{"file":1,"bline":14,"bchr":6,"echr":12}},"effect":[{"action":"CFLOW","name":"ApBp","pattern":[1,2],"tests":[[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":1}]}]],[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]]}],"repeat":{"val":false},"needs_backtrack":false},{"alarm":null,"condition":{"val":true,"loc":{"file":1,"bline":15,"bchr":6,"echr":12}},"effect":[{"action":"CFLOW","name":"ABA","pattern":[3],"tests":[[[5,[{"Existing":[{"agent":[3,0]},{"type":0}]},0],[{"Existing":[{"agent":[2,1]},{"type":0}]},1]],[1,[{"Existing":[{"agent":[3,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[3,0]},{"type":0}]}],[5,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":0}]}],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]]}],"repeat":{"val":false},"needs_backtrack":false}],"dependencies_in_time":[],"dependencies_in_event":[],"algs_reverse_dependencies":[[],[]],"tokens_reverse_dependencies":[]} +{"filenames":["","json.ka"],"update":{"signatures":[{"name":"A","decl":[{"name":"a","decl":{"internal_state":[{"name":"u","decl":null},{"name":"p","decl":null}],"links":null,"counters_info":null}}]},{"name":"B","decl":[{"name":"a","decl":{"internal_state":[{"name":"u","decl":null},{"name":"p","decl":null}],"links":null,"counters_info":null}},{"name":"b","decl":{"internal_state":[],"links":null,"counters_info":null}}]}],"single_agents":[null,null],"elementaries":[[[[[[[1,0],0],[[2,1],1]],12],[[[[1,0],0],[[2,1],0]],11],[[[[1,0],0],1],10],[[[[1,0],0],0],9],[[[[1,0],0],null],8]]],[[[[[[1,0],0],[[2,1],0]],11],[[[[2,1],0],1],15],[[[[2,1],0],0],14],[[[[2,1],0],null],13]],[[[[[1,0],0],[[2,1],1]],12],[[[[2,1],1],null],16]]]],"dag":[{"content":null,"roots":null,"deps":[],"sons":[]},{"content":{"sorts":[null,0],"nodes":[null,[[true,1]]]},"roots":[[1],0],"deps":[["MODIF",0],["RULE",4],["RULE",2],["ALG",0]],"sons":[]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[true,1],[false,null]]]},"roots":[[2],1],"deps":[["MODIF",0],["RULE",2],["ALG",0]],"sons":[{"dst":7,"inj":[[2,2]],"nav":[[[2,1],null]]}]},{"content":{"sorts":[null,0,1,0],"nodes":[null,[[{"node":2,"site":0},1]],[[{"node":1,"site":0},1],[{"node":3,"site":0},null]],[[{"node":2,"site":1},1]]]},"roots":[[1],0],"deps":[["MODIF",1],["ALG",1]],"sons":[]},{"content":{"sorts":[null,0],"nodes":[null,[[true,0]]]},"roots":[[1],0],"deps":[["RULE",0]],"sons":[]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[true,0],[false,null]]]},"roots":[[2],1],"deps":[["RULE",1]],"sons":[]},{"content":{"sorts":[null,0,1],"nodes":[null,[[{"node":2,"site":0},1]],[[{"node":1,"site":0},1],[false,null]]]},"roots":[[1],0],"deps":[["RULE",3]],"sons":[{"dst":3,"inj":[[3,3],[2,2],[1,1]],"nav":[[[2,1],[[3,0],0]],[[3,0],1]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[true,1],[true,null]]]},"roots":[[2],1],"deps":[["RULE",4]],"sons":[]},{"content":{"sorts":[null,0],"nodes":[null,[[true,null]]]},"roots":null,"deps":[],"sons":[{"dst":1,"inj":[[1,1]],"nav":[[[1,0],1]]},{"dst":4,"inj":[[1,1]],"nav":[[[1,0],0]]}]},{"content":{"sorts":[null,0],"nodes":[null,[[false,0]]]},"roots":null,"deps":[],"sons":[{"dst":4,"inj":[[1,1]],"nav":[[[1,0],null]]}]},{"content":{"sorts":[null,0],"nodes":[null,[[false,1]]]},"roots":null,"deps":[],"sons":[{"dst":3,"inj":[[3,1],[2,2],[1,3]],"nav":[[[1,0],[[2,1],1]],[[2,0],[[3,0],0]],[[2,0],1],[[3,0],1]]},{"dst":6,"inj":[[2,2],[1,1]],"nav":[[[1,0],[[2,1],0]],[[2,0],1]]},{"dst":1,"inj":[[1,1]],"nav":[[[1,0],null]]}]},{"content":{"sorts":[null,0,1],"nodes":[null,[[{"node":2,"site":0},null]],[[{"node":1,"site":0},null],[false,null]]]},"roots":null,"deps":[],"sons":[{"dst":6,"inj":[[2,2],[1,1]],"nav":[[[2,0],1],[[1,0],1]]}]},{"content":{"sorts":[null,0,1],"nodes":[null,[[{"node":2,"site":1},null]],[[false,null],[{"node":1,"site":0},null]]]},"roots":null,"deps":[],"sons":[{"dst":3,"inj":[[3,1],[2,2],[1,3]],"nav":[[[2,0],[[3,0],0]],[[1,0],1],[[2,0],1],[[3,0],1]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[true,null],[false,null]]]},"roots":null,"deps":[],"sons":[{"dst":2,"inj":[[2,2]],"nav":[[[2,0],1]]},{"dst":5,"inj":[[2,2]],"nav":[[[2,0],0]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[false,0],[false,null]]]},"roots":null,"deps":[],"sons":[{"dst":5,"inj":[[2,2]],"nav":[[[2,0],null]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[false,1],[false,null]]]},"roots":null,"deps":[],"sons":[{"dst":6,"inj":[[2,2],[1,1]],"nav":[[[2,0],[[1,0],0]],[[1,0],1]]},{"dst":2,"inj":[[2,2]],"nav":[[[2,0],null]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[false,null],[true,null]]]},"roots":null,"deps":[],"sons":[{"dst":7,"inj":[[2,2]],"nav":[[[2,0],null],[[2,0],1]]}]}],"id_by_type":[[1,3],[2]],"max_obs":17},"tokens":[],"algs":[{"name":"ApBp","decl":["MIX",[[1,2]]]},{"name":"ABA","decl":["MIX",[[3]]]}],"observables":["[T]",["VAR",0],["VAR",1]],"ast_rules":[["Ap",{"mixture":[{"type":0,"bindings":[[{"val":"FREE"},"Maintained"]],"states":[[0,1]],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":0.01,"loc":{"file":1,"bline":4,"bchr":32,"echr":36}},"unary_rate":null,"edit_style":false}],["Bp",{"mixture":[{"type":1,"bindings":[[{"val":"FREE"},"Maintained"],[{"val":null},"Maintained"]],"states":[[0,1],null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":0.01,"loc":{"file":1,"bline":5,"bchr":32,"echr":36}},"unary_rate":null,"edit_style":false}],["A.B",{"mixture":[{"type":0,"bindings":[[{"val":"FREE"},1]],"states":[[1,1]],"erased":false},{"type":1,"bindings":[[{"val":"FREE"},1],[{"val":null},"Maintained"]],"states":[[1,1],null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":0.01,"loc":{"file":1,"bline":7,"bchr":57,"echr":61}},"unary_rate":null,"edit_style":false}],["A..B",{"mixture":[{"type":0,"bindings":[[{"val":[1,0,1],"loc":{"file":1,"bline":8,"bchr":14,"echr":15}},"Freed"]],"states":[[1,1]],"erased":false},{"type":1,"bindings":[[{"val":[1,0,0],"loc":{"file":1,"bline":8,"bchr":26,"echr":27}},"Freed"],[{"val":null},"Maintained"]],"states":[[1,1],null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":0.01,"loc":{"file":1,"bline":8,"bchr":58,"echr":62}},"unary_rate":null,"edit_style":false}],["A.B.A",{"mixture":[{"type":0,"bindings":[[{"val":"FREE"},1]],"states":[[1,1]],"erased":false},{"type":1,"bindings":[[{"val":"FREE"},1],[{"val":"FREE"},2]],"states":[[1,1],null],"erased":false},{"type":0,"bindings":[[{"val":"FREE"},2]],"states":[[1,1]],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":0.01,"loc":{"file":1,"bline":9,"bchr":93,"echr":97}},"unary_rate":null,"edit_style":false}]],"elementary_rules":[{"rate":{"val":0.01,"loc":{"file":1,"bline":4,"bchr":32,"echr":36}},"connected_components":[4],"removed":[{"NegativeInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"PositiveInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0,1]}],"syntactic_rule":1,"instantiations":[[[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],0],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1]],[],[],[]]},{"rate":{"val":0.01,"loc":{"file":1,"bline":5,"bchr":32,"echr":36}},"connected_components":[5],"removed":[{"NegativeInternalized":[{"Existing":[{"agent":[2,1]},{"type":0}]},0]}],"inserted":[{"PositiveInternalized":[{"Existing":[{"agent":[2,1]},{"type":0}]},0,1]}],"syntactic_rule":2,"instantiations":[[[[2,[{"Existing":[{"agent":[2,1]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],0],[0,{"Existing":[{"agent":[2,1]},{"type":0}]}]]],[[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],1]],[],[],[]]},{"rate":{"val":0.01,"loc":{"file":1,"bline":7,"bchr":57,"echr":61}},"connected_components":[1,2],"removed":[{"Freed":[{"Existing":[{"agent":[2,1]},{"type":1}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":1}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"syntactic_rule":3,"instantiations":[[[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":1}]}]],[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]]],[],[],[]]},{"rate":{"val":0.01,"loc":{"file":1,"bline":8,"bchr":58,"echr":62}},"connected_components":[6],"removed":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":0}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Freed":[{"Existing":[{"agent":[2,1]},{"type":0}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"syntactic_rule":4,"instantiations":[[[[5,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":0}]}],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[4,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[4,[{"Existing":[{"agent":[2,1]},{"type":0}]},0]]],[],[],[]]},{"rate":{"val":0.01,"loc":{"file":1,"bline":9,"bchr":93,"echr":97}},"connected_components":[1,7,1],"removed":[{"Freed":[{"Existing":[{"agent":[1,0]},{"type":2}]},0]},{"Freed":[{"Existing":[{"agent":[2,1]},{"type":1}]},1]},{"Freed":[{"Existing":[{"agent":[2,1]},{"type":1}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Linked":[{"Existing":[{"agent":[1,0]},{"type":2}]},0,{"Existing":[{"agent":[2,1]},{"type":1}]},1]},{"Linked":[{"Existing":[{"agent":[2,1]},{"type":1}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"syntactic_rule":5,"instantiations":[[[[2,[{"Existing":[{"agent":[1,0]},{"type":2}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":2}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":2}]}]],[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},1]],[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":1}]}]],[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[2,[{"Existing":[{"agent":[1,0]},{"type":2}]},0],[{"Existing":[{"agent":[2,1]},{"type":1}]},1]],[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]]],[],[],[]]}],"contact_map":[[[[1,0],[[1,1],[1,0]]]],[[[1,0],[[0,0]]],[[],[[0,0]]]]],"interventions":[{"alarm":null,"condition":{"val":true,"loc":{"file":1,"bline":14,"bchr":6,"echr":12}},"effect":[{"action":"CFLOW","name":"ApBp","pattern":[1,2],"tests":[[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":1}]}]],[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]]}],"repeat":{"val":false},"needs_backtrack":false},{"alarm":null,"condition":{"val":true,"loc":{"file":1,"bline":15,"bchr":6,"echr":12}},"effect":[{"action":"CFLOW","name":"ABA","pattern":[3],"tests":[[[5,[{"Existing":[{"agent":[3,0]},{"type":0}]},0],[{"Existing":[{"agent":[2,1]},{"type":0}]},1]],[1,[{"Existing":[{"agent":[3,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[3,0]},{"type":0}]}],[5,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":0}]}],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]]}],"repeat":{"val":false},"needs_backtrack":false}],"dependencies_in_time":[],"dependencies_in_event":[],"algs_reverse_dependencies":[[],[]],"tokens_reverse_dependencies":[]} diff --git a/tests/integration/cflows/side-effects3/output/trace.json.ref b/tests/integration/cflows/side-effects3/output/trace.json.ref index abe0ead3a2..b43e71a64a 100644 --- a/tests/integration/cflows/side-effects3/output/trace.json.ref +++ b/tests/integration/cflows/side-effects3/output/trace.json.ref @@ -1,5 +1,5 @@ { "dict":{"agent":{"id":0,"type":1},"binding_type":{"type":0,"site":1},"quark":{"agent":0,"site":1},"test":["Is_here","Has_Internal","Is_Free","Is_Bound","Has_Binding_type","Is_Bound_to"],"actions":["Create","Mod_internal","Bind","Bind_to","Free","Remove"],"binding_state":["ANY","FREE","BOUND","BOUND_TYPE","BOUND_to"],"event":{"tests":0,"actions":1,"side_effect_src":2,"side_effect_dst":3,"connectivity_tests":4},"simulation_info":{"id":0,"time":1,"event":2,"profiling":3},"step":["Subs","Rule","Pert","Init","Obs","Dummy"]}, -"model":{"filenames":["","side-effects.ka"],"update":{"signatures":[{"name":"A","decl":[{"name":"x","decl":[[{"name":"a","decl":null},{"name":"b","decl":null}],null,null]}]},{"name":"B","decl":[{"name":"x","decl":[[{"name":"a","decl":null},{"name":"b","decl":null}],null,null]}]},{"name":"C","decl":[]}],"single_agents":[null,null,null],"elementaries":[[[[[[[1,0],0],[[2,1],0]],1],[[[[1,0],0],1],8],[[[[1,0],0],0],7],[[[[1,0],0],null],6]]],[[[[[[1,0],0],[[2,1],0]],1],[[[[2,1],0],1],10],[[[[2,1],0],0],9],[[[[2,1],0],null],3]]],[]],"dag":[{"content":null,"roots":null,"deps":[],"sons":[]},{"content":{"sorts":[null,0,1],"nodes":[null,[[{"node":2,"site":0},null]],[[{"node":1,"site":0},null]]]},"roots":[[1],0],"deps":[["RULE",1]],"sons":[{"dst":5,"inj":[[2,2],[1,1]],"nav":[[[2,0],1],[[1,0],1]]}]},{"content":{"sorts":[null,0],"nodes":[null,[[true,0]]]},"roots":[[1],0],"deps":[["RULE",2]],"sons":[]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[true,null]]]},"roots":[[2],1],"deps":[["RULE",3],["RULE",2]],"sons":[]},{"content":{"sorts":[null,0],"nodes":[null,[[true,1]]]},"roots":[[1],0],"deps":[["RULE",3]],"sons":[]},{"content":{"sorts":[null,0,1],"nodes":[null,[[{"node":2,"site":0},1]],[[{"node":1,"site":0},1]]]},"roots":[[1],0],"deps":[["MODIF",0],["RULE",4]],"sons":[]},{"content":{"sorts":[null,0],"nodes":[null,[[true,null]]]},"roots":null,"deps":[],"sons":[{"dst":4,"inj":[[1,1]],"nav":[[[1,0],1]]},{"dst":2,"inj":[[1,1]],"nav":[[[1,0],0]]}]},{"content":{"sorts":[null,0],"nodes":[null,[[false,0]]]},"roots":null,"deps":[],"sons":[{"dst":2,"inj":[[1,1]],"nav":[[[1,0],null]]}]},{"content":{"sorts":[null,0],"nodes":[null,[[false,1]]]},"roots":null,"deps":[],"sons":[{"dst":5,"inj":[[2,2],[1,1]],"nav":[[[1,0],[[2,1],0]],[[2,0],1]]},{"dst":4,"inj":[[1,1]],"nav":[[[1,0],null]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[false,0]]]},"roots":null,"deps":[],"sons":[]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[false,1]]]},"roots":null,"deps":[],"sons":[{"dst":5,"inj":[[2,2],[1,1]],"nav":[[[2,0],[[1,0],0]],[[1,0],1]]}]}],"id_by_type":[[1],[2],[]],"max_obs":11},"tokens":[],"algs":[],"observables":["[T]"],"ast_rules":[[null,{"mixture":[],"created":[{"type":2,"sites":[],"internals":[]}],"delta_tokens":[],"rate":{"val":1,"loc":{"file":1,"bline":1,"bchr":11,"echr":12}},"unary_rate":null,"editStyle":false}],[null,{"mixture":[{"type":0,"bindings":[[{"val":"SOME","loc":{"file":1,"bline":2,"bchr":4,"echr":5}},"Freed"]],"states":[null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":1,"loc":{"file":1,"bline":2,"bchr":21,"echr":22}},"unary_rate":null,"editStyle":false}],[null,{"mixture":[{"type":0,"bindings":[[{"val":"FREE"},1]],"states":[[0,1]],"erased":false},{"type":1,"bindings":[[{"val":"FREE"},1]],"states":[null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":1,"loc":{"file":1,"bline":3,"bchr":43,"echr":44}},"unary_rate":null,"editStyle":false}],[null,{"mixture":[{"type":0,"bindings":[[{"val":"FREE"},1]],"states":[[1,0]],"erased":false},{"type":1,"bindings":[[{"val":"FREE"},1]],"states":[null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":1,"loc":{"file":1,"bline":4,"bchr":43,"echr":44}},"unary_rate":null,"editStyle":false}],["GOAL",{"mixture":[{"type":0,"bindings":[[{"val":[1,0,1],"loc":{"file":1,"bline":5,"bchr":14,"echr":15}},"Erased"]],"states":[[1,"ERASED"]],"erased":true},{"type":1,"bindings":[[{"val":[1,0,0],"loc":{"file":1,"bline":5,"bchr":25,"echr":26}},"Erased"]],"states":[[1,"ERASED"]],"erased":true}],"created":[],"delta_tokens":[],"rate":{"val":1,"loc":{"file":1,"bline":5,"bchr":38,"echr":39}},"unary_rate":null,"editStyle":false}]],"elementary_rules":[{"rate":{"val":1,"loc":{"file":1,"bline":1,"bchr":11,"echr":12}},"inserted":[{"Agent":{"Fresh":{"id":2,"type":0}}}],"syntactic_rule":1,"instantiations":[[],[[0,{"Fresh":{"id":2,"type":0}},[]]],[],[],[]]},{"rate":{"val":1,"loc":{"file":1,"bline":2,"bchr":21,"echr":22}},"connected_components":[1],"removed":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":0}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Freed":[{"Existing":[{"agent":[2,1]},{"type":0}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"syntactic_rule":2,"instantiations":[[[[3,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[4,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]]],[[[{"Existing":[{"agent":[1,0]},{"type":0}]},0],[2]]],[[{"Existing":[{"agent":[2,1]},{"type":0}]},0]],[]]},{"rate":{"val":1,"loc":{"file":1,"bline":3,"bchr":43,"echr":44}},"connected_components":[2,3],"removed":[{"Freed":[{"Existing":[{"agent":[2,1]},{"type":1}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"NegativeInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":1}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"PositiveInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0,1]}],"syntactic_rule":3,"instantiations":[[[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0]],[0,{"Existing":[{"agent":[2,1]},{"type":1}]}]],[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],0],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]]],[],[],[]]},{"rate":{"val":1,"loc":{"file":1,"bline":4,"bchr":43,"echr":44}},"connected_components":[4,3],"removed":[{"Freed":[{"Existing":[{"agent":[2,1]},{"type":1}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"NegativeInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":1}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"PositiveInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0,0]}],"syntactic_rule":4,"instantiations":[[[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0]],[0,{"Existing":[{"agent":[2,1]},{"type":1}]}]],[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],0],[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]]],[],[],[]]},{"rate":{"val":1,"loc":{"file":1,"bline":5,"bchr":38,"echr":39}},"connected_components":[5],"removed":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":0}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"NegativeInternalized":[{"Existing":[{"agent":[2,1]},{"type":0}]},0]},{"Agent":{"Existing":[{"agent":[2,1]},{"type":0}]}},{"NegativeInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"Agent":{"Existing":[{"agent":[1,0]},{"type":0}]}}],"syntactic_rule":5,"instantiations":[[[[5,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":0}]}],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[5,{"Existing":[{"agent":[1,0]},{"type":0}]}],[5,{"Existing":[{"agent":[2,1]},{"type":0}]}]],[],[],[]]}],"contact_map":[[],[[[1,0],[[0,0]]]],[[[1,0],[[1,0]]]]],"interventions":[{"alarm":null,"condition":{"val":true,"loc":{"file":1,"bline":10,"bchr":6,"echr":12}},"effect":[{"action":"CFLOW","name":"GOAL","pattern":[5],"tests":[[[5,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":0}]}],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]]}],"repeat":{"val":false},"needs_backtrack":false}],"dependencies_in_time":[],"dependencies_in_event":[],"algs_reverse_dependencies":[],"tokens_reverse_dependencies":[]}, +"model":{"filenames":["","side-effects.ka"],"update":{"signatures":[{"name":"A","decl":[{"name":"x","decl":{"internal_state":[{"name":"a","decl":null},{"name":"b","decl":null}],"links":null,"counters_info":null}}]},{"name":"B","decl":[{"name":"x","decl":{"internal_state":[{"name":"a","decl":null},{"name":"b","decl":null}],"links":null,"counters_info":null}}]},{"name":"C","decl":[]}],"single_agents":[null,null,null],"elementaries":[[[[[[[1,0],0],[[2,1],0]],1],[[[[1,0],0],1],8],[[[[1,0],0],0],7],[[[[1,0],0],null],6]]],[[[[[[1,0],0],[[2,1],0]],1],[[[[2,1],0],1],10],[[[[2,1],0],0],9],[[[[2,1],0],null],3]]],[]],"dag":[{"content":null,"roots":null,"deps":[],"sons":[]},{"content":{"sorts":[null,0,1],"nodes":[null,[[{"node":2,"site":0},null]],[[{"node":1,"site":0},null]]]},"roots":[[1],0],"deps":[["RULE",1]],"sons":[{"dst":5,"inj":[[2,2],[1,1]],"nav":[[[2,0],1],[[1,0],1]]}]},{"content":{"sorts":[null,0],"nodes":[null,[[true,0]]]},"roots":[[1],0],"deps":[["RULE",2]],"sons":[]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[true,null]]]},"roots":[[2],1],"deps":[["RULE",3],["RULE",2]],"sons":[]},{"content":{"sorts":[null,0],"nodes":[null,[[true,1]]]},"roots":[[1],0],"deps":[["RULE",3]],"sons":[]},{"content":{"sorts":[null,0,1],"nodes":[null,[[{"node":2,"site":0},1]],[[{"node":1,"site":0},1]]]},"roots":[[1],0],"deps":[["MODIF",0],["RULE",4]],"sons":[]},{"content":{"sorts":[null,0],"nodes":[null,[[true,null]]]},"roots":null,"deps":[],"sons":[{"dst":4,"inj":[[1,1]],"nav":[[[1,0],1]]},{"dst":2,"inj":[[1,1]],"nav":[[[1,0],0]]}]},{"content":{"sorts":[null,0],"nodes":[null,[[false,0]]]},"roots":null,"deps":[],"sons":[{"dst":2,"inj":[[1,1]],"nav":[[[1,0],null]]}]},{"content":{"sorts":[null,0],"nodes":[null,[[false,1]]]},"roots":null,"deps":[],"sons":[{"dst":5,"inj":[[2,2],[1,1]],"nav":[[[1,0],[[2,1],0]],[[2,0],1]]},{"dst":4,"inj":[[1,1]],"nav":[[[1,0],null]]}]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[false,0]]]},"roots":null,"deps":[],"sons":[]},{"content":{"sorts":[null,null,1],"nodes":[null,null,[[false,1]]]},"roots":null,"deps":[],"sons":[{"dst":5,"inj":[[2,2],[1,1]],"nav":[[[2,0],[[1,0],0]],[[1,0],1]]}]}],"id_by_type":[[1],[2],[]],"max_obs":11},"tokens":[],"algs":[],"observables":["[T]"],"ast_rules":[[null,{"mixture":[],"created":[{"type":2,"sites":[],"internals":[]}],"delta_tokens":[],"rate":{"val":1,"loc":{"file":1,"bline":1,"bchr":11,"echr":12}},"unary_rate":null,"edit_style":false}],[null,{"mixture":[{"type":0,"bindings":[[{"val":"SOME","loc":{"file":1,"bline":2,"bchr":4,"echr":5}},"Freed"]],"states":[null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":1,"loc":{"file":1,"bline":2,"bchr":21,"echr":22}},"unary_rate":null,"edit_style":false}],[null,{"mixture":[{"type":0,"bindings":[[{"val":"FREE"},1]],"states":[[0,1]],"erased":false},{"type":1,"bindings":[[{"val":"FREE"},1]],"states":[null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":1,"loc":{"file":1,"bline":3,"bchr":43,"echr":44}},"unary_rate":null,"edit_style":false}],[null,{"mixture":[{"type":0,"bindings":[[{"val":"FREE"},1]],"states":[[1,0]],"erased":false},{"type":1,"bindings":[[{"val":"FREE"},1]],"states":[null],"erased":false}],"created":[],"delta_tokens":[],"rate":{"val":1,"loc":{"file":1,"bline":4,"bchr":43,"echr":44}},"unary_rate":null,"edit_style":false}],["GOAL",{"mixture":[{"type":0,"bindings":[[{"val":[1,0,1],"loc":{"file":1,"bline":5,"bchr":14,"echr":15}},"Erased"]],"states":[[1,"ERASED"]],"erased":true},{"type":1,"bindings":[[{"val":[1,0,0],"loc":{"file":1,"bline":5,"bchr":25,"echr":26}},"Erased"]],"states":[[1,"ERASED"]],"erased":true}],"created":[],"delta_tokens":[],"rate":{"val":1,"loc":{"file":1,"bline":5,"bchr":38,"echr":39}},"unary_rate":null,"edit_style":false}]],"elementary_rules":[{"rate":{"val":1,"loc":{"file":1,"bline":1,"bchr":11,"echr":12}},"inserted":[{"Agent":{"Fresh":{"id":2,"type":0}}}],"syntactic_rule":1,"instantiations":[[],[[0,{"Fresh":{"id":2,"type":0}},[]]],[],[],[]]},{"rate":{"val":1,"loc":{"file":1,"bline":2,"bchr":21,"echr":22}},"connected_components":[1],"removed":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":0}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Freed":[{"Existing":[{"agent":[2,1]},{"type":0}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"syntactic_rule":2,"instantiations":[[[[3,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[4,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]]],[[[{"Existing":[{"agent":[1,0]},{"type":0}]},0],[2]]],[[{"Existing":[{"agent":[2,1]},{"type":0}]},0]],[]]},{"rate":{"val":1,"loc":{"file":1,"bline":3,"bchr":43,"echr":44}},"connected_components":[2,3],"removed":[{"Freed":[{"Existing":[{"agent":[2,1]},{"type":1}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"NegativeInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":1}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"PositiveInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0,1]}],"syntactic_rule":3,"instantiations":[[[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0]],[0,{"Existing":[{"agent":[2,1]},{"type":1}]}]],[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],0],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]]],[],[],[]]},{"rate":{"val":1,"loc":{"file":1,"bline":4,"bchr":43,"echr":44}},"connected_components":[4,3],"removed":[{"Freed":[{"Existing":[{"agent":[2,1]},{"type":1}]},0]},{"Freed":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"NegativeInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]}],"inserted":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":1}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"PositiveInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0,0]}],"syntactic_rule":4,"instantiations":[[[[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0]],[0,{"Existing":[{"agent":[2,1]},{"type":1}]}]],[[2,[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],0],[2,[{"Existing":[{"agent":[2,1]},{"type":1}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]]],[],[],[]]},{"rate":{"val":1,"loc":{"file":1,"bline":5,"bchr":38,"echr":39}},"connected_components":[5],"removed":[{"Linked":[{"Existing":[{"agent":[2,1]},{"type":0}]},0,{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"NegativeInternalized":[{"Existing":[{"agent":[2,1]},{"type":0}]},0]},{"Agent":{"Existing":[{"agent":[2,1]},{"type":0}]}},{"NegativeInternalized":[{"Existing":[{"agent":[1,0]},{"type":0}]},0]},{"Agent":{"Existing":[{"agent":[1,0]},{"type":0}]}}],"syntactic_rule":5,"instantiations":[[[[5,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":0}]}],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]],[[5,{"Existing":[{"agent":[1,0]},{"type":0}]}],[5,{"Existing":[{"agent":[2,1]},{"type":0}]}]],[],[],[]]}],"contact_map":[[],[[[1,0],[[0,0]]]],[[[1,0],[[1,0]]]]],"interventions":[{"alarm":null,"condition":{"val":true,"loc":{"file":1,"bline":10,"bchr":6,"echr":12}},"effect":[{"action":"CFLOW","name":"GOAL","pattern":[5],"tests":[[[5,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],[{"Existing":[{"agent":[1,0]},{"type":0}]},0]],[1,[{"Existing":[{"agent":[2,1]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[2,1]},{"type":0}]}],[1,[{"Existing":[{"agent":[1,0]},{"type":0}]},0],1],[0,{"Existing":[{"agent":[1,0]},{"type":0}]}]]]}],"repeat":{"val":false},"needs_backtrack":false}],"dependencies_in_time":[],"dependencies_in_event":[],"algs_reverse_dependencies":[],"tokens_reverse_dependencies":[]}, "trace":[[3,[[0,[0,0],[[0,0]]],[0,[1,1],[[0,1]]],[3,[[1,1],0],[[0,0],0]],[3,[[0,0],0],[[1,1],0]],[1,[[1,1],0],1],[1,[[0,0],0],0]]],[3,[[0,[2,1],[[0,0]]],[4,[[2,1],0]],[1,[[2,1],0],0]]],[3,[[0,[3,1],[[0,0]]],[4,[[3,1],0]],[1,[[3,1],0],0]]],[3,[[0,[4,1],[[0,0]]],[4,[[4,1],0]],[1,[[4,1],0],0]]],[3,[[0,[5,1],[[0,0]]],[4,[[5,1],0]],[1,[[5,1],0],0]]],[3,[[0,[6,1],[[0,0]]],[4,[[6,1],0]],[1,[[6,1],0],0]]],[3,[[0,[7,1],[[0,0]]],[4,[[7,1],0]],[1,[[7,1],0],0]]],[3,[[0,[8,1],[[0,0]]],[4,[[8,1],0]],[1,[[8,1],0],0]]],[3,[[0,[9,1],[[0,0]]],[4,[[9,1],0]],[1,[[9,1],0],0]]],[3,[[0,[10,1],[[0,0]]],[4,[[10,1],0]],[1,[[10,1],0],0]]],[3,[[0,[11,1],[[0,0]]],[4,[[11,1],0]],[1,[[11,1],0],0]]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[1,1],0]],[]],[-1,0.13823092776645854,1,null]],[1,2,[[[[0,[10,1]],[2,[[10,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[10,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[-1,0.2336477634914299,2,null]],[1,0,[[],[[0,[12,2],[]]],[],[],[]],[-1,0.6020852152278433,3,null]],[1,0,[[],[[0,[13,2],[]]],[],[],[]],[-1,0.753963826966871,4,null]],[1,0,[[],[[0,[14,2],[]]],[],[],[]],[-1,1.1857271317886693,5,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[10,1],0]],[]],[-1,1.4479897575337672,6,null]],[1,3,[[[[0,[3,1]],[2,[[3,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[3,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[-1,1.626526792640157,7,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[3,1],0]],[]],[-1,1.694399269405521,8,null]],[1,2,[[[[0,[7,1]],[2,[[7,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[7,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[-1,1.7360715939394153,9,null]],[1,0,[[],[[0,[15,2],[]]],[],[],[]],[-1,2.459919167473559,10,null]],[1,0,[[],[[0,[16,2],[]]],[],[],[]],[-1,2.5812814214359765,11,null]],[1,0,[[],[[0,[17,2],[]]],[],[],[]],[-1,2.667802570951534,12,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[7,1],0]],[]],[-1,2.7597142370975534,13,null]],[1,3,[[[[0,[10,1]],[2,[[10,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[10,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[-1,2.805247638580207,14,null]],[1,0,[[],[[0,[18,2],[]]],[],[],[]],[-1,3.3537951297472084,15,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[10,1],0]],[]],[-1,3.488364089958148,16,null]],[1,2,[[[[0,[3,1]],[2,[[3,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[3,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[-1,3.4909102221521375,17,null]],[1,0,[[],[[0,[19,2],[]]],[],[],[]],[-1,3.645170784457633,18,null]],[1,0,[[],[[0,[20,2],[]]],[],[],[]],[-1,3.9423458730348933,19,null]],[1,0,[[],[[0,[21,2],[]]],[],[],[]],[-1,4.341679746398391,20,null]],[1,0,[[],[[0,[22,2],[]]],[],[],[]],[-1,4.434357796224944,21,null]],[1,0,[[],[[0,[23,2],[]]],[],[],[]],[-1,4.916008520028986,22,null]],[1,0,[[],[[0,[24,2],[]]],[],[],[]],[-1,5.080240108051781,23,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[3,1],0]],[]],[-1,5.938225320375272,24,null]],[1,3,[[[[0,[10,1]],[2,[[10,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[10,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[-1,5.998992351062857,25,null]],[1,0,[[],[[0,[25,2],[]]],[],[],[]],[-1,6.041503777915859,26,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[10,1],0]],[]],[-1,7.304262330229044,27,null]],[1,2,[[[[0,[6,1]],[2,[[6,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[6,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[-1,7.37483820694515,28,null]],[1,0,[[],[[0,[26,2],[]]],[],[],[]],[-1,8.020261029820229,29,null]],[1,0,[[],[[0,[27,2],[]]],[],[],[]],[-1,8.026326967284767,30,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[6,1],0]],[]],[-1,8.573087115389793,31,null]],[1,3,[[[[0,[3,1]],[2,[[3,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[3,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[-1,8.648001700685402,32,null]],[1,0,[[],[[0,[28,2],[]]],[],[],[]],[-1,9.79735928173821,33,null]],[1,0,[[],[[0,[29,2],[]]],[],[],[]],[-1,10.225470481224072,34,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[3,1],0]],[]],[-1,10.255129992912112,35,null]],[1,2,[[[[0,[1,1]],[2,[[1,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[1,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[-1,10.330258056457728,36,null]],[4,"GOAL",[[[5,[[1,1],0],[[0,0],0]],[1,[[1,1],0],1],[0,[1,1]],[1,[[0,0],0],1],[0,[0,0]]]],[0,10.330258056457728,36,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[1,1],0]],[]],[0,10.43488219113191,37,null]],[1,3,[[[[0,[5,1]],[2,[[5,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[5,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,10.461288453408391,38,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[5,1],0]],[]],[0,10.74278735319708,39,null]],[1,2,[[[[0,[3,1]],[2,[[3,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[3,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,10.800242424294126,40,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[3,1],0]],[]],[0,11.105090715503655,41,null]],[1,3,[[[[0,[8,1]],[2,[[8,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[8,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,11.113446152479197,42,null]],[1,0,[[],[[0,[30,2],[]]],[],[],[]],[0,11.418490200525016,43,null]],[1,0,[[],[[0,[31,2],[]]],[],[],[]],[0,11.724351651371544,44,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[8,1],0]],[]],[0,12.471429005391435,45,null]],[1,0,[[],[[0,[32,2],[]]],[],[],[]],[0,12.486124450221796,46,null]],[1,2,[[[[0,[10,1]],[2,[[10,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[10,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,12.76768321179996,47,null]],[1,0,[[],[[0,[33,2],[]]],[],[],[]],[0,13.024225497191784,48,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[10,1],0]],[]],[0,15.925201543346688,49,null]],[1,3,[[[[0,[4,1]],[2,[[4,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[4,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,15.956692460372864,50,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[4,1],0]],[]],[0,16.95516113865209,51,null]],[1,2,[[[[0,[7,1]],[2,[[7,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[7,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,17.006031537627784,52,null]],[1,0,[[],[[0,[34,2],[]]],[],[],[]],[0,18.762982130501385,53,null]],[1,0,[[],[[0,[35,2],[]]],[],[],[]],[0,18.908988252459206,54,null]],[1,0,[[],[[0,[36,2],[]]],[],[],[]],[0,18.97850904982092,55,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[7,1],0]],[]],[0,19.23808623142504,56,null]],[1,3,[[[[0,[1,1]],[2,[[1,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[1,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,19.44815534655682,57,null]],[1,0,[[],[[0,[37,2],[]]],[],[],[]],[0,19.994623189169175,58,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[1,1],0]],[]],[0,20.638077346545646,59,null]],[1,2,[[[[0,[4,1]],[2,[[4,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[4,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,20.68375391678002,60,null]],[1,0,[[],[[0,[38,2],[]]],[],[],[]],[0,20.710914625206815,61,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[4,1],0]],[]],[0,20.912125511242472,62,null]],[1,3,[[[[0,[6,1]],[2,[[6,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[6,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,21.017657525564676,63,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[6,1],0]],[]],[0,21.15423751634369,64,null]],[1,2,[[[[0,[8,1]],[2,[[8,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[8,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,21.19165523107778,65,null]],[1,0,[[],[[0,[39,2],[]]],[],[],[]],[0,22.10312915121163,66,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[8,1],0]],[]],[0,22.424912825105707,67,null]],[1,0,[[],[[0,[40,2],[]]],[],[],[]],[0,22.49845197947521,68,null]],[1,3,[[[[0,[2,1]],[2,[[2,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[2,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,22.787215505466673,69,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[2,1],0]],[]],[0,22.850766922374206,70,null]],[1,2,[[[[0,[6,1]],[2,[[6,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[6,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,23.051101628343282,71,null]],[1,0,[[],[[0,[41,2],[]]],[],[],[]],[0,23.654573441546543,72,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[6,1],0]],[]],[0,24.473422416662334,73,null]],[1,3,[[[[0,[5,1]],[2,[[5,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[5,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,24.534887306968972,74,null]],[1,0,[[],[[0,[42,2],[]]],[],[],[]],[0,25.39795204140594,75,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[5,1],0]],[]],[0,25.529229359302782,76,null]],[1,2,[[[[0,[10,1]],[2,[[10,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[10,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,25.569217346847054,77,null]],[1,0,[[],[[0,[43,2],[]]],[],[],[]],[0,26.07128837550854,78,null]],[1,0,[[],[[0,[44,2],[]]],[],[],[]],[0,26.516461716254526,79,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[10,1],0]],[]],[0,27.427755694247335,80,null]],[1,3,[[[[0,[10,1]],[2,[[10,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[10,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,27.711229118585187,81,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[10,1],0]],[]],[0,28.910631551124876,82,null]],[1,2,[[[[0,[10,1]],[2,[[10,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[10,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,29.14482013879848,83,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[10,1],0]],[]],[0,30.037901571711018,84,null]],[1,3,[[[[0,[6,1]],[2,[[6,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[6,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,30.220010286647604,85,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[6,1],0]],[]],[0,30.39225205616227,86,null]],[1,2,[[[[0,[8,1]],[2,[[8,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[8,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,30.510848307941473,87,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[8,1],0]],[]],[0,30.88775834419144,88,null]],[1,3,[[[[0,[3,1]],[2,[[3,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[3,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,30.904574640773408,89,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[3,1],0]],[]],[0,31.884446123975675,90,null]],[1,2,[[[[0,[2,1]],[2,[[2,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[2,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,32.17363656417754,91,null]],[1,0,[[],[[0,[45,2],[]]],[],[],[]],[0,32.32295654205527,92,null]],[1,0,[[],[[0,[46,2],[]]],[],[],[]],[0,32.600966895541816,93,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[2,1],0]],[]],[0,33.07587641114492,94,null]],[1,3,[[[[0,[6,1]],[2,[[6,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[6,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,33.100271099414414,95,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[6,1],0]],[]],[0,33.29771303674189,96,null]],[1,2,[[[[0,[3,1]],[2,[[3,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[3,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,33.35358941527632,97,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[3,1],0]],[]],[0,33.713447280053295,98,null]],[1,3,[[[[0,[10,1]],[2,[[10,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[10,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,33.795464867588166,99,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[10,1],0]],[]],[0,34.86006243613086,100,null]],[1,2,[[[[0,[11,1]],[2,[[11,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[11,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,34.87022309590219,101,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[11,1],0]],[]],[0,35.027150147133405,102,null]],[1,3,[[[[0,[4,1]],[2,[[4,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[4,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,35.17178972212714,103,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[4,1],0]],[]],[0,36.143369884112474,104,null]],[1,2,[[[[0,[6,1]],[2,[[6,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[6,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,36.18948504450144,105,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[6,1],0]],[]],[0,36.86363243247595,106,null]],[1,3,[[[[0,[3,1]],[2,[[3,1],0]]],[[0,[0,0]],[1,[[0,0],0],1],[2,[[0,0],0]]]],[[2,[[3,1],0],[[0,0],0]],[1,[[0,0],0],0]],[],[],[]],[0,37.04252564956838,107,null]],[1,0,[[],[[0,[47,2],[]]],[],[],[]],[0,37.790458776616134,108,null]],[1,1,[[[[0,[0,0]],[3,[[0,0],0]]]],[[4,[[0,0],0]]],[[[[0,0],0],[2]]],[[[3,1],0]],[]],[0,38.04583677097828,109,null]],[1,2,[[[[0,[1,1]],[2,[[1,1],0]]],[[0,[0,0]],[1,[[0,0],0],0],[2,[[0,0],0]]]],[[2,[[1,1],0],[[0,0],0]],[1,[[0,0],0],1]],[],[],[]],[0,38.0464533255708,110,null]],[4,"GOAL",[[[5,[[1,1],0],[[0,0],0]],[1,[[1,1],0],1],[0,[1,1]],[1,[[0,0],0],1],[0,[0,0]]]],[1,38.0464533255708,110,null]],[1,4,[[[[0,[0,0]],[1,[[0,0],0],1],[0,[1,1]],[1,[[1,1],0],1],[5,[[1,1],0],[[0,0],0]]]],[[5,[1,1]],[5,[0,0]]],[],[],[]],[1,38.494097516076884,111,null]],[1,0,[[],[[0,[0,2],[]]],[],[],[]],[1,39.590521527652506,112,null]],[1,0,[[],[[0,[1,2],[]]],[],[],[]],[1,39.845413696129405,113,null]],[1,0,[[],[[0,[48,2],[]]],[],[],[]],[1,40.834442403493796,114,null]],[1,0,[[],[[0,[49,2],[]]],[],[],[]],[1,42.15964811691397,115,null]],[1,0,[[],[[0,[50,2],[]]],[],[],[]],[1,44.16380354850672,116,null]],[1,0,[[],[[0,[51,2],[]]],[],[],[]],[1,46.12185529518045,117,null]],[1,0,[[],[[0,[52,2],[]]],[],[],[]],[1,46.99020734328918,118,null]],[1,0,[[],[[0,[53,2],[]]],[],[],[]],[1,47.3195069041112,119,null]],[1,0,[[],[[0,[54,2],[]]],[],[],[]],[1,47.73501527654362,120,null]],[1,0,[[],[[0,[55,2],[]]],[],[],[]],[1,48.08037645904664,121,null]],[1,0,[[],[[0,[56,2],[]]],[],[],[]],[1,48.317057159348366,122,null]],[1,0,[[],[[0,[57,2],[]]],[],[],[]],[1,49.927819525247614,123,null]],[1,0,[[],[[0,[58,2],[]]],[],[],[]],[1,50.76896644557583,124,null]],[1,0,[[],[[0,[59,2],[]]],[],[],[]],[1,51.41382265556848,125,null]],[1,0,[[],[[0,[60,2],[]]],[],[],[]],[1,51.47946061956511,126,null]],[1,0,[[],[[0,[61,2],[]]],[],[],[]],[1,51.52410360626088,127,null]],[1,0,[[],[[0,[62,2],[]]],[],[],[]],[1,53.14318973162175,128,null]],[1,0,[[],[[0,[63,2],[]]],[],[],[]],[1,53.49460683049122,129,null]],[1,0,[[],[[0,[64,2],[]]],[],[],[]],[1,53.735906855421625,130,null]],[1,0,[[],[[0,[65,2],[]]],[],[],[]],[1,54.471226597667616,131,null]],[1,0,[[],[[0,[66,2],[]]],[],[],[]],[1,54.62366447803344,132,null]],[1,0,[[],[[0,[67,2],[]]],[],[],[]],[1,58.64891952667402,133,null]],[1,0,[[],[[0,[68,2],[]]],[],[],[]],[1,58.66571677933717,134,null]],[1,0,[[],[[0,[69,2],[]]],[],[],[]],[1,58.84261217832868,135,null]],[1,0,[[],[[0,[70,2],[]]],[],[],[]],[1,59.4104108357406,136,null]],[1,0,[[],[[0,[71,2],[]]],[],[],[]],[1,60.024837732409054,137,null]],[1,0,[[],[[0,[72,2],[]]],[],[],[]],[1,60.6835991122626,138,null]],[1,0,[[],[[0,[73,2],[]]],[],[],[]],[1,63.3158673530187,139,null]],[1,0,[[],[[0,[74,2],[]]],[],[],[]],[1,63.38727082230276,140,null]],[1,0,[[],[[0,[75,2],[]]],[],[],[]],[1,65.72170701603665,141,null]],[1,0,[[],[[0,[76,2],[]]],[],[],[]],[1,66.18079768519735,142,null]],[1,0,[[],[[0,[77,2],[]]],[],[],[]],[1,67.41232406185625,143,null]],[1,0,[[],[[0,[78,2],[]]],[],[],[]],[1,71.10030192720819,144,null]],[1,0,[[],[[0,[79,2],[]]],[],[],[]],[1,71.23991846826897,145,null]],[1,0,[[],[[0,[80,2],[]]],[],[],[]],[1,71.55358919906384,146,null]],[1,0,[[],[[0,[81,2],[]]],[],[],[]],[1,72.53844218807349,147,null]],[1,0,[[],[[0,[82,2],[]]],[],[],[]],[1,73.70309448099336,148,null]],[1,0,[[],[[0,[83,2],[]]],[],[],[]],[1,74.07464291937578,149,null]],[1,0,[[],[[0,[84,2],[]]],[],[],[]],[1,75.74858439444773,150,null]],[1,0,[[],[[0,[85,2],[]]],[],[],[]],[1,75.99083804520345,151,null]],[1,0,[[],[[0,[86,2],[]]],[],[],[]],[1,75.99474244284836,152,null]],[1,0,[[],[[0,[87,2],[]]],[],[],[]],[1,79.91041368447468,153,null]],[1,0,[[],[[0,[88,2],[]]],[],[],[]],[1,80.3617705040289,154,null]],[1,0,[[],[[0,[89,2],[]]],[],[],[]],[1,80.47115964962752,155,null]],[1,0,[[],[[0,[90,2],[]]],[],[],[]],[1,81.16950393224009,156,null]],[1,0,[[],[[0,[91,2],[]]],[],[],[]],[1,82.84208581519334,157,null]],[1,0,[[],[[0,[92,2],[]]],[],[],[]],[1,82.96862445066279,158,null]],[1,0,[[],[[0,[93,2],[]]],[],[],[]],[1,83.02574451634469,159,null]],[1,0,[[],[[0,[94,2],[]]],[],[],[]],[1,83.43494540628078,160,null]],[1,0,[[],[[0,[95,2],[]]],[],[],[]],[1,84.75897414500096,161,null]],[1,0,[[],[[0,[96,2],[]]],[],[],[]],[1,86.27800687992146,162,null]],[1,0,[[],[[0,[97,2],[]]],[],[],[]],[1,86.70523863145627,163,null]],[1,0,[[],[[0,[98,2],[]]],[],[],[]],[1,87.00291202216177,164,null]],[1,0,[[],[[0,[99,2],[]]],[],[],[]],[1,87.47683984452136,165,null]],[1,0,[[],[[0,[100,2],[]]],[],[],[]],[1,88.27692884308469,166,null]],[1,0,[[],[[0,[101,2],[]]],[],[],[]],[1,89.45094491401196,167,null]],[1,0,[[],[[0,[102,2],[]]],[],[],[]],[1,90.7999534354089,168,null]],[1,0,[[],[[0,[103,2],[]]],[],[],[]],[1,91.34000842351216,169,null]],[1,0,[[],[[0,[104,2],[]]],[],[],[]],[1,91.36124183554971,170,null]],[1,0,[[],[[0,[105,2],[]]],[],[],[]],[1,92.42637142894652,171,null]],[1,0,[[],[[0,[106,2],[]]],[],[],[]],[1,92.91976615768908,172,null]],[1,0,[[],[[0,[107,2],[]]],[],[],[]],[1,93.19804536448288,173,null]],[1,0,[[],[[0,[108,2],[]]],[],[],[]],[1,95.09421553172456,174,null]],[1,0,[[],[[0,[109,2],[]]],[],[],[]],[1,95.52108673781673,175,null]],[1,0,[[],[[0,[110,2],[]]],[],[],[]],[1,95.7469521442698,176,null]],[1,0,[[],[[0,[111,2],[]]],[],[],[]],[1,95.81231866505402,177,null]],[1,0,[[],[[0,[112,2],[]]],[],[],[]],[1,96.03214880580897,178,null]],[1,0,[[],[[0,[113,2],[]]],[],[],[]],[1,96.23827228909866,179,null]],[1,0,[[],[[0,[114,2],[]]],[],[],[]],[1,96.84541742093506,180,null]],[1,0,[[],[[0,[115,2],[]]],[],[],[]],[1,97.11530276779472,181,null]],[1,0,[[],[[0,[116,2],[]]],[],[],[]],[1,97.43980247159546,182,null]],[1,0,[[],[[0,[117,2],[]]],[],[],[]],[1,97.89061527379926,183,null]],[1,0,[[],[[0,[118,2],[]]],[],[],[]],[1,99.78604285068981,184,null]],[1,0,[[],[[0,[119,2],[]]],[],[],[]],[1,100.10249665795644,185,null]],[1,0,[[],[[0,[120,2],[]]],[],[],[]],[1,103.11273417850109,186,null]],[1,0,[[],[[0,[121,2],[]]],[],[],[]],[1,104.23313308244514,187,null]],[1,0,[[],[[0,[122,2],[]]],[],[],[]],[1,104.39464153879467,188,null]],[1,0,[[],[[0,[123,2],[]]],[],[],[]],[1,104.43775981504315,189,null]],[1,0,[[],[[0,[124,2],[]]],[],[],[]],[1,105.15012677269257,190,null]],[1,0,[[],[[0,[125,2],[]]],[],[],[]],[1,106.87820496904953,191,null]],[1,0,[[],[[0,[126,2],[]]],[],[],[]],[1,107.2378573981612,192,null]],[1,0,[[],[[0,[127,2],[]]],[],[],[]],[1,107.28791165470423,193,null]],[1,0,[[],[[0,[128,2],[]]],[],[],[]],[1,107.69861556813046,194,null]],[1,0,[[],[[0,[129,2],[]]],[],[],[]],[1,110.02295451648506,195,null]],[1,0,[[],[[0,[130,2],[]]],[],[],[]],[1,112.22226658416241,196,null]],[1,0,[[],[[0,[131,2],[]]],[],[],[]],[1,112.43722357268074,197,null]],[1,0,[[],[[0,[132,2],[]]],[],[],[]],[1,112.65766296263841,198,null]],[1,0,[[],[[0,[133,2],[]]],[],[],[]],[1,112.76894147316574,199,null]]] } diff --git a/webapp/dune b/webapp/dune index c41ca46d5d..03ad6a6b88 100644 --- a/webapp/dune +++ b/webapp/dune @@ -1,23 +1,44 @@ (executable - (name WebSim) - (libraries num str lwt.unix cohttp-lwt-unix - kappa_staticanalyses - kappa_json_api kappa_agents) - (public_name WebSim) - (package kappa-server) - (flags (:standard - -open Kappa_generic_toolset - -open Kappa_version - -open Kappa_runtime - -open Kappa_grammar - -open Kappa_logging - -open Kappa_errors - -open Kappa_parameters - -open Kappa_reachability - -open Kappa_staticanalyses - -open Kappa_kasa_frontend - -open Kappa_kasa_export - -open Kappa_kasa_type_interface - -open Kappa_agents - -open Kappa_cli - -open Kappa_json_api))) + (name WebSim) + (libraries + num + str + lwt.unix + cohttp-lwt-unix + kappa_staticanalyses + kappa_json_api + kappa_agents) + (public_name WebSim) + (package kappa-server) + (flags + (:standard + -open + Kappa_generic_toolset + -open + Kappa_version + -open + Kappa_runtime + -open + Kappa_grammar + -open + Kappa_logging + -open + Kappa_errors + -open + Kappa_parameters + -open + Kappa_reachability + -open + Kappa_staticanalyses + -open + Kappa_kasa_frontend + -open + Kappa_kasa_export + -open + Kappa_kasa_type_interface + -open + Kappa_agents + -open + Kappa_cli + -open + Kappa_json_api))) diff --git a/webapp/route_root.ml b/webapp/route_root.ml index b65f0f8db6..177b697854 100644 --- a/webapp/route_root.ml +++ b/webapp/route_root.ml @@ -160,7 +160,7 @@ class new_manager = method get_influence_map_node_at ~filename pos : _ Api.result Lwt.t = List.find_opt - (fun (_, x) -> Locality.is_included_in filename pos x) + (fun (_, x) -> Loc.is_included_in filename pos x) kasa_locator |> Option_util.map fst |> Result_util.ok ?status:None @@ -963,7 +963,7 @@ let route ~(shutdown_key : string option) : Webapp_common.route_handler list = bind_projects (fun manager -> manager#get_influence_map_node_at ~filename - { Locality.line; Locality.chr }) + { Loc.line; Loc.chr }) project_id projects >>= Webapp_common.api_result_response ~string_of_success:(fun x -> let o =