IRJ files parser as an Mlang sublibrary

dune-project

@@ -51,3 +51,17 @@
    (= 0.19.0))
   (parmap
     (= 1.2.3))))
+
+(package
+ (name irj_parser)
+ (synopsis "Parser for the IRJ tests")
+ (description "This parser is aimed for the tests used by la DGFiP to test the calculation of the French income tax")
+ (depends
+  (ocaml
+   (and(>= "4.11.2")))
+  (dune
+   (and :build))
+  (odoc
+  (= 1.5.3))
+  (ocamlformat
+   (= 0.19.0))))

src/mlang/irj_parser/irj_parser.opam → irj_parser.opam

@@ -1,22 +1,18 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
+version: "1.1.0"
 synopsis: "Parser for the IRJ tests"
 description:
   "This parser is aimed for the tests used by la DGFiP to test the calculation of the French income tax"
-maintainer: ["Mathieu Durero" " Noé Ensarguet"]
-authors: ["Mathieu Durero" "Raphaël Monat"]
+maintainer: ["[email protected]"]
+authors: ["Denis Merigoux" "Raphaël Monat"]
 license: "GPL-3.0-or-later"
-homepage: "https://github.com/MLanguage/mlang/tree/IRJ-parser-library"
-bug-reports: "https://github.com/MLanguage/mlang/issues"
+homepage: "https://gitlab.inria.fr/verifisc/mlang"
+bug-reports: "https://gitlab.inria.fr/verifisc/mlang/issues"
 depends: [
   "ocaml" {>= "4.11.2"}
   "dune" {build}
-  "ANSITerminal" {= "0.8.2"}
-  "cmdliner" {= "1.1.0"}
-  "re" {= "1.9.0"}
-  "ocamlgraph" {= "1.8.8"}
   "odoc" {= "1.5.3"}
-  "dune-build-info" {= "2.5.1"}
   "ocamlformat" {= "0.19.0"}
 ]
 build: [
@@ -33,3 +29,4 @@ build: [
     "@doc" {with-doc}
   ]
 ]
+dev-repo: "git+https://gitlab.inria.fr/verifisc/mlang.git"

src/mlang/irj_parser/src/dune → src/irj_parser/src/dune

@@ -3,20 +3,13 @@
   (ocamlopt_flags
    (-O3 -ccopt -static))))
 
-(include_subdirs unqualified)
-
 (library
  (name irj_file)
  (public_name irj_parser)
- (wrapped false)
- (libraries ANSITerminal re dune-build-info threads cmdliner))
+ (wrapped false))
 
 (ocamllex irj_lexer)
 
 (menhir
  (modules irj_parser)
  (flags --strict --explain))
-
-;(documentation
-; (package irj_parser)
-; (mld_files ("index")))

src/mlang/irj_parser/src/irj_ast.ml → src/irj_parser/src/irj_ast.ml

@@ -14,13 +14,22 @@
    You should have received a copy of the GNU General Public License along with
    this program. If not, see <https://www.gnu.org/licenses/>. *)
 
+type t = { pos_filename : string; pos_loc : Lexing.position * Lexing.position }
+
+let mk_position sloc =
+  { pos_filename = (fst sloc).Lexing.pos_fname; pos_loc = sloc }
+
+exception
+  StructuredError of (string * (string option * t) list * (unit -> unit) option)
+(* duplication of some of the utils *)
+
 type literal = I of int | F of float
 
-type var_value = string * literal * Pos.t
+type var_value = string * literal * t
 
 (* type var_values = var_value list *)
 
-type calc_error = string * Pos.t
+type calc_error = string * t
 
 (* type calc_errors = calc_error list *)
 
@@ -40,7 +49,7 @@ type rappel = {
   (* MMYYYY *)
   decl_2042_rect : int option;
   (* 0 or 1 *)
-  pos : Pos.t;
+  pos : t;
 }
 
 type prim_data_block = {

src/mlang/irj_parser/src/irj_file.ml → src/irj_parser/src/irj_file.ml

@@ -27,13 +27,16 @@ let parse_file (test_name : string) : irj_file =
   in
   let f =
     try Irj_parser.irj_file Irj_lexer.token filebuf with
-    | Errors.StructuredError e ->
+    | StructuredError e ->
         close_in input;
-        raise (Errors.StructuredError e)
+        raise (StructuredError e)
     | Irj_parser.Error ->
         close_in input;
-        Errors.raise_spanned_error "Test syntax error"
-          (Parse_utils.mk_position (filebuf.lex_start_p, filebuf.lex_curr_p))
+        raise
+          (StructuredError
+             ( "Test syntax error",
+               [ (None, mk_position (filebuf.lex_start_p, filebuf.lex_curr_p)) ],
+               None ))
   in
   close_in input;
   f

src/mlang/irj_parser/src/irj_lexer.mll → src/irj_parser/src/irj_lexer.mll

@@ -17,6 +17,12 @@
 {
 open Lexing
 open Irj_parser
+open Irj_ast
+
+let error lb msg =
+  raise (StructuredError ("Lexing error : " ^ msg,
+                          [ (None, mk_position (Lexing.lexeme_start_p lb, Lexing.lexeme_end_p lb)) ],
+                          None))
 
 module StrMap = Map.Make (String)
 
@@ -40,11 +46,6 @@ let keywords =
     "#AVIS_CSG",            AVISCSG;
   ]
 
-let error lb msg =
-  Errors.raise_spanned_error ("Lexing error : " ^ msg)
-    (Parse_utils.mk_position (Lexing.lexeme_start_p lb,
-                              Lexing.lexeme_end_p lb))
-
 let is_bol lb =
   (* bol = beginning of line *)
   lb.lex_start_p.pos_cnum - lb.lex_start_p.pos_bol = 0

src/mlang/irj_parser/src/irj_parser.mly → src/irj_parser/src/irj_parser.mly

@@ -16,10 +16,9 @@
    this program. If not, see <https://www.gnu.org/licenses/>. *)
 
 %{ open Irj_ast
-   
+
   let error (sp, ep) msg =
-  Errors.raise_spanned_error ("Parse error : " ^ msg)
-    (Parse_utils.mk_position (sp, ep))
+    raise (StructuredError ("Parse error : " ^ msg, [ (None, mk_position (sp, ep)) ], None))
 
 %}
 
@@ -98,11 +97,11 @@ rappels:
 | ENTREESCORR NL CONTROLESCORR NL RESULTATSCORR NL DATES? AVISIR? AVISCSG? { None }
 
 variable_and_value:
-| var = SYMBOL SLASH value = value NL { (var, value, Parse_utils.mk_position $sloc) }
+| var = SYMBOL SLASH value = value NL { (var, value, mk_position $sloc) }
 | SYMBOL error { error $loc "Missing slash in pair variable/value" }
 
 calc_error:
-  error = SYMBOL NL { (error, Parse_utils.mk_position $sloc) }
+  error = SYMBOL NL { (error, mk_position $sloc) }
 
 rappel:
   event_nb = integer SLASH
@@ -129,7 +128,7 @@ rappel:
      base_tolerance_legale;
      month_year;
      decl_2042_rect; 
-     pos = Parse_utils.mk_position $sloc }
+     pos = mk_position $sloc }
   }
 
 integer:

src/mlang/test_framework/test_interpreter.ml

@@ -15,6 +15,12 @@
 
 open Irj_ast
 
+let convert_pos (sloc : Irj_ast.t) : Pos.t =
+  { pos_filename = sloc.pos_filename; pos_loc = sloc.pos_loc }
+
+(* enforces type compatibility (the type t is defined in exactly the same way in
+   Irj_ast and in Pos) *)
+
 let to_ast_literal (value : Irj_ast.literal) : Mast.literal =
   match value with I i -> Float (float_of_int i) | F f -> Float f
 
@@ -43,7 +49,7 @@ let to_MIR_function_and_inputs (program : Bir.program) (t : irj_file)
     List.fold_left
       (fun (fv, in_f) (var, value, pos) ->
         let var =
-          find_var_of_name program.mir_program (var, pos)
+          find_var_of_name program.mir_program (var, convert_pos pos)
           |> Bir.(var_from_mir default_tgv)
         in
         let lit =
@@ -65,34 +71,35 @@ let to_MIR_function_and_inputs (program : Bir.program) (t : irj_file)
               two using the line below*)
            let var =
              Pos.unmark
-               (find_var_of_name program.mir_program (var, pos))
+               (find_var_of_name program.mir_program (var, convert_pos pos))
                  .Mir.Variable.name
            in
            (* we allow a difference of 0.000001 between the control value and
               the result *)
            let first_exp =
              ( Mast.Comparison
-                 ( (Lte, pos),
+                 ( (Lte, convert_pos pos),
                    ( Mast.Binop
-                       ( (Mast.Sub, pos),
-                         (Literal (Variable (Normal var)), pos),
-                         (Literal (to_ast_literal value), pos) ),
-                     pos ),
-                   (Literal (Float test_error_margin), pos) ),
-               pos )
+                       ( (Mast.Sub, convert_pos pos),
+                         (Literal (Variable (Normal var)), convert_pos pos),
+                         (Literal (to_ast_literal value), convert_pos pos) ),
+                     convert_pos pos ),
+                   (Literal (Float test_error_margin), convert_pos pos) ),
+               convert_pos pos )
            in
            let second_exp =
              ( Mast.Comparison
-                 ( (Lte, pos),
+                 ( (Lte, convert_pos pos),
                    ( Mast.Binop
-                       ( (Mast.Sub, pos),
-                         (Literal (to_ast_literal value), pos),
-                         (Literal (Variable (Normal var)), pos) ),
-                     pos ),
-                   (Literal (Float test_error_margin), pos) ),
-               pos )
+                       ( (Mast.Sub, convert_pos pos),
+                         (Literal (to_ast_literal value), convert_pos pos),
+                         (Literal (Variable (Normal var)), convert_pos pos) ),
+                     convert_pos pos ),
+                   (Literal (Float test_error_margin), convert_pos pos) ),
+               convert_pos pos )
            in
-           (Mast.Binop ((Mast.And, pos), first_exp, second_exp), pos))
+           ( Mast.Binop ((Mast.And, convert_pos pos), first_exp, second_exp),
+             convert_pos pos ))
          t.prim.resultats_attendus)
   in
   ( { func_variable_inputs; func_constant_inputs; func_outputs; func_conds },

src/mlang/irj_parser/src/utils/pos.mli → src/mlang/utils/pos.mli

@@ -18,7 +18,9 @@
 
 (** {2 Source code position} *)
 
-type t
+type t = { pos_filename : string; pos_loc : Lexing.position * Lexing.position }
+(* opened this type. Not very satisfactory but necessary to enforce the
+   compatibility of this type t and that of the module Irj_parser *)
 
 val make_position : string -> Lexing.position * Lexing.position -> t