From 9510950fce1b66a1f38c316657b88578b702536f Mon Sep 17 00:00:00 2001
From: Youssef <youssef.sellami@student-cs.fr>
Date: Thu, 20 Mar 2025 13:15:29 +0100
Subject: [PATCH] Types : local variables handling
---
src/cfg_gen.ml | 4 ++-
src/elang_gen.ml | 92 ++++++++++++++++++++++++++----------------------
src/elang_run.ml | 58 ++++++++++--------------------
3 files changed, 72 insertions(+), 82 deletions(-)
diff --git a/src/cfg_gen.ml b/src/cfg_gen.ml
index 5831632..f347f98 100644
--- a/src/cfg_gen.ml
+++ b/src/cfg_gen.ml
@@ -74,7 +74,9 @@ let rec cfg_node_of_einstr (next: int) (cfg : (int, cfg_node) Hashtbl.t)
list_map_res cfg_expr_of_eexpr args >>= fun es ->
Hashtbl.replace cfg next (Ccall (f, es, succ));
OK (next, next + 1)
- | Elang.Ideclare (_, s) -> cfg_node_of_einstr next cfg succ (Elang.Iassign (s, Eint 0))
+ | Elang.Ideclare (_, _) ->
+ Hashtbl.replace cfg next (Cnop succ);
+ OK (next, next + 1)
(* Some nodes may be unreachable after the CFG is entirely generated. The
[reachable_nodes n cfg] constructs the set of node identifiers that are
diff --git a/src/elang_gen.ml b/src/elang_gen.ml
index d191bbd..63fe655 100644
--- a/src/elang_gen.ml
+++ b/src/elang_gen.ml
@@ -61,9 +61,13 @@ let rec type_expr (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ lis
(match Hashtbl.find_option typ_var s with
| Some t when t != Tvoid -> OK t
| _ -> Error (Format.sprintf "E: Expression %s type is not defined." s))
- | Ecall (f, _) ->
+ | Ecall (f, exprs) ->
match Hashtbl.find_option typ_fun f with
- | Some (_, t) when t != Tvoid -> OK t
+ | Some (arg_types, ret_type) when ret_type != Tvoid ->
+ list_map_res (type_expr typ_var typ_fun) exprs >>= fun types ->
+ if types = arg_types
+ then OK ret_type
+ else Error (Format.sprintf "E: Unvalid argument types in function %s calling." f)
| _ -> Error "E: Function return type is not defined."
let are_compatible (t1 : typ) (t2 : typ) : bool =
@@ -102,56 +106,60 @@ let rec make_eexpr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string,
| Error msg -> Error (Format.sprintf "In make_eexpr_of_ast %s:\n%s"
(string_of_ast a) msg)
-let rec make_einstr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (a: tree) : instr res =
+let rec make_einstr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (a: tree) : (instr * (string,typ) Hashtbl.t)res =
let res =
match a with
(* TODO *)
+ (* typ_var a été ajouté à la valeur de retour de cette fonction
+ pour permettre la gestion des variables locales dans les if et while. *)
| Node(Tassign, [StringLeaf s; e]) ->
make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
type_expr typ_var typ_fun expr >>= fun te ->
type_expr typ_var typ_fun (Evar s) >>= fun ts ->
if are_compatible te ts
- then OK (Iassign (s, expr))
+ then OK (Iassign (s, expr), typ_var)
else Error (Format.sprintf "E: Types %s and %s are not compatible." (string_of_typ ts) (string_of_typ te))
- | Node(Tif, [e; i1; i2]) ->
- make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
- type_expr typ_var typ_fun expr >>= fun te ->
- make_einstr_of_ast typ_var typ_fun i1 >>= fun instr1 ->
- make_einstr_of_ast typ_var typ_fun i2 >>= fun instr2 ->
- OK (Iif (expr, instr1, instr2))
- | Node(Twhile, [e; i]) ->
- make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
- type_expr typ_var typ_fun expr >>= fun te ->
- make_einstr_of_ast typ_var typ_fun i >>= fun instr ->
- OK (Iwhile (expr, instr))
- | Node(Tblock, i_list) ->
- list_map_res (make_einstr_of_ast typ_var typ_fun) i_list >>= fun instr_list ->
- OK (Iblock instr_list)
- | Node(Treturn, [e]) ->
- make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
- type_expr typ_var typ_fun expr >>= fun te ->
- OK (Ireturn expr)
- | Node(Tcall, [StringLeaf f; Node(Targs, args)]) ->
- list_map_res (make_eexpr_of_ast typ_var typ_fun) args >>= fun exprs ->
- list_map_res (type_expr typ_var typ_fun) exprs >>= fun types ->
- (match Hashtbl.find_option typ_fun f with
- | None -> Error (Format.sprintf "E: Unknown argument types of function %s." f)
- | Some (arg_types, ret_type) ->
- if types = arg_types
- then OK (Icall (f, exprs))
- else Error (Format.sprintf "E: Unvalid argument types in function %s calling." f))
- | Node (Tdeclare, [TypeLeaf t; StringLeaf s]) ->
- if t != Tvoid
- then
- if Hashtbl.mem typ_var s
+ | Node(Tif, [e; i1; i2]) ->
+ make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
+ make_einstr_of_ast typ_var typ_fun i1 >>= fun (instr1, new_typ_var) ->
+ make_einstr_of_ast typ_var typ_fun i2 >>= fun (instr2, new_typ_var) ->
+ OK (Iif (expr, instr1, instr2), typ_var)
+ | Node(Twhile, [e; i]) ->
+ make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
+ make_einstr_of_ast typ_var typ_fun i >>= fun (instr, new_typ_var) ->
+ OK (Iwhile (expr, instr), typ_var)
+ | Node(Tblock, i_list) ->
+ List.fold_left (fun acc i ->
+ acc >>= fun (cur_i_list, cur_typ_var) ->
+ make_einstr_of_ast cur_typ_var typ_fun i >>= fun (instr, new_typ_var) ->
+ OK(cur_i_list@[instr], new_typ_var))
+ (OK([], typ_var)) i_list >>= fun (instr_list, new_typ_var) ->
+ OK(Iblock(instr_list), new_typ_var)
+ | Node(Treturn, [e]) ->
+ make_eexpr_of_ast typ_var typ_fun e >>= fun expr ->
+ OK (Ireturn expr, typ_var)
+ | Node(Tcall, [StringLeaf f; Node(Targs, args)]) ->
+ (list_map_res (make_eexpr_of_ast typ_var typ_fun) args >>= fun exprs ->
+ list_map_res (type_expr typ_var typ_fun) exprs >>= fun types ->
+ (match Hashtbl.find_option typ_fun f with
+ | None -> Error (Format.sprintf "E: Unknown argument types of function %s." f)
+ | Some (arg_types, ret_type) ->
+ if types = arg_types
+ then OK (Icall (f, exprs), typ_var)
+ else Error (Format.sprintf "E: Unvalid argument types in function %s calling." f)))
+ | Node (Tdeclare, [TypeLeaf t; StringLeaf s]) ->
+ (if t != Tvoid
then
- Error (Format.sprintf "E: Variable %s already declared." s)
+ (if Hashtbl.mem typ_var s
+ then
+ Error (Format.sprintf "E: Variable %s already declared." s)
+ else
+ let new_typ_var = Hashtbl.copy typ_var
+ in Hashtbl.add new_typ_var s t;
+ OK (Ideclare (t ,s), new_typ_var))
else
- (Hashtbl.add typ_var s t;
- OK (Ideclare (t ,s)))
- else
- Error (Format.sprintf "E: Can not declare void variable.")
- | NullLeaf -> OK (Iblock [])
+ Error (Format.sprintf "E: Can not declare void variable."))
+ | NullLeaf -> OK (Iblock [], typ_var)
| _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s"
(string_of_ast a))
in
@@ -174,7 +182,7 @@ let make_fundef_of_ast (typ_fun : (string, typ list * typ) Hashtbl.t) (a: tree)
let typ_var = Hashtbl.of_list fargs
in let arg_types = List.map (fun (arg, typ) -> typ) fargs
in Hashtbl.add typ_fun fname (arg_types, t);
- make_einstr_of_ast typ_var typ_fun fbody >>= fun fbody ->
+ make_einstr_of_ast typ_var typ_fun fbody >>= fun (fbody, _) ->
OK (fname, {funargs = fargs; funbody = fbody; funvartyp = typ_var; funrettype = t})
| _ ->
Error (Printf.sprintf "make_fundef_of_ast: Expected a Tfundef, got %s."
diff --git a/src/elang_run.ml b/src/elang_run.ml
index 92b77fb..ced1357 100644
--- a/src/elang_run.ml
+++ b/src/elang_run.ml
@@ -4,10 +4,6 @@ open Prog
open Utils
open Builtins
-let remove_local_vars st local_st =
- let filtered_env = Hashtbl.filteri (fun k v -> if Hashtbl.mem st.env k then (Printf.printf "Not removing %s\n" k; true) else (Printf.printf "removing %s\n" k; false) ) local_st.env
- in {local_st with env = filtered_env}
-
let binop_bool_to_int f x y = if f x y then 1 else 0
(* [eval_binop b x y] évalue l'opération binaire [b] sur les arguments [x]
@@ -38,10 +34,7 @@ let eval_unop (u: unop) : int -> int =
let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res =
match e with
| Eint i -> OK (i, st)
- | Evar s ->
- (match Hashtbl.find_option st.env s with
- | Some i -> OK (i, st)
- | None -> Error "Variable is not defined")
+ | Evar s -> OK (Hashtbl.find st.env s, st)
| Ebinop (b, ex, ey) ->
eval_eexpr oc st ep ex >>= fun (x, st') ->
eval_eexpr oc st' ep ey >>= fun (y, st'') ->
@@ -58,15 +51,11 @@ let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res =
(OK([], st)) args >>= fun(int_args, st') ->
match find_function ep f with
| OK found_f ->
- (match eval_efun oc st' ep found_f f int_args with
- | Error msg -> Error msg
- | OK (None, st'') -> Error (Format.sprintf "E: Function %s doesn't have a return value.\n" f)
- | OK (Some ret, st'') -> OK (ret, st''))
+ eval_efun oc st' ep found_f f int_args >>= fun (ret_opt, st'') ->
+ OK (Option.get ret_opt, st'')
| Error msg ->
- (match do_builtin oc st'.mem f int_args with
- | Error msg -> Error msg
- | OK None -> Error (Format.sprintf "E: Function %s doesn't have a return value.\n" f)
- | OK (Some ret) -> OK (ret, st')))
+ do_builtin oc st'.mem f int_args >>= fun (ret_opt) ->
+ OK (Option.get ret_opt, st'))
| Echar c -> OK (Char.code c, st)
(* [eval_einstr oc st ins] évalue l'instruction [ins] en partant de l'état [st].
@@ -84,32 +73,26 @@ let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res =
and eval_einstr oc (st: int state) (ep: eprog) (ins: instr) :
(int option * int state) res =
match ins with
- | Iassign (s, e) ->
- if Hashtbl.mem st.env s
- then
- (let replace st s v =
- let new_env = Hashtbl.copy st.env
- in Hashtbl.replace new_env s v;
- {st with env = new_env}
- in match eval_eexpr oc st ep e with
- | Error msg -> Error msg
- | OK (v, st') -> OK (None, replace st' s v))
- else
- Error (Format.sprintf "E: Variable %s was not declared." s)
+ | Iassign (s, e) ->
+ (let replace st s v =
+ let new_env = Hashtbl.copy st.env
+ in Hashtbl.replace new_env s v;
+ {st with env = new_env}
+ in match eval_eexpr oc st ep e with
+ | Error msg -> Error msg
+ | OK (v, st') -> OK (None, replace st' s v))
| Iif (e, i1, i2) ->
- (eval_eexpr oc st ep e >>= fun (v, st') ->
+ eval_eexpr oc st ep e >>= fun (v, st') ->
if v != 0
- then eval_einstr oc st' ep i1 >>= fun (r_opt, st'') ->
- OK (r_opt, remove_local_vars st' st'')
- else eval_einstr oc st' ep i2 >>= fun (r_opt, st'') ->
- OK (r_opt, remove_local_vars st' st''))
+ then eval_einstr oc st' ep i1
+ else eval_einstr oc st' ep i2
| Iwhile (e, i) ->
(eval_eexpr oc st ep e >>= fun (v, st') ->
if v != 0
then eval_einstr oc st' ep i >>= fun (r_opt, next_st) ->
match r_opt with
- | None -> eval_einstr oc (remove_local_vars st' next_st) ep (Iwhile (e, i))
- | Some r -> OK (r_opt, remove_local_vars st' next_st)
+ | None -> eval_einstr oc next_st ep (Iwhile (e, i))
+ | Some r -> OK (r_opt, next_st)
else OK (None, st'))
| Iblock i_list ->
(match i_list with
@@ -136,10 +119,7 @@ and eval_einstr oc (st: int state) (ep: eprog) (ins: instr) :
| Error msg ->
(do_builtin oc st'.mem f int_args >>= fun _ ->
OK (None, st')))
- | Ideclare (_, s) ->
- let new_env = Hashtbl.copy st.env
- in Hashtbl.add new_env s 0;
- OK (None, {st with env = new_env})
+ | Ideclare (_, s) -> OK (None, st)
(* [eval_efun oc st f fname vargs] évalue la fonction [f] (dont le nom est
[fname]) en partant de l'état [st], avec les arguments [vargs].
--
GitLab