From 0959b54aa819f6938a577036cc05555cc7454517 Mon Sep 17 00:00:00 2001 From: Youssef <youssef.sellami@student-cs.fr> Date: Sun, 16 Mar 2025 21:47:29 +0100 Subject: [PATCH 1/8] Grammar correction --- expr_grammar_action.g | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/expr_grammar_action.g b/expr_grammar_action.g index b871578..5ab84b3 100644 --- a/expr_grammar_action.g +++ b/expr_grammar_action.g @@ -11,7 +11,7 @@ non-terminals MUL_EXPRS MUL_EXPR non-terminals CMP_EXPRS CMP_EXPR non-terminals EQ_EXPRS EQ_EXPR -non-terminals AFTER_IDENTIFIER LARGS REST_ARGS +non-terminals AFTER_IDENTIFIER_INSTR AFTER_IDENTIFIER_FACTOR LARGS REST_ARGS axiom S { @@ -44,12 +44,12 @@ FUNDEF -> IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS INSTR { Node(Tfun LPARAMS -> IDENTIFIER REST_PARAMS { Node(Targ, [$1])::$2 } LPARAMS -> { [] } -REST_PARAMS -> SYM_COMMA LPARAMS { $2 } +REST_PARAMS -> SYM_COMMA IDENTIFIER REST_PARAMS { Node(Targ, [$2])::$3 } REST_PARAMS -> { [] } LARGS -> EXPR REST_ARGS { $1::$2 } LARGS -> { [] } -REST_ARGS -> SYM_COMMA LARGS { $2 } +REST_ARGS -> SYM_COMMA EXPR REST_ARGS { $2::$3 } REST_ARGS -> { [] } LINSTRS -> INSTR INSTRS { Node(Tblock, $1::$2) } @@ -61,7 +61,7 @@ INSTR -> SYM_IF SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS SYM_LBRACE LINSTRS SYM_RB INSTR -> SYM_WHILE SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS INSTR { Node(Twhile, [$3; $5]) } INSTR -> SYM_RETURN EXPR SYM_SEMICOLON { Node(Treturn, [$2]) } INSTR -> SYM_PRINT SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS SYM_SEMICOLON { Node(Tprint, [$3]) } -INSTR -> IDENTIFIER AFTER_IDENTIFIER SYM_SEMICOLON { +INSTR -> IDENTIFIER AFTER_IDENTIFIER_INSTR SYM_SEMICOLON { match $2 with | Assign exp -> Node(Tassign, [$1; exp]) | Funcall args -> Node(Tcall, [$1; Node(Targs, args)]) @@ -69,9 +69,8 @@ INSTR -> IDENTIFIER AFTER_IDENTIFIER SYM_SEMICOLON { } INSTR -> SYM_LBRACE LINSTRS SYM_RBRACE { $2 } -AFTER_IDENTIFIER -> SYM_ASSIGN EXPR { Assign $2 } -AFTER_IDENTIFIER -> SYM_LPARENTHESIS LARGS SYM_RPARENTHESIS { Funcall $2 } -AFTER_IDENTIFIER -> { Nothing } +AFTER_IDENTIFIER_INSTR -> SYM_ASSIGN EXPR { Assign $2 } +AFTER_IDENTIFIER_INSTR -> SYM_LPARENTHESIS LARGS SYM_RPARENTHESIS { Funcall $2 } ELSE -> SYM_ELSE SYM_LBRACE LINSTRS SYM_RBRACE { $3 } ELSE -> { NullLeaf } @@ -104,7 +103,7 @@ MUL_EXPRS -> SYM_MOD MUL_EXPR MUL_EXPRS { (Tmod, $2)::$3 } MUL_EXPRS -> { [] } FACTOR -> INTEGER { $1 } -FACTOR -> IDENTIFIER AFTER_IDENTIFIER { +FACTOR -> IDENTIFIER AFTER_IDENTIFIER_FACTOR { match $2 with | Funcall args -> Node(Tcall, [$1; Node(Targs, args)]) | Nothing -> $1 @@ -114,3 +113,6 @@ FACTOR -> SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS { $2 } IDENTIFIER -> SYM_IDENTIFIER {StringLeaf $1} INTEGER -> SYM_INTEGER {IntLeaf $1} + +AFTER_IDENTIFIER_FACTOR -> { Nothing } +AFTER_IDENTIFIER_FACTOR -> SYM_LPARENTHESIS LARGS SYM_RPARENTHESIS { Funcall $2 } -- GitLab From d793658b4103b64701a3f7d2ca4159a275b0d180 Mon Sep 17 00:00:00 2001 From: Youssef <youssef.sellami@student-cs.fr> Date: Mon, 17 Mar 2025 00:53:44 +0100 Subject: [PATCH 2/8] Built-in functions --- expr_grammar_action.g | 3 +- src/ast.ml | 3 +- src/cfg.ml | 4 --- src/cfg_gen.ml | 5 ---- src/cfg_liveness.ml | 1 - src/cfg_nop_elim.ml | 1 - src/cfg_print.ml | 2 -- src/cfg_run.ml | 35 ++++++++++++++-------- src/e_regexp.ml | 1 - src/elang.ml | 1 - src/elang_gen.ml | 5 ---- src/elang_print.ml | 3 -- src/elang_run.ml | 27 +++++++++-------- src/lexer.mll | 1 - src/linear_liveness.ml | 2 -- src/linear_run.ml | 27 +++++++++-------- src/ltl_gen.ml | 20 ------------- src/parser.ml | 1 - src/rtl.ml | 2 -- src/rtl_gen.ml | 3 -- src/rtl_print.ml | 1 - src/rtl_run.ml | 28 +++++++++-------- src/symbols.ml | 2 -- src/yaccparser.mly | 3 +- tests/funcall/argswap.e.expect_lexer | 8 ++--- tests/funcall/print_and_fun.e.expect_lexer | 4 +-- 26 files changed, 74 insertions(+), 119 deletions(-) diff --git a/expr_grammar_action.g b/expr_grammar_action.g index 5ab84b3..60a5b34 100644 --- a/expr_grammar_action.g +++ b/expr_grammar_action.g @@ -1,6 +1,6 @@ tokens SYM_EOF SYM_IDENTIFIER<string> SYM_INTEGER<int> SYM_PLUS SYM_MINUS SYM_ASTERISK SYM_DIV SYM_MOD tokens SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE -tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA SYM_PRINT +tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA tokens SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ non-terminals S INSTR<tree> INSTRS<tree list> LINSTRS ELSE EXPR FACTOR non-terminals LPARAMS REST_PARAMS @@ -60,7 +60,6 @@ INSTRS -> { [] } INSTR -> SYM_IF SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS SYM_LBRACE LINSTRS SYM_RBRACE ELSE { Node(Tif, [$3; $6; $8]) } INSTR -> SYM_WHILE SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS INSTR { Node(Twhile, [$3; $5]) } INSTR -> SYM_RETURN EXPR SYM_SEMICOLON { Node(Treturn, [$2]) } -INSTR -> SYM_PRINT SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS SYM_SEMICOLON { Node(Tprint, [$3]) } INSTR -> IDENTIFIER AFTER_IDENTIFIER_INSTR SYM_SEMICOLON { match $2 with | Assign exp -> Node(Tassign, [$1; exp]) diff --git a/src/ast.ml b/src/ast.ml index cfb67d6..7560fa6 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -22,7 +22,7 @@ open Batteries *) -type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tprint +type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tint | Tadd | Tmul | Tdiv | Tmod | Txor | Tsub | Tclt | Tcgt | Tcle | Tcge | Tceq | Tne @@ -51,7 +51,6 @@ let string_of_tag = function | Twhile -> "Twhile" | Tblock -> "Tblock" | Treturn -> "Treturn" - | Tprint -> "Tprint" | Tint -> "Tint" | Tadd -> "Tadd" | Tmul -> "Tmul" diff --git a/src/cfg.ml b/src/cfg.ml index 2a60c97..467b19b 100644 --- a/src/cfg.ml +++ b/src/cfg.ml @@ -13,7 +13,6 @@ type expr = type cfg_node = | Cassign of string * expr * int | Creturn of expr - | Cprint of expr * int | Ccmp of expr * int * int | Cnop of int | Ccall of string * expr list * int @@ -32,7 +31,6 @@ type cprog = cfg_fun prog let succs cfg n = match Hashtbl.find_option cfg n with | None -> Set.empty - | Some (Cprint (_, s)) | Some (Cassign (_, _, s)) -> Set.singleton s | Some (Creturn _) -> Set.empty | Some (Ccmp (_, s1, s2)) -> Set.of_list [s1;s2] @@ -45,7 +43,6 @@ let preds cfgfunbody n = Hashtbl.fold (fun m m' acc -> match m' with | Cassign (_, _, s) - | Cprint (_, s) | Cnop s | Ccall (_, _, s) -> if s = n then Set.add m acc else acc | Creturn _ -> acc @@ -71,7 +68,6 @@ let size_instr (i: cfg_node) : int = match (i : cfg_node) with | Cassign (_, e, _) -> 1 + size_expr e | Creturn e -> 1 + (size_expr e) - | Cprint (e, _) -> 1 + (size_expr e) | Ccmp (e, _, _) -> 1 + size_expr e | Cnop _ -> 1 | Ccall (_, args, _) -> 1 + List.fold_left (fun acc arg -> acc + size_expr arg) 0 args diff --git a/src/cfg_gen.ml b/src/cfg_gen.ml index ff2aa1b..f009b7b 100644 --- a/src/cfg_gen.ml +++ b/src/cfg_gen.ml @@ -69,10 +69,6 @@ let rec cfg_node_of_einstr (next: int) (cfg : (int, cfg_node) Hashtbl.t) | Elang.Ireturn e -> cfg_expr_of_eexpr e >>= fun e -> Hashtbl.replace cfg next (Creturn e); OK (next, next + 1) - | Elang.Iprint e -> - cfg_expr_of_eexpr e >>= fun e -> - Hashtbl.replace cfg next (Cprint (e,succ)); - OK (next, next + 1) | Elang.Icall (f, args) -> list_map_res cfg_expr_of_eexpr args >>= fun es -> Hashtbl.replace cfg next (Ccall (f, es, succ)); @@ -89,7 +85,6 @@ let rec reachable_nodes n (cfg: (int,cfg_node) Hashtbl.t) = match Hashtbl.find_option cfg n with | None -> reach | Some (Cnop succ) - | Some (Cprint (_, succ)) | Some (Cassign (_, _, succ)) -> reachable_aux succ reach | Some (Creturn _) -> reach | Some (Ccmp (_, s1, s2)) -> diff --git a/src/cfg_liveness.ml b/src/cfg_liveness.ml index aa40206..0ecbbc3 100644 --- a/src/cfg_liveness.ml +++ b/src/cfg_liveness.ml @@ -32,7 +32,6 @@ let live_cfg_node (node: cfg_node) (live_after: string Set.t) = match node with | Cassign (s, e, i) -> vars_in_expr e | Creturn e -> vars_in_expr e - | Cprint (e, i) -> vars_in_expr e | Ccmp (e, i1, i2) -> vars_in_expr e | Cnop (i) -> Set.empty | Ccall (f, args, i) -> vars_in_expr (Ecall (f, args)) diff --git a/src/cfg_nop_elim.ml b/src/cfg_nop_elim.ml index dba2b51..4592c82 100644 --- a/src/cfg_nop_elim.ml +++ b/src/cfg_nop_elim.ml @@ -64,7 +64,6 @@ let replace_succs nop_succs (n: cfg_node) = (* TODO *) match n with | Cassign (s, e, i) -> Cassign (s, e, replace_succ nop_succs i) - | Cprint (e, i) -> Cprint (e, replace_succ nop_succs i) | Ccmp (e, i1, i2) -> Ccmp (e, replace_succ nop_succs i1, replace_succ nop_succs i2) | Cnop i -> Cnop (replace_succ nop_succs i) | Creturn e -> Creturn e diff --git a/src/cfg_print.ml b/src/cfg_print.ml index a452410..d7bc988 100644 --- a/src/cfg_print.ml +++ b/src/cfg_print.ml @@ -17,7 +17,6 @@ let dump_list_cfgexpr l = let dump_arrows oc fname n (node: cfg_node) = match node with | Cassign (_, _, succ) - | Cprint (_, succ) | Cnop succ | Ccall (_, _, succ) -> Format.fprintf oc "n_%s_%d -> n_%s_%d\n" fname n fname succ @@ -30,7 +29,6 @@ let dump_arrows oc fname n (node: cfg_node) = let dump_cfg_node oc (node: cfg_node) = match node with | Cassign (v, e, _) -> Format.fprintf oc "%s = %s" v (dump_cfgexpr e) - | Cprint (e, _) -> Format.fprintf oc "print %s" (dump_cfgexpr e) | Creturn e -> Format.fprintf oc "return %s" (dump_cfgexpr e) | Ccmp (e, _, _) -> Format.fprintf oc "%s" (dump_cfgexpr e) | Cnop _ -> Format.fprintf oc "nop" diff --git a/src/cfg_run.ml b/src/cfg_run.ml index e2e4212..a705b96 100644 --- a/src/cfg_run.ml +++ b/src/cfg_run.ml @@ -34,12 +34,18 @@ let rec eval_cfgexpr oc st cp (e: expr) : (int * int state) res = | Error msg -> Error msg | OK (i, st'') -> OK ((l@[i]), st'') ) (OK([], st)) args >>= fun (int_args, st') -> - find_function cp f >>= fun 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 (Some ret, st'') -> OK (ret, st'') - + match find_function cp f with + | 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 (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 (Some ret) -> OK (ret, st')) + and eval_cfginstr oc st cp ht (n: int): (int * int state) res = match Hashtbl.find_option ht n with | None -> Error (Printf.sprintf "Invalid node identifier\n") @@ -57,10 +63,6 @@ and eval_cfginstr oc st cp ht (n: int): (int * int state) res = | Creturn(e) -> eval_cfgexpr oc st cp e >>= fun (e, st') -> OK (e, st') - | Cprint(e, succ) -> - eval_cfgexpr oc st cp e >>= fun (e, st') -> - Format.fprintf oc "%d\n" e; - eval_cfginstr oc st' cp ht succ | Ccall (f, args, succ) -> List.fold_left ( fun (acc : (int list * int state) res) (arg : expr) -> @@ -72,9 +74,16 @@ and eval_cfginstr oc st cp ht (n: int): (int * int state) res = | OK (i, st'') -> OK ((l@[i]), st'') ) (OK([], st)) args >>= fun (int_args, st') -> - find_function cp f >>= fun found_f -> - eval_cfgfun oc st' cp f found_f int_args >>= fun (ret, st'') -> - eval_cfginstr oc st'' cp ht succ + match find_function cp f with + | OK found_f -> + (match eval_cfgfun oc st' cp f found_f int_args with + | Error msg -> Error msg + | OK (_, st'') -> eval_cfginstr oc st'' cp ht succ) + | Error msg -> + (match do_builtin oc st'.mem f int_args with + | OK _ -> eval_cfginstr oc st' cp ht succ + | Error msg -> Error msg ) + and eval_cfgfun oc st cp cfgfunname { cfgfunargs; cfgfunbody; diff --git a/src/e_regexp.ml b/src/e_regexp.ml index a87413d..e909133 100644 --- a/src/e_regexp.ml +++ b/src/e_regexp.ml @@ -74,7 +74,6 @@ let list_regexp : (regexp * (string -> token option)) list = (keyword_regexp "if", fun _ -> Some (SYM_IF)); (keyword_regexp "else", fun _ -> Some (SYM_ELSE)); (keyword_regexp "return", fun _ -> Some (SYM_RETURN)); - (keyword_regexp "print", fun _ -> Some (SYM_PRINT)); (keyword_regexp "struct", fun _ -> Some (SYM_STRUCT)); (char_regexp '.', fun _ -> Some (SYM_POINT)); (char_regexp '+', fun _ -> Some (SYM_PLUS)); diff --git a/src/elang.ml b/src/elang.ml index 38b4f66..03d287f 100644 --- a/src/elang.ml +++ b/src/elang.ml @@ -17,7 +17,6 @@ type instr = | Iwhile of expr * instr | Iblock of instr list | Ireturn of expr - | Iprint of expr | Icall of string * expr list type efun = { diff --git a/src/elang_gen.ml b/src/elang_gen.ml index 1d4db2d..54e9203 100644 --- a/src/elang_gen.ml +++ b/src/elang_gen.ml @@ -108,11 +108,6 @@ let rec make_einstr_of_ast (a: tree) : instr res = in match res_of_e with | OK exp -> OK (Ireturn exp) | Error msg -> Error msg) - | Node(Tprint, [e]) -> - (let res_of_e = make_eexpr_of_ast e - in match res_of_e with - | OK exp -> OK (Iprint exp) - | Error msg -> Error msg) | Node(Tcall, [StringLeaf f; Node(Targs, args)]) -> (let res = list_map_res make_eexpr_of_ast args in match res with diff --git a/src/elang_print.ml b/src/elang_print.ml index 8f7f8cf..8e4d55d 100644 --- a/src/elang_print.ml +++ b/src/elang_print.ml @@ -56,9 +56,6 @@ let rec dump_einstr_rec indent oc i = | Ireturn(e) -> print_spaces oc indent; Format.fprintf oc "return %s;\n" (dump_eexpr e) - | Iprint(e) -> - print_spaces oc indent; - Format.fprintf oc "print %s;\n" (dump_eexpr e) | Icall(f, args) -> print_spaces oc indent; Format.fprintf oc "%s(%s);\n" f (String.concat ", " (List.map dump_eexpr args)) diff --git a/src/elang_run.ml b/src/elang_run.ml index 880e938..4a5bd71 100644 --- a/src/elang_run.ml +++ b/src/elang_run.ml @@ -2,6 +2,7 @@ open Elang open Batteries open Prog open Utils +open Builtins let binop_bool_to_int f x y = if f x y then 1 else 0 @@ -65,13 +66,16 @@ let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res = | Error msg -> Error msg | OK (int_args, st') -> match find_function ep f with - | Error msg -> Error msg | OK found_f -> - match eval_efun oc st' ep found_f f int_args with + (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'') - + | 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 "E: Function %s doesn't have a return value.\n" f) + | OK (Some ret) -> OK (ret, st')) (* [eval_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st]. @@ -125,12 +129,6 @@ and eval_einstr oc (st: int state) (ep: eprog) (ins: instr) : (match eval_eexpr oc st ep e with | Error msg -> Error msg | OK (v, st') -> OK(Some v, st')) - | Iprint e -> - (match eval_eexpr oc st ep e with - | Error msg -> Error msg - | OK (v, st') -> - Format.fprintf oc "%d\n" v; - OK(None, st')) | Icall (f, args) -> let (res : (int list * int state) res) = List.fold_left ( fun (acc : (int list * int state) res) (arg : expr) -> @@ -145,11 +143,14 @@ and eval_einstr oc (st: int state) (ep: eprog) (ins: instr) : | Error msg -> Error msg | OK (int_args, st') -> match find_function ep f with - | Error msg -> Error msg | OK found_f -> - match eval_efun oc st' ep found_f f int_args with + (match eval_efun oc st' ep found_f f int_args with | Error msg -> Error msg - | OK (_, st'') -> OK (None, st'') + | OK (_, st'') -> OK (None, st'')) + | Error msg -> + (match do_builtin oc st'.mem f int_args with + | OK _ -> OK (None, st') + | Error msg -> Error msg ) (* [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]. diff --git a/src/lexer.mll b/src/lexer.mll index 9aa999d..f4ac582 100644 --- a/src/lexer.mll +++ b/src/lexer.mll @@ -30,7 +30,6 @@ rule token = parse | "void" { SYM_VOID } | "char" { SYM_CHAR } | "int" { SYM_INT } - | "print" { SYM_PRINT } | "struct" { SYM_STRUCT } | "if" { SYM_IF } | "else" { SYM_ELSE } diff --git a/src/linear_liveness.ml b/src/linear_liveness.ml index 5082e7f..d8fe1aa 100644 --- a/src/linear_liveness.ml +++ b/src/linear_liveness.ml @@ -8,7 +8,6 @@ open Rtl let gen_live (i: rtl_instr) = match i with | Rbinop (b, rd, rs1, rs2) -> Set.of_list [rs1; rs2] - | Rprint rs | Runop (_, _, rs) -> Set.singleton rs | Rconst (_, _) -> Set.empty | Rbranch (_, rs1, rs2, _) -> Set.of_list [rs1; rs2] @@ -26,7 +25,6 @@ let kill_live (i: rtl_instr) = | Rmov (rd,_) | Rcall (Some rd, _, _) -> Set.singleton rd | Rbranch (_, _, _, _) - | Rprint _ | Rret _ | Rjmp _ | Rlabel _ diff --git a/src/linear_run.ml b/src/linear_run.ml index 8051790..9551455 100644 --- a/src/linear_run.ml +++ b/src/linear_run.ml @@ -47,13 +47,6 @@ let rec exec_linear_instr oc lp fname f st (i: rtl_instr) = OK (None, st) | _ -> Error (Printf.sprintf "Mov on undefined register (%s)" (print_reg rs)) end - | Rprint r -> - begin match Hashtbl.find_option st.regs r with - | Some s -> - Format.fprintf oc "%d\n" s; - OK (None, st) - | _ -> Error (Printf.sprintf "Print on undefined register (%s)" (print_reg r)) - end | Rret r -> begin match Hashtbl.find_option st.regs r with | Some s -> OK (Some s, st) @@ -71,12 +64,20 @@ let rec exec_linear_instr oc lp fname f st (i: rtl_instr) = | Some v -> Some (vs@[v]))) (Some []) args in match vs_opt with - | Some params -> find_function lp g >>= fun found_g -> - (match rd_opt, exec_linear_fun oc lp st g found_g params with - | _, Error msg -> Error msg - | Some rd, OK (Some ret, st') -> exec_linear_instr oc lp fname f st' (Rconst (rd, ret)) - | Some rd, OK (None, st') -> Error (Printf.sprintf "Function %s doesn't have a return value" g) - | None, OK (_, st') -> OK(None, st')) + | Some params -> + (match find_function lp g with + | OK found_g -> + (match rd_opt, exec_linear_fun oc lp st g found_g params with + | _, Error msg -> Error msg + | Some rd, OK (Some ret, st') -> exec_linear_instr oc lp fname f st' (Rconst (rd, ret)) + | Some rd, OK (None, st') -> Error (Printf.sprintf "Function %s doesn't have a return value" g) + | None, OK (_, st') -> OK(None, st')) + | 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 (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) end diff --git a/src/ltl_gen.ml b/src/ltl_gen.ml index 581f0c9..dbe0e57 100644 --- a/src/ltl_gen.ml +++ b/src/ltl_gen.ml @@ -217,7 +217,6 @@ let written_rtl_regs_instr (i: rtl_instr) = | Rconst (rd, _) | Rmov (rd, _) | Rcall (Some rd, _, _)-> Set.singleton rd - | Rprint _ | Rret _ | Rlabel _ | Rbranch (_, _, _, _) @@ -228,7 +227,6 @@ let read_rtl_regs_instr (i: rtl_instr) = match i with | Rbinop (_, _, rs1, rs2) | Rbranch (_, rs1, rs2, _) -> Set.of_list [rs1; rs2] - | Rprint rs | Runop (_, _, rs) | Rmov (_, rs) | Rret rs -> Set.singleton rs @@ -302,24 +300,6 @@ let ltl_instrs_of_linear_instr fname live_out allocation load_loc reg_tmp1 allocation rs >>= fun (ls, rs) -> store_loc reg_tmp1 allocation rd >>= fun (ld, rd) -> OK (ls @ LMov(rd, rs) :: ld) - | Rprint r -> - let (save_a_regs, arg_saved, ofs) = - save_caller_save - (range 32) - (- (numspilled+1)) in - let parameter_passing = - match Hashtbl.find_option allocation r with - | None -> Error (Format.sprintf "Could not find allocation for register %d\n" r) - | Some (Reg rs) -> OK [LMov(reg_a0, rs)] - | Some (Stk o) -> OK [LLoad(reg_a0, reg_fp, (Archi.wordsize ()) * o, (archi_mas ()))] - in - parameter_passing >>= fun parameter_passing -> - OK (LComment "Saving a0-a7,t0-t6" :: save_a_regs @ - LAddi(reg_sp, reg_s0, (Archi.wordsize ()) * (ofs + 1)) :: - parameter_passing @ - LCall "print" :: - LComment "Restoring a0-a7,t0-t6" :: restore_caller_save arg_saved) - | Rret r -> load_loc reg_tmp1 allocation r >>= fun (l,r) -> OK (l @ [LMov (reg_ret, r) ; LJmp epilogue_label]) diff --git a/src/parser.ml b/src/parser.ml index 2e2c5f0..44e6a89 100644 --- a/src/parser.ml +++ b/src/parser.ml @@ -53,7 +53,6 @@ let to_yacc_token = function | SYM_LBRACKET -> Yaccparser.SYM_LBRACKET | SYM_RBRACKET -> Yaccparser.SYM_RBRACKET | SYM_ALLOC -> Yaccparser.SYM_ALLOC -| SYM_PRINT -> Yaccparser.SYM_PRINT | SYM_EXTERN -> Yaccparser.SYM_EXTERN | SYM_INCLUDE(s) -> Yaccparser.SYM_INCLUDE s | SYM_AMPERSAND -> Yaccparser.SYM_AMPERSAND diff --git a/src/rtl.ml b/src/rtl.ml index 0360732..18d5f7d 100644 --- a/src/rtl.ml +++ b/src/rtl.ml @@ -14,7 +14,6 @@ type rtl_instr = Rbinop of binop * reg * reg * reg | Rmov of reg * reg | Rret of reg | Rlabel of int - | Rprint of reg | Rcall of reg option * string * reg list type rtl_fun = { rtlfunargs: reg list; @@ -29,7 +28,6 @@ let written_rtl_regs_instr (i: rtl_instr) = | Runop (_, rd, _) | Rconst (rd, _) | Rmov (rd, _) -> Set.singleton rd - | Rprint _ | Rret _ | Rlabel _ | Rbranch (_, _, _, _) diff --git a/src/rtl_gen.ml b/src/rtl_gen.ml index e49d304..0dde9d9 100644 --- a/src/rtl_gen.ml +++ b/src/rtl_gen.ml @@ -90,9 +90,6 @@ let rtl_instrs_of_cfg_node ((next_reg:int), (var2reg: (string*int) list)) (c: cf | Creturn e -> let r_e, l, next_reg', var2reg' = rtl_instrs_of_cfg_expr (next_reg, var2reg) e in (l@[Rret r_e], next_reg', var2reg') - | Cprint (e, i) -> - let r_e, l, next_reg', var2reg' = rtl_instrs_of_cfg_expr (next_reg, var2reg) e - in (l@[Rprint r_e; Rjmp i], next_reg', var2reg') | Ccmp (e, i1, i2) -> let cmp, e1, e2 = rtl_cmp_of_cfg_expr e in let r1, l1, next_reg1, var2reg1 = rtl_instrs_of_cfg_expr (next_reg, var2reg) e1 diff --git a/src/rtl_print.ml b/src/rtl_print.ml index a9c1224..a2837a7 100644 --- a/src/rtl_print.ml +++ b/src/rtl_print.ml @@ -39,7 +39,6 @@ let dump_rtl_instr name (live_in, live_out) ?(endl="\n") oc (i: rtl_instr) = Format.fprintf oc "jmp %s" (print_node s) | Rmov (rd, rs) -> Format.fprintf oc "%s <- %s" (print_reg rd) (print_reg rs) | Rret r -> Format.fprintf oc "ret %s" (print_reg r) - | Rprint r -> Format.fprintf oc "print %s" (print_reg r) | Rlabel n -> Format.fprintf oc "%s_%d:" name n | Rcall (rd_opt, f, regs) -> match rd_opt with diff --git a/src/rtl_run.ml b/src/rtl_run.ml index fb7a809..8a1fa98 100644 --- a/src/rtl_run.ml +++ b/src/rtl_run.ml @@ -69,13 +69,6 @@ let rec exec_rtl_instr oc rp rtlfunname f st (i: rtl_instr) = | Some s -> OK (Some s, st) | _ -> Error (Printf.sprintf "Ret on undefined register (%s)" (print_reg r)) end - | Rprint r -> - begin match Hashtbl.find_option st.regs r with - | Some s -> - Format.fprintf oc "%d\n" s; - OK (None, st) - | _ -> Error (Printf.sprintf "Print on undefined register (%s)" (print_reg r)) - end | Rlabel n -> OK (None, st) | Rcall (rd_opt, g, args) -> begin @@ -88,13 +81,22 @@ let rec exec_rtl_instr oc rp rtlfunname f st (i: rtl_instr) = | Some v -> Some (vs@[v]))) (Some []) args in match vs_opt with - | Some params -> find_function rp g >>= fun found_g -> - (match rd_opt, exec_rtl_fun oc rp st g found_g params with - | _, Error msg -> Error msg - | Some rd, OK (Some ret, st') -> exec_rtl_instr oc rp rtlfunname f st' (Rconst (rd, ret)) - | Some rd, OK (None, st') -> Error (Printf.sprintf "Function %s doesn't have a return value" g) - | None, OK (_, st') -> OK(None, st')) + | Some params -> + (match find_function rp g with + | OK found_g -> + (match rd_opt, exec_rtl_fun oc rp st g found_g params with + | _, Error msg -> Error msg + | Some rd, OK (Some ret, st') -> exec_rtl_instr oc rp rtlfunname f st' (Rconst (rd, ret)) + | Some rd, OK (None, st') -> Error (Printf.sprintf "Function %s doesn't have a return value" g) + | None, OK (_, st') -> OK(None, st')) + | 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 (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) + end and exec_rtl_instr_at oc rp rtlfunname ({ rtlfunbody; } as f: rtl_fun) st i = diff --git a/src/symbols.ml b/src/symbols.ml index 71760ef..ce80f81 100644 --- a/src/symbols.ml +++ b/src/symbols.ml @@ -50,7 +50,6 @@ type token = | SYM_LBRACKET | SYM_RBRACKET | SYM_ALLOC - | SYM_PRINT | SYM_EXTERN | SYM_INCLUDE of string | SYM_AMPERSAND @@ -99,7 +98,6 @@ let string_of_symbol = function | SYM_LBRACKET -> "SYM_LBRACKET" | SYM_RBRACKET -> "SYM_RBRACKET" | SYM_ALLOC -> "SYM_ALLOC" -| SYM_PRINT -> "SYM_PRINT" | SYM_EXTERN -> "SYM_EXTERN" | SYM_INCLUDE(s) -> Printf.sprintf "SYM_INCLUDE(%s)" s | SYM_AMPERSAND -> "SYM_AMPERSAND" diff --git a/src/yaccparser.mly b/src/yaccparser.mly index 3c9a390..f335483 100644 --- a/src/yaccparser.mly +++ b/src/yaccparser.mly @@ -14,7 +14,7 @@ %token<int> SYM_INTEGER %token SYM_PLUS SYM_MINUS SYM_ASTERISK SYM_DIV SYM_MOD %token SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE -%token SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA SYM_PRINT +%token SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA %token SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ %left SYM_EQUALITY SYM_NOTEQ @@ -68,7 +68,6 @@ | SYM_IF SYM_LPARENTHESIS expr SYM_RPARENTHESIS linstrs ntelse { Node (Tif, [$3; $5; $6]) } | SYM_WHILE SYM_LPARENTHESIS expr SYM_RPARENTHESIS instr { Node( Twhile, [$3; $5]) } | SYM_RETURN expr SYM_SEMICOLON { Node(Treturn, [$2]) } - | SYM_PRINT expr SYM_SEMICOLON { Node(Tprint, [$2]) } | linstrs { $1 }; ntelse : SYM_ELSE linstrs { $2 } diff --git a/tests/funcall/argswap.e.expect_lexer b/tests/funcall/argswap.e.expect_lexer index 89b98c3..2c8a87d 100644 --- a/tests/funcall/argswap.e.expect_lexer +++ b/tests/funcall/argswap.e.expect_lexer @@ -5,12 +5,12 @@ SYM_COMMA SYM_IDENTIFIER(b) SYM_RPARENTHESIS SYM_LBRACE -SYM_PRINT +SYM_IDENTIFIER(print) SYM_LPARENTHESIS SYM_IDENTIFIER(a) SYM_RPARENTHESIS SYM_SEMICOLON -SYM_PRINT +SYM_IDENTIFIER(print) SYM_LPARENTHESIS SYM_IDENTIFIER(b) SYM_RPARENTHESIS @@ -30,12 +30,12 @@ SYM_COMMA SYM_IDENTIFIER(b) SYM_RPARENTHESIS SYM_LBRACE -SYM_PRINT +SYM_IDENTIFIER(print) SYM_LPARENTHESIS SYM_IDENTIFIER(a) SYM_RPARENTHESIS SYM_SEMICOLON -SYM_PRINT +SYM_IDENTIFIER(print) SYM_LPARENTHESIS SYM_IDENTIFIER(b) SYM_RPARENTHESIS diff --git a/tests/funcall/print_and_fun.e.expect_lexer b/tests/funcall/print_and_fun.e.expect_lexer index d8e4934..834218f 100644 --- a/tests/funcall/print_and_fun.e.expect_lexer +++ b/tests/funcall/print_and_fun.e.expect_lexer @@ -21,12 +21,12 @@ SYM_LPARENTHESIS SYM_INTEGER(8) SYM_RPARENTHESIS SYM_SEMICOLON -SYM_PRINT +SYM_IDENTIFIER(print) SYM_LPARENTHESIS SYM_IDENTIFIER(a) SYM_RPARENTHESIS SYM_SEMICOLON -SYM_PRINT +SYM_IDENTIFIER(print) SYM_LPARENTHESIS SYM_IDENTIFIER(b) SYM_RPARENTHESIS -- GitLab From 18fb82aec1203e11955c3dd12fb275affe2ea833 Mon Sep 17 00:00:00 2001 From: Youssef <youssef.sellami@student-cs.fr> Date: Thu, 20 Mar 2025 11:59:04 +0100 Subject: [PATCH 3/8] Types (missing local variable handling and mutual recursive functions) --- expr_grammar_action.g | 23 +++++- src/ast.ml | 19 +++-- src/cfg_gen.ml | 5 +- src/e_regexp.ml | 2 +- src/elang.ml | 6 +- src/elang_gen.ml | 158 +++++++++++++++++++++++++++--------------- src/elang_print.ml | 8 ++- src/elang_run.ml | 127 ++++++++++++++++----------------- src/prog.ml | 11 +++ tests/Makefile | 2 +- 10 files changed, 218 insertions(+), 143 deletions(-) diff --git a/expr_grammar_action.g b/expr_grammar_action.g index 60a5b34..0ccce0e 100644 --- a/expr_grammar_action.g +++ b/expr_grammar_action.g @@ -2,6 +2,7 @@ tokens SYM_EOF SYM_IDENTIFIER<string> SYM_INTEGER<int> SYM_PLUS SYM_MINUS SYM_AS tokens SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA tokens SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ +tokens SYM_INT SYM_CHAR SYM_VOID SYM_CHARACTER<char> non-terminals S INSTR<tree> INSTRS<tree list> LINSTRS ELSE EXPR FACTOR non-terminals LPARAMS REST_PARAMS non-terminals IDENTIFIER INTEGER @@ -12,6 +13,7 @@ non-terminals CMP_EXPRS CMP_EXPR non-terminals EQ_EXPRS EQ_EXPR non-terminals AFTER_IDENTIFIER_INSTR AFTER_IDENTIFIER_FACTOR LARGS REST_ARGS +non-terminals TYPE AFTER_IDENTIFIER_DEC CHARACTER axiom S { @@ -40,11 +42,15 @@ rules S -> FUNDEFS SYM_EOF { Node(Tlistglobdef, $1) } FUNDEFS -> FUNDEF FUNDEFS { $1::$2 } FUNDEFS -> { [] } -FUNDEF -> IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS INSTR { Node(Tfundef, [Node(Tfunname, [$1]); Node(Tfunargs, $3); Node(Tfunbody, [$5])]) } +FUNDEF -> TYPE IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS INSTR { Node(Tfundef, [Node(Tfuntype, [$1]); Node(Tfunname, [$2]); Node(Tfunargs, $4); Node(Tfunbody, [$6])]) } -LPARAMS -> IDENTIFIER REST_PARAMS { Node(Targ, [$1])::$2 } +TYPE -> SYM_INT { TypeLeaf Tint } +TYPE -> SYM_CHAR { TypeLeaf Tchar } +TYPE -> SYM_VOID { TypeLeaf Tvoid } + +LPARAMS -> TYPE IDENTIFIER REST_PARAMS { Node(Targ, [$1; $2])::$3 } LPARAMS -> { [] } -REST_PARAMS -> SYM_COMMA IDENTIFIER REST_PARAMS { Node(Targ, [$2])::$3 } +REST_PARAMS -> SYM_COMMA TYPE IDENTIFIER REST_PARAMS { Node(Targ, [$2; $3])::$4 } REST_PARAMS -> { [] } LARGS -> EXPR REST_ARGS { $1::$2 } @@ -66,11 +72,20 @@ INSTR -> IDENTIFIER AFTER_IDENTIFIER_INSTR SYM_SEMICOLON { | Funcall args -> Node(Tcall, [$1; Node(Targs, args)]) | _ -> $1 } +INSTR -> TYPE IDENTIFIER AFTER_IDENTIFIER_DEC SYM_SEMICOLON { + match $3 with + | Assign exp -> Node(Tblock, [Node(Tdeclare, [$1; $2]); Node(Tassign, [$2; exp])]) + | Nothing -> Node(Tdeclare, [$1; $2]) + | _ -> $1 +} INSTR -> SYM_LBRACE LINSTRS SYM_RBRACE { $2 } AFTER_IDENTIFIER_INSTR -> SYM_ASSIGN EXPR { Assign $2 } AFTER_IDENTIFIER_INSTR -> SYM_LPARENTHESIS LARGS SYM_RPARENTHESIS { Funcall $2 } +AFTER_IDENTIFIER_DEC -> SYM_ASSIGN EXPR { Assign $2 } +AFTER_IDENTIFIER_DEC -> { Nothing } + ELSE -> SYM_ELSE SYM_LBRACE LINSTRS SYM_RBRACE { $3 } ELSE -> { NullLeaf } @@ -109,9 +124,11 @@ FACTOR -> IDENTIFIER AFTER_IDENTIFIER_FACTOR { | _ -> $1 } FACTOR -> SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS { $2 } +FACTOR -> CHARACTER { $1 } IDENTIFIER -> SYM_IDENTIFIER {StringLeaf $1} INTEGER -> SYM_INTEGER {IntLeaf $1} +CHARACTER -> SYM_CHARACTER {CharLeaf $1} AFTER_IDENTIFIER_FACTOR -> { Nothing } AFTER_IDENTIFIER_FACTOR -> SYM_LPARENTHESIS LARGS SYM_RPARENTHESIS { Funcall $2 } diff --git a/src/ast.ml b/src/ast.ml index 7560fa6..f8b7689 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -1,4 +1,5 @@ open Batteries +open Prog (* Les AST sont des arbres, du type [tree], étiquetés par des [tag]. @@ -22,14 +23,14 @@ open Batteries *) -type tag = Tassign | Tif | Twhile | Tblock | Treturn - | Tint +type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tdeclare + | Tint | Tchar | Tvoid | Tadd | Tmul | Tdiv | Tmod | Txor | Tsub | Tclt | Tcgt | Tcle | Tcge | Tceq | Tne | Tneg | Tlistglobdef - | Tfundef | Tfunname | Tfunargs | Tfunbody | Tcall - | Tassignvar + | Tfundef | Tfuntype | Tfunname | Tfunargs | Tfunbody | Tcall + | Tassignvar (*never used*) | Targ | Targs type tree = | Node of tag * tree list @@ -37,7 +38,7 @@ type tree = | Node of tag * tree list | IntLeaf of int | NullLeaf | CharLeaf of char - + | TypeLeaf of typ let string_of_stringleaf = function | StringLeaf s -> s | _ -> failwith "string_of_stringleaf called on non-stringleaf nodes." @@ -74,6 +75,10 @@ let string_of_tag = function | Targ -> "Targ" | Tcall -> "Tcall" | Targs -> "Targs" + | Tdeclare -> "Tdeclare" + | Tfuntype -> "Tfuntype" + | Tchar -> "Tchar" + | Tvoid -> "Tvoid" (* Écrit un fichier .dot qui correspond à un AST *) let rec draw_ast a next = @@ -100,7 +105,8 @@ let rec draw_ast a next = (next, next+1, [ Format.sprintf "n%d [label=\"null\"]\n" next]) | CharLeaf i -> (next, next+1, [ Format.sprintf "n%d [label=\"%c\"]\n" next i]) - + | TypeLeaf t -> + (next, next+1, [ Format.sprintf "n%d [label=\"%s\"]\n" next (string_of_typ t)]) let draw_ast_tree oc ast = let (_, _, s) = draw_ast ast 1 in let s = String.concat "" s in @@ -115,3 +121,4 @@ let rec string_of_ast a = | IntLeaf i -> Format.sprintf "%d" i | CharLeaf i -> Format.sprintf "%c" i | NullLeaf -> "null" + | TypeLeaf t -> string_of_typ t \ No newline at end of file diff --git a/src/cfg_gen.ml b/src/cfg_gen.ml index f009b7b..5831632 100644 --- a/src/cfg_gen.ml +++ b/src/cfg_gen.ml @@ -28,6 +28,7 @@ let rec cfg_expr_of_eexpr (e: Elang.expr) : expr res = | Elang.Ecall (f, args) -> list_map_res cfg_expr_of_eexpr args >>= fun es -> OK (Ecall (f, es)) + | Elang.Echar c -> OK (Eint (Char.code c)) (* [cfg_node_of_einstr next cfg succ i] builds the CFG node(s) that correspond to the E instruction [i]. @@ -73,7 +74,7 @@ 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)) (* Some nodes may be unreachable after the CFG is entirely generated. The [reachable_nodes n cfg] constructs the set of node identifiers that are @@ -100,7 +101,7 @@ let cfg_fun_of_efun { funargs; funbody } = (* remove unreachable nodes *) let r = reachable_nodes node cfg in Hashtbl.filteri_inplace (fun k _ -> Set.mem k r) cfg; - OK { cfgfunargs = funargs; + OK { cfgfunargs = List.map (fun (s, t) -> s) funargs; cfgfunbody = cfg; cfgentry = node; } diff --git a/src/e_regexp.ml b/src/e_regexp.ml index e909133..5bba68f 100644 --- a/src/e_regexp.ml +++ b/src/e_regexp.ml @@ -70,7 +70,7 @@ let list_regexp : (regexp * (string -> token option)) list = (keyword_regexp "int", fun _ -> Some (SYM_INT)); (* begin TODO *) (keyword_regexp "void", fun _ -> Some (SYM_VOID)); - (keyword_regexp "void", fun _ -> Some (SYM_CHAR)); + (keyword_regexp "char", fun _ -> Some (SYM_CHAR)); (keyword_regexp "if", fun _ -> Some (SYM_IF)); (keyword_regexp "else", fun _ -> Some (SYM_ELSE)); (keyword_regexp "return", fun _ -> Some (SYM_RETURN)); diff --git a/src/elang.ml b/src/elang.ml index 03d287f..f10e95f 100644 --- a/src/elang.ml +++ b/src/elang.ml @@ -10,6 +10,7 @@ type expr = | Eint of int | Evar of string | Ecall of string * expr list + | Echar of char type instr = | Iassign of string * expr @@ -18,10 +19,13 @@ type instr = | Iblock of instr list | Ireturn of expr | Icall of string * expr list + | Ideclare of typ * string type efun = { - funargs: ( string ) list; + funargs: ( string * typ ) list; funbody: instr; + funvartyp : (string, typ) Hashtbl.t; + funrettype : typ } type eprog = efun prog diff --git a/src/elang_gen.ml b/src/elang_gen.ml index 54e9203..d191bbd 100644 --- a/src/elang_gen.ml +++ b/src/elang_gen.ml @@ -39,80 +39,118 @@ let binop_of_tag = | Tne -> Ecne | _ -> assert false +let remove_local_vars typ_var local_typ_var = + Hashtbl.filteri (fun s t -> Hashtbl.mem typ_var s) local_typ_var + +let rec type_expr (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (e: expr) : typ res = + match e with + | Ebinop (b, e1, e2) -> + type_expr typ_var typ_fun e1 >>= fun t1 -> + type_expr typ_var typ_fun e2 >>= fun t2 -> + if t1 != Tvoid && t2 != Tvoid + then OK Tint + else Error "E: Binop is not defined on void type." + | Eunop (u, e) -> + type_expr typ_var typ_fun e >>= fun t -> + if t != Tvoid + then OK Tint + else Error "E: Unop is not defined on void 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)) + | Ecall (f, _) -> + match Hashtbl.find_option typ_fun f with + | Some (_, t) when t != Tvoid -> OK t + | _ -> Error "E: Function return type is not defined." + +let are_compatible (t1 : typ) (t2 : typ) : bool = + match t1, t2 with + | Tint, Tint + | Tchar, Tchar + | Tint, Tchar + | Tchar, Tint -> true + | _ -> false + (* [make_eexpr_of_ast a] builds an expression corresponding to a tree [a]. If the tree is not well-formed, fails with an [Error] message. *) -let rec make_eexpr_of_ast (a: tree) : expr res = +let rec make_eexpr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (a: tree) : expr res = let res = match a with (* TODO *) | IntLeaf i -> OK (Eint i) | StringLeaf s -> OK (Evar s) + | CharLeaf c -> OK (Echar c) | Node(t, [e1; e2]) when tag_is_binop t -> - (let res1 = make_eexpr_of_ast e1 - in let res2 = make_eexpr_of_ast e2 - in match res1, res2 with - | Error msg, _ -> Error msg - | _, Error msg -> Error msg - | OK expr1, OK expr2 -> OK (Ebinop (binop_of_tag t, expr1, expr2))) + (make_eexpr_of_ast typ_var typ_fun e1 >>= fun expr1 -> + make_eexpr_of_ast typ_var typ_fun e2 >>= fun expr2 -> + OK (Ebinop (binop_of_tag t, expr1, expr2))) | Node(Tneg, [e]) -> - (let res = make_eexpr_of_ast e - in match res with - | Error msg -> Error msg - | OK expr -> OK (Eunop (Eneg, expr))) + make_eexpr_of_ast typ_var typ_fun e >>= fun expr -> + OK (Eunop (Eneg, expr)) | Node(Tcall, [StringLeaf f; Node(Targs, args)]) -> - (let res = list_map_res make_eexpr_of_ast args - in match res with - | Error msg -> Error msg - | OK exprs -> OK (Ecall (f, exprs))) + list_map_res (make_eexpr_of_ast typ_var typ_fun) args >>= fun exprs -> + OK (Ecall (f, exprs)) | _ -> Error (Printf.sprintf "Unacceptable ast in make_eexpr_of_ast %s" (string_of_ast a)) in match res with - OK o -> res + OK o -> type_expr typ_var typ_fun o >>= fun t -> res | Error msg -> Error (Format.sprintf "In make_eexpr_of_ast %s:\n%s" (string_of_ast a) msg) -let rec make_einstr_of_ast (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 res = let res = match a with (* TODO *) | Node(Tassign, [StringLeaf s; e]) -> - (let res_of_e = make_eexpr_of_ast e - in match res_of_e with - | OK exp -> OK (Iassign (s, exp)) - | Error msg -> Error msg) + 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)) + 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]) -> - (let res_of_e = make_eexpr_of_ast e - in let res_of_i1 = make_einstr_of_ast i1 - in let res_of_i2 = make_einstr_of_ast i2 - in match res_of_e, res_of_i1, res_of_i2 with - | Error msg, _, _ -> Error msg - | _, Error msg, _ -> Error msg - | _, _, Error msg -> Error msg - | OK exp, OK inst1, OK inst2 -> OK (Iif (exp, inst1, inst2))) + 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]) -> - (let res_of_e = make_eexpr_of_ast e - in let res_of_i = make_einstr_of_ast i - in match res_of_e, res_of_i with - | Error msg, _ -> Error msg - | _, Error msg -> Error msg - | OK exp, OK inst-> OK (Iwhile (exp, inst))) - | Node(Tblock, i_list) -> - (let res_of_i_list = list_map_res make_einstr_of_ast i_list - in match res_of_i_list with - | Error msg -> Error msg - | OK instr_list -> OK (Iblock instr_list)) + 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]) -> - (let res_of_e = make_eexpr_of_ast e - in match res_of_e with - | OK exp -> OK (Ireturn exp) - | Error msg -> Error msg) + 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)]) -> - (let res = list_map_res make_eexpr_of_ast args - in match res with - | Error msg -> Error msg - | OK exprs -> OK (Icall (f, exprs))) + 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 + then + Error (Format.sprintf "E: Variable %s already declared." s) + 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 (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s" (string_of_ast a)) @@ -122,20 +160,22 @@ let rec make_einstr_of_ast (a: tree) : instr res = | Error msg -> Error (Format.sprintf "In make_einstr_of_ast %s:\n%s" (string_of_ast a) msg) -let make_ident (a: tree) : string res = +let make_ident (a: tree) : (string * typ) res = match a with - | Node (Targ, [s]) -> - OK (string_of_stringleaf s) + | Node (Targ, [TypeLeaf t; StringLeaf s]) -> OK (s, t) | a -> Error (Printf.sprintf "make_ident: unexpected AST: %s" (string_of_ast a)) -let make_fundef_of_ast (a: tree) : (string * efun) res = +let make_fundef_of_ast (typ_fun : (string, typ list * typ) Hashtbl.t) (a: tree) : (string * efun) res = match a with - | Node (Tfundef, [Node(Tfunname, [StringLeaf fname]); Node (Tfunargs, fargs); Node(Tfunbody, [fbody])]) -> + | Node (Tfundef, [Node(Tfuntype, [TypeLeaf t]); Node(Tfunname, [StringLeaf fname]); Node (Tfunargs, fargs); Node(Tfunbody, [fbody])]) -> list_map_res make_ident fargs >>= fun fargs -> - (* TODO *) - make_einstr_of_ast fbody >>= fun fbody -> - OK (fname, {funargs = fargs; funbody = fbody}) + (* TODO *) + 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 -> + OK (fname, {funargs = fargs; funbody = fbody; funvartyp = typ_var; funrettype = t}) | _ -> Error (Printf.sprintf "make_fundef_of_ast: Expected a Tfundef, got %s." (string_of_ast a)) @@ -143,7 +183,11 @@ let make_fundef_of_ast (a: tree) : (string * efun) res = let make_eprog_of_ast (a: tree) : eprog res = match a with | Node (Tlistglobdef, l) -> - list_map_res (fun a -> make_fundef_of_ast a >>= fun (fname, efun) -> OK (fname, Gfun efun)) l + let fun_typ = Hashtbl.create (List.length l) in + Hashtbl.replace fun_typ "print" ([Tint], Tvoid); + Hashtbl.replace fun_typ "print_int" ([Tint], Tvoid); + Hashtbl.replace fun_typ "print_char" ([Tchar], Tvoid); + list_map_res (fun a -> make_fundef_of_ast fun_typ a >>= fun (fname, efun) -> OK (fname, Gfun efun)) l | _ -> Error (Printf.sprintf "make_fundef_of_ast: Expected a Tlistglobdef, got %s." (string_of_ast a)) diff --git a/src/elang_print.ml b/src/elang_print.ml index 8e4d55d..c090ed5 100644 --- a/src/elang_print.ml +++ b/src/elang_print.ml @@ -27,7 +27,7 @@ let rec dump_eexpr = function | Eint i -> Printf.sprintf "%d" i | Evar s -> Printf.sprintf "%s" s | Ecall (f, args) -> Printf.sprintf "%s(%s)" f (String.concat ", " (List.map dump_eexpr args)) - + | Echar c -> Printf.sprintf "%c" c let indent_size = 2 let spaces n = range (indent_size*n) |> List.map (fun _ -> ' ') |> String.of_list @@ -59,7 +59,9 @@ let rec dump_einstr_rec indent oc i = | Icall(f, args) -> print_spaces oc indent; Format.fprintf oc "%s(%s);\n" f (String.concat ", " (List.map dump_eexpr args)) - + | Ideclare(t, s) -> + print_spaces oc indent; + Format.fprintf oc "%s %s;\n" (string_of_typ t) s let dump_einstr oc i = dump_einstr_rec 0 oc i @@ -67,7 +69,7 @@ let dump_einstr oc i = dump_einstr_rec 0 oc i let dump_efun oc funname {funargs; funbody} = Format.fprintf oc "%s(%s) {\n%a\n}\n" funname - (String.concat "," funargs) + (String.concat "," (List.map (fun (s, t) -> Printf.sprintf "%s %s" (string_of_typ t) s) funargs)) dump_einstr funbody let dump_eprog oc = dump_prog dump_efun oc diff --git a/src/elang_run.ml b/src/elang_run.ml index 4a5bd71..92b77fb 100644 --- a/src/elang_run.ml +++ b/src/elang_run.ml @@ -4,6 +4,10 @@ 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] @@ -39,32 +43,19 @@ let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res = | Some i -> OK (i, st) | None -> Error "Variable is not defined") | Ebinop (b, ex, ey) -> - (let res_x = eval_eexpr oc st ep ex - in match res_x with - | Error msg -> Error msg - | OK (x, st') -> - let res_y = eval_eexpr oc st' ep ey - in match res_y with - | Error msg -> Error msg - | OK (y, st'') -> OK (eval_binop b x y, st'')) + eval_eexpr oc st ep ex >>= fun (x, st') -> + eval_eexpr oc st' ep ey >>= fun (y, st'') -> + OK (eval_binop b x y, st'') | Eunop (u, ex) -> - (let res_x = eval_eexpr oc st ep ex - in match res_x with - | Error msg -> Error msg - | OK (x, st') -> OK (eval_unop u x, st')) + eval_eexpr oc st ep ex >>= fun (x, st') -> + OK (eval_unop u x, st') | Ecall (f, args) -> - let (res : (int list * int state) res) = List.fold_left ( - fun (acc : (int list * int state) res) (arg : expr) -> - match acc with - | Error msg -> Error msg - | OK (l, st') -> - match eval_eexpr oc st' ep arg with - | Error msg -> Error msg - | OK (i, st'') -> OK ((l@[i]), st'') - ) (OK([], st)) args - in match res with - | Error msg -> Error msg - | OK (int_args, st') -> + (List.fold_left + (fun acc arg -> + acc >>= fun (l, st') -> + eval_eexpr oc st' ep arg >>= fun (i, st'') -> + OK ((l@[i]), st'')) + (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 @@ -75,9 +66,10 @@ let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res = (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')) + | OK (Some ret) -> OK (ret, st'))) + | Echar c -> OK (Char.code c, st) -(* [eval_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st]. +(* [eval_einstr oc st ins] évalue l'instruction [ins] en partant de l'état [st]. Le paramètre [oc] est un "output channel", dans lequel la fonction "print" écrit sa sortie, au moyen de l'instruction [Format.fprintf]. @@ -92,31 +84,33 @@ 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) -> - (match eval_eexpr oc st ep e with - | Error msg -> Error msg - | OK (v, st') -> - let replace st s v = + | 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 OK (None, replace st' 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) | Iif (e, i1, i2) -> - (match eval_eexpr oc st ep e with - | Error msg -> Error msg - | OK (v, st') -> if v = 0 then eval_einstr oc st' ep i2 else eval_einstr oc st' ep i1) + (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'')) | Iwhile (e, i) -> - (match eval_eexpr oc st ep e with - | Error msg -> Error msg - | OK (v, st') -> - if v = 1 - then (let res_i = eval_einstr oc st' ep i - in match res_i with - | Error msg -> Error msg - | OK (r_opt, next_st) -> match r_opt with - | None -> eval_einstr oc next_st ep (Iwhile (e, i)) - | Some r -> OK (r_opt, next_st)) - else OK(None, st')) + (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) + else OK (None, st')) | Iblock i_list -> (match i_list with | [] -> OK (None, st) @@ -126,31 +120,26 @@ and eval_einstr oc (st: int state) (ep: eprog) (ins: instr) : | OK (Some r, next_st) -> OK (Some r, next_st) | OK (None, next_st) -> eval_einstr oc next_st ep (Iblock rest)) | Ireturn e -> - (match eval_eexpr oc st ep e with - | Error msg -> Error msg - | OK (v, st') -> OK(Some v, st')) + eval_eexpr oc st ep e >>= fun (v, st') -> + OK(Some v, st') | Icall (f, args) -> - let (res : (int list * int state) res) = List.fold_left ( - fun (acc : (int list * int state) res) (arg : expr) -> - match acc with - | Error msg -> Error msg - | OK (l, st') -> - match eval_eexpr oc st' ep arg with - | Error msg -> Error msg - | OK (i, st'') -> OK ((l@[i]), st'') - ) (OK([], st)) args - in match res with - | Error msg -> Error msg - | OK (int_args, st') -> + (List.fold_left + (fun acc arg -> + acc >>= fun (l, st') -> + eval_eexpr oc st' ep arg >>= fun (i, st'') -> + OK ((l@[i]), st'')) + (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 (_, st'') -> OK (None, st'')) + (eval_efun oc st' ep found_f f int_args >>= fun (_, st'') -> + OK (None, st'')) | Error msg -> - (match do_builtin oc st'.mem f int_args with - | OK _ -> OK (None, st') - | Error msg -> 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}) (* [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]. @@ -167,7 +156,7 @@ and eval_efun oc (st: int state) ep ({ funargs; funbody}: efun) seulement ses arguments), puis on restore l'environnement de l'appelant. *) let env_save = Hashtbl.copy st.env in let env = Hashtbl.create 17 in - match List.iter2 (fun a v -> Hashtbl.replace env a v) funargs vargs with + match List.iter2 (fun (a, t) v -> Hashtbl.replace env a v) funargs vargs with | () -> eval_einstr oc { st with env } ep funbody >>= fun (v, st') -> OK (v, { st' with env = env_save }) diff --git a/src/prog.ml b/src/prog.ml index 5da2674..515bbfb 100644 --- a/src/prog.ml +++ b/src/prog.ml @@ -6,6 +6,17 @@ type mem_access_size = | MAS4 | MAS8 +type typ = + | Tint + | Tchar + | Tvoid + +let string_of_typ t = + match t with + | Tint -> "int" + | Tchar -> "char" + | Tvoid -> "void" + let string_of_mem_access_size mas = match mas with | MAS1 -> "{1}" diff --git a/tests/Makefile b/tests/Makefile index ef3fa0a..5dbb620 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),funcall/*.e) +FILES := $(if $(DIR),$(DIR),type_basic/*.e) OPTS := $(if $(OPTS), $(OPTS),) -- GitLab 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 4/8] 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 From ec4bd4385097ba14bcf1ac8a38a8c84707ab4995 Mon Sep 17 00:00:00 2001 From: Youssef <youssef.sellami@student-cs.fr> Date: Thu, 20 Mar 2025 18:07:40 +0100 Subject: [PATCH 5/8] Types : mutual recursive functions --- expr_grammar_action.g | 7 +++++-- src/elang_gen.ml | 10 ++++++++-- src/elang_print.ml | 7 ++++--- tests/Makefile | 2 +- 4 files changed, 18 insertions(+), 8 deletions(-) diff --git a/expr_grammar_action.g b/expr_grammar_action.g index 0ccce0e..7a39b82 100644 --- a/expr_grammar_action.g +++ b/expr_grammar_action.g @@ -13,7 +13,7 @@ non-terminals CMP_EXPRS CMP_EXPR non-terminals EQ_EXPRS EQ_EXPR non-terminals AFTER_IDENTIFIER_INSTR AFTER_IDENTIFIER_FACTOR LARGS REST_ARGS -non-terminals TYPE AFTER_IDENTIFIER_DEC CHARACTER +non-terminals TYPE AFTER_IDENTIFIER_DEC CHARACTER FUN_INSTR axiom S { @@ -42,7 +42,7 @@ rules S -> FUNDEFS SYM_EOF { Node(Tlistglobdef, $1) } FUNDEFS -> FUNDEF FUNDEFS { $1::$2 } FUNDEFS -> { [] } -FUNDEF -> TYPE IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS INSTR { Node(Tfundef, [Node(Tfuntype, [$1]); Node(Tfunname, [$2]); Node(Tfunargs, $4); Node(Tfunbody, [$6])]) } +FUNDEF -> TYPE IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS FUN_INSTR { Node(Tfundef, [Node(Tfuntype, [$1]); Node(Tfunname, [$2]); Node(Tfunargs, $4); Node(Tfunbody, [$6])]) } TYPE -> SYM_INT { TypeLeaf Tint } TYPE -> SYM_CHAR { TypeLeaf Tchar } @@ -58,6 +58,9 @@ LARGS -> { [] } REST_ARGS -> SYM_COMMA EXPR REST_ARGS { $2::$3 } REST_ARGS -> { [] } +FUN_INSTR -> SYM_LBRACE LINSTRS SYM_RBRACE { $2 } +FUN_INSTR -> SYM_SEMICOLON { NullLeaf } + LINSTRS -> INSTR INSTRS { Node(Tblock, $1::$2) } LINSTRS -> { NullLeaf } INSTRS -> INSTR INSTRS { $1::$2 } diff --git a/src/elang_gen.ml b/src/elang_gen.ml index 63fe655..a91e073 100644 --- a/src/elang_gen.ml +++ b/src/elang_gen.ml @@ -48,7 +48,7 @@ let rec type_expr (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ lis type_expr typ_var typ_fun e1 >>= fun t1 -> type_expr typ_var typ_fun e2 >>= fun t2 -> if t1 != Tvoid && t2 != Tvoid - then OK Tint + then OK Tint (* à vérifier *) else Error "E: Binop is not defined on void type." | Eunop (u, e) -> type_expr typ_var typ_fun e >>= fun t -> @@ -195,7 +195,13 @@ let make_eprog_of_ast (a: tree) : eprog res = Hashtbl.replace fun_typ "print" ([Tint], Tvoid); Hashtbl.replace fun_typ "print_int" ([Tint], Tvoid); Hashtbl.replace fun_typ "print_char" ([Tchar], Tvoid); - list_map_res (fun a -> make_fundef_of_ast fun_typ a >>= fun (fname, efun) -> OK (fname, Gfun efun)) l + List.fold_left (fun acc a -> + acc >>= fun f_list -> + make_fundef_of_ast fun_typ a >>= fun (fname, efun) -> + 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 (Printf.sprintf "make_fundef_of_ast: Expected a Tlistglobdef, got %s." (string_of_ast a)) diff --git a/src/elang_print.ml b/src/elang_print.ml index c090ed5..b1ed342 100644 --- a/src/elang_print.ml +++ b/src/elang_print.ml @@ -27,7 +27,7 @@ let rec dump_eexpr = function | Eint i -> Printf.sprintf "%d" i | Evar s -> Printf.sprintf "%s" s | Ecall (f, args) -> Printf.sprintf "%s(%s)" f (String.concat ", " (List.map dump_eexpr args)) - | Echar c -> Printf.sprintf "%c" c + | Echar c -> Printf.sprintf "'%c'" c let indent_size = 2 let spaces n = range (indent_size*n) |> List.map (fun _ -> ' ') |> String.of_list @@ -66,8 +66,9 @@ let rec dump_einstr_rec indent oc i = let dump_einstr oc i = dump_einstr_rec 0 oc i -let dump_efun oc funname {funargs; funbody} = - Format.fprintf oc "%s(%s) {\n%a\n}\n" +let dump_efun oc funname {funargs; funbody; funrettype} = + Format.fprintf oc "%s %s(%s) %a\n" + (string_of_typ funrettype) funname (String.concat "," (List.map (fun (s, t) -> Printf.sprintf "%s %s" (string_of_typ t) s) funargs)) dump_einstr funbody diff --git a/tests/Makefile b/tests/Makefile index 5dbb620..f4bc98a 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),type_basic/*.e) +FILES := $(if $(DIR),$(DIR),type_funcall/*.e) OPTS := $(if $(OPTS), $(OPTS),) -- GitLab From 9e11a4974c57fe0f173cceab1d3f58a09a7e0c30 Mon Sep 17 00:00:00 2001 From: Youssef <youssef.sellami@student-cs.fr> Date: Wed, 26 Mar 2025 16:12:54 +0100 Subject: [PATCH 6/8] Pointers : E --- expr_grammar_action.g | 48 ++++++---- src/ast.ml | 21 +++-- src/e_regexp.ml | 1 + src/elang.ml | 7 +- src/elang_gen.ml | 203 +++++++++++++++++++++++++++++++----------- src/elang_print.ml | 8 +- src/elang_run.ml | 137 ++++++++++++++++++++-------- src/prog.ml | 11 ++- src/yaccparser.mly | 1 - tests/Makefile | 2 +- 10 files changed, 322 insertions(+), 117 deletions(-) diff --git a/expr_grammar_action.g b/expr_grammar_action.g index 7a39b82..8eb98dd 100644 --- a/expr_grammar_action.g +++ b/expr_grammar_action.g @@ -3,6 +3,7 @@ tokens SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA tokens SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ tokens SYM_INT SYM_CHAR SYM_VOID SYM_CHARACTER<char> +tokens SYM_AMPERSAND non-terminals S INSTR<tree> INSTRS<tree list> LINSTRS ELSE EXPR FACTOR non-terminals LPARAMS REST_PARAMS non-terminals IDENTIFIER INTEGER @@ -14,6 +15,7 @@ non-terminals EQ_EXPRS EQ_EXPR non-terminals AFTER_IDENTIFIER_INSTR AFTER_IDENTIFIER_FACTOR LARGS REST_ARGS non-terminals TYPE AFTER_IDENTIFIER_DEC CHARACTER FUN_INSTR +non-terminals ASTERIKS MEM_OPS axiom S { @@ -24,6 +26,7 @@ axiom S open BatBuffer open Batteries open Utils + open Prog type after_id = | Assign of tree @@ -36,6 +39,14 @@ axiom S match List.rev other with | [] -> term | (high_tag, right_side)::rest -> Node(high_tag, [resolve_associativity term (List.rev rest); right_side]) + + let rec make_type_ast (l : string list) : typ = + match List.rev l with + | ["int"] -> Tint + | ["char"] -> Tchar + | ["void"] -> Tvoid + | "*"::rest -> Tptr (make_type_ast (List.rev rest)) + | _ -> Tvoid } rules @@ -44,9 +55,12 @@ FUNDEFS -> FUNDEF FUNDEFS { $1::$2 } FUNDEFS -> { [] } FUNDEF -> TYPE IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS FUN_INSTR { Node(Tfundef, [Node(Tfuntype, [$1]); Node(Tfunname, [$2]); Node(Tfunargs, $4); Node(Tfunbody, [$6])]) } -TYPE -> SYM_INT { TypeLeaf Tint } -TYPE -> SYM_CHAR { TypeLeaf Tchar } -TYPE -> SYM_VOID { TypeLeaf Tvoid } +TYPE -> SYM_INT ASTERIKS { TypeLeaf (make_type_ast ("int"::$2)) } +TYPE -> SYM_CHAR ASTERIKS { TypeLeaf (make_type_ast ("char"::$2)) } +TYPE -> SYM_VOID ASTERIKS { TypeLeaf (make_type_ast ("void"::$2)) } + +ASTERIKS -> SYM_ASTERISK ASTERIKS { "*"::$2 } +ASTERIKS -> { [] } LPARAMS -> TYPE IDENTIFIER REST_PARAMS { Node(Targ, [$1; $2])::$3 } LPARAMS -> { [] } @@ -69,17 +83,17 @@ INSTRS -> { [] } INSTR -> SYM_IF SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS SYM_LBRACE LINSTRS SYM_RBRACE ELSE { Node(Tif, [$3; $6; $8]) } INSTR -> SYM_WHILE SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS INSTR { Node(Twhile, [$3; $5]) } INSTR -> SYM_RETURN EXPR SYM_SEMICOLON { Node(Treturn, [$2]) } -INSTR -> IDENTIFIER AFTER_IDENTIFIER_INSTR SYM_SEMICOLON { - match $2 with - | Assign exp -> Node(Tassign, [$1; exp]) - | Funcall args -> Node(Tcall, [$1; Node(Targs, args)]) - | _ -> $1 +INSTR -> MEM_OPS IDENTIFIER AFTER_IDENTIFIER_INSTR SYM_SEMICOLON { + match $3 with + | Assign exp -> Node(Tassign, [Node(Tmem, [MemopsLeaf $1; $2]); exp]) + | Funcall args -> Node(Tmem, [MemopsLeaf $1; Node(Tcall, [$2; Node(Targs, args)])]) + | _ -> $2 } INSTR -> TYPE IDENTIFIER AFTER_IDENTIFIER_DEC SYM_SEMICOLON { match $3 with | Assign exp -> Node(Tblock, [Node(Tdeclare, [$1; $2]); Node(Tassign, [$2; exp])]) | Nothing -> Node(Tdeclare, [$1; $2]) - | _ -> $1 + | _ -> $2 } INSTR -> SYM_LBRACE LINSTRS SYM_RBRACE { $2 } @@ -120,18 +134,22 @@ MUL_EXPRS -> SYM_MOD MUL_EXPR MUL_EXPRS { (Tmod, $2)::$3 } MUL_EXPRS -> { [] } FACTOR -> INTEGER { $1 } -FACTOR -> IDENTIFIER AFTER_IDENTIFIER_FACTOR { - match $2 with - | Funcall args -> Node(Tcall, [$1; Node(Targs, args)]) - | Nothing -> $1 - | _ -> $1 +FACTOR -> MEM_OPS IDENTIFIER AFTER_IDENTIFIER_FACTOR { + match $3 with + | Funcall args -> Node(Tmem, [MemopsLeaf $1; Node(Tcall, [$2; Node(Targs, args)])]) + | Nothing -> Node(Tmem, [MemopsLeaf $1; $2]) + | _ -> Node(Tmem, [MemopsLeaf $1; $2]) } FACTOR -> SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS { $2 } FACTOR -> CHARACTER { $1 } -IDENTIFIER -> SYM_IDENTIFIER {StringLeaf $1} +IDENTIFIER -> SYM_IDENTIFIER { StringLeaf $1 } INTEGER -> SYM_INTEGER {IntLeaf $1} CHARACTER -> SYM_CHARACTER {CharLeaf $1} +MEM_OPS -> SYM_AMPERSAND MEM_OPS { Ampersand::$2 } +MEM_OPS -> SYM_ASTERISK MEM_OPS { Asterik::$2 } +MEM_OPS -> { [] } + AFTER_IDENTIFIER_FACTOR -> { Nothing } AFTER_IDENTIFIER_FACTOR -> SYM_LPARENTHESIS LARGS SYM_RPARENTHESIS { Funcall $2 } diff --git a/src/ast.ml b/src/ast.ml index f8b7689..c366d58 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -24,7 +24,6 @@ open Prog *) type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tdeclare - | Tint | Tchar | Tvoid | Tadd | Tmul | Tdiv | Tmod | Txor | Tsub | Tclt | Tcgt | Tcle | Tcge | Tceq | Tne | Tneg @@ -32,6 +31,10 @@ type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tdeclare | Tfundef | Tfuntype | Tfunname | Tfunargs | Tfunbody | Tcall | Tassignvar (*never used*) | Targ | Targs + | Tmem + +type mem_op = | Asterik + | Ampersand type tree = | Node of tag * tree list | StringLeaf of string @@ -39,10 +42,15 @@ type tree = | Node of tag * tree list | NullLeaf | CharLeaf of char | TypeLeaf of typ + | MemopsLeaf of mem_op list let string_of_stringleaf = function | StringLeaf s -> s | _ -> failwith "string_of_stringleaf called on non-stringleaf nodes." +let string_of_memop = function + | Asterik -> "*" + | Ampersand -> "&" + type astfun = (string list * tree) type ast = (string * astfun) list @@ -52,7 +60,6 @@ let string_of_tag = function | Twhile -> "Twhile" | Tblock -> "Tblock" | Treturn -> "Treturn" - | Tint -> "Tint" | Tadd -> "Tadd" | Tmul -> "Tmul" | Tdiv -> "Tdiv" @@ -77,8 +84,7 @@ let string_of_tag = function | Targs -> "Targs" | Tdeclare -> "Tdeclare" | Tfuntype -> "Tfuntype" - | Tchar -> "Tchar" - | Tvoid -> "Tvoid" + | Tmem -> "Tmem" (* Écrit un fichier .dot qui correspond à un AST *) let rec draw_ast a next = @@ -96,7 +102,6 @@ let rec draw_ast a next = ] @ List.map (fun n -> Format.sprintf "n%d -> n%d\n" next n )nodes) - | StringLeaf s -> (next, next+1, [ Format.sprintf "n%d [label=\"%s\"]\n" next s]) | IntLeaf i -> @@ -107,6 +112,9 @@ let rec draw_ast a next = (next, next+1, [ Format.sprintf "n%d [label=\"%c\"]\n" next i]) | TypeLeaf t -> (next, next+1, [ Format.sprintf "n%d [label=\"%s\"]\n" next (string_of_typ t)]) + | MemopsLeaf memops -> + (next, next+1, [ Format.sprintf "n%d [label=\"%s\"]\n" next (String.concat "" (List.map string_of_memop memops))]) + let draw_ast_tree oc ast = let (_, _, s) = draw_ast ast 1 in let s = String.concat "" s in @@ -121,4 +129,5 @@ let rec string_of_ast a = | IntLeaf i -> Format.sprintf "%d" i | CharLeaf i -> Format.sprintf "%c" i | NullLeaf -> "null" - | TypeLeaf t -> string_of_typ t \ No newline at end of file + | TypeLeaf t -> string_of_typ t + | MemopsLeaf memops -> String.concat "" (List.map string_of_memop memops) \ No newline at end of file diff --git a/src/e_regexp.ml b/src/e_regexp.ml index 5bba68f..62c5c8f 100644 --- a/src/e_regexp.ml +++ b/src/e_regexp.ml @@ -90,6 +90,7 @@ let list_regexp : (regexp * (string -> token option)) list = (char_regexp ';', fun _ -> Some (SYM_SEMICOLON)); (char_regexp ',', fun _ -> Some (SYM_COMMA)); (char_regexp '=', fun _ -> Some (SYM_ASSIGN)); + (char_regexp '&', fun _ -> Some (SYM_AMPERSAND)); (Cat(char_regexp '=', char_regexp '='), fun _ -> Some (SYM_EQUALITY)); (Cat(char_regexp '!', char_regexp '='), fun _ -> Some (SYM_NOTEQ)); (char_regexp '<', fun _ -> Some (SYM_LT)); diff --git a/src/elang.ml b/src/elang.ml index f10e95f..f28fc57 100644 --- a/src/elang.ml +++ b/src/elang.ml @@ -11,6 +11,8 @@ type expr = | Evar of string | Ecall of string * expr list | Echar of char + | Eaddrof of expr + | Eload of expr type instr = | Iassign of string * expr @@ -20,12 +22,15 @@ type instr = | Ireturn of expr | Icall of string * expr list | Ideclare of typ * string + | Istore of expr * expr type efun = { funargs: ( string * typ ) list; funbody: instr; funvartyp : (string, typ) Hashtbl.t; - funrettype : typ + funrettype : typ; + funvarinmem : (string, int) Hashtbl.t; + funstksz : int } type eprog = efun prog diff --git a/src/elang_gen.ml b/src/elang_gen.ml index a91e073..675df19 100644 --- a/src/elang_gen.ml +++ b/src/elang_gen.ml @@ -39,6 +39,21 @@ let binop_of_tag = | Tne -> Ecne | _ -> assert false +let binop_is_cmp = + function + | Ecle + | Eclt + | Ecge + | Ecgt + | Eceq + | Ecne -> true + | _ -> false + +let type_is_ptr = + function + | Tptr ty -> true + | _ -> false + let remove_local_vars typ_var local_typ_var = Hashtbl.filteri (fun s t -> Hashtbl.mem typ_var s) local_typ_var @@ -48,13 +63,34 @@ let rec type_expr (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ lis type_expr typ_var typ_fun e1 >>= fun t1 -> type_expr typ_var typ_fun e2 >>= fun t2 -> if t1 != Tvoid && t2 != Tvoid - then OK Tint (* à vérifier *) + then + match t1, t2 with + | Tptr ty, Tint + | Tptr ty, Tchar -> + (match b with + | Eadd -> OK (Tptr ty) + | Esub -> OK (Tptr ty) + | _ -> Error "E: 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.") + | Tptr ty1, Tptr ty2 -> + if binop_is_cmp b + then + if ty1 = ty2 + then OK Tint + else Error "E: Uncomparable pointers." + else + Error "E: Binop is not defined on pointer type." + | _ -> OK (Tint) else Error "E: Binop is not defined on void type." | Eunop (u, e) -> type_expr typ_var typ_fun e >>= fun t -> - if t != Tvoid + if t != Tvoid && t!= Tptr t then OK Tint - else Error "E: Unop is not defined on void type." + else Error "E: Unop is not defined on void or pointer type." | Eint i -> OK Tint | Echar c -> OK Tchar | Evar s -> @@ -62,13 +98,46 @@ let rec type_expr (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ lis | Some t when t != Tvoid -> OK t | _ -> Error (Format.sprintf "E: Expression %s type is not defined." s)) | Ecall (f, exprs) -> - match Hashtbl.find_option typ_fun f with + (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." + | _ -> Error "E: Function return type is not defined.") + | Eaddrof e -> + type_expr typ_var typ_fun e >>= fun t -> + OK (Tptr t) + | Eload e -> + type_expr typ_var typ_fun e >>= fun t -> + match t with + | Tptr ty -> OK ty + | _ -> Error "E: Unvalid loading." + +let rec addr_taken_expr (e: expr) : string Set.t = + match e with + | Ebinop (b, e1, e2) -> Set.union (addr_taken_expr e1) (addr_taken_expr e2) + | Eunop (b, e) -> addr_taken_expr e + | Eint _ + | Evar _ + | Echar _ -> Set.empty + | Ecall (_, e_list) -> set_concat (List.map addr_taken_expr e_list) + | Eaddrof e -> + (match e with + | Evar s -> Set.singleton s + | _ -> Set.empty) + | Eload e -> addr_taken_expr e + +let rec addr_taken_instr (i: instr) : string Set.t = + match i with + | Iassign (_, e) -> addr_taken_expr e + | Iif (e, i1, i2) -> set_concat ([addr_taken_expr e; addr_taken_instr i1; addr_taken_instr i2]) + | Iwhile (e, i) -> Set.union (addr_taken_expr e) (addr_taken_instr i) + | Iblock i_list -> set_concat (List.map addr_taken_instr i_list) + | Ireturn e -> addr_taken_expr e + | Icall (_, e_list) -> set_concat (List.map addr_taken_expr e_list) + | Ideclare _ -> Set.empty + | Istore (e1, e2) -> Set.union (addr_taken_expr e1) (addr_taken_expr e2) let are_compatible (t1 : typ) (t2 : typ) : bool = match t1, t2 with @@ -76,6 +145,7 @@ let are_compatible (t1 : typ) (t2 : typ) : bool = | Tchar, Tchar | Tint, Tchar | Tchar, Tint -> true + | Tptr ty1, Tptr ty2 when ty1 = ty2 -> true | _ -> false (* [make_eexpr_of_ast a] builds an expression corresponding to a tree [a]. If @@ -97,6 +167,14 @@ let rec make_eexpr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, | Node(Tcall, [StringLeaf f; Node(Targs, args)]) -> list_map_res (make_eexpr_of_ast typ_var typ_fun) args >>= fun exprs -> OK (Ecall (f, exprs)) + | Node(Tmem, [MemopsLeaf memops; e]) -> + (match memops with + | [] -> make_eexpr_of_ast typ_var typ_fun e + | memop::rest -> + (make_eexpr_of_ast typ_var typ_fun (Node(Tmem, [MemopsLeaf rest; e])) >>= fun e_rest -> + match memop with + | Asterik -> OK (Eload e_rest) + | Ampersand -> OK (Eaddrof e_rest))) | _ -> Error (Printf.sprintf "Unacceptable ast in make_eexpr_of_ast %s" (string_of_ast a)) @@ -112,53 +190,58 @@ let rec make_einstr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string (* 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]) -> + | Node(Tassign, [id; e]) -> + make_eexpr_of_ast typ_var typ_fun id >>= fun id_expr -> + type_expr typ_var typ_fun id_expr >>= fun tid -> 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), 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 -> - 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 - (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 - Error (Format.sprintf "E: Can not declare void variable.")) + (match id_expr with + | 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)) + | 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]) -> + 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(Tmem, [MemopsLeaf []; 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 + (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 + 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)) @@ -167,7 +250,7 @@ let rec make_einstr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string OK o -> res | Error msg -> Error (Format.sprintf "In make_einstr_of_ast %s:\n%s" (string_of_ast a) msg) - + let make_ident (a: tree) : (string * typ) res = match a with | Node (Targ, [TypeLeaf t; StringLeaf s]) -> OK (s, t) @@ -182,8 +265,22 @@ 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, _) -> - OK (fname, {funargs = fargs; funbody = fbody; funvartyp = typ_var; funrettype = t}) + make_einstr_of_ast typ_var typ_fun fbody >>= fun (fbody, typ_var) -> + let ofs = ref 0 + in let funvarinmem = Hashtbl.create 17 + in List.iter (fun x -> + match Hashtbl.find_option typ_var x with + | None -> () + | Some t -> + ofs := !ofs + size_type t; + Hashtbl.add funvarinmem x !ofs;) (List.rev (Set.to_list (addr_taken_instr fbody))); + OK (fname, + {funargs = fargs; + funbody = fbody; + funvartyp = typ_var; + funrettype = t; + funvarinmem = funvarinmem; + funstksz = !ofs}) | _ -> Error (Printf.sprintf "make_fundef_of_ast: Expected a Tfundef, got %s." (string_of_ast a)) diff --git a/src/elang_print.ml b/src/elang_print.ml index b1ed342..9d401ff 100644 --- a/src/elang_print.ml +++ b/src/elang_print.ml @@ -28,6 +28,8 @@ let rec dump_eexpr = function | Evar s -> Printf.sprintf "%s" s | Ecall (f, args) -> Printf.sprintf "%s(%s)" f (String.concat ", " (List.map dump_eexpr args)) | Echar c -> Printf.sprintf "'%c'" c + | Eaddrof e -> Printf.sprintf "&%s" (dump_eexpr e) + | Eload e -> Printf.sprintf "*%s" (dump_eexpr e) let indent_size = 2 let spaces n = range (indent_size*n) |> List.map (fun _ -> ' ') |> String.of_list @@ -49,10 +51,11 @@ let rec dump_einstr_rec indent oc i = Format.fprintf oc "while (%s) %a\n" (dump_eexpr cond) (dump_einstr_rec (indent)) i | Iblock(il) -> + print_spaces oc indent; Format.fprintf oc "{\n"; List.iter (Format.fprintf oc "%a" (dump_einstr_rec (indent + 1))) il; print_spaces oc indent; - Format.fprintf oc "}"; + Format.fprintf oc "}\n"; | Ireturn(e) -> print_spaces oc indent; Format.fprintf oc "return %s;\n" (dump_eexpr e) @@ -62,6 +65,9 @@ let rec dump_einstr_rec indent oc i = | Ideclare(t, s) -> print_spaces oc indent; Format.fprintf oc "%s %s;\n" (string_of_typ t) s + | Istore(p, e) -> + print_spaces oc indent; + Format.fprintf oc "*%s = %s;\n" (dump_eexpr p) (dump_eexpr e) let dump_einstr oc i = dump_einstr_rec 0 oc i diff --git a/src/elang_run.ml b/src/elang_run.ml index ced1357..2dc808e 100644 --- a/src/elang_run.ml +++ b/src/elang_run.ml @@ -3,6 +3,7 @@ open Batteries open Prog open Utils open Builtins +open Elang_gen let binop_bool_to_int f x y = if f x y then 1 else 0 @@ -31,32 +32,55 @@ let eval_unop (u: unop) : int -> int = (* [eval_eexpr st e] évalue l'expression [e] dans l'état [st]. Renvoie une erreur si besoin. *) -let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res = +let rec eval_eexpr oc st (ep: eprog) (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (inmem_var : (string, int) Hashtbl.t) (sp : int) (e : expr) : (int * int state) res = match e with | Eint i -> OK (i, st) - | Evar s -> OK (Hashtbl.find st.env s, st) + | Evar s -> + (match Hashtbl.find_opt inmem_var s with + | 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)) | Ebinop (b, ex, ey) -> - eval_eexpr oc st ep ex >>= fun (x, st') -> - eval_eexpr oc st' ep ey >>= fun (y, st'') -> - OK (eval_binop b x y, st'') + 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'') -> + type_expr typ_var typ_fun ex >>= fun tx -> + type_expr typ_var typ_fun ey >>= fun ty -> + (match tx, ty with + | Tptr t, Tint -> OK (eval_binop b x (y * size_type t), st'') + | Tint, Tptr t -> OK (eval_binop b (x * size_type t) y, st'') + | _ -> OK (eval_binop b x y, st'')) | Eunop (u, ex) -> - eval_eexpr oc st ep ex >>= fun (x, st') -> + eval_eexpr oc st ep typ_var typ_fun inmem_var sp ex >>= fun (x, st') -> OK (eval_unop u x, st') | Ecall (f, args) -> (List.fold_left (fun acc arg -> acc >>= fun (l, st') -> - eval_eexpr oc st' ep arg >>= fun (i, st'') -> + eval_eexpr oc st' ep typ_var typ_fun inmem_var sp arg >>= fun (i, st'') -> OK ((l@[i]), st'')) (OK([], st)) args >>= fun(int_args, st') -> match find_function ep f with | OK found_f -> - eval_efun oc st' ep found_f f int_args >>= fun (ret_opt, st'') -> + eval_efun oc st' ep found_f f int_args typ_fun sp >>= fun (ret_opt, st'') -> OK (Option.get ret_opt, st'') | Error msg -> do_builtin oc st'.mem f int_args >>= fun (ret_opt) -> OK (Option.get ret_opt, st')) | Echar c -> OK (Char.code c, st) + | Eload e -> + 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') + | 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) + | 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" (* [eval_einstr oc st ins] évalue l'instruction [ins] en partant de l'état [st]. @@ -70,64 +94,90 @@ let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res = lieu et que l'exécution doit continuer. - [st'] est l'état mis à jour. *) -and eval_einstr oc (st: int state) (ep: eprog) (ins: instr) : - (int option * int state) res = +and eval_einstr oc (st: int state) (ep: eprog) (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (inmem_var : (string, int) Hashtbl.t) (sp : int) (ins: instr) : + (int option * int state * (string,typ) Hashtbl.t) res = + (* typ_var a été ajouté à la valeur de retour de cette fonction + pour permettre la gestion des variables locales dans les if et while. *) match ins with | 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 + in match eval_eexpr oc st ep typ_var typ_fun inmem_var sp e with | Error msg -> Error msg - | OK (v, st') -> OK (None, replace st' s v)) + | OK (v, st') -> + match Hashtbl.find_opt inmem_var s with + | 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)) | Iif (e, i1, i2) -> - eval_eexpr oc st ep e >>= fun (v, st') -> + eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (v, st') -> if v != 0 - then eval_einstr oc st' ep i1 - else eval_einstr oc st' ep i2 + then + eval_einstr oc st' ep typ_var typ_fun inmem_var sp i1 >>= fun (ret_opt, st', new_typ_var) -> + OK (ret_opt, st', typ_var) + else + eval_einstr oc st' ep typ_var typ_fun inmem_var sp i2 >>= fun (ret_opt, st', new_typ_var) -> + OK (ret_opt, st', typ_var) | Iwhile (e, i) -> - (eval_eexpr oc st ep e >>= fun (v, st') -> + (eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (v, st') -> if v != 0 - then eval_einstr oc st' ep i >>= fun (r_opt, next_st) -> + then eval_einstr oc st' ep typ_var typ_fun inmem_var sp i >>= fun (r_opt, next_st, new_typ_var) -> match r_opt with - | None -> eval_einstr oc next_st ep (Iwhile (e, i)) - | Some r -> OK (r_opt, next_st) - else OK (None, st')) + | None -> eval_einstr oc next_st ep typ_var typ_fun inmem_var sp (Iwhile (e, i)) + | Some r -> OK (r_opt, next_st, typ_var) + else OK (None, st', typ_var)) | Iblock i_list -> (match i_list with - | [] -> OK (None, st) + | [] -> OK (None, st, typ_var) | i::rest -> - match eval_einstr oc st ep i with + match eval_einstr oc st ep typ_var typ_fun inmem_var sp i with | Error msg -> Error msg - | OK (Some r, next_st) -> OK (Some r, next_st) - | OK (None, next_st) -> eval_einstr oc next_st ep (Iblock rest)) + | OK (Some r, next_st, new_typ_var) -> OK (Some r, next_st, new_typ_var) + | OK (None, next_st, new_typ_var) -> eval_einstr oc next_st ep new_typ_var typ_fun inmem_var sp (Iblock rest)) | Ireturn e -> - eval_eexpr oc st ep e >>= fun (v, st') -> - OK(Some v, st') + eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (v, st') -> + OK(Some v, st', typ_var) | Icall (f, args) -> (List.fold_left (fun acc arg -> acc >>= fun (l, st') -> - eval_eexpr oc st' ep arg >>= fun (i, st'') -> + eval_eexpr oc st' ep typ_var typ_fun inmem_var sp arg >>= fun (i, st'') -> OK ((l@[i]), st'')) (OK([], st)) args >>= fun(int_args, st') -> match find_function ep f with | OK found_f -> - (eval_efun oc st' ep found_f f int_args >>= fun (_, st'') -> - OK (None, st'')) + (eval_efun oc st' ep found_f f int_args typ_fun sp >>= fun (_, st'') -> + OK (None, st'', typ_var)) | Error msg -> (do_builtin oc st'.mem f int_args >>= fun _ -> - OK (None, st'))) - | Ideclare (_, s) -> OK (None, st) - + OK (None, st', typ_var))) + | Ideclare (t, s) -> + let new_typ_var = Hashtbl.copy typ_var + in Hashtbl.add new_typ_var s t; + OK (None, st, new_typ_var) + | Istore (p_expr, e) -> + eval_eexpr oc st ep typ_var typ_fun inmem_var sp p_expr >>= fun (addr, st') -> + eval_eexpr oc st ep typ_var typ_fun inmem_var sp e >>= fun (v, st'') -> + type_expr typ_var typ_fun p_expr >>= fun tp -> + 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) + | _ -> + 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 + (* [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]. Cette fonction renvoie un couple (ret, st') avec la même signification que pour [eval_einstr]. *) -and eval_efun oc (st: int state) ep ({ funargs; funbody}: efun) - (fname: string) (vargs: int list) +and eval_efun oc (st: int state) ep ({funargs; funbody; funvartyp; funrettype; funvarinmem; funstksz}: efun) + (fname: string) (vargs: int list) (typ_fun : (string, typ list * typ) Hashtbl.t) (sp : int) : (int option * int state) res = (* L'environnement d'une fonction (mapping des variables locales vers leurs valeurs) est local et un appel de fonction ne devrait pas modifier les @@ -138,13 +188,23 @@ and eval_efun oc (st: int state) ep ({ funargs; funbody}: efun) let env = Hashtbl.create 17 in match List.iter2 (fun (a, t) v -> Hashtbl.replace env a v) funargs vargs with | () -> - eval_einstr oc { st with env } ep funbody >>= fun (v, st') -> - OK (v, { st' with env = env_save }) + 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 _ -> Error (Format.sprintf "E: Called function %s with %d arguments, expected %d.\n" fname (List.length vargs) (List.length funargs) ) +let create_typ_fun (ep: eprog) : (string, typ list * typ) Hashtbl.t = + let typ_fun = Hashtbl.create (List.length ep) + in List.iter (fun (fname, gfun) -> + match gfun with + | Gfun efun -> + let arg_types = List.map (fun (arg, typ) -> typ) efun.funargs + in Hashtbl.add typ_fun fname (arg_types, efun.funrettype)) ep; + typ_fun (* [eval_eprog oc ep memsize params] évalue un programme complet [ep], avec les arguments [params]. @@ -161,7 +221,7 @@ and eval_efun oc (st: int state) ep ({ funargs; funbody}: efun) - [OK None] lorsque l'évaluation de la fonction termine sans renvoyer de valeur. - [Error msg] lorsqu'une erreur survient. - *) + *) let eval_eprog oc (ep: eprog) (memsize: int) (params: int list) : int option res = let st = init_state memsize in @@ -169,5 +229,6 @@ let eval_eprog oc (ep: eprog) (memsize: int) (params: int list) (* ne garde que le nombre nécessaire de paramètres pour la fonction "main". *) let n = List.length f.funargs in let params = take n params in - eval_efun oc st ep f "main" params >>= fun (v, _) -> + let typ_fun = create_typ_fun ep in + eval_efun oc st ep f "main" params typ_fun 0 >>= fun (v, _) -> OK v diff --git a/src/prog.ml b/src/prog.ml index 515bbfb..47a6000 100644 --- a/src/prog.ml +++ b/src/prog.ml @@ -10,12 +10,14 @@ type typ = | Tint | Tchar | Tvoid + | Tptr of typ -let string_of_typ t = +let rec string_of_typ t = match t with | Tint -> "int" | Tchar -> "char" | Tvoid -> "void" + | Tptr ty -> Format.sprintf "%s*" (string_of_typ ty) let string_of_mem_access_size mas = match mas with @@ -78,3 +80,10 @@ let find_function (ep: 'a prog) fname : 'a res = match List.assoc_opt fname ep with | Some (Gfun f) -> OK f | _ -> Error (Format.sprintf "Unknown function %s\n" fname) + +let size_type (t: typ) : int = + match t with + | Tint -> 4 + | Tchar -> 1 + | Tptr _ -> 4 + | Tvoid -> 0 \ No newline at end of file diff --git a/src/yaccparser.mly b/src/yaccparser.mly index f335483..c3449ba 100644 --- a/src/yaccparser.mly +++ b/src/yaccparser.mly @@ -86,7 +86,6 @@ | expr SYM_LEQ expr { Node (Tcle, [$1; $3]) } | expr SYM_GEQ expr { Node (Tcge, [$1; $3]) } | SYM_MINUS expr %prec UMINUS { Node (Tneg, [$2])} - | integer { Node(Tint, [$1])} | identifier { $1 } | SYM_LPARENTHESIS expr SYM_RPARENTHESIS { $2 } ; diff --git a/tests/Makefile b/tests/Makefile index f4bc98a..d6ec16f 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),type_funcall/*.e) +FILES := $(if $(DIR),$(DIR),ptr/*.e) OPTS := $(if $(OPTS), $(OPTS),) -- GitLab From fa2aa77c1b832bf512936b8f4173e3a07bfea38e Mon Sep 17 00:00:00 2001 From: Youssef <youssef.sellami@student-cs.fr> Date: Wed, 26 Mar 2025 17:08:42 +0100 Subject: [PATCH 7/8] Debug infos and errors --- src/cfg_run.ml | 4 ++-- src/elang_gen.ml | 32 ++++++++++++++++---------------- src/elang_run.ml | 16 ++++++---------- src/linear_run.ml | 2 +- src/rtl_run.ml | 2 +- tests/Makefile | 2 +- 6 files changed, 27 insertions(+), 31 deletions(-) diff --git a/src/cfg_run.ml b/src/cfg_run.ml index a705b96..138c34a 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 675df19..9df57d0 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 2dc808e..f8fb9c0 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 9551455..7f8f471 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 8a1fa98..9e4ca5f 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 d6ec16f..40bb123 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),) -- GitLab From 68c05c1de15b6236d9f8add34e37edf3688b2cd5 Mon Sep 17 00:00:00 2001 From: Youssef <youssef.sellami@student-cs.fr> Date: Wed, 26 Mar 2025 17:29:35 +0100 Subject: [PATCH 8/8] Type compatibility in function call --- src/elang_gen.ml | 37 ++++++++++++++++++++++++------------- tests/Makefile | 2 +- 2 files changed, 25 insertions(+), 14 deletions(-) diff --git a/src/elang_gen.ml b/src/elang_gen.ml index 9df57d0..3ab0388 100644 --- a/src/elang_gen.ml +++ b/src/elang_gen.ml @@ -54,9 +54,22 @@ let type_is_ptr = | Tptr ty -> true | _ -> false -let remove_local_vars typ_var local_typ_var = - Hashtbl.filteri (fun s t -> Hashtbl.mem typ_var s) local_typ_var - +let are_compatible (t1 : typ) (t2 : typ) : bool = + match t1, t2 with + | Tint, Tint + | Tchar, Tchar + | Tint, Tchar + | Tchar, Tint -> true + | Tptr ty1, Tptr ty2 when ty1 = ty2 -> true + | _ -> false + +let are_lists_compatible (l1 : typ list) (l2 : typ list) : bool = + if List.length l1 != List.length l2 + then false + else let comp = ref true + in List.iter2 (fun t1 t2 -> if not (are_compatible t1 t2) then comp := false) l1 l2; + !comp + let rec type_expr (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, typ list * typ) Hashtbl.t) (e: expr) : typ res = match e with | Ebinop (b, e1, e2) -> @@ -139,14 +152,6 @@ let rec addr_taken_instr (i: instr) : string Set.t = | Ideclare _ -> Set.empty | Istore (e1, e2) -> Set.union (addr_taken_expr e1) (addr_taken_expr e2) -let are_compatible (t1 : typ) (t2 : typ) : bool = - match t1, t2 with - | Tint, Tint - | Tchar, Tchar - | Tint, Tchar - | Tchar, Tint -> true - | Tptr ty1, Tptr ty2 when ty1 = ty2 -> true - | _ -> false (* [make_eexpr_of_ast a] builds an expression corresponding to a tree [a]. If the tree is not well-formed, fails with an [Error] message. *) @@ -166,7 +171,13 @@ let rec make_eexpr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string, OK (Eunop (Eneg, expr)) | Node(Tcall, [StringLeaf f; Node(Targs, args)]) -> list_map_res (make_eexpr_of_ast typ_var typ_fun) args >>= fun exprs -> - OK (Ecall (f, 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 "Unknown argument types of function %s." f) + | Some (arg_types, ret_type) -> + if are_lists_compatible types arg_types + then OK (Ecall (f, exprs)) + else Error (Format.sprintf "Unvalid argument types in function %s calling." f)) | Node(Tmem, [MemopsLeaf memops; e]) -> (match memops with | [] -> make_eexpr_of_ast typ_var typ_fun e @@ -227,7 +238,7 @@ let rec make_einstr_of_ast (typ_var : (string,typ) Hashtbl.t) (typ_fun : (string (match Hashtbl.find_option typ_fun f with | None -> Error (Format.sprintf "Unknown argument types of function %s." f) | Some (arg_types, ret_type) -> - if types = arg_types + if are_lists_compatible types arg_types then OK (Icall (f, exprs), typ_var) else Error (Format.sprintf "Unvalid argument types in function %s calling." f))) | Node (Tdeclare, [TypeLeaf t; StringLeaf s]) -> diff --git a/tests/Makefile b/tests/Makefile index 40bb123..d6ec16f 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),char/*.e) +FILES := $(if $(DIR),$(DIR),ptr/*.e) OPTS := $(if $(OPTS), $(OPTS),) -- GitLab