Add support for dump and listing files

CHANGELOG.md

@@ -3,6 +3,7 @@
 ## [0.1.4] Next release
 
 ### Added
+- Support for dump and listing files, along with a task attribute for outputting the latter [#347](https://github.com/OCamlPro/superbol-studio-oss/pull/347)
 - Improved information shown on completion [#336](https://github.com/OCamlPro/superbol-studio-oss/pull/336)
 - Configuration flag for caching in storage provided by Visual Studio Code [#167](https://github.com/OCamlPro/superbol-studio-oss/pull/167)
 - Configuration setting for copybook filename extensions [#332](https://github.com/OCamlPro/superbol-studio-oss/pull/332), with updated JSON schema [#333](https://github.com/OCamlPro/superbol-studio-oss/pull/333)

src/lsp/cobol_lsp/lsp_document.ml

@@ -66,6 +66,7 @@ include TYPES
 
 type t = document
 let uri { textdoc; _ } = Lsp.Text_document.documentUri textdoc
+let language_id { textdoc; _ } = Lsp.Text_document.languageId textdoc
 
 let rewindable_parse ({ project; textdoc; _ } as doc) =
   Cobol_parser.rewindable_parse_with_artifacts
@@ -80,7 +81,10 @@ let rewindable_parse ({ project; textdoc; _ } as doc) =
         copybook_lookup_config =
           Lsp_project.copybook_lookup_config_for ~uri:(uri doc) project;
         config = project.config.cobol_config;
-        source_format = project.config.source_format
+        source_format = match language_id doc with
+          | "COBOL_GNU_LISTFILE"
+          | "COBOL_GNU_DUMPFILE" -> SF SFVariable
+          | _ -> project.config.source_format
       } @@
   String { contents = Lsp.Text_document.text textdoc;
            filename = Lsp.Uri.to_path (uri doc) }

src/lsp/superbol_free_lib/vscode_extension.ml

@@ -95,9 +95,34 @@ let contributes =
   Manifest.contributes ()
     ~languages: [
       Manifest.language "cobol"
-        ~aliases: [ "COBOL" ]
-        ~filenamePatterns: [ "*." ^ cob_extensions_pattern ]
-        ~configuration: "./syntaxes/language-configuration.json"
+        ~aliases: ["COBOL"]
+        ~filenamePatterns: ["*." ^ cob_extensions_pattern]
+        ~configuration: "./syntaxes/language-configuration.json";
+      Manifest.language "COBOL_GNU_LISTFILE"
+        ~aliases: ["LISTFILE"]
+        ~extensions: [".lst"]
+        ~configuration: "./syntaxes/list-n-dump-configuration.json";
+      Manifest.language "COBOL_GNU_DUMPFILE"
+        ~aliases: ["DUMPFILE"]
+        ~extensions: [".dump"]
+        ~configuration: "./syntaxes/list-n-dump-configuration.json";
+    ]
+    ~grammars: [
+      Manifest.grammar ()
+        ~language: "cobol"
+        ~scopeName: "source.cobol"
+        ~path: "./syntaxes/COBOL.tmLanguage.json"
+        ~embeddedLanguages: [
+          "meta.embedded.block.sql", "sql";
+        ];
+      Manifest.grammar ()
+        ~language: "COBOL_GNU_LISTFILE"
+        ~scopeName: "source.gnucobol_listfile"
+        ~path: "./syntaxes/listfile.tmLanguage.json";
+      Manifest.grammar ()
+        ~language: "COBOL_GNU_DUMPFILE"
+        ~scopeName: "source.gnucobol_dumpfile"
+        ~path: "./syntaxes/dumpfile.tmLanguage.json"
     ]
     ~debuggers: [
       Manifest.debugger "gdb"
@@ -425,10 +450,16 @@ let contributes =
 
           Manifest.PROPERTY.null_string "cobc-path"
             ~title:"GnuCOBOL Compiler Executable"
-            ~description:"Path to the GnuCOBOL compiler executable; when `null`, \
-                          defaults to the value of \"superbol.cobc-path\" from \
-                          the workspace configuration, if defined, to \"cobc\" \
-                          otherwise.";
+            ~markdownDescription:
+              "Path to the GnuCOBOL compiler executable; when `null`, defaults \
+               to the value of \"superbol.cobc-path\" from the workspace \
+               configuration, if defined, to \"cobc\" otherwise.";
+
+          Manifest.PROPERTY.null_string "listings-target"
+            ~title:"Output file or directory for preprocessed program listings"
+            ~markdownDescription:
+              "Path to a directory where preprocessed program listings are \
+               generated; no listing is saved when `null`";
 
           Manifest.PROPERTY.array "extra-args"
             ~description:"Additional arguments passed to `cobc`";
@@ -470,15 +501,6 @@ let contributes =
         ];
       ]
     ]
-    ~grammars: [
-      Manifest.grammar ()
-        ~language: "cobol"
-        ~scopeName: "source.cobol"
-        ~path:"./syntaxes/COBOL.tmLanguage.json"
-        ~embeddedLanguages:[
-          "meta.embedded.block.sql", "sql";
-        ];
-    ]
     ~problemPatterns: [
       Manifest.problemPattern
         (Some "^(.*): ?(\\d+): (error|warning): ([^[]*)(\\[(.*)\\])?$")

src/vscode/superbol-vscode-platform/superbol_languageclient.ml

@@ -94,6 +94,10 @@ let client_options () =
     ~documentSelector:[|
       `Filter (LSP.DocumentFilter.createLanguage ()
                  ~language:"cobol");
+      `Filter (LSP.DocumentFilter.createLanguage ()
+                 ~language:"COBOL_GNU_LISTFILE");
+      `Filter (LSP.DocumentFilter.createLanguage ()
+                 ~language:"COBOL_GNU_DUMPFILE");
     |]
 
 

src/vscode/superbol-vscode-platform/superbol_tasks.ml

@@ -32,6 +32,8 @@ let attributes_spec ~debug ~coverage ~executable =
                      [%js.of: bool], executable);
     "cobc-path", C ([%js.to: string or_undefined],
                     [%js.of: string], "cobc");
+    "listings-target", C ([%js.to: string option or_undefined],
+                          [%js.of: string option], None);
     "extra-args", C ([%js.to: string list or_undefined],
                      [%js.of: string list], []);
   ]
@@ -47,13 +49,8 @@ let attr_bool_flag key ~ok ?(ko = Fun.id) ~attributes args =
   | None when Superbol_workspace.bool key -> ok args
   | _ -> ko args
 
-let string_arg ?(allow_empty = false) ~mk s args =
-  if s = "" && not allow_empty then args else mk s :: args
-
-(* let attr_string ?allow_empty key ~mk ~attributes args = *)
-(*   match List.assoc_opt key attributes with *)
-(*   | Some s -> string_arg ([%js.to: string] s) ?allow_empty ~mk args *)
-(*   | None -> args *)
+let string_arg ?(allow_empty = false) ~append s args =
+  if s = "" && not allow_empty then args else append s args
 
 let config_string key ~config =
   string_arg @@
@@ -66,11 +63,18 @@ let config_strings key ~config ~append =
   with Not_found -> Superbol_workspace.strings key
      | Jsonoo.Decode_error _ -> []  (* Warning: silenced decode errors for now *)
 
-let attr_strings key ~append ~attributes args =
+let attr_strings key ?(append = List.append) ~attributes args =
   match List.assoc_opt key attributes with
   | Some l -> append ([%js.to: string list] l) args
   | None -> args
 
+let attr_string_opt key ~append ~attributes args =
+  match List.assoc_opt key attributes with
+  | None -> args
+  | Some s -> match [%js.to: string option] s with
+    | None -> args
+    | Some s -> string_arg s ~allow_empty:false ~append args
+
 (* let config_strings key ~config:_ ~append args = *)
 (*   append (Superbol_workspace.string_list key) args *)
 
@@ -119,22 +123,26 @@ let cobc_execution ?config attributes =
         List.append args
       end |>
     config_strings "cobol.copyexts" ~config
-      ~append:begin fun exts args ->
-        List.append args @@ List.flatten @@ List.map (fun e -> ["-ext"; e]) exts
+      ~append:begin fun exts ->
+        List.append @@ List.flatten @@ List.map (fun e -> ["-ext"; e]) exts
       end |>
     config_string "cobol.dialect" ~config
-      ~mk:(function "gnucobol" -> "-std=default" | s -> "-std=" ^ s) |>
+      ~append:begin function
+        | "gnucobol" -> List.cons "-std=default"
+        | s -> List.cons ("-std=" ^ s)
+      end|>
     config_string "cobol.source-format" ~config
-      ~mk:((^) "-fformat=") |>
+      ~append:(fun f -> List.cons ("-fformat=" ^ f)) |>
     attr_bool_flag "for-debug" ~attributes
-      ~ok:(fun args -> "-fsource-location" :: "-ftraceall" :: "-g" :: args) |>
+      ~ok:(List.append ["-fsource-location"; "-ftraceall"; "-g"]) |>
     attr_bool_flag "for-coverage" ~attributes
       ~ok:(List.cons "--coverage") |>
     attr_bool_flag "executable" ~attributes
       ~ok:(List.cons "-x")
       ~ko:(List.cons "-m") |>
+    attr_string_opt "listings-target" ~attributes
+      ~append:(fun t -> List.append ["-P"; t]) |>
     attr_strings "extra-args" ~attributes
-      ~append:(fun args' args -> args @ args')
   in
   `ShellExecution (ShellExecution.makeCommandArgs ()
                      ~command:(`String cobc)

syntaxes/dumpfile.tmLanguage.json

@@ -0,0 +1,34 @@
+{
+  "_copyright": "The MIT License (MIT)\nCopyright (c) 2015-2021 spgennard\nSource: https://github.com/spgennard/vscode_cobol/blob/master/syntaxes/COBOL_gnu_dumpfile.tmLanguage.json",
+  "fileTypes": [],
+  "name": "COBOL_GNU_DUMPFILE",
+  "patterns": [
+    {
+      "match": "(\\f)",
+      "name": "strong comment.line.form_feed.gnucobol_dumpfile"
+    },
+    {
+      "match": "(^\\*.*$)",
+      "name": "comment.line.modern"
+    },
+    {
+      "begin": "((?i:^WORKING-STORAGE|^LINKAGE|^FD))",
+      "name": "constant.numeric.gnucobol_dumpfile",
+      "patterns": [
+        {
+          "match": "(^\\*.*$)",
+          "name": "comment.line.modern"
+        },
+        {
+          "include": "source.cobol"
+        }
+      ],
+      "end": "(?=(?i:LINKAGE|END\\s+OF\\s+DUMP))"
+    },
+    {
+      "match": "(.*$)",
+      "name": ""
+    }
+  ],
+  "scopeName": "source.gnucobol_dumpfile"
+}

syntaxes/list-n-dump-configuration.json

@@ -0,0 +1,26 @@
+{
+    "comments": {
+	"lineComment": "*>"
+    },
+    "brackets": [
+	[ "[", "]" ],
+	[ "(", ")" ],
+	[ "\"", "\"" ],
+	[ "'", "'" ]
+    ],
+    "autoClosingPairs": [
+	{ "open": "[", "close": "]" },
+	{ "open": "(", "close": ")" },
+	{ "open": "'", "close": "'", "notIn": [ "string", "comment" ] },
+	{ "open": "\"", "close": "\"", "notIn": [ "string", "comment" ] }
+    ],
+    "surroundingPairs": [
+	[ "{", "}" ],
+	[ "[", "]" ],
+	[ "(", ")" ],
+	[ "\"", "\"" ],
+	[ "'", "'" ]
+    ],
+    "folding": { },
+    "wordPattern": "[a-zA-Z0-9_-]+"
+}