Skip to content

Commit

Permalink
JS: in the middle of debugging dead rules
Browse files Browse the repository at this point in the history
  • Loading branch information
@pirbo @antoinepouille
pirbo authored and antoinepouille committed Mar 21, 2024
1 parent e7284c0 commit cca7f77
Show file tree
Hide file tree
Showing 10 changed files with 161 additions and 158 deletions.
7 changes: 3 additions & 4 deletions core/grammar/counters_compiler.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -316,7 +316,7 @@ let split_counter_variables_into_separate_rules ~warning rules signatures =
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_of_var_setup
(split_for_each_counter_var_value_sites ids counter_defs t)
Expand All @@ -337,7 +337,7 @@ let split_counter_variables_into_separate_rules ~warning rules signatures =
in
let rec split_for_each_counter_var_value_mixture (ids : Mods.StringSet.t) :
Ast.agent list -> (Ast.agent list * (string * int) list) list = function
| [] -> [[],[]]
| [] -> [ [], [] ]
| ast_agent :: t ->
combinations_of_var_setup
(split_for_each_counter_var_value_mixture ids t)
Expand Down Expand Up @@ -434,8 +434,7 @@ let split_counter_variables_into_separate_rules ~warning rules signatures =

List.fold_left
(fun acc (rule_name, rule_annoted) ->
(split_for_each_counter_var_value_rule rule_name rule_annoted)
@ acc)
split_for_each_counter_var_value_rule rule_name rule_annoted @ acc)
[] rules
(* TODO: is rev relevant here? *)
|> List.rev
Expand Down
7 changes: 4 additions & 3 deletions gui/state_project.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -566,8 +566,8 @@ let eval_with_project :
Lwt.return (Api_common.result_error_msg error_msg)
| Some current -> handler current.project_manager

let on_project_change_async ?eq ~on ?(others_eq = ( = )) init_others others
default handler =
let on_project_change_async ?eq ~on ?(others_eq = ( = )) others default handler
=
let eq_pair = Mods.pair_equal state_equal others_eq in
React.S.hold ?eq default
(Lwt_react.E.map_p
Expand All @@ -576,5 +576,6 @@ let on_project_change_async ?eq ~on ?(others_eq = ( = )) init_others others
| None -> Lwt.return default
| Some current -> handler current.project_manager oth)
(React.S.changes
(React.S.on ~eq:eq_pair on (init_state, init_others)
(React.S.on ~eq:eq_pair on
(init_state, React.S.value others)
(React.S.Pair.pair ~eq:eq_pair state others))))
1 change: 0 additions & 1 deletion gui/state_project.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,6 @@ val on_project_change_async :
?eq:('a -> 'a -> bool) ->
on:bool React.signal ->
?others_eq:('b -> 'b -> bool) ->
'b ->
'b React.signal ->
'a ->
(Api.concrete_manager -> 'b -> 'a Lwt.t) ->
Expand Down
4 changes: 2 additions & 2 deletions gui/tab_constraints.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,8 +22,8 @@ let tab_was_active = ref false

let content () =
let constraints_div =
State_project.on_project_change_async ~on:tab_is_active ()
(React.S.const ()) [] (fun (manager : Api.concrete_manager) () ->
State_project.on_project_change_async ~on:tab_is_active (React.S.const ())
[] (fun (manager : Api.concrete_manager) () ->
manager#get_constraints_list
>|= Result_util.fold
~ok:(fun constraints ->
Expand Down
2 changes: 1 addition & 1 deletion gui/tab_contact_map.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ let contact_map_js : Js_contact.contact_map Js.t =
Js_contact.create_contact_map display_id State_settings.agent_coloring

let contact_map_text : string React.signal =
State_project.on_project_change_async ~on:tab_is_active None accuracy "null"
State_project.on_project_change_async ~on:tab_is_active accuracy "null"
(fun
(manager : Api.concrete_manager)
(acc : Public_data.accuracy_level option)
Expand Down
283 changes: 142 additions & 141 deletions gui/tab_editor.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,158 +75,159 @@ let content () =
]

let init_dead_rules () =
React.S.l1
(fun model ->
State_project.on_project_change_async ~on:(React.S.const true)
(React.S.const ()) (Result_util.ok ()) (fun manager () ->
State_error.wrap ~append:true "tab_editor_dead_rule"
(State_project.eval_with_project ~label:__LOC__
(fun (manager : Api.concrete_manager) ->
if
model.State_project.model_parameters
.State_project.show_dead_rules
then
manager#get_dead_rules
>|= Result_util.fold
~ok:(fun list ->
let warnings =
List.fold_left
(fun acc rule ->
if rule.Public_data.rule_hidden then
acc
else (
let text =
"Dead rule "
^
if rule.Public_data.rule_label <> "" then
" '" ^ rule.Public_data.rule_label ^ "'"
else if rule.Public_data.rule_ast <> "" then
rule.Public_data.rule_ast
else
string_of_int rule.Public_data.rule_id
in
{
Result_util.severity = Logs.Warning;
Result_util.range =
Some rule.Public_data.rule_position;
Result_util.text;
}
:: acc
))
[] list
in
List.rev warnings)
~error:(fun mh -> mh)
>|= Api_common.result_messages ?result_code:None
else
Lwt.return (Result_util.ok ()))))
State_project.model
(if
(*model.State_project.model_parameters
.State_project.show_dead_rules*)
true
then
manager#get_dead_rules
>|= Result_util.fold
~ok:(fun list ->
let warnings =
List.fold_left
(fun acc rule ->
if rule.Public_data.rule_hidden then
acc
else (
let text =
"Dead rule "
^
if rule.Public_data.rule_label <> "" then
" '" ^ rule.Public_data.rule_label ^ "'"
else if rule.Public_data.rule_ast <> "" then
rule.Public_data.rule_ast
else
string_of_int rule.Public_data.rule_id
in
{
Result_util.severity = Logs.Warning;
Result_util.range =
Some rule.Public_data.rule_position;
Result_util.text;
}
:: acc
))
[] list
in
List.rev warnings)
~error:(fun mh -> mh)
>|= Api_common.result_messages ?result_code:None
else
Lwt.return (Result_util.ok ())))

let init_dead_agents () =
React.S.l1
(fun model ->
State_project.on_project_change_async ~on:(React.S.const true)
(React.S.const ()) (Result_util.ok ()) (fun manager () ->
State_error.wrap ~append:true "tab_editor_dead_agent"
(State_project.eval_with_project ~label:__LOC__
(fun (manager : Api.concrete_manager) ->
if
model.State_project.model_parameters
.State_project.show_dead_agents
then
manager#get_dead_agents
>|= Result_util.fold
~ok:(fun list ->
let warnings =
(if
(*model.State_project.model_parameters
.State_project.show_dead_agents*)
true
then
manager#get_dead_agents
>|= Result_util.fold
~ok:(fun list ->
let warnings =
List.fold_left
(fun acc agent ->
let text =
"Dead agent "
^
if agent.Public_data.agent_ast <> "" then
agent.Public_data.agent_ast
else
string_of_int agent.Public_data.agent_id
in
List.fold_left
(fun acc agent ->
let text =
"Dead agent "
^
if agent.Public_data.agent_ast <> "" then
agent.Public_data.agent_ast
else
string_of_int agent.Public_data.agent_id
in
List.fold_left
(fun acc range ->
{
Result_util.severity = Logs.Warning;
Result_util.range = Some range;
Result_util.text;
}
:: acc)
acc agent.Public_data.agent_position)
[] list
in
List.rev warnings)
~error:(fun mh -> mh)
>|= Api_common.result_messages ?result_code:None
else
Lwt.return (Result_util.ok ()))))
State_project.model
(fun acc range ->
{
Result_util.severity = Logs.Warning;
Result_util.range = Some range;
Result_util.text;
}
:: acc)
acc agent.Public_data.agent_position)
[] list
in
List.rev warnings)
~error:(fun mh -> mh)
>|= Api_common.result_messages ?result_code:None
else
Lwt.return (Result_util.ok ())))

let init_non_weakly_reversible_transitions () =
React.S.l1
(fun model ->
State_project.on_project_change_async ~on:(React.S.const true)
(React.S.const ()) (Result_util.ok ()) (fun manager () ->
State_error.wrap ~append:true "tab_editor_dead_rule"
(State_project.eval_with_project ~label:__LOC__
(fun (manager : Api.concrete_manager) ->
if
model.State_project.model_parameters
.State_project.show_non_weakly_reversible_transitions
then
manager#get_non_weakly_reversible_transitions
>|= Result_util.fold
~ok:(fun list ->
let warnings =
List.fold_left
(fun acc (rule, context_list) ->
if rule.Public_data.rule_hidden then
acc
(* hint: reversible rule are always weakly reversible *)
else (
let plural, skip, tab =
match context_list with
| [] | [ _ ] -> "", "", " "
| _ :: _ -> "s", "\n", "\t"
in
let text =
Format.asprintf
"Rule %s may induce non weakly reversible \
events in the following context%s:%s%a"
(if rule.Public_data.rule_label <> "" then
" '" ^ rule.Public_data.rule_label ^ "'"
else if rule.Public_data.rule_ast <> "" then
rule.Public_data.rule_ast
else
string_of_int rule.Public_data.rule_id)
plural skip
(Pp.list
(fun fmt -> Format.fprintf fmt "%s" skip)
(fun fmt (a, b) ->
Format.fprintf fmt "%s%s -> %s " tab a b))
context_list
in
(* to do, add the potential contexts *)
{
Result_util.severity = Logs.Warning;
Result_util.range =
Some rule.Public_data.rule_position;
Result_util.text;
}
:: acc
))
[] list
in
List.rev warnings)
~error:(fun mh -> mh)
>|= Api_common.result_messages ?result_code:None
else
Lwt.return (Result_util.ok ()))))
State_project.model
(if
(*model.State_project.model_parameters
.State_project.show_non_weakly_reversible_transitions*)
true
then
manager#get_non_weakly_reversible_transitions
>|= Result_util.fold
~ok:(fun list ->
let warnings =
List.fold_left
(fun acc (rule, context_list) ->
if rule.Public_data.rule_hidden then
acc
(* hint: reversible rule are always weakly reversible *)
else (
let plural, skip, tab =
match context_list with
| [] | [ _ ] -> "", "", " "
| _ :: _ -> "s", "\n", "\t"
in
let text =
Format.asprintf
"Rule %s may induce non weakly reversible \
events in the following context%s:%s%a"
(if rule.Public_data.rule_label <> "" then
" '" ^ rule.Public_data.rule_label ^ "'"
else if rule.Public_data.rule_ast <> "" then
rule.Public_data.rule_ast
else
string_of_int rule.Public_data.rule_id)
plural skip
(Pp.list
(fun fmt -> Format.fprintf fmt "%s" skip)
(fun fmt (a, b) ->
Format.fprintf fmt "%s%s -> %s " tab a b))
context_list
in
(* to do, add the potential contexts *)
{
Result_util.severity = Logs.Warning;
Result_util.range =
Some rule.Public_data.rule_position;
Result_util.text;
}
:: acc
))
[] list
in
List.rev warnings)
~error:(fun mh -> mh)
>|= Api_common.result_messages ?result_code:None
else
Lwt.return (Result_util.ok ())))

let dont_gc_me = ref []

let onload () =
let () = Subpanel_editor.onload () in
let _ = init_dead_rules () in
let _ = init_dead_agents () in
let _ = init_non_weakly_reversible_transitions () in
let () =
dont_gc_me :=
[
init_dead_rules ();
init_dead_agents ();
init_non_weakly_reversible_transitions ();
]
in
let () = Tab_contact_map.onload () in
let () = Tab_influences.onload () in
let () = Tab_constraints.onload () in
Expand Down
3 changes: 2 additions & 1 deletion gui/tab_flux.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,8 @@ let din_data =
(Lwt_react.E.from (fun () ->
Lwt.map
(Result_util.fold ~ok:(fun x -> x) ~error:(fun _ -> None))
(State_simulation.eval_with_sim_manager_and_info ~label:__LOC__
(State_simulation.eval_with_sim_manager_and_info
~label:__LOC__
~stopped:(fun _ -> Lwt.return (Result_util.ok None))
~initializing:(fun _ -> Lwt.return (Result_util.ok None))
~ready:(fun manager _ ->
Expand Down
Loading

0 comments on commit cca7f77

Please sign in to comment.