Itérateur sur les valeurs.

m_ext/2022/cibles.m

@@ -773,6 +773,56 @@ si nb_discordances() + nb_informatives() > 0 alors
   exporte_erreurs;
 finsi
 
+fonction truc:
+application: iliad;
+argument: A0, A1;
+resultat: RES;
+variable temporaire: TOTO;
+#V_IND_TRAIT = 4;
+afficher_erreur "truc\n" indenter(2);
+TOTO = 1;
+iterer
+: variable I
+: A0 .. A1 increment 1
+: dans (
+  si I = A0 alors
+    RES = 1;
+  sinon
+    RES = 2 * RES + TOTO;
+  finsi
+  afficher_erreur (I) ": " (RES) "\n";
+)
+afficher_erreur indenter(-2);
+
+cible test_boucle:
+application: iliad;
+argument: I0, I1;
+variable temporaire: TOTO;
+TOTO = 0;
+iterer
+: variable I
+: I0 .. I1 increment 0.7
+: 2 .. 1 increment -1
+: dans (
+  iterer
+  : variable J
+  : -3 .. -1 increment 1
+  : 1 .. 0 increment -1
+  : dans (
+    afficher_erreur nom(I) " = " (I) ", " nom(J) " = " (J) "\n";
+  )
+)
+TOTO = truc(TOTO, truc(4, truc(7, 9)));
+afficher_erreur "truc: " (TOTO) "\n";
+
+cible test:
+application: iliad;
+variable temporaire: A0, A1;
+A0 = 1.6;
+A1 = 3.6;
+calculer cible test_boucle : avec A0, A1;
+
+
 cible enchainement_primitif:
 application: iliad;
 variable temporaire: EXPORTE_ERREUR;
@@ -810,6 +860,7 @@ puis_quand nb_anomalies() = 0 faire
 finquand
 calculer cible trace_out;
 #afficher_erreur "]traite_double_liquidation2\n";
+#calculer cible test;
 
 # primitif iterpréteur
 

src/mlang/backend_compilers/bir_to_dgfip_c.ml

@@ -642,6 +642,58 @@ let rec generate_stmt (dgfip_flags : Dgfip_options.flags)
               pr "@]@;}@;")
             vcs)
         var_params
+  | Iterate_values (m_var, var_intervals, stmts) ->
+      let pr fmt = Format.fprintf oc fmt in
+      let var = Pos.unmark m_var in
+      let itval_def = VID.gen_def var "" in
+      let itval_val = VID.gen_val var "" in
+      let itval_name = fresh_c_local "iterate_values" in
+      let itval_e0_val = Format.sprintf "%s_e0" itval_name in
+      let itval_e1_val = Format.sprintf "%s_e1" itval_name in
+      let itval_step_val = Format.sprintf "%s_step" itval_name in
+      let itval_e0_def = Format.sprintf "%s_def" itval_e0_val in
+      let itval_e1_def = Format.sprintf "%s_def" itval_e1_val in
+      let itval_step_def = Format.sprintf "%s_def" itval_step_val in
+      List.iter
+        (fun (e0, e1, step) ->
+          let locals_e0, set_e0, def_e0, value_e0 =
+            D.build_expression @@ generate_c_expr e0
+          in
+          let locals_e1, set_e1, def_e1, value_e1 =
+            D.build_expression @@ generate_c_expr e1
+          in
+          let locals_step, set_step, def_step, value_step =
+            D.build_expression @@ generate_c_expr step
+          in
+          pr "@[<v 2>{@;";
+          pr "char %s;@;double %s;@;" itval_e0_def itval_e0_val;
+          pr "char %s;@;double %s;@;" itval_e1_def itval_e1_val;
+          pr "char %s;@;double %s;@;" itval_step_def itval_step_val;
+          pr "%a" D.format_local_declarations locals_e0;
+          pr "%a" D.format_local_declarations locals_e1;
+          pr "%a" D.format_local_declarations locals_step;
+          pr "%a" (D.format_set_vars dgfip_flags) set_e0;
+          pr "%a" (D.format_set_vars dgfip_flags) set_e1;
+          pr "%a" (D.format_set_vars dgfip_flags) set_step;
+          pr "%a@;" (D.format_assign dgfip_flags itval_e0_def) def_e0;
+          pr "%a@;" (D.format_assign dgfip_flags itval_e1_def) def_e1;
+          pr "%a@;" (D.format_assign dgfip_flags itval_step_def) def_step;
+          pr "%a@;" (D.format_assign dgfip_flags itval_e0_val) value_e0;
+          pr "%a@;" (D.format_assign dgfip_flags itval_e1_val) value_e1;
+          pr "%a@;" (D.format_assign dgfip_flags itval_step_val) value_step;
+          pr "@[<hov 2>if(%s && %s && %s && %s != 0.0){@;" itval_e0_def
+            itval_e1_def itval_step_def itval_step_val;
+          pr
+            "@[<hov 2>for(%s = 1, %s = %s; (%s > 0.0 ? %s <= %s : %s >= %s); \
+             %s = %s + %s){@;"
+            itval_def itval_val itval_e0_val itval_step_val itval_val
+            itval_e1_val itval_val itval_e1_val itval_val itval_val
+            itval_step_val;
+          pr "%a@]@;" (generate_stmts dgfip_flags program) stmts;
+          pr "}@;";
+          pr "@]@;}@;";
+          pr "@]@;}")
+        var_intervals
   | Restore (vars, var_params, stmts) ->
       let pr fmt = Format.fprintf oc fmt in
       pr "@[<v 2>{@;";

src/mlang/m_frontend/check_validity.ml

@@ -282,6 +282,12 @@ module Err = struct
     let msg = Format.sprintf "result missing in function %s" fn in
     Errors.raise_spanned_error msg pos
 
+  let forbidden_in_var_in_function vn fn pos =
+    let msg =
+      Format.sprintf "variable %s cannot be read in function %s" vn fn
+    in
+    Errors.raise_spanned_error msg pos
+
   let forbidden_out_var_in_function vn fn pos =
     let msg =
       Format.sprintf "variable %s cannot be written in function %s" vn fn
@@ -1350,7 +1356,6 @@ let rec check_instructions (instrs : Mast.instruction Pos.marked list)
             let res_instr = Com.Iterate (var, vars, var_params, res_instrs) in
             aux (env, (res_instr, instr_pos) :: res, in_vars, out_vars) il
         | Com.Iterate_values (var, var_intervals, instrs) ->
-            if is_rule then Err.insruction_forbidden_in_rules instr_pos;
             let var_pos = Pos.get_position var in
             let var_name =
               match Pos.unmark var with
@@ -1375,18 +1380,30 @@ let rec check_instructions (instrs : Mast.instruction Pos.marked list)
                 tmp_vars = StrMap.add var_name (None, var_pos) env.tmp_vars;
               }
             in
-            List.iter
-              (fun (e0, e1) ->
-                ignore (check_expression false e0 env);
-                ignore (check_expression false e1 env))
-              var_intervals;
-            let prog, res_instrs, _, _ =
+            let in_exprs =
+              List.fold_left
+                (fun in_exprs (e0, e1, step) ->
+                  in_exprs
+                  |> StrSet.union (check_expression false e0 env)
+                  |> StrSet.union (check_expression false e1 env)
+                  |> StrSet.union (check_expression false step env))
+                StrSet.empty var_intervals
+            in
+            let prog, res_instrs, in_instrs, out_instrs =
               check_instructions instrs is_rule env'
             in
             let env = { env with prog } in
             let res_instr =
               Com.Iterate_values (var, var_intervals, res_instrs)
             in
+            let in_vars =
+              in_vars
+              |> StrSet.union
+                   (in_exprs |> StrSet.union in_instrs |> StrSet.remove var_name)
+            in
+            let out_vars =
+              out_vars |> StrSet.union (out_instrs |> StrSet.remove var_name)
+            in
             aux (env, (res_instr, instr_pos) :: res, in_vars, out_vars) il
         | Com.Restore (vars, var_params, instrs) ->
             if is_rule then Err.insruction_forbidden_in_rules instr_pos;
@@ -1539,15 +1556,24 @@ let check_target (is_function : bool) (t : Mast.target) (prog : program) :
     let res_var = target_result in
     let prog, target_prog =
       let env = { prog; tmp_vars; ref_vars; res_var } in
-      let prog, target_prog, _in_vars, out_vars =
+      let prog, target_prog, in_vars, out_vars =
         check_instructions t.target_prog is_function env
       in
-      (if is_function then
-       let vr = Pos.unmark (Option.get target_result) in
-       let bad_out_vars = StrSet.remove vr out_vars in
-       if StrSet.card bad_out_vars > 0 then
-         let vn = StrSet.min_elt bad_out_vars in
-         Err.forbidden_out_var_in_function vn tname tpos);
+      if is_function then (
+        let vr = Pos.unmark (Option.get target_result) in
+        let bad_in_vars =
+          List.fold_left
+            (fun res (vn, _) -> StrSet.remove vn res)
+            in_vars target_args
+          |> StrSet.remove vr
+        in
+        let bad_out_vars = StrSet.remove vr out_vars in
+        (if StrSet.card bad_in_vars > 0 then
+         let vn = StrSet.min_elt bad_in_vars in
+         Err.forbidden_in_var_in_function vn tname tpos);
+        if StrSet.card bad_out_vars > 0 then
+          let vn = StrSet.min_elt bad_out_vars in
+          Err.forbidden_out_var_in_function vn tname tpos);
       (prog, target_prog)
     in
     let target =
@@ -2590,12 +2616,13 @@ let complete_vars_stack (prog : program) : program =
           let nbRef = 1 + max nbRef nbRef' in
           (nb, sz, nbRef, tdata)
       | Com.Iterate_values (_, me2l, instrs) ->
-          let fold (nb, sz, nbRef, tdata) (me0, me1) =
+          let fold (nb, sz, nbRef, tdata) (me0, me1, mstep) =
             let nb', sz', nbRef', tdata = aux_expr tdata me0 in
             let nb'', sz'', nbRef'', tdata = aux_expr tdata me1 in
-            let nb = max nb (max nb' nb'') in
-            let sz = max sz (max sz' sz'') in
-            let nbRef = max nbRef (max nbRef' nbRef'') in
+            let nb''', sz''', nbRef''', tdata = aux_expr tdata mstep in
+            let nb = max nb (max nb' (max nb'' nb''')) in
+            let sz = max sz (max sz' (max sz'' sz''')) in
+            let nbRef = max nbRef (max nbRef' (max nbRef'' nbRef''')) in
             (nb, sz, nbRef, tdata)
           in
           let nb', sz', nbRef', tdata =

src/mlang/m_frontend/expand_macros.ml

@@ -712,10 +712,11 @@ let rec expand_instruction (const_map : const_context)
   | Com.Iterate_values (name, var_intervals, instrs) ->
       let var_intervals' =
         List.map
-          (fun (e0, e1) ->
+          (fun (e0, e1, step) ->
             let e0' = expand_expression const_map ParamsMap.empty e0 in
             let e1' = expand_expression const_map ParamsMap.empty e1 in
-            (e0', e1'))
+            let step' = expand_expression const_map ParamsMap.empty step in
+            (e0', e1', step'))
           var_intervals
       in
       let instrs' = expand_instructions const_map instrs in

src/mlang/m_frontend/mast_to_mir.ml

@@ -172,7 +172,7 @@ let rec translate_expression (cats : Com.CatVar.data Com.CatVar.Map.t)
 
 let rec translate_prog (error_decls : Com.Error.t StrMap.t)
     (cats : Com.CatVar.data Com.CatVar.Map.t) (var_data : Com.Var.t StrMap.t)
-    (it_depth : int) prog =
+    (it_depth : int) (itval_depth : int) prog =
   let rec aux res = function
     | [] -> List.rev res
     | (Com.Affectation (Com.SingleFormula (v, idx, e), _), pos) :: il ->
@@ -297,10 +297,48 @@ let rec translate_prog (error_decls : Com.Error.t StrMap.t)
             var_params
         in
         let prog_it =
-          translate_prog error_decls cats var_data (it_depth + 1) instrs
+          translate_prog error_decls cats var_data (it_depth + 1) itval_depth
+            instrs
         in
         let m_var = Pos.same_pos_as var vn in
         aux ((Com.Iterate (m_var, vars', var_params', prog_it), pos) :: res) il
+    | (Com.Iterate_values (vn, var_intervals, instrs), pos) :: il ->
+        let var_pos = Pos.get_position vn in
+        let var_name =
+          match Pos.unmark vn with
+          | Mast.Normal name -> name
+          | Mast.Generic _ -> assert false
+        in
+        (match StrMap.find_opt var_name var_data with
+        | Some v ->
+            let msg =
+              Format.asprintf "variable already declared %a" Pos.format_position
+                (Pos.get_position v.name)
+            in
+            Errors.raise_spanned_error msg pos
+        | _ -> ());
+        let var =
+          Com.Var.new_temp ~name:(var_name, var_pos) ~is_table:None
+            ~loc_int:itval_depth
+        in
+        let var_data = StrMap.add var_name var var_data in
+        let var_intervals' =
+          List.map
+            (fun (e0, e1, step) ->
+              let e0' = translate_expression cats var_data e0 in
+              let e1' = translate_expression cats var_data e1 in
+              let step' = translate_expression cats var_data step in
+              (e0', e1', step'))
+            var_intervals
+        in
+        let prog_it =
+          translate_prog error_decls cats var_data it_depth (itval_depth + 1)
+            instrs
+        in
+        let m_var = Pos.same_pos_as var vn in
+        aux
+          ((Com.Iterate_values (m_var, var_intervals', prog_it), pos) :: res)
+          il
     | (Com.Restore (vars, var_params, instrs), pos) :: il ->
         let vars' =
           List.map
@@ -325,7 +363,7 @@ let rec translate_prog (error_decls : Com.Error.t StrMap.t)
             var_params
         in
         let prog_rest =
-          translate_prog error_decls cats var_data it_depth instrs
+          translate_prog error_decls cats var_data it_depth itval_depth instrs
         in
         aux ((Com.Restore (vars', var_params', prog_rest), pos) :: res) il
     | (Com.RaiseError (err_name, var_opt), pos) :: il ->
@@ -370,7 +408,7 @@ let get_targets (is_function : bool) (error_decls : Com.Error.t StrMap.t)
             t.target_args
       in
       let target_sz_tmps = t.target_sz_tmps in
-      let tmp_var_data, _ =
+      let tmp_var_data, itval_depth =
         StrMap.fold
           (fun name ((_, pos), size) (tmp_var_data, n) ->
             let size' = Pos.unmark_option (Mast.get_table_size_opt size) in
@@ -410,7 +448,7 @@ let get_targets (is_function : bool) (error_decls : Com.Error.t StrMap.t)
       let target_prog =
         translate_prog error_decls cats tmp_var_data
           (List.length target_args - target_nb_refs)
-          t.target_prog
+          itval_depth t.target_prog
       in
       let target_data =
         Mir.

src/mlang/m_frontend/mlexer.mll

@@ -91,6 +91,7 @@ rule token = parse
     | "finquand" -> ENDWHEN
     | "finsi" -> ENDIF
     | "fonction" -> FONCTION
+    | "increment" -> STEP
     | "indefini" -> UNDEFINED
     | "indenter" -> INDENT
     | "informative" -> INFORMATIVE

src/mlang/m_frontend/mparser.mly

@@ -58,7 +58,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 %token INFORMATIVE OUTPUT FONCTION VARIABLE ATTRIBUT
 %token BASE GIVEN_BACK COMPUTABLE BY_DEFAULT
 %token DOMAIN SPECIALIZE AUTHORIZE VERIFIABLE
-%token EVENT VALUE
+%token EVENT VALUE STEP
 
 %token EOF
 
@@ -685,7 +685,7 @@ instruction:
     | (`VarInterval _, _) :: _ ->
         let var_intervals =
           let fold var_intervals = function
-          | (`VarInterval (e0, e1), _) -> (e0, e1) :: var_intervals
+          | (`VarInterval (e0, e1, step), _) -> (e0, e1, step) :: var_intervals
           | (`VarList _, pos) | (`VarCatsIt _, pos) ->
               Errors.raise_spanned_error "variable descriptors forbidden in values iteration" pos
           in
@@ -830,8 +830,10 @@ it_param:
     in
     `VarCatsIt (vcats, expr)
   }
-| expr0 = with_pos(expression) RANGE expr1 = with_pos(expression) COLON {
-    `VarInterval (expr0, expr1)
+| expr0 = with_pos(expression) RANGE expr1 = with_pos(expression)
+  STEP step = with_pos(expression) COLON {
+
+    `VarInterval (expr0, expr1, step)
   }
 
 it_param_with_expr:

src/mlang/m_ir/com.ml

@@ -483,7 +483,7 @@ type ('v, 'e) instruction =
       * ('v, 'e) m_instruction list
   | Iterate_values of
       'v Pos.marked
-      * ('v m_expression * 'v m_expression) list
+      * ('v m_expression * 'v m_expression * 'v m_expression) list
       * ('v, 'e) m_instruction list
   | Restore of
       'v Pos.marked list
@@ -776,9 +776,10 @@ let rec format_instruction form_var form_err =
           var_params;
         Format.fprintf fmt "@[<h 2>  %a@]@\n)@\n" form_instrs itb
     | Iterate_values (var, var_intervals, itb) ->
-        let format_var_intervals fmt (e0, e1) =
-          Format.fprintf fmt ": %a .. %a@\n" form_expr (Pos.unmark e0) form_expr
-            (Pos.unmark e1)
+        let format_var_intervals fmt (e0, e1, step) =
+          Format.fprintf fmt ": %a .. %a increment %a@\n" form_expr
+            (Pos.unmark e0) form_expr (Pos.unmark e1) form_expr
+            (Pos.unmark step)
         in
         Format.fprintf fmt "iterate variable %a@;: %a@;: dans (" form_var
           (Pos.unmark var)