Merge pull request #353 from NeoKaios/fix/grammar-goto

Improve `GO` statement grammar

CHANGELOG.md

@@ -15,7 +15,7 @@
 - COBOL language configuration for highlighting matching brackets and auto-insertion of line numbers in fixed-format code [#330](https://github.com/OCamlPro/superbol-studio-oss/pull/330)
 
 ### Fixed
-- Improvements to the grammar [#331](https://github.com/OCamlPro/superbol-studio-oss/pull/331)
+- Improvements to the grammar [#331](https://github.com/OCamlPro/superbol-studio-oss/pull/331), [#353](https://github.com/OCamlPro/superbol-studio-oss/pull/353)
 - Word wrapping in presence of hyphens [#330](https://github.com/OCamlPro/superbol-studio-oss/pull/330)
 
 

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

src/lsp/cobol_parser/grammar.mly

@@ -3453,9 +3453,14 @@ 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 = ro(pair(rl(procedure_name), DEPENDING; ON?; ident));
+    { match depending_on_clause with
+      | None ->
+          GoTo (GoToSimple { 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 }) }

src/lsp/cobol_ptree/branching_statements.ml

@@ -24,9 +24,13 @@ open Simple_statements
 (* GOTO *)
 type goto_stmt =
   | 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 +40,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)

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