Fonction nb_evenements pour l'interpréteur

m_ext/2022/cibles.m

@@ -773,56 +773,6 @@ 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;
@@ -860,7 +810,6 @@ puis_quand nb_anomalies() = 0 faire
 finquand
 calculer cible trace_out;
 #afficher_erreur "]traite_double_liquidation2\n";
-#calculer cible test;
 
 # primitif iterpréteur
 

m_ext/2023/cibles.m

@@ -773,6 +773,57 @@ 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;
+afficher_erreur "nb_evenements() = " (nb_evenements()) "\n";
+
 cible enchainement_primitif:
 application: iliad;
 variable temporaire: EXPORTE_ERREUR;
@@ -810,6 +861,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/m_frontend/check_validity.ml

@@ -1024,6 +1024,9 @@ let rec fold_var_expr
       | Com.PresentFunc ->
           if is_filter then Err.forbidden_expresion_in_filter expr_pos;
           check_func 1
+      | Com.NbEvents ->
+          if is_filter then Err.forbidden_expresion_in_filter expr_pos;
+          check_func 0
       | Com.Func fn ->
           if is_filter then Err.forbidden_expresion_in_filter expr_pos;
           let fd =
@@ -2171,7 +2174,8 @@ let eval_expr_verif (prog : program) (verif : verif)
             | [ Some f ] when f = 0.0 -> None
             | [ r ] -> r
             | _ -> assert false)
-        | Com.PresentFunc | Com.Multimax | Com.Func _ -> assert false)
+        | Com.PresentFunc | Com.Multimax | Com.NbEvents | Com.Func _ ->
+            assert false)
     | Comparison (op, e0, e1) -> (
         match (aux e0, aux e1) with
         | None, _ | _, None -> None

src/mlang/m_frontend/parse_utils.ml

@@ -116,6 +116,7 @@ let parse_function_name f_name =
     | "supzero" -> Supzero
     | "numero_verif" -> VerifNumber
     | "numero_compl" -> ComplNumber
+    | "nb_evenements" -> NbEvents
     | fn -> Func fn
   in
   Pos.map_under_mark map f_name

src/mlang/m_ir/com.ml

@@ -387,6 +387,7 @@ type func =
   | Supzero  (** ??? *)
   | VerifNumber
   | ComplNumber
+  | NbEvents
   | Func of string
 
 type 'v expression =
@@ -618,6 +619,7 @@ let format_func fmt f =
     | Supzero -> "supzero"
     | VerifNumber -> "numero_verif"
     | ComplNumber -> "numero_compl"
+    | NbEvents -> "nb_evenements"
     | Func fn -> fn)
 
 let rec format_expression form_var fmt =

src/mlang/m_ir/com.mli

@@ -245,6 +245,7 @@ type func =
   | Supzero  (** ??? *)
   | VerifNumber
   | ComplNumber
+  | NbEvents
   | Func of string
 
 type 'v expression =

src/mlang/m_ir/mir_interpreter.ml

@@ -47,6 +47,7 @@ module type S = sig
     mutable ctx_nb_bloquantes : int;
     mutable ctx_finalized_anos : (Com.Error.t * string option) list;
     mutable ctx_exported_anos : (Com.Error.t * string option) list;
+    mutable ctx_events : Com.event_value StrMap.t IntMap.t;
   }
 
   val empty_ctx : Mir.program -> ctx
@@ -57,6 +58,9 @@ module type S = sig
 
   val update_ctx_with_inputs : ctx -> Com.literal Com.Var.Map.t -> unit
 
+  val update_ctx_with_events :
+    ctx -> Mir.program -> Com.event_value IntMap.t list -> unit
+
   type run_error =
     | NanOrInf of string * Mir.expression Pos.marked
     | StructuredError of
@@ -123,6 +127,7 @@ struct
     mutable ctx_nb_bloquantes : int;
     mutable ctx_finalized_anos : (Com.Error.t * string option) list;
     mutable ctx_exported_anos : (Com.Error.t * string option) list;
+    mutable ctx_events : Com.event_value StrMap.t IntMap.t;
   }
 
   let empty_ctx (p : Mir.program) : ctx =
@@ -147,6 +152,7 @@ struct
       ctx_nb_bloquantes = 0;
       ctx_finalized_anos = [];
       ctx_exported_anos = [];
+      ctx_events = IntMap.empty;
     }
 
   let literal_to_value (l : Com.literal) : value =
@@ -174,6 +180,50 @@ struct
         ctx.ctx_tgv.(Com.Var.loc_int var) <- value)
       value_inputs
 
+  let update_ctx_with_events (ctx : ctx) (p : Mir.program)
+      (events : Com.event_value IntMap.t list) : unit =
+    let ctx_events =
+      let fold (map, idx) (evt : Com.event_value IntMap.t) =
+        let foldEvt id ev map =
+          match IntMap.find_opt id p.program_event_field_idxs with
+          | Some fname -> (
+              match StrMap.find_opt fname p.program_event_fields with
+              | Some ef -> (
+                  match (ev, ef.is_var) with
+                  | Com.Numeric _, false | Com.RefVar _, true ->
+                      StrMap.add fname ev map
+                  | _ -> Errors.raise_error "Wrong event field type")
+              | None -> Errors.raise_error "Wrong event field")
+          | None ->
+              Errors.raise_error
+                (Format.sprintf "Too much event fields: index %d for size %d" id
+                   (IntMap.cardinal p.program_event_field_idxs))
+        in
+        (IntMap.add idx (IntMap.fold foldEvt evt StrMap.empty) map, idx + 1)
+      in
+      fst (List.fold_left fold (IntMap.empty, 0) events)
+    in
+    let max_field_length =
+      StrMap.fold
+        (fun s _ r -> max r (String.length s))
+        p.program_event_fields 0
+    in
+    let pp_field fmt s =
+      let l = String.length s in
+      Format.fprintf fmt "%s%s" s (String.make (max_field_length - l + 1) ' ')
+    in
+    let pp_ev fmt = function
+      | Com.Numeric None -> Pp.string fmt "indefini"
+      | Com.Numeric (Some f) -> Pp.float fmt f
+      | Com.RefVar v -> Pp.string fmt v
+    in
+    IntMap.iter
+      (fun i m ->
+        Format.eprintf "%d@." i;
+        StrMap.iter (fun s v -> Format.eprintf "  %a%a@." pp_field s pp_ev v) m)
+      ctx_events;
+    ctx.ctx_events <- ctx_events
+
   type run_error =
     | NanOrInf of string * Mir.expression Pos.marked
     | StructuredError of
@@ -419,6 +469,9 @@ struct
                 match !maxi with
                 | None -> Undefined
                 | Some f -> Number (N.of_int f)))
+        | FuncCall ((NbEvents, _), _) ->
+            let card = IntMap.cardinal ctx.ctx_events in
+            Number (N.of_int @@ Int64.of_int @@ card)
         | FuncCall ((Func fn, _), args) ->
             let fd = Com.TargetMap.find fn p.program_functions in
             let atab = Array.of_list (List.map (evaluate_expr ctx p) args) in
@@ -904,6 +957,7 @@ let evaluate_program (p : Mir.program) (inputs : Com.literal Com.Var.Map.t)
   let module Interp = (val get_interp sort roundops : S) in
   let ctx = Interp.empty_ctx p in
   Interp.update_ctx_with_inputs ctx inputs;
+  Interp.update_ctx_with_events ctx p events;
   Interp.evaluate_program p ctx;
   let varMap =
     let fold name (var : Com.Var.t) res =
@@ -919,27 +973,6 @@ let evaluate_program (p : Mir.program) (inputs : Com.literal Com.Var.Map.t)
     in
     StrMap.fold fold p.program_vars StrMap.empty
   in
-  let _eventMap =
-    let fold (map, idx) (evt : Com.event_value IntMap.t) =
-      let foldEvt id ev map =
-        match IntMap.find_opt id p.program_event_field_idxs with
-        | Some fname -> (
-            match StrMap.find_opt fname p.program_event_fields with
-            | Some ef -> (
-                match (ev, ef.is_var) with
-                | Com.Numeric _, false | Com.RefVar _, true ->
-                    StrMap.add fname ev map
-                | _ -> Errors.raise_error "Wrong event field type")
-            | None -> Errors.raise_error "Wrong event field")
-        | None ->
-            Errors.raise_error
-              (Format.sprintf "Too much event fields: index %d for size %d" id
-                 (IntMap.cardinal p.program_event_field_idxs))
-      in
-      (IntMap.add idx (IntMap.fold foldEvt evt StrMap.empty) map, idx + 1)
-    in
-    fst (List.fold_left fold (IntMap.empty, 0) events)
-  in
   let anoSet =
     let fold res (e, _) = StrSet.add (Pos.unmark e.Com.Error.name) res in
     List.fold_left fold StrSet.empty ctx.ctx_exported_anos

src/mlang/m_ir/mir_interpreter.mli

@@ -68,6 +68,7 @@ module type S = sig
     mutable ctx_nb_bloquantes : int;
     mutable ctx_finalized_anos : (Com.Error.t * string option) list;
     mutable ctx_exported_anos : (Com.Error.t * string option) list;
+    mutable ctx_events : Com.event_value StrMap.t IntMap.t;
   }
   (** Interpretation context *)
 
@@ -79,6 +80,9 @@ module type S = sig
 
   val update_ctx_with_inputs : ctx -> Com.literal Com.Var.Map.t -> unit
 
+  val update_ctx_with_events :
+    ctx -> Mir.program -> Com.event_value IntMap.t list -> unit
+
   (** Interpreter runtime errors *)
   type run_error =
     | NanOrInf of string * Mir.expression Pos.marked

src/mlang/utils/pp.ml

@@ -14,6 +14,10 @@ let nil _ _ = ()
 
 let string = Format.pp_print_string
 
+let int = Format.pp_print_int
+
+let float = Format.pp_print_float
+
 let option pp_elt fmt opt = Format.pp_print_option pp_elt fmt opt
 
 let list sep pp_elt fmt l =

src/mlang/utils/pp.mli

@@ -14,6 +14,10 @@ val nil : t -> 'a -> unit
 
 val string : t -> string -> unit
 
+val int : t -> int -> unit
+
+val float : t -> float -> unit
+
 val option : (t -> 'a -> unit) -> t -> 'a option -> unit
 
 val list : (unit, t, unit) format -> (t -> 'a -> unit) -> t -> 'a list -> unit