Merge pull request #63 from nberth/auto-sourceformat

Implement autodetection of source format as in GnuCOBOL

.drom

@@ -5,7 +5,7 @@ version:0.9.0
 
 # hash of toml configuration files
 # used for generation of all files
-f593ca640b0428b52f00f9a54b784372:.
+33600fe888d71659a58729dcf2aa5517:.
 # end context for .
 
 # begin context for .github/workflows/workflow.yml
@@ -80,7 +80,7 @@ c8281f46ba9a11d0b61bc8ef67eaa357:docs/style.css
 
 # begin context for dune-project
 # file dune-project
-e4dedba41fc92468ec674cbee826a8ae:dune-project
+b8e5b29ae669482824c6b8cd2ff4fc9c:dune-project
 # end context for dune-project
 
 # begin context for opam/cobol_ast.opam
@@ -120,7 +120,7 @@ b59079469702b9b3c76559bff3e8d8d6:opam/cobol_lsp.opam
 
 # begin context for opam/cobol_preproc.opam
 # file opam/cobol_preproc.opam
-177397ceec1c37ebf412047ec223bd10:opam/cobol_preproc.opam
+9a463e0c260b2ffe2681c21d06e25df2:opam/cobol_preproc.opam
 # end context for opam/cobol_preproc.opam
 
 # begin context for opam/cobol_ptree.opam
@@ -340,7 +340,7 @@ c830729656f586961a44188b55cb4ac6:src/lsp/cobol_data/dune
 
 # begin context for src/lsp/cobol_preproc/dune
 # file src/lsp/cobol_preproc/dune
-72290e9f09cebbc9fdea47a9045c0330:src/lsp/cobol_preproc/dune
+6959ec99a7299e1be2b6bd025568bb21:src/lsp/cobol_preproc/dune
 # end context for src/lsp/cobol_preproc/dune
 
 # begin context for src/lsp/cobol_preproc/version.mlt

dune-project

@@ -376,6 +376,7 @@
  (description "This is the description\nof the superbol-studio-oss OCaml project\n")
  (depends
    (ocaml (>= 4.14.0))
+   (ppx_import ( >= 1 ))
    (ppx_deriving ( >= 5.2.1 ))
    (menhir ( >= 1.2 ))
    (cobol_config (= version))

opam/cobol_preproc.opam

@@ -48,6 +48,7 @@ install: [
 depends: [
   "ocaml" {>= "4.14.0"}
   "dune" {>= "2.8.0"}
+  "ppx_import" {>= "1"}
   "ppx_deriving" {>= "5.2.1"}
   "menhir" {>= "1.2"}
   "cobol_config" {= version}

src/lsp/cobol_indent/indenter.ml

@@ -75,7 +75,8 @@ let indent_range' ~dialect ~source_format ~range ~file =
     Cobol_preproc.fold_source_lines ~dialect ~source_format
       ~skip_compiler_directives_text:false
       ~f:(fun _lnum line acc -> Indent_check.check_indentation line acc)
-      (Filename file) { scope = BEGIN; context  = []; acc = []; range }
+      (String { contents = file_content; filename = file; })
+      { scope = BEGIN; context  = []; acc = []; range }
   in
   (* NB: note here we ignore diagnostics *)
   let ind_recds = state.result.acc in

src/lsp/cobol_preproc/cobol_preproc.ml

@@ -30,5 +30,8 @@ module Directives = Preproc_directives
 
 (** {1 Main entry points for the processor itself} *)
 
+type input = [%import: Src_input.t]
+
+module Input = Src_input
 module Options = Preproc_options
 include Preproc_engine

src/lsp/cobol_preproc/dune

@@ -5,11 +5,11 @@
   (public_name cobol_preproc)
   (wrapped true)
   ; use field 'dune-libraries' to add libraries without opam deps
-  (libraries ppx_deriving menhirLib cobol_config cobol_common str)
+  (libraries ppx_import ppx_deriving menhirLib cobol_config cobol_common str)
   ; use field 'dune-flags' to set this value
   (flags (:standard))
   ; use field 'dune-stanzas' to add more stanzas here
-  (preprocess (pps ppx_deriving.show))
+  (preprocess (staged_pps ppx_import ppx_deriving.show))
 
   )
 

src/lsp/cobol_preproc/package.toml

@@ -43,7 +43,7 @@ generators = ["ocamllex"]
 
 # preprocessing options
 #  preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" 
-preprocess = "pps ppx_deriving.show"
+preprocess = "staged_pps ppx_import ppx_deriving.show"
 
 # files to skip while updating at package level
 skip = ["main.ml", "index.mld"]
@@ -56,6 +56,7 @@ skip = ["main.ml", "index.mld"]
 cobol_common = "version"
 cobol_config = "version"
 ppx_deriving = ">=5.2.1"
+ppx_import = "1"
 [dependencies.menhir]
 libname = "menhirLib"
 version = ">=1.2"

src/lsp/cobol_preproc/preproc_diagnostics.ml

@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                        SuperBOL OSS Studio                             *)
+(*                                                                        *)
+(*  Copyright (c) 2022-2023 OCamlPro SAS                                  *)
+(*                                                                        *)
+(* All rights reserved.                                                   *)
+(* This source code is licensed under the GNU Affero General Public       *)
+(* License version 3 found in the LICENSE.md file in the root directory   *)
+(* of this source tree.                                                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Cobol_common.Srcloc.TYPES
+
+module DIAGS =  Cobol_common.Diagnostics
+
+type error =
+  | Malformed_or_unknown_compiler_directive of srcloc
+  | Unknown_source_format of string * srcloc
+  | Forbidden_change_of_source_format of srcloc
+
+let error = function
+  | Malformed_or_unknown_compiler_directive loc ->
+      DIAGS.One.error ~loc "Malformed@ or@ unknown@ compiler@ directive"
+  | Unknown_source_format (f, loc) ->
+      DIAGS.One.error ~loc "Unknown@ source@ format@ `%s'" f
+  | Forbidden_change_of_source_format loc ->
+      DIAGS.One.error ~loc "Forbidden@ change@ of@ source@ format"

src/lsp/cobol_preproc/preproc_engine.ml

@@ -20,23 +20,6 @@ module DIAGS = Cobol_common.Diagnostics
 
 (* --- *)
 
-type input =
-  | Filename of string
-  | String of { contents: string; filename: string }
-  | Channel of { contents: in_channel; filename: string }
-
-let decide_source_format _input
-  : Cobol_config.source_format_spec ->
-    Src_format.any with_diags = function
-  | SF result ->
-      { result = Src_format.from_config result; diags = DIAGS.Set.none }
-  | Auto ->
-      { result = Src_format.from_config SFFixed;
-        diags = DIAGS.(Acc.warn Set.none) "Source format `auto` is not supported \
-                                           yet, using `fixed`" }
-
-(* --- *)
-
 type preprocessor =
   {
     buff: Text.t;
@@ -46,14 +29,16 @@ type preprocessor =
     diags: DIAGS.diagnostics;
     persist: preprocessor_persist;
   }
+
+(** the preprocessor state that does not change very often *)
 and preprocessor_persist =
-  (** the preprocessor state that does not change very often *)
   {
     pparser: (module Text_processor.PPPARSER);
     overlay_manager: (module Src_overlay.MANAGER);
     replacing: Preproc_directives.replacing with_loc list list;
     copybooks: Cobol_common.Srcloc.copylocs;              (* opened copybooks *)
     dialect: Cobol_config.dialect;
+    source_format: Src_format.any option;  (* to keep auto-detecting on reset *)
     libpath: string list;
     verbose: bool;
     show_if_verbose: [`Txt | `Src] list;
@@ -86,35 +71,31 @@ let with_replacing lp replacing =
 let show tag { persist = { verbose; show_if_verbose; _ }; _ } =
   verbose && List.mem tag show_if_verbose
 
-let make_reader ~source_format = function
-  | Filename filename ->
-      Src_reader.from_file ~source_format filename
-  | String { contents; filename } ->
-      Src_reader.from_string ~filename ~source_format contents
-  | Channel { contents; filename } ->
-      Src_reader.from_channel ~filename ~source_format contents
+let source_format_config = function
+  | Cobol_config.SF sf -> Some (Src_format.from_config sf)
+  | Auto -> None
 
 let preprocessor input = function
   | `WithOptions { libpath; verbose; source_format;
                    config = (module Config) } ->
       let module Om_name = struct let name = __MODULE__ end in
       let module Om = Src_overlay.New_manager (Om_name) in
       let module Pp = Preproc_grammar.Make (Config) (Om) in
-      let { result = source_format; diags }
-        = decide_source_format input source_format in
+      let source_format = source_format_config source_format in
       {
         buff = [];
-        reader = make_reader ~source_format input;
+        reader = Src_reader.from input ?source_format;
         ppstate = Preproc_state.initial;
         pplog = Preproc_trace.empty;
-        diags;
+        diags = DIAGS.Set.none;
         persist =
           {
             pparser = (module Pp);
             overlay_manager = (module Om);
             replacing = [];
             copybooks = Cobol_common.Srcloc.no_copy;
             dialect = Config.dialect;
+            source_format;
             libpath;
             verbose;
             show_if_verbose = [`Src];
@@ -125,7 +106,7 @@ let preprocessor input = function
       {
         from with
         buff = [];
-        reader = make_reader ~source_format input;
+        reader = Src_reader.from input ~source_format;
         persist =
           {
             persist with
@@ -171,7 +152,7 @@ let rec next_chunk ({ reader; buff; persist = { dialect; _ }; _ } as lp) =
           let lp = { lp with reader; buff = [] } in
           preprocess_line (apply_compiler_directive lp compdir) (buff @ text)
       | Error (text, e, _) ->
-          let diag = Src_reader.error_diagnostic e in
+          let diag = Preproc_diagnostics.error e in
           let lp = add_diag { lp with reader; buff = [] } diag in
           preprocess_line lp (buff @ text)
 
@@ -180,7 +161,9 @@ and apply_compiler_directive
   let lp = with_pplog lp @@ Preproc_trace.new_compdir ~loc ~compdir pplog in
   match (compdir : Preproc_directives.compiler_directive) with
   | CDirSource sf ->
-      with_reader lp (Src_reader.with_source_format sf reader)
+      (match Src_reader.with_source_format sf reader with
+       | Ok reader -> with_reader lp reader
+       | Error e -> add_diag lp (Preproc_diagnostics.error e))
   | CDirSet _ ->
       DIAGS.Cont.kwarn (add_diag lp) ~loc "Ignored@ compiler@ directive"
 
@@ -308,9 +291,11 @@ and read_lib ({ persist = { libpath; copybooks; verbose; _ }; _ } as lp)
         if verbose then
           Pretty.error "Reading library `%s'@." filename;
         let text, lp =             (* note: [lp] holds all prev and new diags *)
-          full_text                (* likewise for pplog *)
-            (preprocessor (Filename filename) (`Fork (lp, loc, filename)))
-            ~postproc:(Cobol_common.Srcloc.copy_from ~filename ~copyloc:loc)
+          Src_input.from ~filename ~f:begin fun input ->
+            full_text                                   (* likewise for pplog *)
+              (preprocessor input (`Fork (lp, loc, filename)))
+              ~postproc:(Cobol_common.Srcloc.copy_from ~filename ~copyloc:loc)
+          end
         in
         text, lp.diags, Preproc_trace.copy_done ~loc ~filename lp.pplog
     | Error lnf ->
@@ -386,9 +371,9 @@ let reset_preprocessor_for_string string ?new_position pp =
   let contents = match new_position with
     | Some Lexing.{ pos_cnum; _ } -> EzString.after string (pos_cnum - 1)
     | None -> string
-  in
+  and source_format = pp.persist.source_format in
   reset_preprocessor ?new_position pp contents
-    ~restart:Src_reader.restart_on_string
+    ~restart:(Src_reader.restart_on_string ?source_format)
 
 (* --- *)
 
@@ -399,44 +384,43 @@ let preprocessor ?(options = Preproc_options.default) input =
     {!preprocess_file}. *)
 let default_oppf = Fmt.stdout
 
-let lex_file ~dialect ~source_format ?(ppf = default_oppf) input =
-  let { result = source_format; diags } =
-    decide_source_format input source_format in
-  DIAGS.result ~diags @@
+let lex_input ~dialect ~source_format ?(ppf = default_oppf) input =
+  DIAGS.result @@
   Src_reader.print_lines ~dialect ~skip_compiler_directives_text:true ppf @@
-  make_reader ~source_format input
+  Src_reader.from input ?source_format:(source_format_config source_format)
+
+let lex_file ~dialect ~source_format ?ppf filename =
+  Src_input.from ~filename ~f:(lex_input ~dialect ~source_format ?ppf)
 
 let lex_lib ~dialect ~source_format ~libpath ?(ppf = default_oppf) libname =
   match Cobol_common.Copybook.find_lib ~libpath libname with
   | Ok filename ->
-      let { result = source_format; diags } =
-        decide_source_format (Filename filename) source_format in
-      DIAGS.result ~diags @@
-      Src_reader.print_lines ~dialect ~skip_compiler_directives_text:true ppf @@
-      Src_reader.from_file ~source_format filename
+      Src_input.from ~filename ~f:begin fun input ->
+        DIAGS.result @@
+        Src_reader.print_lines ~dialect ~skip_compiler_directives_text:true ppf @@
+        Src_reader.from input ?source_format:(source_format_config source_format)
+      end
   | Error lnf ->
       DIAGS.error_result () "%a" Cobol_common.Copybook.pp_lookup_error lnf
 
 let fold_source_lines ~dialect ~source_format
     ?skip_compiler_directives_text ?on_compiler_directive
     ~f input acc =
-  let { result = source_format; diags } =
-    decide_source_format input source_format in
-  DIAGS.result ~diags @@
-  Src_reader.fold_lines ~dialect ~f (make_reader ~source_format input) acc
-    ?skip_compiler_directives_text ?on_compiler_directive
+  DIAGS.result @@
+  Src_reader.fold_lines ~dialect ~f
+    (Src_reader.from input ?source_format:(source_format_config source_format))
+    ?skip_compiler_directives_text ?on_compiler_directive acc
 
 let text_of_input ?options input =
   let text, pp = full_text ~item:"file" @@ preprocessor ?options input in
   DIAGS.result text ~diags:(diags pp)
 
 let text_of_file ?options filename =
-  text_of_input ?options (Filename filename)
+  Src_input.from ~filename ~f:(text_of_input ?options)
 
 let preprocess_input ?options ?(ppf = default_oppf) input =
   text_of_input ?options input |>
   DIAGS.map_result ~f:(Pretty.print ppf "%a@." Text.pp_text)
 
-let preprocess_file ?options ?(ppf = default_oppf) filename =
-  text_of_file ?options filename |>
-  DIAGS.map_result ~f:(Pretty.print ppf "%a@." Text.pp_text)
+let preprocess_file ?options ?ppf filename =
+  Src_input.from ~filename ~f:(preprocess_input ?options ?ppf)

src/lsp/cobol_preproc/preproc_engine.mli

@@ -15,14 +15,9 @@ open Cobol_common.Srcloc.TYPES
 
 type preprocessor
 
-type input =
-  | Filename of string
-  | String of { contents: string; filename: string }
-  | Channel of { contents: in_channel; filename: string }
-
 val preprocessor
   : ?options: Preproc_options.preproc_options
-  -> input
+  -> Src_input.t
   -> preprocessor
 val reset_preprocessor_for_string
   : string
@@ -45,16 +40,18 @@ val next_chunk: preprocessor -> Text.text * preprocessor
 
 (** {2 High-level commands} *)
 
-val decide_source_format
-  : string
-  -> Cobol_config.source_format_spec
-  -> Src_format.any Cobol_common.Diagnostics.with_diags
+val lex_input
+  : dialect: Cobol_config.dialect
+  -> source_format: Cobol_config.source_format_spec
+  -> ?ppf:Format.formatter
+  -> Src_input.t
+  -> unit Cobol_common.Diagnostics.with_diags
 
 val lex_file
   : dialect: Cobol_config.dialect
   -> source_format: Cobol_config.source_format_spec
   -> ?ppf:Format.formatter
-  -> input
+  -> string
   -> unit Cobol_common.Diagnostics.with_diags
 
 val lex_lib
@@ -88,14 +85,14 @@ val fold_source_lines
   -> ?on_compiler_directive
      : (int -> Preproc_directives.compiler_directive with_loc -> 'a -> 'a)
   -> f:(int -> Text.text -> 'a -> 'a)
-  -> input
+  -> Src_input.t
   -> 'a
   -> 'a Cobol_common.Diagnostics.with_diags
 
 val preprocess_input
   : ?options: Preproc_options.preproc_options
   -> ?ppf:Format.formatter
-  -> input
+  -> Src_input.t
   -> unit Cobol_common.Diagnostics.with_diags
 
 val preprocess_file
@@ -111,5 +108,5 @@ val text_of_file
 
 val text_of_input
   : ?options: Preproc_options.preproc_options
-  -> input
+  -> Src_input.t
   -> Text.t Cobol_common.Diagnostics.with_diags