diff --git a/src/cfg_run.ml b/src/cfg_run.ml index a705b9638cf4d4afd9bc763e31b79e0ac8f1cf82..138c34a4ffbf2dc0c6a2cff5334216153ff8abc4 100644 --- a/src/cfg_run.ml +++ b/src/cfg_run.ml @@ -38,12 +38,12 @@ let rec eval_cfgexpr oc st cp (e: expr) : (int * int state) res = | OK found_f -> (match eval_cfgfun oc st' cp f found_f int_args with | Error msg -> Error msg - | OK (None, st'') -> Error (Format.sprintf "CFG: Function %s doesn't have a return value.\n" f) + | OK (None, st'') -> Error (Format.sprintf "Function %s doesn't have a return value.\n" f) | OK (Some ret, st'') -> OK (ret, st'')) | Error msg -> (match do_builtin oc st.mem f int_args with | Error msg -> Error msg - | OK None -> Error (Format.sprintf "CFG: Function %s doesn't have a return value.\n" f) + | OK None -> Error (Format.sprintf "Function %s doesn't have a return value.\n" f) | OK (Some ret) -> OK (ret, st')) and eval_cfginstr oc st cp ht (n: int): (int * int state) res = diff --git a/src/elang_gen.ml b/src/elang_gen.ml index 675df19008a8c0b0c1bd3c0a197205e27b430037..9df57d0dbc8794ce42a61aa617aa556f16a983fa 100644 --- a/src/elang_gen.ml +++ b/src/elang_gen.ml @@ -70,41 +70,41 @@ let rec type_expr (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ lis (match b with | Eadd -> OK (Tptr ty) | Esub -> OK (Tptr ty) - | _ -> Error "E: Binop is not defined on pointer.") + | _ -> Error "Binop is not defined on pointer.") | Tchar, Tptr ty | Tint, Tptr ty -> (match b with | Eadd -> OK (Tptr ty) - | _ -> Error "E: Binop is not defined on pointer.") + | _ -> Error "Binop is not defined on pointer.") | Tptr ty1, Tptr ty2 -> if binop_is_cmp b then if ty1 = ty2 then OK Tint - else Error "E: Uncomparable pointers." + else Error "Uncomparable pointers." else - Error "E: Binop is not defined on pointer type." + Error "Binop is not defined on pointer type." | _ -> OK (Tint) - else Error "E: Binop is not defined on void type." + else Error "Binop is not defined on void type." | Eunop (u, e) -> type_expr typ_var typ_fun e >>= fun t -> if t != Tvoid && t!= Tptr t then OK Tint - else Error "E: Unop is not defined on void or pointer type." + else Error "Unop is not defined on void or pointer type." | Eint i -> OK Tint | Echar c -> OK Tchar | Evar s -> (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)) + | _ -> Error (Format.sprintf "Expression %s type is not defined." s)) | Ecall (f, exprs) -> (match Hashtbl.find_option typ_fun f with | 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.") + else Error (Format.sprintf "Unvalid argument types in function %s calling." f) + | _ -> Error "Function return type is not defined.") | Eaddrof e -> type_expr typ_var typ_fun e >>= fun t -> OK (Tptr t) @@ -112,7 +112,7 @@ let rec type_expr (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ lis type_expr typ_var typ_fun e >>= fun t -> match t with | Tptr ty -> OK ty - | _ -> Error "E: Unvalid loading." + | _ -> Error "Unvalid loading." let rec addr_taken_expr (e: expr) : string Set.t = match e with @@ -199,7 +199,7 @@ let rec make_einstr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string | Evar s -> if are_compatible te tid then OK (Iassign (s, expr), typ_var) - else Error (Format.sprintf "E: Types %s and %s are not compatible." (string_of_typ tid) (string_of_typ te)) + else Error (Format.sprintf "Types %s and %s are not compatible." (string_of_typ tid) (string_of_typ te)) | Eload ptr_expr -> OK (Istore (ptr_expr, expr), typ_var) | _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s" (string_of_ast a))) | Node(Tif, [e; i1; i2]) -> @@ -225,23 +225,23 @@ let rec make_einstr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string (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) + | None -> Error (Format.sprintf "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))) + else Error (Format.sprintf "Unvalid argument types in function %s calling." f))) | Node (Tdeclare, [TypeLeaf t; StringLeaf s]) -> (if t != Tvoid then (if Hashtbl.mem typ_var s then - Error (Format.sprintf "E: Variable %s already declared." s) + Error (Format.sprintf "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 - Error (Format.sprintf "E: Can not declare void variable.")) + Error (Format.sprintf "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)) @@ -298,7 +298,7 @@ let make_eprog_of_ast (a: tree) : eprog res = match List.assoc_opt fname f_list with | None -> OK (f_list@[fname, Gfun efun]) | Some (Gfun dec) when dec.funbody = Iblock [] -> OK (List.remove_assoc fname f_list @ [fname, Gfun efun]) - | _ -> Error (Format.sprintf "E: Multiple definitions of function %s." fname)) (OK []) l + | _ -> Error (Format.sprintf "Multiple definitions of function %s." fname)) (OK []) l | _ -> Error (Printf.sprintf "make_fundef_of_ast: Expected a Tlistglobdef, got %s." (string_of_ast a)) diff --git a/src/elang_run.ml b/src/elang_run.ml index 2dc808e5047dac3cac84411ef7b291c0ec494c16..f8fb9c05ea05e71e1af17ebea2ab2a7bb7dbb62e 100644 --- a/src/elang_run.ml +++ b/src/elang_run.ml @@ -40,7 +40,7 @@ let rec eval_eexpr oc st (ep: eprog) (typ_var : (string,typ) Hashtbl.t) (typ_fun | None -> OK (Hashtbl.find st.env s, st) | Some ofs -> Mem.read_bytes_as_int st.mem (sp - ofs) (size_type (Hashtbl.find typ_var s)) >>= fun v -> - Printf.printf "Read %d in address %d\n" v (sp - ofs); OK (v, st)) + OK (v, st)) | Ebinop (b, ex, ey) -> eval_eexpr oc st ep typ_var typ_fun inmem_var sp ex >>= fun (x, st') -> eval_eexpr oc st' ep typ_var typ_fun inmem_var sp ey >>= fun (y, st'') -> @@ -72,12 +72,12 @@ let rec eval_eexpr oc st (ep: eprog) (typ_var : (string,typ) Hashtbl.t) (typ_fun eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (p, st') -> type_expr typ_var typ_fun e >>= fun tp -> Mem.read_bytes_as_int st'.mem p (size_type tp) >>= fun v -> - Printf.printf "Read %d in memory address %d\n" v p; OK (v, st') + OK (v, st') | Eaddrof e -> match e with | Evar s -> (match Hashtbl.find_option inmem_var s with - | Some ofs -> Printf.printf "Address of %s evaluated : %d\n" s (sp - ofs); OK (sp - ofs, st) + | Some ofs -> OK (sp - ofs, st) | None -> Error (Format.sprintf "Address of %s not found" s)) | Eload p -> eval_eexpr oc st ep typ_var typ_fun inmem_var sp p | _ -> Error "Type cannot have an address" @@ -111,7 +111,7 @@ and eval_einstr oc (st: int state) (ep: eprog) (typ_var : (string,typ) Hashtbl.t | None -> OK (None, replace st' s v, typ_var) | Some ofs -> Mem.write_bytes st'.mem (sp - ofs) (split_bytes (size_type (Hashtbl.find typ_var s)) v) >>= fun _ -> - Printf.printf "Assigning %d in address %d\n" v (sp - ofs); OK (None, st', typ_var)) + OK (None, st', typ_var)) | Iif (e, i1, i2) -> eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (v, st') -> if v != 0 @@ -165,11 +165,9 @@ and eval_einstr oc (st: int state) (ep: eprog) (typ_var : (string,typ) Hashtbl.t match tp with | Tptr t -> Mem.write_bytes st''.mem addr (split_bytes (size_type t) v) >>= fun u -> - Printf.printf "Storing %d in address %d\n" v addr; OK (None, st'', typ_var) + OK (None, st'', typ_var) | _ -> - Error "Storing in unvalid address" -and print_hashtbl (tbl : (string, int) Hashtbl.t) sp = - Hashtbl.iter (fun key value -> Printf.printf "%s -> %d\n" key (sp - value)) tbl + Error "Storing in unvalid address" (* [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]. @@ -188,8 +186,6 @@ and eval_efun oc (st: int state) ep ({funargs; funbody; funvartyp; funrettype; f let env = Hashtbl.create 17 in match List.iter2 (fun (a, t) v -> Hashtbl.replace env a v) funargs vargs with | () -> - Printf.printf "Stack size = %d\n" funstksz; - print_hashtbl funvarinmem (sp + funstksz); eval_einstr oc { st with env } ep funvartyp typ_fun funvarinmem (sp + funstksz) funbody >>= fun (v, st', _) -> OK (v, { st' with env = env_save }) | exception Invalid_argument _ -> diff --git a/src/linear_run.ml b/src/linear_run.ml index 95514555c56c05ae34f75ab5142a2d3c1318af22..7f8f471c8acc2cf5c80d7e077e4186c06283a26c 100644 --- a/src/linear_run.ml +++ b/src/linear_run.ml @@ -75,7 +75,7 @@ let rec exec_linear_instr oc lp fname f st (i: rtl_instr) = | Error msg -> (match rd_opt, do_builtin oc st.mem g params with | _, Error msg -> Error msg - | Some rd, OK None -> Error (Format.sprintf "RTL: Function %s doesn't have a return value.\n" g) + | Some rd, OK None -> Error (Printf.sprintf "Function %s doesn't have a return value.\n" g) | Some rd, OK (Some ret) -> exec_linear_instr oc lp fname f st (Rconst (rd, ret)) | None, OK _ -> OK(None, st))) | _ -> Error (Printf.sprintf "Function %s applied on undefined register" g) diff --git a/src/rtl_run.ml b/src/rtl_run.ml index 8a1fa9872ceea80eeb2a9878509c1a36683a5b8e..9e4ca5fca88968448fc13a4030f694c5aec38766 100644 --- a/src/rtl_run.ml +++ b/src/rtl_run.ml @@ -92,7 +92,7 @@ let rec exec_rtl_instr oc rp rtlfunname f st (i: rtl_instr) = | Error msg -> (match rd_opt, do_builtin oc st.mem g params with | _, Error msg -> Error msg - | Some rd, OK None -> Error (Format.sprintf "RTL: Function %s doesn't have a return value.\n" g) + | Some rd, OK None -> Error (Printf.sprintf "Function %s doesn't have a return value.\n" g) | Some rd, OK (Some ret) -> exec_rtl_instr oc rp rtlfunname f st (Rconst (rd, ret)) | None, OK _ -> OK(None, st))) | _ -> Error (Printf.sprintf "Function %s applied on undefined register" g) diff --git a/tests/Makefile b/tests/Makefile index d6ec16f0043ce0c983741d86351ac6a573c3c937..40bb123ab5ff3c136f710865ee05674a96302fa6 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -1,7 +1,7 @@ # if make is launched with a DIR variable, pass it as the -f option to test.py # 'make DIR=basic/mul*.e' launches all the files starting with mul in the basic directory # otherwise, use basic/*.e as a default -FILES := $(if $(DIR),$(DIR),ptr/*.e) +FILES := $(if $(DIR),$(DIR),char/*.e) OPTS := $(if $(OPTS), $(OPTS),)