diff --git a/src/lsp/cobol_lsp/lsp_lookup.ml b/src/lsp/cobol_lsp/lsp_lookup.ml index 517e1c638..2fc7a2d0c 100644 --- a/src/lsp/cobol_lsp/lsp_lookup.ml +++ b/src/lsp/cobol_lsp/lsp_lookup.ml @@ -376,7 +376,10 @@ let type_at_pos ~filename (pos: Lsp.Types.Position.t) group : approx_typing_info method! fold_goto' { payload = g; _ } acc = begin match g with - | GoToSimple { depending_on; _ } + | GoToSimple _ -> acc + | GoToDepending { depending_on; _ } -> + acc + |> Numeric (* int *) @>@ fold_ident v depending_on | GoToEntry { depending_on; _ } -> acc |> Numeric (* int *) @>@ fold_option ~fold:fold_ident v depending_on diff --git a/src/lsp/cobol_parser/grammar.mly b/src/lsp/cobol_parser/grammar.mly index 392c36fbc..2d96e357b 100644 --- a/src/lsp/cobol_parser/grammar.mly +++ b/src/lsp/cobol_parser/grammar.mly @@ -3453,9 +3453,12 @@ let generate_statement := let go_to_statement := | GO; TO?; %prec lowest { LoneGoTo } (* COB85; obsolete; should be sole statement of paragraph *) - | GO; TO?; targets = nel_(procedure_name); - depending_on = o(DEPENDING; ON?; ident); - { GoTo (GoToSimple { targets; depending_on }) } + | GO; TO?; target = procedure_name; + depending_on_clause = o(pair(rl(procedure_name), DEPENDING; ON?; ident)); + { match depending_on_clause with + | None -> GoTo (GoToSimple { target = target }) + | Some (other_targets, depending_on) -> GoTo (GoToDepending + { targets = NEL.of_list (target :: other_targets); depending_on }) } | GO; TO?; ENTRY; targets = nel_(loc(alphanum)); depending_on = o(DEPENDING; ON?; ident); { GoTo (GoToEntry { targets; depending_on }) } diff --git a/src/lsp/cobol_ptree/branching_statements.ml b/src/lsp/cobol_ptree/branching_statements.ml index 81c7e6317..509eceba3 100644 --- a/src/lsp/cobol_ptree/branching_statements.ml +++ b/src/lsp/cobol_ptree/branching_statements.ml @@ -23,10 +23,11 @@ open Simple_statements (* GOTO *) type goto_stmt = - | GoToSimple of + | GoToSimple of { target: procedure_name with_loc } + | GoToDepending of { targets: procedure_name with_loc nel; - depending_on: ident option; + depending_on: ident; } | GoToEntry of { @@ -36,13 +37,12 @@ type goto_stmt = [@@deriving ord] let pp_goto_stmt ppf = function - | GoToSimple { targets; depending_on = None } -> - Fmt.pf ppf "@[GO TO @[%a@]@]" - (pp_nel pp_procedure_name') targets - | GoToSimple { targets; depending_on = Some i } -> + | GoToSimple { target } -> + Fmt.pf ppf "@[GO TO %a@]" pp_procedure_name' target + | GoToDepending { targets; depending_on } -> Fmt.pf ppf "@[GO TO @[%a@]@ DEPENDING ON %a@]" (pp_nel pp_procedure_name') targets - pp_ident i + pp_ident depending_on | GoToEntry { targets; depending_on = None } -> Fmt.pf ppf "@[GO TO ENTRY @[%a@]@]" (pp_nel @@ pp_with_loc pp_alphanum) diff --git a/src/lsp/cobol_ptree/statements_visitor.ml b/src/lsp/cobol_ptree/statements_visitor.ml index 86a3beb53..459aabdad 100644 --- a/src/lsp/cobol_ptree/statements_visitor.ml +++ b/src/lsp/cobol_ptree/statements_visitor.ml @@ -486,9 +486,11 @@ let fold_goback' (v: _ #folder) = let fold_goto' (v: _ #folder) = handle' v#fold_goto' v ~fold:begin fun v s x -> match s with - | GoToSimple { targets; depending_on } -> x + | GoToSimple { target } -> x + >> fold_procedure_name' v target + | GoToDepending { targets; depending_on } -> x >> fold_nel ~fold:fold_procedure_name' v targets - >> fold_option ~fold:fold_ident v depending_on + >> fold_ident v depending_on | GoToEntry { targets; depending_on } -> x >> fold_nel ~fold:fold_alphanum' v targets >> fold_option ~fold:fold_ident v depending_on @@ -1000,7 +1002,7 @@ and fold_entry' (v: _ #folder) : entry_stmt with_loc -> 'a -> 'a = handle' v#fold_entry' v ~fold:begin fun v stmt x -> match stmt with | EntrySimple name -> x - >> fold_alphanum' v name + >> fold_alphanum' v name | EntryUsing { entry_name; entry_by_clauses } -> x >> fold_alphanum' v entry_name >> fold_list ~fold:fold_entry_by_clause v entry_by_clauses