Skip to content

Commit

Permalink
WIP
Browse files Browse the repository at this point in the history
  • Loading branch information
@antoinepouille
antoinepouille committed Aug 30, 2024
1 parent d666705 commit 3e68e14
Show file tree
Hide file tree
Showing 5 changed files with 77 additions and 109 deletions.
89 changes: 73 additions & 16 deletions core/KaSa_rep/export/export.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -598,6 +598,57 @@ functor
(*influence_map*)
(******************************************************************)

let nrules state =
let parameters = Remanent_state.get_parameters state in
let state, handler = get_handler state in
let error = get_errors state in
state, Handler.nrules parameters error handler

let nvars state =
let parameters = Remanent_state.get_parameters state in
let state, handler = get_handler state in
let error = get_errors state in
state, Handler.nvars parameters error handler

(** Convert a id from type in option `Rule of int` or `Var of int` to an flattened id of type`int` *)
let flattened_id_of_short_node state short_node =
let state, nrules = nrules state in
( state,
match short_node with
| Public_data.Rule a -> a
| Public_data.Var a -> a + nrules )

let flattened_id_of_short_node_opt state short_node_opt =
let parameters = get_parameters state in
let error = get_errors state in
let error, (state, flattened_id) =
match short_node_opt with
| Some short_node -> error, flattened_id_of_short_node state short_node
| None -> Exception.warn parameters error __POS__ Exit (state, 0)
in
let state = set_errors error state in
state, flattened_id

let refined_node_of_flattened_id state flattened_id =
let parameters = get_parameters state in
let state, handler = get_handler state in
let state, compil = get_c_compilation state in
let error = get_errors state in
let state, nrules = nrules state in
let state, nvars = nvars state in
let error, refined_id_opt =
if flattened_id < nrules + nvars then (
let error, refined_id =
refined_node_of_flattened_id parameters error handler compil
(Ckappa_sig.rule_id_of_int flattened_id)
in
error, Some refined_id
) else
Exception.warn parameters error __POS__ Exit None
in
let state = set_errors error state in
state, refined_id_opt

let compute_pos_of_rules_and_vars show_title state =
let parameters = get_parameters state in
let state, compil = get_c_compilation state in
Expand All @@ -616,19 +667,37 @@ functor
aux inc pos of_int lift (n - 1) (error, (lift n, p) :: l)
)
in
let error, l =
let error, short_nodes =
aux 0 Handler.pos_of_rule Ckappa_sig.rule_id_of_int
(fun x -> Public_data.Rule x)
(nrules - 1)
(aux nrules Handler.pos_of_var Ckappa_sig.rule_id_of_int
(fun x -> Public_data.Var x)
(nvars - 1) (error, []))
in
let json = Public_data.pos_of_rules_and_vars_to_json l in

(* change short_nodes to refined_nodes *)
let current_state = ref state in
let refined_nodes =
short_nodes
|> List.map
(Loc.map_annot (fun short_node ->
let state, flattened_id =
flattened_id_of_short_node !current_state short_node
in
let state, refined_node_opt =
refined_node_of_flattened_id state flattened_id
in
current_state := state;
Option_util.unsome_or_raise refined_node_opt))
in
let state = !current_state in

let json = Public_data.pos_of_rules_and_vars_to_json refined_nodes in
let _ = Public_data.pos_of_rules_and_vars_of_json json in
( Remanent_state.set_errors error
(Remanent_state.set_pos_of_rules_and_vars l state),
l )
(Remanent_state.set_pos_of_rules_and_vars refined_nodes state),
refined_nodes )

let get_pos_of_rules_and_vars =
get_gen ~log_prefix:"Summarize the position of rules and variables"
Expand Down Expand Up @@ -999,18 +1068,6 @@ functor
(Remanent_state.get_influence_map accuracy_level)
(compute_influence_map ~accuracy_level ~do_we_show_title ~log_title)
let nrules state =
let parameters = Remanent_state.get_parameters state in
let state, handler = get_handler state in
let error = get_errors state in
state, Handler.nrules parameters error handler
let nvars state =
let parameters = Remanent_state.get_parameters state in
let state, handler = get_handler state in
let error = get_errors state in
state, Handler.nvars parameters error handler
let convert_to_birectional_influence_map show_title state influence_map =
let () = show_title state in
let state, nrules = nrules state in
Expand Down
65 changes: 0 additions & 65 deletions core/KaSa_rep/export/export_to_json.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,6 @@ module type Type = sig
state * Yojson.Basic.t

val get_influence_map_nodes_location : state -> state * Yojson.Basic.t
val get_influence_map_nodes_location_refined : state -> state * Yojson.Basic.t

val get_influence_map :
?accuracy_level:Public_data.accuracy_level ->
Expand Down Expand Up @@ -112,50 +111,6 @@ functor
let state, nodes = get_all_nodes_of_influence_map ~accuracy_level state in
state, Public_data.nodes_of_influence_map_to_json (accuracy_level, nodes)

(** Convert a id from type in option `Rule of int` or `Var of int` to an flattened id of type`int` *)
let flattened_id_of_short_node state short_node =
let state, nrules = nrules state in
( state,
match short_node with
| Public_data.Rule a -> a
| Public_data.Var a -> a + nrules )

let flattened_id_of_short_node_opt state short_node_opt =
let parameters = get_parameters state in
let error = get_errors state in
let error, (state, flattened_id) =
match short_node_opt with
| Some short_node -> error, flattened_id_of_short_node state short_node
| None -> Exception.warn parameters error __POS__ Exit (state, 0)
in
let state = set_errors error state in
state, flattened_id

let refined_node_of_flattened_id
(state :
(A.static_information, A.dynamic_information) Remanent_state.state)
(i : int) :
(A.static_information, A.dynamic_information) Remanent_state.state
* Public_data.refined_influence_node option =
let parameters = get_parameters state in
let state, handler = get_handler state in
let state, compil = get_c_compilation state in
let error = get_errors state in
let state, nrules = nrules state in
let state, nvars = nvars state in
let error, refined_id_opt =
if i < nrules + nvars then (
let error, refined_id =
refined_node_of_flattened_id parameters error handler compil
(Ckappa_sig.rule_id_of_int i)
in
error, Some refined_id
) else
Exception.warn parameters error __POS__ Exit None
in
let state = set_errors error state in
state, refined_id_opt

let default_origin_of_influence_map state =
refined_node_of_flattened_id state 0

Expand Down Expand Up @@ -236,26 +191,6 @@ functor
let state, node = default_origin_of_influence_map state in
state, JsonUtil.of_option Public_data.refined_influence_node_to_json node

let get_influence_map_nodes_location_refined state =
(* need reference to update state in each func in a simple map *)
let state, short_node_loc_list = get_pos_of_rules_and_vars state in
let current_state = ref state in
let refined_node_loc_list =
short_node_loc_list
|> List.map
(Loc.map_annot (fun short_node ->
let state, flattened_id =
flattened_id_of_short_node !current_state short_node
in
let state, refined_node_opt =
refined_node_of_flattened_id state flattened_id
in
current_state := state;
Option_util.unsome_or_raise refined_node_opt))
|> Public_data.pos_of_rules_and_vars_refined_to_json
in
!current_state, refined_node_loc_list

let get_dead_rules state =
let state, rules = get_dead_rules state in
state, Public_data.dead_rules_to_json rules
Expand Down
1 change: 0 additions & 1 deletion core/KaSa_rep/export/export_to_json.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,6 @@ module type Type = sig
state * Yojson.Basic.t

val get_influence_map_nodes_location : state -> state * Yojson.Basic.t
val get_influence_map_nodes_location_refined : state -> state * Yojson.Basic.t

val get_influence_map :
?accuracy_level:Public_data.accuracy_level ->
Expand Down
21 changes: 3 additions & 18 deletions core/KaSa_rep/type_interface/public_data.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -436,8 +436,7 @@ let json_to_var = function
type ('rule, 'var) influence_node = Rule of 'rule | Var of 'var
type short_influence_node = (int, int) influence_node
type refined_influence_node = (rule, var) influence_node
type pos_of_rules_and_vars = short_influence_node Loc.annoted list
type pos_of_rules_and_vars_refined = refined_influence_node Loc.annoted list
type pos_of_rules_and_vars = refined_influence_node Loc.annoted list

let influence_node_to_json rule_to_json var_to_json a =
match a with
Expand All @@ -459,32 +458,18 @@ let short_influence_node_of_json =
(JsonUtil.to_int ~error_msg:(JsonUtil.build_msg "rule id"))
(JsonUtil.to_int ~error_msg:(JsonUtil.build_msg "var id"))

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 -> 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
(Loc.annoted_of_yojson
(JsonUtil.to_unit ~error_msg:(JsonUtil.build_msg "locality"))
x)))

let refined_influence_node_to_json =
influence_node_to_json rule_to_json var_to_json

let refined_influence_node_of_json =
influence_node_of_json json_to_rule json_to_var

let pos_of_rules_and_vars_refined_to_json =
let pos_of_rules_and_vars_to_json =
JsonUtil.of_list
(JsonUtil.of_pair ~lab1:key ~lab2:locality refined_influence_node_to_json
(fun loc -> Loc.yojson_of_annoted JsonUtil.of_unit ((), loc)))

let pos_of_rules_and_vars_refined_of_json =
let pos_of_rules_and_vars_of_json =
JsonUtil.to_list
(JsonUtil.to_pair ~lab1:key ~lab2:locality refined_influence_node_of_json
(fun x ->
Expand Down
10 changes: 1 addition & 9 deletions core/KaSa_rep/type_interface/public_data.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -93,18 +93,10 @@ type var = {
type ('rule, 'var) influence_node = Rule of 'rule | Var of 'var
type short_influence_node = (int, int) influence_node
type refined_influence_node = (rule, var) influence_node
type pos_of_rules_and_vars = short_influence_node Loc.annoted list
type pos_of_rules_and_vars_refined = refined_influence_node Loc.annoted list
type pos_of_rules_and_vars = refined_influence_node Loc.annoted 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

val pos_of_rules_and_vars_refined_of_json :
Yojson.Basic.t -> pos_of_rules_and_vars_refined

val pos_of_rules_and_vars_refined_to_json :
pos_of_rules_and_vars_refined -> Yojson.Basic.t

val short_node_of_refined_node : refined_influence_node -> short_influence_node
val short_influence_node_of_json : Yojson.Basic.t -> short_influence_node
val short_influence_node_to_json : short_influence_node -> Yojson.Basic.t
Expand Down

0 comments on commit 3e68e14

Please sign in to comment.