diff --git a/.drom b/.drom index 8fa52b6ad..f0f0e1cb2 100644 --- a/.drom +++ b/.drom @@ -5,12 +5,12 @@ version:0.9.0 # hash of toml configuration files # used for generation of all files -cc894e743bb85460e00abcdaf8d9fae5:. +93d2e460909a3ddf6a2ed971ff2e8639:. # end context for . # begin context for .github/workflows/workflow.yml # file .github/workflows/workflow.yml -5429d9f0846180852fae7d2e49e767e8:.github/workflows/workflow.yml +a123dfeb615e907fa895b378cd52ee3c:.github/workflows/workflow.yml # end context for .github/workflows/workflow.yml # begin context for .gitignore @@ -30,7 +30,7 @@ d00f73c835ae4a1589d55ebda4ab381b:CHANGES.md # begin context for Makefile # file Makefile -f77bb2a3fc45e32226c8cad8171cd91c:Makefile +7fd4812f5873242aaa1d65a344f7e4c3:Makefile # end context for Makefile # begin context for README.md @@ -80,7 +80,7 @@ c8281f46ba9a11d0b61bc8ef67eaa357:docs/style.css # begin context for dune-project # file dune-project -972a09725c93d6b9991e532be3dc6c8a:dune-project +22badd64255c88417b1d5ed3a0d03754:dune-project # end context for dune-project # begin context for opam/cobol_common.opam @@ -138,6 +138,11 @@ b8d28175ca0061bb86a8c097940bfe34:opam/cobol_indent.opam fc02e4984b73153fecd9d70c4ccab428:opam/cobol_typeck.opam # end context for opam/cobol_typeck.opam +# begin context for opam/cobol_typeck_old.opam +# file opam/cobol_typeck_old.opam +a69b0b9f93c6bac105da84b6072b3355:opam/cobol_typeck_old.opam +# end context for opam/cobol_typeck_old.opam + # begin context for opam/cobol_unit.opam # file opam/cobol_unit.opam 76d88c1b0a68e0af28464a34049d254c:opam/cobol_unit.opam @@ -378,6 +383,16 @@ ef30db283bff57bd7bfea9b29e9178fd:src/lsp/cobol_typeck/dune 940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_typeck/version.mlt # end context for src/lsp/cobol_typeck/version.mlt +# begin context for src/lsp/cobol_typeck_old/dune +# file src/lsp/cobol_typeck_old/dune +f806267d9749a4f405ed7b6e4e0ebffe:src/lsp/cobol_typeck_old/dune +# end context for src/lsp/cobol_typeck_old/dune + +# begin context for src/lsp/cobol_typeck_old/version.mlt +# file src/lsp/cobol_typeck_old/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_typeck_old/version.mlt +# end context for src/lsp/cobol_typeck_old/version.mlt + # begin context for src/lsp/cobol_unit/dune # file src/lsp/cobol_unit/dune 461e7b0db5a7aaf9cf342be193d92cd5:src/lsp/cobol_unit/dune diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index ce26db25d..d8eb7e514 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -61,7 +61,7 @@ jobs: - run: opam pin add . -y --no-action - - run: opam depext -y superbol-studio-oss superbol-vscode-platform polka-js-stubs interop-js-stubs node-js-stubs vscode-js-stubs vscode-languageclient-js-stubs vscode-json vscode-debugadapter vscode-debugprotocol superbol-free superbol_free_lib superbol_project cobol_common cobol_parser cobol_ptree ebcdic_lib cobol_lsp ppx_cobcflags pretty cobol_config cobol_indent cobol_preproc cobol_data cobol_data_old cobol_typeck cobol_unit ez_toml ezr_toml + - run: opam depext -y superbol-studio-oss superbol-vscode-platform polka-js-stubs interop-js-stubs node-js-stubs vscode-js-stubs vscode-languageclient-js-stubs vscode-json vscode-debugadapter vscode-debugprotocol superbol-free superbol_free_lib superbol_project cobol_common cobol_parser cobol_ptree ebcdic_lib cobol_lsp ppx_cobcflags pretty cobol_config cobol_indent cobol_preproc cobol_data cobol_data_old cobol_typeck cobol_typeck_old cobol_unit ez_toml ezr_toml # if: steps.cache-opam.outputs.cache-hit != 'true' - run: opam install -y opam/*.opam --deps-only --with-test diff --git a/Makefile b/Makefile index 37632e74f..b0ae3097e 100644 --- a/Makefile +++ b/Makefile @@ -28,7 +28,7 @@ all: build build: ./scripts/before.sh build ${DUNE} build ${DUNE_ARGS} ${DUNE_CROSS_ARGS} @install - ./scripts/copy-bin.sh superbol-studio-oss superbol-vscode-platform polka-js-stubs interop-js-stubs node-js-stubs vscode-js-stubs vscode-languageclient-js-stubs vscode-json vscode-debugadapter vscode-debugprotocol superbol-free superbol_free_lib superbol_project cobol_common cobol_parser cobol_ptree ebcdic_lib cobol_lsp ppx_cobcflags pretty cobol_config cobol_indent cobol_preproc cobol_data cobol_data_old cobol_typeck cobol_unit ez_toml ezr_toml + ./scripts/copy-bin.sh superbol-studio-oss superbol-vscode-platform polka-js-stubs interop-js-stubs node-js-stubs vscode-js-stubs vscode-languageclient-js-stubs vscode-json vscode-debugadapter vscode-debugprotocol superbol-free superbol_free_lib superbol_project cobol_common cobol_parser cobol_ptree ebcdic_lib cobol_lsp ppx_cobcflags pretty cobol_config cobol_indent cobol_preproc cobol_data cobol_data_old cobol_typeck cobol_typeck_old cobol_unit ez_toml ezr_toml ./scripts/after.sh build build-deps: diff --git a/drom.toml b/drom.toml index c22d15fda..8d3dbaa05 100644 --- a/drom.toml +++ b/drom.toml @@ -208,6 +208,10 @@ dir = "src/lsp/cobol_data_old" dir = "src/lsp/cobol_typeck" # edit 'src/lsp/cobol_lsp/package.toml' for package-specific options +[[package]] +dir = "src/lsp/cobol_typeck_old" +# edit 'src/lsp/cobol_lsp/package.toml' for package-specific options + [[package]] dir = "src/lsp/cobol_unit" # edit 'src/lsp/cobol_unit/package.toml' for package-specific options diff --git a/dune-project b/dune-project index 942572800..2a77d9e0f 100644 --- a/dune-project +++ b/dune-project @@ -399,6 +399,23 @@ ) ) +(package + (name cobol_typeck_old) + (synopsis "SuperBOL Studio OSS Project") + (description "SuperBOL Studio OSS is a new platform for COBOL") + (depends + (ocaml (>= 4.14.0)) + (cobol_unit (= version)) + (cobol_typeck (= version)) + (cobol_ptree (= version)) + (cobol_parser (= version)) + (cobol_data (= version)) + (cobol_common (= version)) + (ppx_deriving ( >= 5.2.1 )) + odoc + ) + ) + (package (name cobol_unit) (synopsis "SuperBOL Studio OSS Project") diff --git a/opam/cobol_typeck_old.opam b/opam/cobol_typeck_old.opam new file mode 100644 index 000000000..76a5505d4 --- /dev/null +++ b/opam/cobol_typeck_old.opam @@ -0,0 +1,57 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "cobol_typeck_old" +version: "0.1.0" +license: "MIT" +synopsis: "SuperBOL Studio OSS Project" +description: "SuperBOL Studio OSS is a new platform for COBOL" +authors: [ + "Nicolas Berthier " + "David Declerck " + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Nicolas Berthier " + "David Declerck " + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-studio-oss" +doc: "https://ocamlpro.github.io/superbol-studio-oss/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-studio-oss/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-studio-oss.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.14.0"} + "dune" {>= "2.8.0"} + "cobol_unit" {= version} + "cobol_typeck" {= version} + "cobol_ptree" {= version} + "cobol_parser" {= version} + "cobol_data" {= version} + "cobol_common" {= version} + "ppx_deriving" {>= "5.2.1"} + "odoc" {with-doc} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/src/lsp/cobol_lsp/lsp_document.ml b/src/lsp/cobol_lsp/lsp_document.ml index 235950c3b..3c4aff173 100644 --- a/src/lsp/cobol_lsp/lsp_document.ml +++ b/src/lsp/cobol_lsp/lsp_document.ml @@ -92,8 +92,8 @@ let check doc ptree = let DIAGS.{ result = artifacts, rewinder, checked; diags} = DIAGS.more_result ~f:begin fun (ptree, rewinder) -> let config = doc.project.config.cobol_config in - Cobol_typeck.compilation_group ~config ptree |> - Cobol_typeck.translate_diagnostics ~config |> + Cobol_typeck.Engine.compilation_group ~config ptree |> + Cobol_typeck.Engine.translate_diagnostics ~config |> DIAGS.map_result ~f:begin fun checked -> Cobol_parser.artifacts ptree, Some rewinder, Some checked end diff --git a/src/lsp/cobol_typeck/cobol_typeck.ml b/src/lsp/cobol_typeck/cobol_typeck.ml deleted file mode 100644 index 5c55e878f..000000000 --- a/src/lsp/cobol_typeck/cobol_typeck.ml +++ /dev/null @@ -1,24 +0,0 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - -module OLD = struct - include Old_typeck_engine - - module Env_builder = Old_env_builder - module Group_builder = Old_group_builder - module Prog_builder = Old_prog_builder -end - -module Outputs = Typeck_outputs -module Diagnostics = Typeck_diagnostics -include Typeck_engine diff --git a/src/lsp/cobol_typeck/cobol_typeck.mli b/src/lsp/cobol_typeck/cobol_typeck.mli deleted file mode 100644 index d8f007477..000000000 --- a/src/lsp/cobol_typeck/cobol_typeck.mli +++ /dev/null @@ -1,28 +0,0 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - -(** Type-checking and validation of COBOL compilation groups *) - -module OLD: sig - include module type of Old_typeck_engine - - (** {1 Access to independent builder modules} *) - - module Env_builder = Old_env_builder - module Group_builder = Old_group_builder - module Prog_builder = Old_prog_builder -end - -module Outputs = Typeck_outputs -module Diagnostics = Typeck_diagnostics -include module type of Typeck_engine diff --git a/src/lsp/cobol_typeck/typeck_diagnostics.ml b/src/lsp/cobol_typeck/diagnostics.ml similarity index 100% rename from src/lsp/cobol_typeck/typeck_diagnostics.ml rename to src/lsp/cobol_typeck/diagnostics.ml diff --git a/src/lsp/cobol_typeck/old_typeck_engine.ml b/src/lsp/cobol_typeck/engine.ml similarity index 74% rename from src/lsp/cobol_typeck/old_typeck_engine.ml rename to src/lsp/cobol_typeck/engine.ml index 9627b0748..b5da1546d 100644 --- a/src/lsp/cobol_typeck/old_typeck_engine.ml +++ b/src/lsp/cobol_typeck/engine.ml @@ -13,21 +13,16 @@ (** Type-checking and validation of COBOL compilation groups *) -module Prog_builder = Old_prog_builder - module DIAGS = Cobol_common.Diagnostics -module CU = Cobol_data_old.Compilation_unit -module CUs = CU.SET -let analyze_compilation_group +let compilation_group (type m) : ?config: _ -> m Cobol_parser.Outputs.parsed_compilation_group -> _ = fun ?(config = Cobol_config.Config.default) -> function | Only None | WithArtifacts (None, _) -> - DIAGS.result (Cobol_data_old.Compilation_unit.SET.empty, None) + Outputs.none, Diagnostics.none | Only Some cg | WithArtifacts (Some cg, _) -> - match Prog_builder.compilation_group config cg with - | { diags; _ } when DIAGS.Set.has_errors diags -> - DIAGS.result ~diags (CUs.empty, Some cg) - | { diags; result } -> - DIAGS.result ~diags (result, Some cg) + Typeck_units.of_compilation_group config cg + +let translate_diagnostics ?(config = Cobol_config.Config.default) (output, diags) = + DIAGS.result output ~diags:(Diagnostics.translate ~config diags) diff --git a/src/lsp/cobol_typeck/typeck_engine.mli b/src/lsp/cobol_typeck/engine.mli similarity index 88% rename from src/lsp/cobol_typeck/typeck_engine.mli rename to src/lsp/cobol_typeck/engine.mli index 212ac5830..2341c58a9 100644 --- a/src/lsp/cobol_typeck/typeck_engine.mli +++ b/src/lsp/cobol_typeck/engine.mli @@ -14,9 +14,9 @@ val compilation_group : ?config: Cobol_config.Types.t -> _ Cobol_parser.Outputs.parsed_compilation_group - -> Typeck_outputs.t * Typeck_diagnostics.t + -> Outputs.t * Diagnostics.t val translate_diagnostics : ?config: Cobol_config.Types.t - -> Typeck_outputs.t * Typeck_diagnostics.t - -> Typeck_outputs.t Cobol_common.Diagnostics.with_diags + -> Outputs.t * Diagnostics.t + -> Outputs.t Cobol_common.Diagnostics.with_diags diff --git a/src/lsp/cobol_typeck/typeck_outputs.ml b/src/lsp/cobol_typeck/outputs.ml similarity index 100% rename from src/lsp/cobol_typeck/typeck_outputs.ml rename to src/lsp/cobol_typeck/outputs.ml diff --git a/src/lsp/cobol_typeck/typeck_clauses.ml b/src/lsp/cobol_typeck/typeck_clauses.ml index d8039687b..0beaa8e9f 100644 --- a/src/lsp/cobol_typeck/typeck_clauses.ml +++ b/src/lsp/cobol_typeck/typeck_clauses.ml @@ -14,7 +14,7 @@ open Cobol_data.Types open Cobol_common.Srcloc.TYPES open Cobol_common.Srcloc.INFIX -open Typeck_diagnostics +open Diagnostics module PIC = Cobol_data.Picture diff --git a/src/lsp/cobol_typeck/typeck_config.ml b/src/lsp/cobol_typeck/typeck_config.ml index 160629c94..55d2d1c66 100644 --- a/src/lsp/cobol_typeck/typeck_config.ml +++ b/src/lsp/cobol_typeck/typeck_config.ml @@ -23,7 +23,7 @@ type output = Cobol_unit.Types.unit_config type acc = { config: output; - diags: Typeck_diagnostics.t; + diags: Diagnostics.t; } let default_config = @@ -35,7 +35,7 @@ let default_config = let init config = { config; - diags = Typeck_diagnostics.none; + diags = Diagnostics.none; } let error acc e = { acc with diags = Config_error e :: acc.diags } diff --git a/src/lsp/cobol_typeck/typeck_config.mli b/src/lsp/cobol_typeck/typeck_config.mli index f08e361ec..f30f9d200 100644 --- a/src/lsp/cobol_typeck/typeck_config.mli +++ b/src/lsp/cobol_typeck/typeck_config.mli @@ -18,4 +18,4 @@ type output = Cobol_unit.Types.unit_config val of_compilation_unit : ?parent_config:Cobol_unit.Types.unit_config -> Cobol_ptree.Types.compilation_unit with_loc - -> output * Typeck_diagnostics.t + -> output * Diagnostics.t diff --git a/src/lsp/cobol_typeck/typeck_data_items.ml b/src/lsp/cobol_typeck/typeck_data_items.ml index 551c66158..9e6367fdd 100644 --- a/src/lsp/cobol_typeck/typeck_data_items.ml +++ b/src/lsp/cobol_typeck/typeck_data_items.ml @@ -28,7 +28,7 @@ module PIC = Cobol_data.Picture type output = { definitions: Cobol_unit.Types.data_definitions; - references: Typeck_outputs.qualrefmap; + references: Outputs.qualrefmap; } (* --- *) @@ -44,7 +44,7 @@ type acc = definitions: Cobol_unit.Types.data_definitions; references: srcloc list Cobol_unit.Qual.MAP.t; picture_config: Cobol_data.Types.picture_config; - diags: Typeck_diagnostics.t; + diags: Diagnostics.t; } and item_stack = item_under_construction list and item_under_construction = (* item currently being assembled *) @@ -104,7 +104,7 @@ let error acc error = { acc with diags = Data_error error :: acc.diags } let warn acc d = { acc with diags = Data_warning d :: acc.diags } let result { definitions = { data_items; data_records }; - references; diags; _ } : output * Typeck_diagnostics.t = + references; diags; _ } : output * Diagnostics.t = { definitions = { data_items = { data_items with list = List.rev data_items.list }; data_records = List.rev data_records }; @@ -330,7 +330,7 @@ let field_usage_n_value acc { item_name; item_loc; item_clauses; _ } = Typeck_clauses.to_usage_n_value item_clauses ~item_name ~item_loc ~picture_config:acc.picture_config in - let acc = { acc with diags = Typeck_diagnostics.union acc.diags diags } in + let acc = { acc with diags = Diagnostics.union acc.diags diags } in acc, usage, value @@ -488,7 +488,7 @@ let register_ref ~from:{ loc; _ } ~to_:qualname_opt acc = acc | Some qn -> { acc with - references = Typeck_outputs.register_qualref ~&qn ~loc acc.references } + references = Outputs.register_qualref ~&qn ~loc acc.references } let find_in_current_record qualname acc = @@ -597,7 +597,7 @@ let on_item acc ~at_level let item_clauses = Typeck_clauses.of_data_item data_clauses in let acc = { acc with - diags = Typeck_diagnostics.union acc.diags item_clauses.clause_diags } in + diags = Diagnostics.union acc.diags item_clauses.clause_diags } in match item_clauses.redefines with | Some redefined_name -> on_redefinition_item acc item_clauses diff --git a/src/lsp/cobol_typeck/typeck_data_items.mli b/src/lsp/cobol_typeck/typeck_data_items.mli index ce25efbe6..e396b87e3 100644 --- a/src/lsp/cobol_typeck/typeck_data_items.mli +++ b/src/lsp/cobol_typeck/typeck_data_items.mli @@ -16,10 +16,10 @@ open Cobol_common.Srcloc.TYPES type output = { definitions: Cobol_unit.Types.data_definitions; - references: Typeck_outputs.qualrefmap; + references: Outputs.qualrefmap; } val of_compilation_unit : Cobol_unit.Types.unit_config -> Cobol_ptree.Types.compilation_unit with_loc - -> output * Typeck_diagnostics.t + -> output * Diagnostics.t diff --git a/src/lsp/cobol_typeck/typeck_procedure.ml b/src/lsp/cobol_typeck/typeck_procedure.ml index d2905f682..2c43b34c2 100644 --- a/src/lsp/cobol_typeck/typeck_procedure.ml +++ b/src/lsp/cobol_typeck/typeck_procedure.ml @@ -21,7 +21,7 @@ module Visitor = Cobol_common.Visitor type output = { procedure: Cobol_unit.Types.procedure; - references: Typeck_outputs.references_in_unit; + references: Outputs.references_in_unit; } let procedure_of_compilation_unit cu' = @@ -161,14 +161,14 @@ let references ~(data_definitions: Cobol_unit.Types.data_definitions) procedure type acc = { current_section: Cobol_unit.Types.procedure_section option; - refs: Typeck_outputs.references_in_unit; - diags: Typeck_diagnostics.t; + refs: Outputs.references_in_unit; + diags: Diagnostics.t; } let init = { current_section = None; - refs = Typeck_outputs.no_refs; - diags = Typeck_diagnostics.none; + refs = Outputs.no_refs; + diags = Diagnostics.none; } let references { refs; diags; _ } = refs, diags end in @@ -191,20 +191,20 @@ let references ~(data_definitions: Cobol_unit.Types.data_definitions) procedure (* match Qualmap.find qn data_definitions.data_items.named with *) (* | Data_field { def; _ } -> *) (* { acc with *) - (* refs = Typeck_outputs.register_data_field_ref ~loc def acc.refs } *) + (* refs = Outputs.register_data_field_ref ~loc def acc.refs } *) (* | Data_renaming { def; _ } -> *) (* { acc with *) - (* refs = Typeck_outputs.register_data_renaming_ref ~loc def acc.refs } *) + (* refs = Outputs.register_data_renaming_ref ~loc def acc.refs } *) (* | Data_condition { def; _ } -> *) (* { acc with *) - (* refs = Typeck_outputs.register_condition_name_ref ~loc def acc.refs } *) + (* refs = Outputs.register_condition_name_ref ~loc def acc.refs } *) (* | Table_index { qualname = qn; _ } -> *) (* { acc with *) - (* refs = Typeck_outputs.register_data_qualref ~loc ~&qn acc.refs } *) + (* refs = Outputs.register_data_qualref ~loc ~&qn acc.refs } *) 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 } + refs = 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. *) @@ -223,7 +223,7 @@ let references ~(data_definitions: Cobol_unit.Types.data_definitions) procedure match Cobol_unit.Procedure.find ~&qn ?in_section procedure with | block -> { acc with - refs = Typeck_outputs.register_procedure_ref ~loc block acc.refs } + refs = Outputs.register_procedure_ref ~loc block acc.refs } | exception Not_found -> error acc @@ Unknown_proc_name qn | exception Qualmap.Ambiguous (lazy matching_qualnames) -> diff --git a/src/lsp/cobol_typeck/typeck_procedure.mli b/src/lsp/cobol_typeck/typeck_procedure.mli index 0cc8b81d0..64965c14a 100644 --- a/src/lsp/cobol_typeck/typeck_procedure.mli +++ b/src/lsp/cobol_typeck/typeck_procedure.mli @@ -16,10 +16,10 @@ open Cobol_common.Srcloc.TYPES type output = { procedure: Cobol_unit.Types.procedure; - references: Typeck_outputs.references_in_unit; + references: Outputs.references_in_unit; } val of_compilation_unit : data_definitions: Cobol_unit.Types.data_definitions -> Cobol_ptree.Types.compilation_unit with_loc - -> output * Typeck_diagnostics.t + -> output * Diagnostics.t diff --git a/src/lsp/cobol_typeck/typeck_units.ml b/src/lsp/cobol_typeck/typeck_units.ml index b04d1174e..6727718f8 100644 --- a/src/lsp/cobol_typeck/typeck_units.ml +++ b/src/lsp/cobol_typeck/typeck_units.ml @@ -31,8 +31,8 @@ type acc = parent_name: string with_loc option; parent_config: unit_config option; cus: CUs.t; (* = group *) - artifacts: Typeck_outputs.artifacts; - diags: Typeck_diagnostics.diagnostics; + artifacts: Outputs.artifacts; + diags: Diagnostics.diagnostics; } let init = @@ -40,8 +40,8 @@ let init = parent_name = None; parent_config = None; cus = CUs.empty; - artifacts = Typeck_outputs.no_artifacts; - diags = Typeck_diagnostics.none; + artifacts = Outputs.no_artifacts; + diags = Diagnostics.none; (* unit_config = *) (* { *) (* unit_currency_signs = Cobol_common.Basics.CharSet.singleton '$'; *) @@ -50,7 +50,7 @@ let init = } let result ptree acc = - Typeck_outputs.{ + Outputs.{ ptree; group = acc.cus; artifacts = acc.artifacts; @@ -84,7 +84,7 @@ let build_units _config = object let references = CUMap.add unit { unit_procedure.references with - data_refs = Typeck_outputs.merge_qualrefmaps + data_refs = Outputs.merge_qualrefmaps unit_data.references unit_procedure.references.data_refs } acc.artifacts.references @@ -97,7 +97,7 @@ let build_units _config = object cus = CUs.add unit acc.cus; artifacts = { references }; diags = - Typeck_diagnostics.(union unit_config_diags @@ + Diagnostics.(union unit_config_diags @@ union unit_data_diags @@ unit_procedure_diags); } in @@ -120,7 +120,7 @@ end groups. *) let of_compilation_group : Cobol_config.Types.t -> Cobol_ptree.Types.compilation_group -> - Typeck_outputs.t * Typeck_diagnostics.t = + Outputs.t * Diagnostics.t = fun config compilation_group_ptree -> Cobol_ptree.Visitor.fold_compilation_group (build_units config) compilation_group_ptree init |> diff --git a/src/lsp/cobol_typeck/typeck_units.mli b/src/lsp/cobol_typeck/typeck_units.mli index d36a82b43..afdd31eaf 100644 --- a/src/lsp/cobol_typeck/typeck_units.mli +++ b/src/lsp/cobol_typeck/typeck_units.mli @@ -14,4 +14,4 @@ val of_compilation_group : Cobol_config.Types.t -> Cobol_ptree.Types.compilation_group - -> Typeck_outputs.t * Typeck_diagnostics.t + -> Outputs.t * Diagnostics.t diff --git a/src/lsp/cobol_typeck_old/dune b/src/lsp/cobol_typeck_old/dune new file mode 100644 index 000000000..5ec35ec86 --- /dev/null +++ b/src/lsp/cobol_typeck_old/dune @@ -0,0 +1,26 @@ +; generated by drom from package skeleton 'library' + +(library + (name cobol_typeck_old) + (public_name cobol_typeck_old) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries cobol_unit cobol_typeck cobol_ptree cobol_parser cobol_data cobol_common ) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + (preprocess (pps ppx_deriving.show ppx_deriving.ord)) + + ) + + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package cobol_typeck_old)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/cobol_typeck/old_env_builder.ml b/src/lsp/cobol_typeck_old/env_builder.ml similarity index 100% rename from src/lsp/cobol_typeck/old_env_builder.ml rename to src/lsp/cobol_typeck_old/env_builder.ml diff --git a/src/lsp/cobol_typeck/old_env_builder.mli b/src/lsp/cobol_typeck_old/env_builder.mli similarity index 100% rename from src/lsp/cobol_typeck/old_env_builder.mli rename to src/lsp/cobol_typeck_old/env_builder.mli diff --git a/src/lsp/cobol_typeck/old_group_builder.ml b/src/lsp/cobol_typeck_old/group_builder.ml similarity index 99% rename from src/lsp/cobol_typeck/old_group_builder.ml rename to src/lsp/cobol_typeck_old/group_builder.ml index c0036485c..5e64bf597 100644 --- a/src/lsp/cobol_typeck/old_group_builder.ml +++ b/src/lsp/cobol_typeck_old/group_builder.ml @@ -57,7 +57,7 @@ let rev_and_validate_data_item_descrs descr | Data item -> DIAGS.Set.union diags @@ - Cobol_validation.validate_data_clauses ~is_elementary + Cobol_typeck.Cobol_validation.validate_data_clauses ~is_elementary (item &@<- descr), descr | _ -> (* TODO *) diff --git a/src/lsp/cobol_typeck/old_group_builder.mli b/src/lsp/cobol_typeck_old/group_builder.mli similarity index 100% rename from src/lsp/cobol_typeck/old_group_builder.mli rename to src/lsp/cobol_typeck_old/group_builder.mli diff --git a/src/lsp/cobol_typeck_old/package.toml b/src/lsp/cobol_typeck_old/package.toml new file mode 100644 index 000000000..92d641643 --- /dev/null +++ b/src/lsp/cobol_typeck_old/package.toml @@ -0,0 +1,79 @@ + +# name of package +name = "cobol_typeck_old" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# 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" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# 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 +skip = ["index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +cobol_ptree = "version" +cobol_common = "version" +cobol_data = "version" +cobol_parser = "version" +cobol_unit = "version" +cobol_typeck = "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" +[fields] +# ... diff --git a/src/lsp/cobol_typeck/old_prog_builder.ml b/src/lsp/cobol_typeck_old/prog_builder.ml similarity index 97% rename from src/lsp/cobol_typeck/old_prog_builder.ml rename to src/lsp/cobol_typeck_old/prog_builder.ml index 66dcb3b52..7bd77fa64 100644 --- a/src/lsp/cobol_typeck/old_prog_builder.ml +++ b/src/lsp/cobol_typeck_old/prog_builder.ml @@ -11,9 +11,6 @@ (* *) (**************************************************************************) -module Env_builder = Old_env_builder -module Group_builder = Old_group_builder - open Cobol_ptree.Types open Cobol_common.Srcloc.INFIX open Cobol_common.Diagnostics.TYPES diff --git a/src/lsp/cobol_typeck/typeck_engine.ml b/src/lsp/cobol_typeck_old/typeck_engine.ml similarity index 75% rename from src/lsp/cobol_typeck/typeck_engine.ml rename to src/lsp/cobol_typeck_old/typeck_engine.ml index df9dd1c3f..192bba020 100644 --- a/src/lsp/cobol_typeck/typeck_engine.ml +++ b/src/lsp/cobol_typeck_old/typeck_engine.ml @@ -14,15 +14,18 @@ (** Type-checking and validation of COBOL compilation groups *) module DIAGS = Cobol_common.Diagnostics +module CU = Cobol_data_old.Compilation_unit +module CUs = CU.SET -let compilation_group +let analyze_compilation_group (type m) : ?config: _ -> m Cobol_parser.Outputs.parsed_compilation_group -> _ = fun ?(config = Cobol_config.Config.default) -> function | Only None | WithArtifacts (None, _) -> - Typeck_outputs.none, Typeck_diagnostics.none + DIAGS.result (Cobol_data_old.Compilation_unit.SET.empty, None) | Only Some cg | WithArtifacts (Some cg, _) -> - Typeck_units.of_compilation_group config cg - -let translate_diagnostics ?(config = Cobol_config.Config.default) (output, diags) = - DIAGS.result output ~diags:(Typeck_diagnostics.translate ~config diags) + match Prog_builder.compilation_group config cg with + | { diags; _ } when DIAGS.Set.has_errors diags -> + DIAGS.result ~diags (CUs.empty, Some cg) + | { diags; result } -> + DIAGS.result ~diags (result, Some cg) diff --git a/src/lsp/cobol_typeck_old/version.mlt b/src/lsp/cobol_typeck_old/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/lsp/cobol_typeck_old/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + ()