Merge branch 'MLanguage:master' into makefilesfor2023

.github/workflows/binary-releases.yml

@@ -20,51 +20,6 @@ jobs:
           tag_name: ${{ github.run_number }}
           release_name: Release ${{ github.run_number }}
 
-  macos-build:
-    runs-on: macos-latest
-    needs: create-release
-
-    steps:
-      - uses: actions/checkout@v2
-
-      - name: Opam modules cache
-        uses: actions/cache@v1
-        env:
-          cache-name: cache-opam-modules
-        with:
-          path: ~/.opam
-          key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('mlang.opam', 'Makefile') }}
-          restore-keys: |
-            ${{ runner.os }}-build-${{ env.cache-name }}-
-            ${{ runner.os }}-build-
-            ${{ runner.os }}-
-
-      - name: Set up OCaml
-        uses: ocaml/setup-ocaml@v2
-        with:
-          ocaml-compiler: 4.11.2
-
-      - name: Install dependencies
-        run: |
-          brew install gmp mpfr
-          opam update
-          make init-without-switch
-
-      - name: Make mlang binary
-        run: |
-          eval $(opam env)
-          make build
-
-      - name: Upload release asset
-        uses: actions/upload-release-asset@v1
-        env:
-          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-        with:
-          upload_url: ${{ needs.create-release.outputs.upload_url }}
-          asset_path: ./_build/default/src/main.exe
-          asset_name: mlang-macos-v${{ github.run_number }}.exe
-          asset_content_type: application/octet-stream
-
   linux-build:
     # The type of runner that the job will run on
     runs-on: ubuntu-latest

dune-project

@@ -7,11 +7,11 @@
 (generate_opam_files true)
 
 (source
- (uri git+https://gitlab.inria.fr/verifisc/mlang.git))
+ (uri git+https://github.com/MLanguage/mlang.git))
 
-(homepage https://gitlab.inria.fr/verifisc/mlang)
+(homepage https://github.com/MLanguage/mlang)
 
-(bug_reports https://gitlab.inria.fr/verifisc/mlang/issues)
+(bug_reports https://github.com/MLanguage/mlang/issues)
 
 (authors "Denis Merigoux" "Rapha\195\171l Monat")
 
@@ -54,10 +54,10 @@
    (= 1.2.3))))
 
 (package
- (name irj_parser)
- (synopsis "Parser for the IRJ tests")
+ (name irj_checker)
+ (synopsis "IRJ test validation tool")
  (description
-  "This parser is aimed for the tests used by la DGFiP to test the calculation of the French income tax")
+  "This standalone module performs a syntactic validation of the DGFiP IRJ test format")
  (depends
   (ocaml
    (and
@@ -67,4 +67,4 @@
   (odoc
    (>= 1.5.3))
   (ocamlformat
-   (= 0.19.0))))
+   (= 0.19.0))))

irj_parser.opam → irj_checker.opam

@@ -1,14 +1,14 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
 version: "1.1.0"
-synopsis: "Parser for the IRJ tests"
+synopsis: "IRJ test validation tool"
 description:
-  "This parser is aimed for the tests used by la DGFiP to test the calculation of the French income tax"
+  "This standalone module performs a syntactic validation of the DGFiP IRJ test format"
 maintainer: ["[email protected]"]
 authors: ["Denis Merigoux" "Raphaël Monat"]
 license: "GPL-3.0-or-later"
-homepage: "https://gitlab.inria.fr/verifisc/mlang"
-bug-reports: "https://gitlab.inria.fr/verifisc/mlang/issues"
+homepage: "https://github.com/MLanguage/mlang"
+bug-reports: "https://github.com/MLanguage/mlang/issues"
 depends: [
   "ocaml" {>= "4.11.2"}
   "dune" {build}
@@ -29,4 +29,4 @@ build: [
     "@doc" {with-doc}
   ]
 ]
-dev-repo: "git+https://gitlab.inria.fr/verifisc/mlang.git"
+dev-repo: "git+https://github.com/MLanguage/mlang.git"

mlang.opam

@@ -12,8 +12,8 @@ before translating it into various backend languages.
 maintainer: ["[email protected]"]
 authors: ["Denis Merigoux" "Raphaël Monat"]
 license: "GPL-3.0-or-later"
-homepage: "https://gitlab.inria.fr/verifisc/mlang"
-bug-reports: "https://gitlab.inria.fr/verifisc/mlang/issues"
+homepage: "https://github.com/MLanguage/mlang"
+bug-reports: "https://github.com/MLanguage/mlang/issues"
 depends: [
   "ocaml" {>= "4.11.2"}
   "dune" {build}
@@ -42,4 +42,4 @@ build: [
     "@doc" {with-doc}
   ]
 ]
-dev-repo: "git+https://gitlab.inria.fr/verifisc/mlang.git"
+dev-repo: "git+https://github.com/MLanguage/mlang.git"

src/irj_checker/backend_irj/pas_calc.ml

@@ -0,0 +1,61 @@
+open Mlang.Irj_ast
+
+type avis_type = Texte | Gavlir
+
+let open_file filename =
+  let oc = open_out filename in
+  let fmt = Format.formatter_of_out_channel oc in
+  (oc, fmt)
+
+let print_comma oc () = Format.fprintf oc ","
+
+let format_value fmt (value : literal) =
+  match value with
+  | I i -> Format.fprintf fmt "%d" i
+  | F f -> Format.fprintf fmt "%f" f
+
+let format_code_revenu fmt (((var, _), (value, _)) : var_value) =
+  Format.fprintf fmt
+    {|@;<0 2>{@;<0 4>"code": "%s",@;<0 4>"valeur": "%a"@;<0 2>}|} var
+    format_value value
+
+let format_rappel fmt (rappel : rappel) =
+  Format.fprintf fmt
+    {|@;<0 2>{@;<0 4>"numEvt": "%d",@;<0 4>"numRappel": "%d",@;<0 4>"descripteur": "%s",@;<0 4>"montant": "%d",@;<0 4>"sens": "%s",@;<0 4>"penalite": "%a",@;<0 4>"baseTL": "%a",@;<0 4>"date": "%.6d",@;<0 4>"abatt": "%a"@;<0 2>}|}
+    rappel.event_nb rappel.rappel_nb rappel.variable_code rappel.change_value
+    rappel.direction
+    (Format.pp_print_option Format.pp_print_int)
+    rappel.penalty_code
+    (Format.pp_print_option Format.pp_print_int)
+    rappel.base_tolerance_legale rappel.month_year
+    (Format.pp_print_option Format.pp_print_int)
+    rappel.decl_2042_rect
+
+let format_code_list fmt input_list =
+  Format.pp_print_list ~pp_sep:print_comma format_code_revenu fmt input_list
+
+let format_rappel_list fmt rappels =
+  Format.pp_print_list ~pp_sep:print_comma format_rappel fmt rappels
+
+let format_avis_element fmt avis_type =
+  Format.fprintf fmt {|"formatAvis": "%s",@,|}
+    (match avis_type with Texte -> "texte" | Gavlir -> "gavlir")
+
+let gen_pas_calc_json_primitif fmt (prim_data : prim_data_block) mode =
+  Format.fprintf fmt {|@[<%c 2>{@,%a"listeCodes": [%a@,]@]|} mode
+    format_avis_element Texte format_code_list prim_data.entrees;
+  Format.fprintf fmt "}"
+
+let gen_pas_calc_json_correctif fmt (test_data : irj_file) mode =
+  (*Pour l’instant on va se contenter de partir en dur sur du correctif avec avis.*)
+  let rappels : rappel list option =
+    match test_data.rapp with
+    | None -> None
+    | Some rappels -> Some rappels.entrees_rappels
+  in
+  Format.fprintf fmt
+    {|@[<%c 2>{@,%a"codesRevenu": [%a@,],@,"lignesRappel": [%a@,]@]|} mode
+    format_avis_element Texte format_code_list test_data.prim.entrees
+    (Format.pp_print_option format_rappel_list)
+    rappels;
+  Format.fprintf fmt "}"

src/irj_checker/dune

@@ -0,0 +1,12 @@
+(include_subdirs unqualified)
+
+(env
+ (dev
+  (flags
+   (:standard -warn-error -A))))
+
+(executable
+ (name irj_checker)
+ (package irj_checker)
+ (public_name irj_checker)
+ (libraries mlang cmdliner dune-build-info))

src/irj_checker/irj_checker.ml

@@ -0,0 +1,147 @@
+(* Copyright (C) 2023-2024 DGFiP, contributor: David Declerck, Mathieu Durero
+
+   This program is free software: you can redistribute it and/or modify it under
+   the terms of the GNU General Public License as published by the Free Software
+   Foundation, either version 3 of the License, or (at your option) any later
+   version.
+
+   This program is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+   FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+   details.
+
+   You should have received a copy of the GNU General Public License along with
+   this program. If not, see <https://www.gnu.org/licenses/>. *)
+
+(** The Irj_checker Module is a simple entry point to use the Mlang IRJ file
+    parser in order to perform syntactic checks on test files or produce other IR
+    test formats.
+
+    Usage: irj_checker.exe [--message-format=VAL] <test_file.irj> [transformation-target]*)
+
+open Cmdliner
+open Mlang
+
+type message_format_enum = Human | GNU
+
+type validation_mode_enum = Strict | Corrective | Primitive
+
+type transformation_target = None | PasCalcP | PasCalcC
+
+let gen_file generator test_data =
+  let mode = 'v' in
+  (* use h for a monoline json *)
+  let out_fmt = Format.std_formatter in
+  generator out_fmt test_data mode;
+  Format.pp_print_newline out_fmt ();
+  Format.pp_print_flush out_fmt ()
+
+let irj_checker (f : string) (message_format : message_format_enum)
+    (validation_mode : validation_mode_enum)
+    (transform_target : transformation_target) : unit =
+  try
+    if not (Sys.file_exists f && not (Sys.is_directory f)) then
+      Errors.raise_error
+        (Format.asprintf "%s: this path is not a valid file in the filesystem" f);
+    let test_data = Mlang.Irj_file.parse_file f in
+    let test_data =
+      match validation_mode with
+      | Primitive ->
+          if Option.is_some test_data.rapp then
+            Errors.raise_error
+              (Format.asprintf "%s: is a corrective file!" test_data.nom)
+          else test_data
+      | Corrective ->
+          if Option.is_none test_data.rapp then
+            Errors.raise_error
+              (Format.asprintf "%s: is a primitive file!" test_data.nom)
+          else test_data
+      | _ -> test_data
+    in
+    match transform_target with
+    | None ->
+        Cli.result_print "%s: checked as %s with %d primitive codes!"
+          test_data.nom
+          (match test_data.rapp with
+          | Some _ -> "corrective"
+          | None -> "primitive")
+          (List.length test_data.prim.entrees)
+    | PasCalcP -> gen_file Pas_calc.gen_pas_calc_json_primitif test_data.prim
+    | PasCalcC -> gen_file Pas_calc.gen_pas_calc_json_correctif test_data
+  with Errors.StructuredError (msg, pos, kont) ->
+    (match message_format with
+    | Human -> Cli.error_print "%a" Errors.format_structured_error
+    | GNU -> Format.eprintf "%a" Errors.format_structured_error_gnu_format)
+      (msg, pos);
+    (match kont with None -> () | Some kont -> kont ());
+    exit 123
+
+let validation_mode_opt =
+  [ ("strict", Strict); ("corrective", Corrective); ("primitive", Primitive) ]
+
+let validation_mode =
+  Arg.(
+    value
+    & opt (enum validation_mode_opt) Strict
+    & info [ "v"; "validation-mode" ]
+        ~doc:
+          "Select the validation criteria. If set to $(i,strict), the whole \
+           grammar is applied. If set to $(i,corrective) or $(i,primitive), \
+           only the corresponding files are accepted, for instance primitive \
+           file in corrective mode will raise an error.")
+
+let message_format_opt = [ ("human", Human); ("gnu", GNU) ]
+
+let message_format =
+  Arg.(
+    value
+    & opt (enum message_format_opt) Human
+    & info [ "m"; "message-format" ]
+        ~doc:
+          "Selects the format of error and warning messages emitted by the \
+           compiler. If set to $(i,human), the messages will be nicely \
+           displayed and meant to be read by a human. If set to $(i,gnu), the \
+           messages will be rendered according to the GNU coding standards.")
+
+let file =
+  let doc = "Test file (usually with the .irj extension)" in
+  Arg.(value & pos 0 string "" & info [] ~docv:"FILE" ~doc)
+
+let transformation_target_opt =
+  [ ("none", None); ("pasp", PasCalcP); ("pasc", PasCalcC) ]
+
+let transform_target =
+  let doc =
+    "Transformation target, among the following list: $(i,none) (only checks \
+     test syntax), $(i,pasp) (API PAS-CALC for primitive computation \
+     resources), $(i,pasc) (API PAS-CALC for corrective computation \
+     resources)."
+  in
+  Arg.(
+    value
+    & pos 1 (enum transformation_target_opt) None
+    & info [] ~docv:"TARGET" ~doc)
+
+let irj_checker_t =
+  Term.(
+    const irj_checker $ file $ message_format $ validation_mode
+    $ transform_target)
+
+let cmd =
+  let doc = "parses, validates and transforms IRJ test files" in
+  let man =
+    [
+      `S Manpage.s_bugs;
+      `P "File bug reports at <https://github.com/MLanguage/mlang/issues>.";
+    ]
+  in
+  Cmd.v
+    (Cmd.info "irj_checker"
+       ~version:
+         (match Build_info.V1.version () with
+         | None -> "n/a"
+         | Some v -> Build_info.V1.Version.to_string v)
+       ~doc ~man)
+    irj_checker_t
+
+let () = exit (Cmd.eval cmd)

src/mlang/dune

@@ -2,7 +2,8 @@
 
 (library
  (public_name mlang)
- (libraries re ANSITerminal parmap cmdliner threads dune-build-info num gmp))
+ (libraries re ANSITerminal parmap cmdliner threads dune-build-info num gmp
+   menhirLib))
 
 (documentation
  (package mlang)