Skip to content

Commit

Permalink
Add some more wide-ranging source locations in the AST
Browse files Browse the repository at this point in the history
  • Loading branch information
nberth committed Sep 26, 2023
1 parent ff3a689 commit 8420daa
Show file tree
Hide file tree
Showing 10 changed files with 416 additions and 348 deletions.
16 changes: 8 additions & 8 deletions src/lsp/cobol_ast/misc_descr.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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]

Expand Down Expand Up @@ -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]

Expand Down
28 changes: 14 additions & 14 deletions src/lsp/cobol_ast/raw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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]

Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand All @@ -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;
Expand All @@ -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;
Expand All @@ -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;
Expand All @@ -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;
Expand Down
23 changes: 15 additions & 8 deletions src/lsp/cobol_ast/raw_compilation_group_visitor.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand Down
52 changes: 45 additions & 7 deletions src/lsp/cobol_ast/raw_data_division_visitor.ml
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@
(* *)
(**************************************************************************)

open Cobol_common.Srcloc.TYPES
open Cobol_common.Visitor
open Cobol_common.Visitor.INFIX (* for `>>` (== `|>`) *)

Expand All @@ -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
35 changes: 30 additions & 5 deletions src/lsp/cobol_ast/raw_misc_sections_visitor.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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

Expand All @@ -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
Expand Down Expand Up @@ -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) =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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) =
Expand Down
Loading

0 comments on commit 8420daa

Please sign in to comment.