open Pp open Printf (* Les valeurs *) type valeur = | Entier of int | Booléen of bool | Tableau of valeur array | Indéfinie ;; (* Les erreurs de l'évaluateur *) type erreur_exécution = Indice of int * valeur | Type of string * valeur | Définition_de_type of string * type_expr list * valeur list * type_expr option * bool | Libre of string ;; exception Exécution of erreur_exécution;; let erreur err = raise (Exécution err);; (* Pour extraires les valeurs du bon type *) let int = function Entier i -> i | v -> erreur (Type ("entier", v)) let bool = function Booléen b -> b | v -> erreur (Type ("booléen", v)) let array = function Tableau t -> t | v -> erreur (Type ("tableau", v)) ;; (* Environnements *) (* L'environnement comprend trois composantes: -- les liaisons globales -- les définitions -- les liaisons locales Seules les variables locales changent au cours de l'évaluation *) type environnement = { definitions : (string * definition) list; global : (string * valeur ref) list; local : (string * valeur ref) list; } (* Chacune de ses composantes est une liste d'association *) let ajoute env env0 = {env with local = env0 @ env.local } let remplace env env0 = {env with local = env0 } let cherche env x = try List.assoc x env.local with Not_found -> try List.assoc x env.global with Not_found -> erreur (Libre x) ;; let cherche_definition env x = try List.assoc x env.definitions with Not_found -> erreur (Libre x);; (* Une variable est mise dans l'environnement avec une valeur indéfinie *) let alloue_var (x, ty) = x, ref Indéfinie;; let rec instruction env = function | Sequence code -> List.iter (instruction env) code | While (e, i) -> while bool (expression env e) do instruction env i done | If (e, i1, i2) -> if bool (expression env e) then instruction env i1 else instruction env i2 | Set (x,e) -> (cherche env x) := expression env e | Seti (e1, e2, e3) -> let v1 = expression env e1 in let t = array v1 in let k = int (expression env e2) in if k < 0 || k >= Array.length t then erreur (Indice (k, v1)) else t.(k) <- expression env e3 | Procedure_call (f, args) -> call env false f args; () | Write_int e -> print_int (int (expression env e)) | Writeln_int e -> print_int (int (expression env e)); print_newline() | Read_int x -> cherche env x := Entier (read_int()) and expression env = function | Get x -> !(cherche env x) | Geti (e1,e2) -> let v1 = expression env e1 in let t = array v1 in let k = int (expression env e2) in if k < 0 || k >= Array.length t then erreur (Indice (k, v1)) else t.(k) | Alloc (e1,t) -> let k = int (expression env e1) in Tableau (Array.create k Indéfinie) | Function_call (f, args) -> call env true f args | Bin (op, e1, e2) -> let n1 = int (expression env e1) in let n2 = int (expression env e2) in begin match op with Plus -> Entier (n1 + n2) | Minus -> Entier (n1 - n2) | Times -> Entier (n1 * n2) | Div -> Entier (n1 / n2) | Le -> Booléen (n1 <= n2) | Lt -> Booléen (n1 < n2) | Ge -> Booléen (n1 >= n2) | Gt -> Booléen (n1 > n2) | Eq -> Booléen (n1 = n2) | Ne -> Booléen (n1 <> n2) end | Int n -> Entier n | Bool n -> Booléen n and call env true_si_fonction f args = (* on évalue les arguements *) let arguments_évalués = List.map (expression env) args in (* on cherche la fonction *) let définition = cherche_definition env f in (* on lie les noms des arguments à leur valeur *) let liaisons_des_arguments = try List.map2 (fun (x, ty) v -> x, ref v) définition.arguments arguments_évalués with Invalid_argument _ -> erreur (Définition_de_type (f, List.map snd définition.arguments, arguments_évalués, définition.result, true_si_fonction)) in (* on crée les liaisons locales *) let liaisons_locales = List.map alloue_var définition.local_vars in (* le résultat est une valeur indéfinie *) let r = ref Indéfinie in (* on ajoute une liaison pour le résultat si besoin *) let liaison_du_résultat = match définition.result, true_si_fonction with | Some ty, true -> [ f, r ] | None, false -> [] | x, b -> erreur (Définition_de_type (f, List.map snd définition.arguments, arguments_évalués, x, b)) in (* l'environnement d'exécution du coprs de la définition *) let nouvel_env = {env with local = liaisons_locales @ liaison_du_résultat @ liaisons_des_arguments} in instruction nouvel_env définition.body; !r ;; (* Pour la mise au point et pour reporter les erreurs *) let rec print_result out = function Entier n -> fprintf out "%d" n | Booléen true -> fprintf out "true" | Booléen false -> fprintf out "false" | Tableau t -> fprintf out "[|"; Array.iter (fun v -> print_result out v; fprintf out "; ") t; fprintf out "|]"; | Indéfinie -> fprintf out "" ;; let print_erreur out = function | Type (s, v) -> fprintf out "La valeur trouvée n'est pas du type %s attendu\n %a" s print_result v | Indice (k, v) -> fprintf out "L'indice %d est en dehors des bornes du tableau\n %a" k print_result v | Définition_de_type (f, ty_args, args, ty_r, r) -> fprintf out "Appel à %s\n%s" f (if List.length ty_args <> List.length args then "Mauvaise arité" else if r && ty_r <> None then "Fonction trouvée à la place d'une procédure attendue" else "Procédure trouvée à la place d'une fonction attendue"); | Libre s -> fprintf out "la variable %s est libre" s ;; (* L'évaluation d'un programme *) let eval p = let env = { global = List.map alloue_var p.global_vars; definitions = p.Pp.definitions; local = [] } in try instruction env p.main with Exécution x -> fprintf stderr "Erreur d'éxécution:\n%a" print_erreur x; prerr_newline(); exit 1 ;;