Merge pull request #382 from nberth/colorize-substitution-section

Colorize the `SUBSTITUTION SECTION` of the `CONTROL DIVISION` (GCOS)
OCamlPro · Dec 18, 2024 · e8edfbc · e8edfbc
2 parents f1dc62e + ac1bb60
commit e8edfbc
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 4 deletions.
diff --git a/src/lsp/cobol_preproc/preproc_directives.ml b/src/lsp/cobol_preproc/preproc_directives.ml
@@ -16,6 +16,7 @@ open Text.TYPES
 
 type compiler_directive =
   | CDir_source of Src_format.any with_loc
+  | CDir_control_section                       (* SECTION in CONTROL DIVISION *)
   | CDir_preproc of Compdir_tree.preproc_directive
 
 type copy_statement =

diff --git a/src/lsp/cobol_preproc/preproc_engine.ml b/src/lsp/cobol_preproc/preproc_engine.ml
@@ -224,6 +224,8 @@ and apply_compiler_directive ({ reader; pplog; _ } as lp)
       (match Src_reader.with_source_format sf reader with
        | Ok reader -> with_reader lp reader
        | Error e -> add_error lp e)
+  | CDir_control_section ->                              (* nothing to do here *)
+      lp
   | CDir_preproc preproc_directive ->
       apply_preproc_directive lp (preproc_directive &@ loc)
 
@@ -324,15 +326,18 @@ and process_preproc_phrase ({ persist = { pparser = (module Pp);
         ~error:(fun e -> `ReplaceDone (add_error lp e,
                                        List.rev rev_prefix, suffix))
   | Header (header, { prefix = rev_prefix; phrase; suffix }) ->
-      let prefix = match header with
+      let prefix, lp = match header with
         | ControlDivision
         | IdentificationDivision ->
             (* keep phrases that are further syntax-checked by the parser, and
                used to perform dialect-related checks there. *)
-            List.rev_append rev_prefix phrase
+            List.rev_append rev_prefix phrase, lp
         | SubstitutionSection ->
-            (* discard this phrase, which is not checked by the parser *)
-            List.rev rev_prefix
+            (* discard this phrase, which is not checked by the parser; keep it
+               in pplog anyways, so as to keep its location for later use. *)
+            let loc = Option.get @@ Cobol_common.Srcloc.concat_locs phrase in
+            let section = Preproc_directives.CDir_control_section &@ loc in
+            List.rev rev_prefix, apply_compiler_directive lp section
       in
       `ReplaceDone (lp, prefix, suffix)
   | ExecBlock { prefix = rev_prefix; phrase; suffix } ->

diff --git a/src/lsp/cobol_preproc/src_reader.ml b/src/lsp/cobol_preproc/src_reader.ml
@@ -161,6 +161,7 @@ let fold_chunks
         (match with_source_format sf pl with
          | Ok pl -> pl
          | Error _error -> pl)                                       (* ignore *)
+    | CDir_control_section
     | CDir_preproc _ -> pl                                           (* ignore *)
   in
   aux pl acc