Rule and var location now match full name+expression

core/KaSa_rep/export/export.ml

@@ -657,26 +657,34 @@ functor
       let nrules = Handler.nrules parameters error handler in
       let nvars = Handler.nvars parameters error handler in
       let () = show_title state in
-      let rec aux inc pos of_int lift n (error, l) =
-        if n < 0 then
+      let rec aux id_offset pos_of_node_id id_of_int short_node_of_id current_id
+          (error, l) =
+        if current_id < 0 then
           error, l
         else (
+          let flattened_id = current_id + id_offset in
           let error, p =
-            pos parameters error handler compil (of_int (n + inc))
+            pos_of_node_id parameters error handler compil
+              (id_of_int flattened_id)
           in
-          aux inc pos of_int lift (n - 1) (error, (lift n, p) :: l)
+          aux id_offset pos_of_node_id id_of_int short_node_of_id
+            (current_id - 1)
+            (error, (short_node_of_id current_id, p) :: l)
         )
       in
+
+      let error, short_nodes_var =
+        aux nrules Handler.pos_of_var Ckappa_sig.rule_id_of_int
+          (fun x -> Public_data.Var x)
+          (nvars - 1) (error, [])
+      in
       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, []))
+          (nrules - 1) (error, short_nodes_var)
       in
 
-      (* change short_nodes to refined_nodes *)
+      (* convert short_nodes to refined_nodes *)
       let current_state = ref state in
       let refined_nodes =
         short_nodes
@@ -693,10 +701,12 @@ functor
       in
       let state = !current_state in
 
+      (* Test json conversion *)
       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 refined_nodes state),
+
+      ( Remanent_state.set_pos_of_rules_and_vars refined_nodes state
+        |> Remanent_state.set_errors error,
         refined_nodes )
 
     let get_pos_of_rules_and_vars =

core/KaSa_rep/frontend/cckappa_sig.ml

@@ -121,9 +121,10 @@ type mixture = {
 
 type enriched_variable = {
   e_id: string * Ckappa_sig.position;
-  e_id_dot: string * Ckappa_sig.position;
+  e_id_dot: string;  (** Variable id cleaned to be used in dot export *)
   c_variable: (Ckappa_sig.mixture, string) Alg_expr.e;
   e_variable: (mixture, string) Ast.variable_def;
+  expr_loc: Loc.t;
 }
 
 type counter_action = {

core/KaSa_rep/frontend/cckappa_sig.mli

@@ -114,9 +114,10 @@ type mixture = {
 
 type enriched_variable = {
   e_id: string * Ckappa_sig.position;
-  e_id_dot: string * Ckappa_sig.position;
+  e_id_dot: string;
   c_variable: (Ckappa_sig.mixture, string) Alg_expr.e;
   e_variable: (mixture, string) Ast.variable_def;
+  expr_loc: Loc.t;
 }
 
 type counter_action = {
@@ -223,7 +224,8 @@ val rename_mixture :
   (Remanent_parameters_sig.parameters ->
   Exception_without_parameter.exceptions_caught_and_uncaught ->
   Ckappa_sig.c_agent_id ->
-  Exception_without_parameter.exceptions_caught_and_uncaught * Ckappa_sig.c_agent_id) ->
+  Exception_without_parameter.exceptions_caught_and_uncaught
+  * Ckappa_sig.c_agent_id) ->
   mixture ->
   Exception_without_parameter.exceptions_caught_and_uncaught * mixture
 
@@ -237,11 +239,13 @@ val join_mixture :
   (Remanent_parameters_sig.parameters ->
   Exception_without_parameter.exceptions_caught_and_uncaught ->
   Ckappa_sig.c_agent_id ->
-  Exception_without_parameter.exceptions_caught_and_uncaught * Ckappa_sig.c_agent_id) ->
+  Exception_without_parameter.exceptions_caught_and_uncaught
+  * Ckappa_sig.c_agent_id) ->
   (Remanent_parameters_sig.parameters ->
   Exception_without_parameter.exceptions_caught_and_uncaught ->
   Ckappa_sig.c_agent_id ->
-  Exception_without_parameter.exceptions_caught_and_uncaught * Ckappa_sig.c_agent_id) ->
+  Exception_without_parameter.exceptions_caught_and_uncaught
+  * Ckappa_sig.c_agent_id) ->
   mixture ->
   mixture ->
   Exception_without_parameter.exceptions_caught_and_uncaught * mixture
@@ -257,15 +261,17 @@ val add_port :
   Ckappa_sig.c_state option ->
   Ckappa_sig.c_state option ->
   Ckappa_sig.c_state interval port ->
-  Exception_without_parameter.exceptions_caught_and_uncaught * Ckappa_sig.c_state interval port
+  Exception_without_parameter.exceptions_caught_and_uncaught
+  * Ckappa_sig.c_state interval port
 
 val add_state :
   Remanent_parameters_sig.parameters ->
   Exception_without_parameter.exceptions_caught_and_uncaught ->
   Ckappa_sig.c_site_name ->
   Ckappa_sig.c_state option ->
   Ckappa_sig.c_state interval port ->
-  Exception_without_parameter.exceptions_caught_and_uncaught * Ckappa_sig.c_state interval port
+  Exception_without_parameter.exceptions_caught_and_uncaught
+  * Ckappa_sig.c_state interval port
 
 val add_agent_interface :
   Remanent_parameters_sig.parameters ->

core/KaSa_rep/frontend/handler.ml

@@ -211,7 +211,7 @@ let info_of_rule parameters ?(with_rates = false) ?(original = false) error
         Ckappa_sig.dummy_rule_id )
   | Some rule ->
     let label_opt = rule.Cckappa_sig.e_rule_label in
-    let error, (label, _) =
+    let error, (label, label_annot) =
       Misc_sa.unsome (error, label_opt) (fun error ->
           error, Loc.annot_with_dummy "")
     in
@@ -224,7 +224,9 @@ let info_of_rule parameters ?(with_rates = false) ?(original = false) error
         | Ckappa_sig.Reverse -> Ast.flip_label label
       )
     in
-    let position = rule.Cckappa_sig.e_rule_rule.Ckappa_sig.position in
+    let position =
+      Loc.merge label_annot rule.Cckappa_sig.e_rule_rule.Ckappa_sig.position
+    in
     let direction =
       match rule.Cckappa_sig.e_rule_initial_direction with
       | Ckappa_sig.Direct -> Public_data.Direct_rule
@@ -274,8 +276,9 @@ let info_of_var parameters error handler compiled
         var_id )
   | Some var ->
     ( error,
-      ( fst var.Cckappa_sig.e_id_dot,
-        snd var.Cckappa_sig.e_id,
+      ( (* Use variable name compatible with dot export *)
+        var.Cckappa_sig.e_id_dot,
+        Loc.merge (Loc.get_annot var.Cckappa_sig.e_id) var.Cckappa_sig.expr_loc,
         Public_data.Variable,
         ""
         (* TO DO: string for the ast representation (from var.Cckappa_sig.c_variable?) *),
@@ -615,10 +618,10 @@ let get_label_of_rule_dot _parameters error rule =
   error, rule.Cckappa_sig.e_rule_label_dot
 
 let get_label_of_var_txt _parameters error rule =
-  error, fst rule.Cckappa_sig.e_id
+  error, Loc.v rule.Cckappa_sig.e_id
 
 let get_label_of_var_dot _parameters error rule =
-  error, fst rule.Cckappa_sig.e_id_dot
+  error, rule.Cckappa_sig.e_id_dot
 
 let print_rule_txt parameters error rule_id m1 _m2 rule =
   let m = "'" ^ m1 ^ "' " in

core/KaSa_rep/frontend/preprocess.ml

@@ -1030,7 +1030,7 @@ let translate_view parameters error handler (k : Ckappa_sig.c_agent_id)
             in
             let error, (bool, output) =
               Ckappa_sig.Dictionary_of_agents.allocate_bool parameters error
-                Ckappa_sig.compare_unit_agent_name (fst agent') ()
+                Ckappa_sig.compare_unit_agent_name (Loc.v agent') ()
                 Misc_sa.const_unit handler.Cckappa_sig.agents_dic
             in
             let error, agent_name' =
@@ -1053,7 +1053,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 (fst site'))
+                (Ckappa_sig.Binding (Loc.v site'))
                 () Misc_sa.const_unit site_dic'
             in
             let error, site_name' =
@@ -2151,28 +2151,32 @@ let translate_init parameters error handler ((alg, pos_alg), init_t) =
     | Remanent_parameters_sig.Server ->
       error, dft)
 
-let translate_var parameters error handler (a, b) =
-  let error, b' =
-    alg_with_pos_map (lift_allowing_question_marks parameters handler) error b
+let translate_var parameters error handler (var_name, var_expr) =
+  let error, var_expr' =
+    alg_with_pos_map
+      (lift_allowing_question_marks parameters handler)
+      error var_expr
   in
-  let error, a_dot =
-    Tools_kasa.make_id_compatible_with_dot_format parameters error (fst a)
+  let error, var_name_dot =
+    Tools_kasa.make_id_compatible_with_dot_format parameters error
+      (Loc.v var_name)
   in
   ( error,
     {
-      Cckappa_sig.e_id = a;
-      Cckappa_sig.e_id_dot = a_dot, snd a;
-      Cckappa_sig.c_variable = fst b;
-      Cckappa_sig.e_variable = a, b';
+      Cckappa_sig.e_id = var_name;
+      Cckappa_sig.e_id_dot = var_name_dot;
+      Cckappa_sig.c_variable = Loc.v var_expr;
+      Cckappa_sig.e_variable = var_name, var_expr';
+      Cckappa_sig.expr_loc = Loc.get_annot var_expr;
     } )
 
-let translate_obs parameters error handler (a, b) =
-  let error, a' =
+let translate_obs parameters error handler (obs_name, obs_expr) =
+  let error, obs_name' =
     Prepreprocess.alg_map
       (lift_allowing_question_marks parameters handler)
-      error a
+      error obs_name
   in
-  error, (a', b)
+  error, (obs_name', obs_expr)
 
 let bool_with_pos_map = Prepreprocess.map_with_pos Prepreprocess.bool_map
 
@@ -2462,8 +2466,9 @@ let print_list_of_lines parameters list =
       ())
     list
 
-let gexf_of_contact_map ?logger parameters (error : Exception.exceptions_caught_and_uncaught)
-    handler _scc_map contact_map =
+let gexf_of_contact_map ?logger parameters
+    (error : Exception.exceptions_caught_and_uncaught) handler _scc_map
+    contact_map =
   let parameters_gexf =
     match logger with
     | None -> Remanent_parameters.open_contact_map_file parameters

core/dataStructures/loc.ml

@@ -178,12 +178,18 @@ let is_included_in file { line; chr } range =
   && (line <> range.to_position.line || chr <= range.to_position.chr)
 
 let merge b e =
-  let () = assert (b.file = e.file) in
-  {
-    file = b.file;
-    from_position = b.from_position;
-    to_position = e.to_position;
-  }
+  if is_dummy b then
+    e
+  else if is_dummy e then
+    b
+  else (
+    let () = assert (b.file = e.file) in
+    {
+      file = b.file;
+      from_position = b.from_position;
+      to_position = e.to_position;
+    }
+  )
 
 (** Annoted yojson helpers *)