Add some more wide-ranging source locations in the AST

Author: nberth

src/lsp/cobol_ast/misc_descr.ml

@@ -29,18 +29,18 @@ type informational_paragraphs =
 (* ------------------------- ENVIRONMENT DIVISION -------------------------- *)
 type environment_division =
   {
-    env_configuration: configuration_section option;
-    env_input_output: input_output_section option;
+    env_configuration: configuration_section with_loc option;
+    env_input_output: input_output_section with_loc option;
   }
 [@@deriving show, ord]
 
 (* ------------- ENVIRONMENT DIVISION / CONFIGURATION SECTION -------------- *)
 and configuration_section =
   {
-    source_computer_paragraph: source_computer_paragraph option;
-    object_computer_paragraph: object_computer_paragraph option;
-    special_names_paragraph: special_names_paragraph option;
-    repository_paragraph: repository_paragraph option; (* +COB2002 *)
+    source_computer_paragraph: source_computer_paragraph with_loc option;
+    object_computer_paragraph: object_computer_paragraph with_loc option;
+    special_names_paragraph: special_names_paragraph with_loc option;
+    repository_paragraph: repository_paragraph with_loc option;   (* +COB2002 *)
   }
 [@@deriving show]
 
@@ -249,8 +249,8 @@ and expands =
 (* -------------- ENVIRONMENT DIVISION / INPUT-OUTPUT SECTION -------------- *)
 and input_output_section =
   {
-    file_control_paragraph: file_control_paragraph option; (* COB85: mandatory *)
-    io_control_paragraph: io_control_paragraph option;
+    file_control_paragraph: file_control_paragraph with_loc option; (* COB85: mandatory *)
+    io_control_paragraph: io_control_paragraph with_loc option;
   }
 [@@deriving show]
 

src/lsp/cobol_ast/raw.ml

@@ -271,13 +271,13 @@ module Data_division (Data_sections: Abstract.DATA_SECTIONS) = struct
 
   type data_division =
     {
-      file_section: file_section option;
-      working_storage_section: working_storage_section option;
-      linkage_section: linkage_section option;
-      communication_section: communication_section option;
-      local_storage_section: local_storage_section option;
-      report_section: report_section option;
-      screen_section: screen_section option;
+      file_section: file_section with_loc option;
+      working_storage_section: working_storage_section with_loc option;
+      linkage_section: linkage_section with_loc option;
+      communication_section: communication_section with_loc option;
+      local_storage_section: local_storage_section with_loc option;
+      report_section: report_section with_loc option;
+      screen_section: screen_section with_loc option;
     }
   [@@deriving show]
 
@@ -392,7 +392,7 @@ struct
       program_name: name with_loc;
       program_as: strlit option;
       program_level: program_level;
-      program_options: options_paragraph option;
+      program_options: options_paragraph with_loc option;
       program_env: environment_division with_loc option;
       program_data: data_division with_loc option;
       program_proc: procedure_division with_loc option;
@@ -422,7 +422,7 @@ struct
       function_name: name with_loc;
       function_as: strlit option;
       function_is_proto: bool;
-      function_options: options_paragraph option;
+      function_options: options_paragraph with_loc option;
       function_env: environment_division with_loc option;
       function_data: data_division with_loc option;
       function_proc: procedure_division option;
@@ -436,7 +436,7 @@ struct
       method_kind: method_kind;
       method_override: bool;
       method_final: bool;
-      method_options: options_paragraph option;
+      method_options: options_paragraph with_loc option;
       method_env: environment_division with_loc option;
       method_data: data_division with_loc option;
       method_proc: procedure_division option;
@@ -451,7 +451,7 @@ struct
   type factory_definition = (* Note: could be merged with instance_definition *)
     {
       factory_implements: name with_loc list;
-      factory_options: options_paragraph option;
+      factory_options: options_paragraph with_loc option;
       factory_env: environment_division with_loc option;
       factory_data: data_division with_loc option;
       factory_methods: method_definition with_loc list option;
@@ -461,7 +461,7 @@ struct
   type instance_definition =
     {
       instance_implements: name with_loc list;
-      instance_options: options_paragraph option;
+      instance_options: options_paragraph with_loc option;
       instance_env: environment_division with_loc option;
       instance_data: data_division with_loc option;
       instance_methods: method_definition with_loc list option;
@@ -475,7 +475,7 @@ struct
       class_final: bool;
       class_inherits: name with_loc list;
       class_usings: name with_loc list;
-      class_options: options_paragraph option;
+      class_options: options_paragraph with_loc option;
       class_env: environment_division with_loc option;
       class_factory: factory_definition option;
       class_instance: instance_definition option;
@@ -489,7 +489,7 @@ struct
       interface_as: strlit option;
       interface_inherits: name with_loc list;
       interface_usings: name with_loc list;
-      interface_options: options_paragraph option;
+      interface_options: options_paragraph with_loc option;
       interface_env: environment_division with_loc option;
       interface_methods: method_definition with_loc list option;
       interface_end_name: name with_loc;

src/lsp/cobol_ast/raw_compilation_group_visitor.ml

@@ -46,6 +46,8 @@ struct
     inherit ['a] Terms_visitor.folder
     inherit ['a] Misc_sections_visitor.folder
     inherit ['a] Data_division_visitor.folder
+    method fold_options_paragraph'       : (options_paragraph with_loc   , 'a) fold = default
+    method fold_environment_division'    : (environment_division with_loc, 'a) fold = default
     method fold_data_division'           : (data_division with_loc       , 'a) fold = default
     inherit ['a] Proc_division_visitor.folder
     method fold_procedure_division'      : (procedure_division with_loc  , 'a) fold = default
@@ -67,11 +69,16 @@ struct
   let todo    x = todo    __MODULE__ x
   let partial x = partial __MODULE__ x
 
-  let fold_options_paragraph_opt (v: _ #folder) =
-    fold_option ~fold:(fun v -> v#continue_with_options_paragraph) v
+  let fold_options_paragraph' (v: _ #folder) =
+    handle' v#fold_options_paragraph' v
+      ~fold:(fun v -> v#continue_with_options_paragraph)
+
+  let fold_options_paragraph'_opt (v: _ #folder) =
+    fold_option ~fold:fold_options_paragraph' v
 
   let fold_environment_division' (v: _ #folder) =
-    fold' ~fold:(fun v -> v#continue_with_environment_division) v
+    handle' v#fold_environment_division' v
+      ~fold:(fun v -> v#continue_with_environment_division)
 
   let fold_environment_division'_opt (v: _ #folder) =
     fold_option ~fold:fold_environment_division' v
@@ -99,7 +106,7 @@ struct
                             program_proc; program_end_name } x -> x
         >> fold_name' v program_name
         >> fold_strlit_opt v program_as
-        >> fold_options_paragraph_opt v program_options
+        >> fold_options_paragraph'_opt v program_options
         >> fold_environment_division'_opt v program_env
         >> fold_data_division'_opt v program_data
         >> (fun x -> match program_level with
@@ -126,7 +133,7 @@ struct
         >> fold_name' v function_name
         >> fold_strlit_opt v function_as
         >> fold_bool v function_is_proto                      (* XXX: useful? *)
-        >> fold_options_paragraph_opt v function_options
+        >> fold_options_paragraph'_opt v function_options
         >> fold_environment_division'_opt v function_env
         >> fold_data_division'_opt v function_data
         >> fold_procedure_division_opt v function_proc
@@ -153,7 +160,7 @@ struct
         >> fold_method_kind v method_kind
         >> fold_bool v method_override
         >> fold_bool v method_final
-        >> fold_options_paragraph_opt v method_options
+        >> fold_options_paragraph'_opt v method_options
         >> fold_environment_division'_opt v method_env
         >> fold_data_division'_opt v method_data
         >> fold_procedure_division_opt v method_proc
@@ -165,7 +172,7 @@ struct
       ~continue:begin fun { factory_implements; factory_options; factory_env;
                             factory_data; factory_methods } x -> x
         >> fold_name'_list v factory_implements
-        >> fold_options_paragraph_opt v factory_options
+        >> fold_options_paragraph'_opt v factory_options
         >> fold_environment_division'_opt v factory_env
         >> fold_data_division'_opt v factory_data
         >> fold_option v factory_methods
@@ -180,7 +187,7 @@ struct
         partial __LINE__ "fold_instance_definition" ();
         x
         >> fold_name'_list v instance_implements
-        >> fold_options_paragraph_opt v instance_options
+        >> fold_options_paragraph'_opt v instance_options
         >> fold_data_division'_opt v instance_data
         >> fold_option v instance_methods
           ~fold:(fold_with_loc_list ~fold:fold_method_definition)

src/lsp/cobol_ast/raw_data_division_visitor.ml

@@ -11,6 +11,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Cobol_common.Srcloc.TYPES
 open Cobol_common.Visitor
 open Cobol_common.Visitor.INFIX                         (* for `>>` (== `|>`) *)
 
@@ -31,32 +32,69 @@ struct
   module Data_division_visitor =
     Abstract_visitor.For_data_division (Data_division)
 
+  open Data_sections
+
   class virtual ['a] folder = object
     inherit ['a] Terms_visitor.folder
     inherit ['a] Data_sections_visitor.folder
     inherit ['a] Data_division_visitor.folder
+    method fold_file_section': (file_section with_loc, 'a) fold = default
+    method fold_working_storage_section': (working_storage_section with_loc, 'a) fold = default
+    method fold_linkage_section': (linkage_section with_loc, 'a) fold = default
+    method fold_communication_section': (communication_section with_loc, 'a) fold = default
+    method fold_local_storage_section': (local_storage_section with_loc, 'a) fold = default
+    method fold_report_section': (report_section with_loc, 'a) fold = default
+    method fold_screen_section': (screen_section with_loc, 'a) fold = default
   end
 
+  let fold_file_section' (v: _ #folder) =
+    handle' v#fold_file_section' v
+      ~fold:(fun v -> v#continue_with_file_section)
+
+  let fold_working_storage_section' (v: _ #folder) =
+    handle' v#fold_working_storage_section' v
+      ~fold:(fun v -> v#continue_with_working_storage_section)
+
+  let fold_linkage_section' (v: _ #folder) =
+    handle' v#fold_linkage_section' v
+      ~fold:(fun v -> v#continue_with_linkage_section)
+
+  let fold_communication_section' (v: _ #folder) =
+    handle' v#fold_communication_section' v
+      ~fold:(fun v -> v#continue_with_communication_section)
+
+  let fold_local_storage_section' (v: _ #folder) =
+    handle' v#fold_local_storage_section' v
+      ~fold:(fun v -> v#continue_with_local_storage_section)
+
+  let fold_report_section' (v: _ #folder) =
+    handle' v#fold_report_section' v
+      ~fold:(fun v -> v#continue_with_report_section)
+
+  let fold_screen_section' (v: _ #folder) =
+    handle' v#fold_screen_section' v
+      ~fold:(fun v -> v#continue_with_screen_section)
+
   let fold_data_division (v: _#folder) =
     handle v#fold_data_division
       ~continue:begin fun { file_section; working_storage_section;
                             linkage_section; communication_section;
                             local_storage_section; report_section;
                             screen_section } x -> x
         >> fold_option v file_section
-          ~fold:(fun v -> v#continue_with_file_section)
+          ~fold:fold_file_section'
         >> fold_option v working_storage_section
-          ~fold:(fun v -> v#continue_with_working_storage_section)
+          ~fold:fold_working_storage_section'
         >> fold_option v linkage_section
-          ~fold:(fun v -> v#continue_with_linkage_section)
+          ~fold:fold_linkage_section'
         >> fold_option v communication_section
-          ~fold:(fun v -> v#continue_with_communication_section)
+          ~fold:fold_communication_section'
         >> fold_option v local_storage_section
-          ~fold:(fun v -> v#continue_with_local_storage_section)
+          ~fold:fold_local_storage_section'
         >> fold_option v report_section
-          ~fold:(fun v -> v#continue_with_report_section)
+          ~fold:fold_report_section'
         >> fold_option v screen_section
-          ~fold:(fun v -> v#continue_with_screen_section)
+          ~fold:fold_screen_section'
       end
 
 end

src/lsp/cobol_ast/raw_misc_sections_visitor.ml

@@ -33,16 +33,20 @@ module Make = struct
     inherit ['a] Misc_sections_visitor.folder
     method fold_options_clause: (options_clause, 'a) fold = default
     method fold_configuration_section: (configuration_section, 'a) fold = default
+    method fold_configuration_section': (configuration_section with_loc, 'a) fold = default
     method fold_special_names_paragraph: (special_names_paragraph, 'a) fold = default
     method fold_special_names_clause: (special_names_clause, 'a) fold = default
     method fold_special_names_clause': (special_names_clause with_loc, 'a) fold = default
     method fold_repository_paragraph: (repository_paragraph, 'a) fold = default
+    method fold_repository_paragraph': (repository_paragraph with_loc, 'a) fold = default
     method fold_specifier: (specifier, 'a) fold = default
     method fold_expands: (expands, 'a) fold = default
     method fold_select: (select, 'a) fold = default
     method fold_select_clause: (select_clause, 'a) fold = default
     method fold_file_control_paragraph: (file_control_paragraph, 'a) fold = default
+    method fold_file_control_paragraph': (file_control_paragraph with_loc, 'a) fold = default
     method fold_io_control_paragraph: (io_control_paragraph, 'a) fold = default
+    method fold_io_control_paragraph': (io_control_paragraph with_loc, 'a) fold = default
     method fold_io_control_entry: (io_control_entry, 'a) fold = default
     method fold_rerun_clause: (rerun_clause, 'a) fold = default
     method fold_rerun_frequency: (rerun_frequency, 'a) fold = default
@@ -51,6 +55,7 @@ module Make = struct
     method fold_multiple_file_clause: (multiple_file_clause, 'a) fold = default
     method fold_file_portion: (file_portion, 'a) fold = default
     method fold_input_output_section: (input_output_section, 'a) fold = default
+    method fold_input_output_section': (input_output_section with_loc, 'a) fold = default
     method fold_alphabet_specification: (alphabet_specification, 'a) fold = default
   end
 
@@ -77,6 +82,10 @@ module Make = struct
     handle v#fold_file_control_paragraph
       ~continue:(fold_list ~fold:fold_select v)
 
+  let fold_file_control_paragraph' (v: _ #folder) =
+    handle' v#fold_file_control_paragraph' v
+      ~fold:fold_file_control_paragraph
+
   let fold_rerun_frequency (v: _ #folder) =
     handle v#fold_rerun_frequency
       ~continue:begin function
@@ -133,15 +142,23 @@ module Make = struct
     handle v#fold_io_control_paragraph
       ~continue:(fold_option ~fold:fold_io_control_entry v)
 
+  let fold_io_control_paragraph' (v: _ #folder) =
+    handle' v#fold_io_control_paragraph' v
+      ~fold:fold_io_control_paragraph
+
   let fold_input_output_section (v: _ #folder) =
     handle v#fold_input_output_section
       ~continue:begin fun { file_control_paragraph; io_control_paragraph } x -> x
         >> fold_option v file_control_paragraph
-          ~fold:fold_file_control_paragraph
+          ~fold:fold_file_control_paragraph'
         >> fold_option v io_control_paragraph
-          ~fold:fold_io_control_paragraph
+          ~fold:fold_io_control_paragraph'
       end
 
+  let fold_input_output_section' (v: _ #folder) =
+    handle' v#fold_input_output_section' v
+      ~fold:fold_input_output_section
+
   (* --- *)
 
   let fold_informational_paragraphs (v: _ #folder) =
@@ -189,6 +206,10 @@ module Make = struct
     handle v#fold_repository_paragraph
       ~continue:(fold_list ~fold:fold_specifier v)
 
+  let fold_repository_paragraph' (v: _ #folder) =
+    handle' v#fold_repository_paragraph' v
+      ~fold:fold_repository_paragraph
+
   let fold_special_names_clause (v: _ #folder) =
     handle v#fold_special_names_clause
       ~continue:begin fun c x -> match c with
@@ -217,14 +238,18 @@ module Make = struct
         ignore special_names_paragraph;
         x
         >> partial __LINE__ "fold_configuration_section"
-        >> fold_option ~fold:fold_repository_paragraph v repository_paragraph
+        >> fold_option ~fold:fold_repository_paragraph' v repository_paragraph
       end
 
+  let fold_configuration_section' (v: _ #folder) =
+    handle' v#fold_configuration_section' v
+      ~fold:fold_configuration_section
+
   let fold_environment_division (v: _ #folder) =
     handle v#fold_environment_division
       ~continue:begin fun { env_configuration; env_input_output } x -> x
-        >> fold_option ~fold:fold_configuration_section v env_configuration
-        >> fold_option ~fold:fold_input_output_section v env_input_output
+        >> fold_option ~fold:fold_configuration_section' v env_configuration
+        >> fold_option ~fold:fold_input_output_section' v env_input_output
       end
 
   let fold_alphabet_specification (v: _ #folder) =