diff --git a/m_ext/2022/cibles.m b/m_ext/2022/cibles.m index 1e2e351b2..4448b011c 100644 --- a/m_ext/2022/cibles.m +++ b/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 diff --git a/m_ext/2023/cibles.m b/m_ext/2023/cibles.m index f1120323b..f6bcb2621 100644 --- a/m_ext/2023/cibles.m +++ b/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 diff --git a/src/mlang/m_frontend/check_validity.ml b/src/mlang/m_frontend/check_validity.ml index f9a2ad26e..5aed941e3 100644 --- a/src/mlang/m_frontend/check_validity.ml +++ b/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 diff --git a/src/mlang/m_frontend/parse_utils.ml b/src/mlang/m_frontend/parse_utils.ml index 3cbb37d78..c87d2ab9c 100644 --- a/src/mlang/m_frontend/parse_utils.ml +++ b/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 diff --git a/src/mlang/m_ir/com.ml b/src/mlang/m_ir/com.ml index 260aae7d8..a2b62e7f1 100644 --- a/src/mlang/m_ir/com.ml +++ b/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 = diff --git a/src/mlang/m_ir/com.mli b/src/mlang/m_ir/com.mli index 1229ad48e..81bb884d0 100644 --- a/src/mlang/m_ir/com.mli +++ b/src/mlang/m_ir/com.mli @@ -245,6 +245,7 @@ type func = | Supzero (** ??? *) | VerifNumber | ComplNumber + | NbEvents | Func of string type 'v expression = diff --git a/src/mlang/m_ir/mir_interpreter.ml b/src/mlang/m_ir/mir_interpreter.ml index 84be16716..274deae79 100644 --- a/src/mlang/m_ir/mir_interpreter.ml +++ b/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 diff --git a/src/mlang/m_ir/mir_interpreter.mli b/src/mlang/m_ir/mir_interpreter.mli index edc70dfc0..55a8aa5e5 100644 --- a/src/mlang/m_ir/mir_interpreter.mli +++ b/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 diff --git a/src/mlang/utils/pp.ml b/src/mlang/utils/pp.ml index 4a62ef722..ebbff394c 100644 --- a/src/mlang/utils/pp.ml +++ b/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 = diff --git a/src/mlang/utils/pp.mli b/src/mlang/utils/pp.mli index 894618f2a..0e660cdb7 100644 --- a/src/mlang/utils/pp.mli +++ b/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