Skip to content
Snippets Groups Projects
Commit 9510950f authored by Sellami Youssef's avatar Sellami Youssef
Browse files

Types : local variables handling

parent 18fb82ae
No related branches found
No related tags found
1 merge request!3Master
Hide whitespace changes
Inline Side-by-side
src/cfg_gen.ml
+ 3
− 1
View file @ 9510950f
......@@ -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
......
src/elang_gen.ml
+ 50
− 42
View file @ 9510950f
......@@ -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."
......
src/elang_run.ml
+ 19
− 39
View file @ 9510950f
......@@ -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].
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment