Detect COBOL variable in EXEC SQL, provides go to def, show refs and hover

CHANGELOG.md

@@ -2,6 +2,11 @@
 
 ## [_] Next release
 
+### Added
+- Improved support for `EXEC SQL` blocks, with detection of COBOL variables [#375](https://github.com/OCamlPro/superbol-studio-oss/pull/375)
+- Information on how to get support for the extension and GnuCOBOL [#401](https://github.com/OCamlPro/superbol-studio-oss/pull/401)
+- Universal VSIX, with LSP server transpiled into JavaScript [#93](https://github.com/OCamlPro/superbol-studio-oss/pull/93)
+
 ### Fixed
 - Check for x86 binaries when on `darwin-arm64` [#385](https://github.com/OCamlPro/superbol-studio-oss/pull/385)
 - Binaries included in VSIXs for Darwin [#383](https://github.com/OCamlPro/superbol-studio-oss/pull/383)

opam/cobol_typeck.opam

@@ -47,6 +47,8 @@ install: [
 depends: [
   "ocaml" {>= "4.14.0"}
   "dune" {>= "3.17.0"}
+  "superbol_preprocs" {= version}
+  "sql_ast" {= version}
   "cobol_unit" {= version}
   "cobol_ptree" {= version}
   "cobol_parser" {= version}

opam/osx/cobol_typeck-osx.opam

@@ -49,6 +49,8 @@ install: [
 depends: [
   "ocaml" {>= "4.14.0"}
   "dune" {>= "3.17.0"}
+  "superbol_preprocs-osx" {= version}
+  "sql_ast-osx" {= version}
   "cobol_unit-osx" {= version}
   "cobol_ptree-osx" {= version}
   "cobol_parser-osx" {= version}

opam/windows/cobol_typeck-windows.opam

@@ -49,6 +49,8 @@ install: [
 depends: [
   "ocaml" {>= "4.14.0"}
   "dune" {>= "3.17.0"}
+  "superbol_preprocs-windows" {= version}
+  "sql_ast-windows" {= version}
   "cobol_unit-windows" {= version}
   "cobol_ptree-windows" {= version}
   "cobol_parser-windows" {= version}

src/lsp/cobol_common/srcloc.ml

@@ -669,8 +669,10 @@ let loc: 'a with_loc -> srcloc = fun e -> e.loc
 let as_pair e = e.payload, e.loc
 let locfrom: 'a -> 'b with_loc -> 'a with_loc = fun payload b ->
   flagit payload (loc b)
-let locmap: ('a -> 'b) -> 'a with_loc -> 'b with_loc = fun f a ->
+let map_payload: ('a -> 'b) -> 'a with_loc -> 'b with_loc = fun f a ->
   flagit (f (payload a)) (loc a)
+let map_loc: (srcloc -> srcloc) -> 'a with_loc -> 'a with_loc = fun f a ->
+  flagit (payload a) (f (loc a))
 
 module INFIX : sig
   (* Meaning of letters:

src/lsp/cobol_common/srcloc.mli

@@ -116,7 +116,8 @@ val payload: 'a with_loc -> 'a
 val loc: 'a with_loc -> srcloc
 val as_pair: 'a with_loc -> 'a * srcloc
 val locfrom: 'a -> 'b with_loc -> 'a with_loc
-val locmap: ('a -> 'b) -> 'a with_loc -> 'b with_loc
+val map_payload: ('a -> 'b) -> 'a with_loc -> 'b with_loc
+val map_loc: (srcloc -> srcloc) -> 'a with_loc -> 'a with_loc
 
 val lift_option: 'a option with_loc -> 'a with_loc option
 val lift_result: ('a, 'e) result with_loc -> ('a with_loc, 'e with_loc) result

src/lsp/cobol_lsp/lsp_lookup.ml

@@ -201,6 +201,32 @@ let element_at_position ~uri pos group : element_at_position =
       Visitor.skip_children @@
       on_proc_name (qualname_at_pos ~filename qn pos) acc
 
+    method! fold_exec_block' exec_block acc =
+      Visitor.skip_children @@
+      match exec_block.payload with
+      | Superbol_preprocs.Generic.Generic_exec_block _ ->
+          acc
+      | Superbol_preprocs.Esql.Esql_exec_block esql ->
+          let cob_var_extractor_folder = object
+            (* TODO: also use a sieve *)
+            inherit [Sql_ast.cobolVarId list] Sql_ast.Visitor.folder
+            method! fold_cobol_var_id cob_var acc =
+              Visitor.skip (cob_var::acc)
+          end in
+          let cobol_vars =
+            Sql_ast.Visitor.fold_esql_instruction cob_var_extractor_folder
+              esql []
+          in
+          let string_name_opt = List.find_opt begin fun cobol_var_id ->
+              Lsp_position.is_in_srcloc ~filename pos ~@cobol_var_id
+            end cobol_vars
+          in
+          (match string_name_opt with
+           | Some name -> on_data_name (Name name) acc
+           | None -> acc)
+      | _ ->                        (* unknow/unimplemented kind of EXEC block *)
+          acc
+
   end group init |> result
 
 (* --- *)

src/lsp/cobol_preproc/preproc_env.ml

@@ -87,7 +87,7 @@ let pp: t Pretty.printer = fun ppf map ->
 let empty = MAP.empty
 
 let var = VAR.of_string
-let var' = Cobol_common.Srcloc.locmap var
+let var' = Cobol_common.Srcloc.map_payload var
 
 let mem v = MAP.mem v
 let mem' v = MAP.mem ~&v

src/lsp/cobol_typeck/package.toml

@@ -21,8 +21,8 @@ kind = "library"
 # name of a file to generate with the current version
 gen-version = "version.ml"
 
-# supported file generators are "ocamllex", "ocamlyacc" and "menhir" 
-# default is [ "ocamllex", "ocamlyacc" ] 
+# supported file generators are "ocamllex", "ocamlyacc" and "menhir"
+# default is [ "ocamllex", "ocamlyacc" ]
 # generators = [ "ocamllex", "menhir" ]
 
 # menhir options for the package
@@ -42,7 +42,7 @@ gen-version = "version.ml"
 # pack = "Mylib"
 
 # preprocessing options
-#  preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" 
+#  preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))"
 preprocess = "pps ppx_deriving.show ppx_deriving.ord"
 
 # files to skip while updating at package level
@@ -51,28 +51,30 @@ skip = ["index.mld"]
 # package library dependencies
 #   [dependencies]
 #   ez_file = ">=0.1 <1.3"
-#   base-unix = { libname = "unix", version = ">=base" } 
+#   base-unix = { libname = "unix", version = ">=base" }
 [dependencies]
 cobol_ptree = "version"
 cobol_common = "version"
 cobol_data = "version"
 cobol_parser = "version"
 cobol_unit = "version"
+superbol_preprocs = "version"
+sql_ast = "version"
 
 # package tools dependencies
 [tools]
 ppx_deriving = ">=5.2.1"
 
 # package fields (depends on package skeleton)
 #Examples:
-#  dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" 
-#  dune-libraries = "bigstring" 
-#  dune-trailer = "(install (..))" 
-#  opam-trailer = "pin-depends: [..]" 
-#  no-opam-test = "yes" 
-#  no-opam-doc = "yes" 
-#  gen-opam = "some" | "all" 
-#  dune-stanzas = "(flags (:standard (:include linking.sexp)))" 
-#  static-clibs = "unix" 
+#  dune-stanzas = "(preprocess (pps ppx_deriving_encoding))"
+#  dune-libraries = "bigstring"
+#  dune-trailer = "(install (..))"
+#  opam-trailer = "pin-depends: [..]"
+#  no-opam-test = "yes"
+#  no-opam-doc = "yes"
+#  gen-opam = "some" | "all"
+#  dune-stanzas = "(flags (:standard (:include linking.sexp)))"
+#  static-clibs = "unix"
 [fields]
 # ...

src/lsp/cobol_typeck/typeck_data_items.ml

@@ -278,7 +278,7 @@ let item_range acc ~item_qualifier
   let qualify_as_subordinate n = qual n item_qualifier &@<- n in
   let qualify n = qualify n item_stack in                         (* CHECKME! *)
   let opt = Option.map in
-  let int = Cobol_common.Srcloc.locmap int_of_string in
+  let int = Cobol_common.Srcloc.map_payload int_of_string in
   let range = match Option.map (~&) item_clauses.occurs with
     | None ->
         None

src/lsp/cobol_typeck/typeck_procedure.ml

@@ -249,6 +249,42 @@ let references ~(data_definitions: Cobol_unit.Types.data_definitions) procedure
       in
       Visitor.skip_children acc
 
+    method! fold_exec_block' exec_block acc =
+      let register_name name acc =
+        let qn = Cobol_ptree.Name name in
+        let loc = name.loc in
+        begin try
+            let bnd = Qualmap.find_binding qn data_definitions.data_items.named in
+            { acc with
+              refs = Typeck_outputs.register_data_qualref
+                  ~loc bnd.full_qn acc.refs }
+          with
+          | Not_found ->
+            acc  (* ignored for now, as we don't process all the DATA DIV. yet. *)
+          | Qualmap.Ambiguous (lazy matching_qualnames) ->
+            error acc @@ Ambiguous_data_name { given_qualname = qn &@ loc;
+                                               matching_qualnames }
+        end in
+      let acc = match exec_block.payload with
+        | Superbol_preprocs.Generic.Generic_exec_block _ ->
+            acc
+        | Superbol_preprocs.Esql.Esql_exec_block esql ->
+          let cob_var_extractor_folder = object
+            inherit [Sql_ast.cobolVarId list] Sql_ast.Visitor.folder
+            method! fold_cobol_var_id cob_var acc =
+              Cobol_common.Visitor.skip (cob_var::acc)
+          end in
+          let cobol_vars =
+            Sql_ast.Visitor.fold_esql_instruction cob_var_extractor_folder
+              esql []
+          in
+          List.fold_left begin fun acc cobol_var_id ->
+              register_name cobol_var_id acc
+          end acc cobol_vars
+        | _ -> acc
+      in
+      Visitor.skip_children acc
+
   end in
 
   Cobol_unit.Visitor.fold_procedure visitor procedure init |> references

src/lsp/sql_parser/grammar.mly

@@ -63,7 +63,9 @@ let main :=
 
 let cobol_var_id :=
 | COLON; c=loc(WORD); {c}
-| c = loc(COBOL_VAR); {c}
+| c = loc(COBOL_VAR); {
+    Cobol_common.Srcloc.(map_loc (trunc_prefix 1)) c          (* take `:` out *)
+  }
 
 let cobol_var :=
 | c = cobol_var_id; {CobVarNotNull c}