Merge pull request #131 from MLanguage/enchains

Distinguish M code in separate chains

mpp_specs/2018_6_7.mpp

@@ -9,7 +9,7 @@ compute_benefits():
     V_INDTEO = 1
     V_CALCUL_NAPS = 1
     partition with var_is_taxbenefit:
-      IAD11, INE, IRE <- call_m(calcul_primitif)
+      IAD11, INE, IRE <- call_m(primitif)
     V_CALCUL_NAPS = 0
     iad11 = cast(IAD11)
     ire = cast(IRE)
@@ -41,9 +41,9 @@ compute_double_liquidation3(outputs):
   8ZG = v_8ZG
   V_ACO_MTAP = 0
   V_NEGACO = 0
-  outputs <- call_m(calcul_primitif_isf)
-  outputs <- call_m(calcul_primitif)
-  outputs <- call_m(calcul_primitif_taux)
+  outputs <- call_m(isf)
+  outputs <- call_m(primitif)
+  outputs <- call_m(taux)
 
 compute_double_liquidation_exit_taxe(outputs):
   annee = 2018 # FIXME

mpp_specs/2019_8_0.mpp

@@ -9,7 +9,7 @@ compute_benefits():
     partition with var_is_taxbenefit:
       V_INDTEO = 1
       V_CALCUL_NAPS = 1
-      IAD11, INE, IRE <- call_m(calcul_primitif)
+      IAD11, INE, IRE <- call_m(primitif)
       V_CALCUL_NAPS = 0
       iad11 = cast(IAD11)
       ire = cast(IRE)
@@ -41,9 +41,9 @@ compute_double_liquidation3(outputs):
   8ZG = v_8ZG
   V_ACO_MTAP = 0
   V_NEGACO = 0
-  outputs <- call_m(calcul_primitif_isf)
-  outputs <- call_m(calcul_primitif)
-  outputs <- call_m(calcul_primitif_taux)
+  outputs <- call_m(isf)
+  outputs <- call_m(primitif)
+  outputs <- call_m(taux)
 
 compute_double_liquidation_exit_taxe(outputs):
   annee = 2018 # FIXME

mpp_specs/2020_6_5.mpp

@@ -5,13 +5,13 @@ compute_article1731bis():
     PREM8_11 = 1
 
 calcul_primitif_isf(outputs):
-  outputs <- call_m(calcul_primitif_isf)
- 
+  outputs <- call_m(isf)
+
 calcul_primitif(outputs):
-  outputs <- call_m(calcul_primitif)
+  outputs <- call_m(primitif)
 
 calcul_primitif_taux(outputs):
-  outputs <- call_m(calcul_primitif_taux)
+  outputs <- call_m(taux)
 
 compute_benefits():
  if exists_deposit_defined_variables() or exists_taxbenefit_ceiled_variables():

mpp_specs/dgfip_base.mpp

@@ -1,4 +1,4 @@
 dgfip_calculation():
-  outputs <- call_m(calcul_primitif_isf)
-  outputs <- call_m(calcul_primitif)
-  outputs <- call_m(calcul_primitif_taux)
+  outputs <- call_m(isf)
+  outputs <- call_m(primitif)
+  outputs <- call_m(taux)

src/mlang/backend_compilers/bir_to_java.ml

@@ -67,7 +67,9 @@ let print_double_cut oc () = Format.fprintf oc "@,@,"
 let get_var_pos (var : variable) var_indexes : int =
   match VariableMap.find_opt var var_indexes with
   | Some i -> i
-  | None -> Errors.raise_error "Variable not found"
+  | None ->
+      Errors.raise_error
+        ("Variable not found: " ^ Pos.unmark (var_to_mir var).name)
 
 let rec generate_java_expr (e : expression Pos.marked)
     (var_indexes : int VariableMap.t) :

src/mlang/backend_compilers/dgfip_gen_files.ml

@@ -772,7 +772,7 @@ let get_rules_verif_etc prog =
             | Rule r ->
                 let rules, chainings =
                   if is_valid_app r.rule_applications then
-                    ( rule_number r.rule_name :: rules,
+                    ( Pos.unmark r.rule_number :: rules,
                       match r.rule_chaining with
                       | None -> chainings
                       | Some cn -> StringSet.add (Pos.unmark cn) chainings )
@@ -785,7 +785,7 @@ let get_rules_verif_etc prog =
                     fst
                     @@ List.fold_left
                          (fun (verifs, vn) _vc -> (vn :: verifs, vn + 1))
-                         (verifs, verification_number v.verif_name)
+                         (verifs, Pos.unmark v.verif_number)
                          v.verif_conditions
                   else verifs
                 in

src/mlang/backend_ir/bir_interface.ml

@@ -168,7 +168,8 @@ let translate_external_conditions idmap
   let program =
     Mast.Verification
       {
-        verif_name = [ ("000", Pos.no_pos) ];
+        verif_number = (0, Pos.no_pos);
+        verif_tags = [];
         verif_applications = [ ("iliad", Pos.no_pos) ];
         verif_conditions = verif_conds;
       }

src/mlang/driver.ml

@@ -58,8 +58,7 @@ let driver (files : string list) (debug : bool) (var_info_debug : string list)
         let filebuf, input =
           if source_file <> "" then
             let input = open_in source_file in
-            (Lexing.from_channel input, Some input)
-          else if source_file <> "" then (Lexing.from_string source_file, None)
+            (Lexing.from_channel input, input)
           else failwith "You have to specify at least one file!"
         in
         current_progress source_file;
@@ -73,33 +72,37 @@ let driver (files : string list) (debug : bool) (var_info_debug : string list)
           let commands = Mparser.source_file token filebuf in
           m_program := commands :: !m_program
         with Mparser.Error ->
-          begin
-            match input with
-            | Some input -> close_in input
-            | None -> ()
-          end;
+          close_in input;
           Errors.raise_spanned_error "M syntax error"
             (Parse_utils.mk_position (filebuf.lex_start_p, filebuf.lex_curr_p)))
       !Cli.source_files;
     finish "completed!";
     Cli.debug_print "Elaborating...";
     let source_m_program = !m_program in
     let m_program = Mast_to_mir.translate !m_program in
-    let full_m_program = Mir_interface.to_full_program m_program in
+    let full_m_program =
+      Mir_interface.to_full_program m_program Mast.all_tags
+    in
     let full_m_program = Mir_typechecker.expand_functions full_m_program in
     Cli.debug_print "Typechecking...";
     let full_m_program = Mir_typechecker.typecheck full_m_program in
-    Cli.debug_print "Checking for circular variable definitions...";
-    if
-      Mir_dependency_graph.check_for_cycle full_m_program.dep_graph
-        full_m_program.program true
-    then Errors.raise_error "Cycles between rules.";
+    Mir.TagMap.iter
+      (fun tag Mir_interface.{ dep_graph; _ } ->
+        Cli.debug_print
+          "Checking for circular variable definitions for chain %a..."
+          Format_mast.format_chain_tag tag;
+        if
+          Mir_dependency_graph.check_for_cycle dep_graph full_m_program.program
+            true
+        then Errors.raise_error "Cycles between rules.")
+      full_m_program.chains_orders;
     let mpp = Mpp_frontend.process mpp_file full_m_program in
     let full_m_program =
       Mir_interface.to_full_program
         (match function_spec with
         | Some _ -> Mir_interface.reset_all_outputs full_m_program.program
         | None -> full_m_program.program)
+        Mast.all_tags
     in
     Cli.debug_print "Creating combined program suitable for execution...";
     let combined_program =

src/mlang/m_frontend/format_mast.ml

@@ -39,8 +39,39 @@ let format_application fmt (app : application) = Format.fprintf fmt "%s" app
 
 let format_chaining fmt (c : chaining) = Format.fprintf fmt "%s" c
 
-let format_rule_name fmt (rn : rule_name) =
-  (pp_print_list_space (pp_unmark Format.pp_print_string)) fmt rn
+let format_chain_tag fmt (t : chain_tag) =
+  Format.pp_print_string fmt
+    (match t with
+    | Primitif -> "primitif"
+    | Corrective -> "corrective"
+    | Isf -> "isf"
+    | Taux -> "taux"
+    | Irisf -> "irisf"
+    | Base_hr -> "base_HR"
+    | Base_tl -> "base_tl"
+    | Base_tl_init -> "base_tl_init"
+    | Base_tl_rect -> "base_tl_rect"
+    | Base_inr -> "base_INR"
+    | Base_inr_ref -> "base_inr_ref"
+    | Base_inr_tl -> "base_inr_tl"
+    | Base_inr_tl22 -> "base_inr_tl22"
+    | Base_inr_tl24 -> "base_inr_tl24"
+    | Base_inr_ntl -> "base_inr_ntl"
+    | Base_inr_ntl22 -> "base_inr_ntl22"
+    | Base_inr_ntl24 -> "base_inr_ntl24"
+    | Base_inr_inter22 -> "base_inr_inter22"
+    | Base_inr_intertl -> "base_inr_intertl"
+    | Base_inr_r9901 -> "base_inr_r9901"
+    | Base_abat98 -> "base_ABAT98"
+    | Base_abat99 -> "base_ABAT99"
+    | Base_initial -> "base_INITIAL"
+    | Base_premier -> "base_premier"
+    | Base_anterieure -> "base_anterieure"
+    | Base_anterieure_cor -> "base_anterieure_cor"
+    | Base_majo -> "base_MAJO"
+    | Base_stratemajo -> "base_stratemajo"
+    | Non_auto_cc -> "non_auto_cc"
+    | Horizontale -> "horizontale")
 
 let format_variable_name fmt (v : variable_name) = Format.fprintf fmt "%s" v
 
@@ -54,9 +85,6 @@ let format_variable fmt (v : variable) =
   | Normal v -> format_variable_name fmt v
   | Generic v -> format_variable_generic_name fmt v
 
-let format_verification_name fmt (n : verification_name) =
-  (pp_print_list_space (pp_unmark Format.pp_print_string)) fmt n
-
 let format_error_name fmt (e : error_name) = Format.fprintf fmt "%s" e
 
 let format_literal fmt (l : literal) =
@@ -191,9 +219,8 @@ let format_formula fmt (f : formula) =
         format_formula_decl f
 
 let format_rule fmt (r : rule) =
-  Format.fprintf fmt "regle %a:\napplication %a;\n%a;\n"
-    (pp_print_list_space (pp_unmark Format.pp_print_string))
-    r.rule_name
+  Format.fprintf fmt "regle %d:\napplication %a;\n%a;\n"
+    (Pos.unmark r.rule_number)
     (pp_print_list_comma (pp_unmark Format.pp_print_string))
     r.rule_applications
     (Format.pp_print_list
@@ -267,7 +294,8 @@ let format_verification_condition fmt (vc : verification_condition) =
     (snd vc.verif_cond_error)
 
 let format_verification fmt (v : verification) =
-  Format.fprintf fmt "verif %a : %a;\n%a" format_verification_name v.verif_name
+  Format.fprintf fmt "verif %d : %a;\n%a"
+    (Pos.unmark v.verif_number)
     (pp_print_list_space (pp_unmark format_application))
     v.verif_applications
     (pp_print_list_space (pp_unmark format_verification_condition))

src/mlang/m_frontend/format_mast.mli

@@ -24,8 +24,6 @@ val format_value_typ : Format.formatter -> Mast.value_typ -> unit
 
 val format_variable : Format.formatter -> Mast.variable -> unit
 
-val format_rule_name : Format.formatter -> Mast.rule_name -> unit
-
 val format_source_file : Format.formatter -> Mast.source_file -> unit
 
 val pp_print_list_endline :
@@ -35,3 +33,5 @@ val pp_print_list_comma :
   (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a list -> unit
 
 val pp_unmark : ('a -> 'b -> 'c) -> 'a -> 'b Pos.marked -> 'c
+
+val format_chain_tag : Format.formatter -> Mast.chain_tag -> unit