Commit 3825d2cb authored by Armillon Damien's avatar Armillon Damien
Browse files

types are working !

parent bb778ca1
......@@ -28,4 +28,7 @@ test: main.native
make -C tests
testFun: main.native
make -C tests DIR=funcall/*.e
\ No newline at end of file
make -C tests DIR="type_funcall/*.e type_basic/*.e char/*.e"
testChar: main.native
make -C tests DIR=char/*.e
\ No newline at end of file
......@@ -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_VOID SYM_CHAR SYM_INT SYM_CHARACTER<char>
non-terminals S INSTR INSTRS 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 BLOC
non-terminals IN_INSTR L_CALL_PARAMS REST_CALL_PARAMS FACTORS FUN_CALL_EXPRS FUN_CALL_EXPR FACTOR_IDENTIFIER
non-terminals SYM_TYPE ASSIGN_EXPR FUNBODY
axiom S
{
......@@ -33,10 +35,12 @@ S -> FUNDEFS SYM_EOF { Node (Tlistglobdef, $1) }
BLOC -> SYM_LBRACE INSTRS SYM_RBRACE {Node(Tblock, $2)}
FUNDEFS -> {[]}
FUNDEFS -> FUNDEF FUNDEFS { (Node (Tfundef, $1)) :: $2 }
FUNDEF -> SYM_IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS BLOC { [StringLeaf($1); (Node(Tfunargs, $3)); $5] }
FUNDEF -> SYM_TYPE SYM_IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS FUNBODY { [$1; StringLeaf($2); (Node(Tfunargs, $4)); $6] }
FUNBODY -> BLOC {$1}
FUNBODY -> SYM_SEMICOLON {NullLeaf}
LPARAMS -> {[]}
LPARAMS -> SYM_IDENTIFIER REST_PARAMS {(Node(Targ, [StringLeaf($1)])) :: $2}
REST_PARAMS -> SYM_COMMA SYM_IDENTIFIER REST_PARAMS {(Node(Targ, [StringLeaf($2)])):: $3}
LPARAMS -> SYM_TYPE SYM_IDENTIFIER REST_PARAMS {(Node(Targ, [$1; StringLeaf($2)])) :: $3}
REST_PARAMS -> SYM_COMMA SYM_TYPE SYM_IDENTIFIER REST_PARAMS {(Node(Targ, [$2; StringLeaf($3)])):: $4}
REST_PARAMS -> {[]}
L_CALL_PARAMS -> {[]}
L_CALL_PARAMS -> EXPR REST_CALL_PARAMS {[Node(Targs, $1::$2)]}
......@@ -44,10 +48,13 @@ REST_CALL_PARAMS -> {[]}
REST_CALL_PARAMS -> SYM_COMMA EXPR REST_CALL_PARAMS {$2::$3}
IN_INSTR -> SYM_LPARENTHESIS L_CALL_PARAMS SYM_RPARENTHESIS SYM_SEMICOLON {fun x -> Node(Tcall, (StringLeaf x)::$2)}
IN_INSTR -> SYM_ASSIGN EXPR SYM_SEMICOLON {fun x -> Node(Tassign, [Node(Tassignvar,[StringLeaf(x); $2])])}
ASSIGN_EXPR -> SYM_ASSIGN EXPR {[$2]}
ASSIGN_EXPR -> {[NullLeaf]}
INSTRS -> {[]}
INSTRS -> INSTR INSTRS {$1::$2}
INSTR -> BLOC {$1}
INSTR -> SYM_IDENTIFIER IN_INSTR {$2 $1}
INSTR -> SYM_TYPE SYM_IDENTIFIER ASSIGN_EXPR SYM_SEMICOLON {Node(Tassign, [Node(Tassignvar ,(StringLeaf $2)::$3@[$1])])}
INSTR -> SYM_IF SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS BLOC ELSE {Node(Tif, $3::$5::$6)}
INSTR -> SYM_WHILE SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS BLOC {Node(Twhile, [$3;$5])}
INSTR -> SYM_RETURN EXPR SYM_SEMICOLON {Node(Treturn, [$2])}
......@@ -56,7 +63,7 @@ ELSE -> {[]}
EXPR -> EQ_EXPR EQ_EXPRS {resolve_associativity $1 $2}
EQ_EXPRS -> SYM_EQUALITY EQ_EXPR {[(Tceq, [$2])]}
EQ_EXPRS -> SYM_NOTEQ EQ_EXPR {[(Tne, [$2])]}
EQ_EXPRS ->{[]}
EQ_EXPRS -> {[]}
EQ_EXPR -> CMP_EXPR CMP_EXPRS {resolve_associativity $1 $2}
CMP_EXPRS -> SYM_LT CMP_EXPR {[(Tclt, [$2])]}
CMP_EXPRS -> SYM_GT CMP_EXPR {[(Tcgt, [$2])]}
......@@ -80,6 +87,10 @@ FACTORS -> FACTOR {$1}
FACTORS -> SYM_MINUS FACTOR {Node(Tneg,[$2])}
FACTOR_IDENTIFIER -> {fun x -> StringLeaf(x)}
FACTOR_IDENTIFIER -> SYM_LPARENTHESIS L_CALL_PARAMS SYM_RPARENTHESIS {fun x -> Node(Tcall, (StringLeaf x)::$2)}
FACTOR -> SYM_INTEGER {Node(Tint,[IntLeaf($1)])}
FACTOR -> SYM_INTEGER {IntLeaf($1)}
FACTOR -> SYM_CHARACTER {CharLeaf($1)}
FACTOR -> SYM_IDENTIFIER FACTOR_IDENTIFIER {$2 $1}
FACTOR -> SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS {$2}
SYM_TYPE -> SYM_INT {Node(Tint, [])}
SYM_TYPE -> SYM_CHAR {Node(Tchar,[])}
SYM_TYPE -> SYM_VOID {Node(Tvoid,[])}
open Batteries
open BatPrintf
open Utils
open Prog
(* Les AST sont des arbres, du type [tree], étiquetés par des [tag].
......@@ -24,7 +26,6 @@ open BatPrintf
*)
type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tprint
| Tint
| Tadd | Tmul | Tdiv | Tmod | Txor | Tsub
| Tclt | Tcgt | Tcle | Tcge | Tceq | Tne
| Tneg
......@@ -32,6 +33,7 @@ type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tprint
| Tfundef | Tfunname | Tfunargs | Tfunbody
| Tassignvar
| Targ | Tcall | Targs
| Tvoid | Tint | Tchar
type tree = | Node of tag * tree list
| StringLeaf of string
......@@ -39,6 +41,13 @@ type tree = | Node of tag * tree list
| NullLeaf
| CharLeaf of char
let is_type (t:tag) : typ res =
match t with
| Tvoid -> OK(Tvoid)
| Tint -> OK(Tint)
| Tchar -> OK(Tchar)
| _ -> Error "Not a type"
let string_of_stringleaf = function
| StringLeaf s -> s
| _ -> failwith "string_of_stringleaf called on non-stringleaf nodes."
......@@ -76,6 +85,8 @@ let string_of_tag = function
| Targ -> "Targ"
| Tcall -> "Tcall"
| Targs -> "Targs"
| Tchar -> "Tchar"
| Tvoid -> "Tvoid"
(* Écrit un fichier .dot qui correspond à un AST *)
......
......@@ -23,6 +23,7 @@ let rec cfg_expr_of_eexpr (e: Elang.expr) : expr res =
cfg_expr_of_eexpr e >>= fun ee ->
OK (Eunop (u, ee))
| Elang.Eint i -> OK (Eint i)
| Elang.Echar c -> OK (Eint (Char.code c))
| Elang.Evar v ->
OK (Evar v)
| Elang.Ecall(name, elist) ->
......@@ -104,7 +105,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 = fst (List.split funargs);
cfgfunbody = cfg;
cfgentry = node;
}
......
......@@ -11,6 +11,7 @@ type expr =
Ebinop of binop * expr * expr
| Eunop of unop * expr
| Eint of int
| Echar of char
| Evar of string
| Ecall of string * expr list
......@@ -24,8 +25,10 @@ type instr =
| Icall of string * expr list
type efun = {
funargs: ( string ) list;
funargs: ( string * typ ) list;
funbody: instr;
funvartyp : (string, typ) Hashtbl.t;
funrettype : typ;
}
type eprog = efun prog
......@@ -39,22 +39,41 @@ let binop_of_tag =
| Tne -> Ecne
| _ -> assert false
let tag_is_unary_inst =
function
Treturn -> true
| Tprint -> true
| _ -> false
let uniinst_of_tag e =
function
Treturn -> Ireturn e
| Tprint -> Iprint e
| _ -> assert false
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(op,e1,e2) -> type_expr typ_var typ_fun e1
| Eunop(op,e) -> type_expr typ_var typ_fun e
| Eint n -> OK Tint
| Echar c -> OK Tchar
| Evar v ->
(match Hashtbl.find_option typ_var v with
| Some t -> OK t
| None -> Error (Format.sprintf "variable %s not found (unknown type)" v)
)
| Ecall (func, el) ->
(match Hashtbl.find_option typ_fun func with
| Some (_,t) -> OK t
| None -> Error (Format.sprintf "function %s not found (unknown type)" func)
)
let are_types_compatible (t1: typ) (t2:typ): typ res =
match t1 with
| Tint
| Tchar -> (
match t2 with
| Tint | Tchar -> OK(t1)
| _ -> Error (Format.sprintf "Incompatible type %s %s" (string_of_typ t1) (string_of_typ t2))
)
| _ -> Error (Format.sprintf "Incompatible type %s %s" (string_of_typ t1) (string_of_typ t2))
(* [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 (>>=) = Result.bind *)
let rec make_eexpr_of_ast (a: tree) : expr res =
let rec make_eexpr_of_ast (a: tree)
(typ_var : (string,typ) Hashtbl.t)
(typ_fun : (string, typ list * typ) Hashtbl.t) : (expr * typ) res =
let res =
match a with
| Node(Tcall, StringLeaf(name)::r) ->
......@@ -62,18 +81,31 @@ let rec make_eexpr_of_ast (a: tree) : expr res =
| Node(Targs, l )::[] -> l
| _ -> []
) in
list_map_res (fun e -> make_eexpr_of_ast e) args_list >>= fun args_expr ->
OK (Ecall(name, args_expr))
list_map_res (fun e -> make_eexpr_of_ast e typ_var typ_fun) args_list >>= fun args_expr ->
let (args_expr, args_t) = List.split args_expr in
let returned_expression = Ecall(name, args_expr) in
let (args_typ,_) = Hashtbl.find typ_fun name in
if (List.length args_typ) != (List.length args_t) then Error (Format.sprintf "%s called with %d instead of %d" name (List.length args_t) (List.length args_typ) ) else
let does_args_typ_match = List.for_all2 (=) args_typ args_t in
if does_args_typ_match then
let* t = type_expr typ_var typ_fun returned_expression in
OK (returned_expression, t)
else Error (Format.sprintf "arguments types does not match in expression calling %s" name)
| Node(t, [e1; e2]) when tag_is_binop t ->
make_eexpr_of_ast e1 >>= fun expr1 ->
make_eexpr_of_ast e2 >>= fun expr2 ->
OK (Ebinop(binop_of_tag t, expr1 , expr2))
| Node(t, [e1]) when t = Tneg -> make_eexpr_of_ast e1 >>= fun expr1 ->
OK(Eunop(Eneg,expr1))
| Node(t,[e1]) when t = Tint -> make_eexpr_of_ast e1
| IntLeaf(num) -> OK(Eint(num))
| StringLeaf(str) -> OK(Evar(str))
make_eexpr_of_ast e1 typ_var typ_fun >>= fun (expr1,t1) ->
make_eexpr_of_ast e2 typ_var typ_fun >>= fun (expr2,t2) ->
let* t1 = are_types_compatible t1 t2 in
OK (Ebinop(binop_of_tag t, expr1 , expr2),t1)
| Node(t, [e1]) when t = Tneg -> make_eexpr_of_ast e1 typ_var typ_fun >>= fun (expr1,t1) ->
OK(Eunop(Eneg,expr1), t1)
| Node(t,[e1]) when t = Tint -> make_eexpr_of_ast e1 typ_var typ_fun
| IntLeaf(num) -> OK(Eint(num), Tint)
| StringLeaf(str) ->
let returned_expression = Evar(str) in
let* t = type_expr typ_var typ_fun returned_expression in
OK(returned_expression, t)
| CharLeaf(c) -> OK(Echar(c),Tchar)
| _ -> Error (Printf.sprintf "Unacceptable ast in make_eexpr_of_ast %s"
(string_of_ast a))
in
......@@ -82,43 +114,69 @@ let rec make_eexpr_of_ast (a: tree) : expr 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 (a: tree) typ_var typ_fun ret_typ: instr res =
let res =
match a with
| NullLeaf -> OK(Iblock [])
| Node(Tcall, StringLeaf(name)::r) ->
let args_list = (match r with
| Node(Targs, l )::[] -> l
| _ -> []
) in
list_map_res (fun e -> make_eexpr_of_ast e) args_list >>= fun args_expr ->
OK (Icall(name, args_expr))
list_map_res (fun e -> make_eexpr_of_ast e typ_var typ_fun) args_list >>= fun args_expr ->
let (args_expr, args_t) = List.split args_expr in
let returned_expression = Icall(name, args_expr) in
let (args_typ,_) = Hashtbl.find typ_fun name in
if (List.length args_typ) != (List.length args_t) then Error (Format.sprintf "%s called with %d instead of %d" name (List.length args_t) (List.length args_typ) ) else
let does_args_typ_match = List.for_all2 (=) args_typ args_t in
if does_args_typ_match then
let* t = type_expr typ_var typ_fun (Ecall(name, args_expr)) in
OK (returned_expression)
else Error (Format.sprintf "arguments types does not match in expression calling %s" name)
| Node(t, e1::i1::i2) when t = Tif ->
make_eexpr_of_ast e1 >>= fun expr1 ->
make_einstr_of_ast i1 >>= fun inst1 ->
make_eexpr_of_ast e1 typ_var typ_fun>>= fun (expr1,_) ->
make_einstr_of_ast i1 typ_var typ_fun ret_typ>>= fun inst1 ->
(match i2 with
| [] -> OK (Iif(expr1,inst1,Iblock([])))
| [i2'] -> make_einstr_of_ast (i2') >>= fun inst2 -> OK (Iif(expr1, inst1 , inst2))
| [i2'] -> make_einstr_of_ast (i2') typ_var typ_fun ret_typ >>= fun inst2 -> OK (Iif(expr1, inst1 , inst2))
| _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s" (string_of_ast a)))
| Node(t,[i1]) when t = Tassign -> make_einstr_of_ast i1
| Node(t,[i1]) when t = Tassign -> make_einstr_of_ast i1 typ_var typ_fun ret_typ
| Node(t,[StringLeaf(str);e1;Node(ty,[])]) when t = Tassignvar ->
let* ty = is_type ty in
if ty = Tvoid then Error (Format.sprintf "variable %s cannot be void" str) else
(Hashtbl.replace typ_var str ty;
(match e1 with
| NullLeaf -> OK(Iblock [])
| _ -> make_eexpr_of_ast e1 typ_var typ_fun >>= fun (expr1,ty') ->
if ty = ty'
then OK(Iassign(str,expr1))
else Error (Format.sprintf "Can't assign %s to %s" (string_of_typ ty') str)
))
| Node(t,[StringLeaf(str);e1]) when t = Tassignvar ->
make_eexpr_of_ast e1 >>= fun expr1 ->
OK(Iassign(str,expr1))
(match Hashtbl.find_option typ_var str with
| Some ty -> make_eexpr_of_ast e1 typ_var typ_fun >>= fun (expr1,ty') ->
if ty = ty'
then OK(Iassign(str,expr1))
else Error (Format.sprintf "Can't assign %s to %s" (string_of_typ ty') str)
| None -> Error (Format.sprintf "Can't assign untyped var %s" str))
| Node(t,[e1;i1]) when t = Twhile ->
make_eexpr_of_ast e1 >>= fun expr1 ->
make_einstr_of_ast i1 >>= fun inst1 ->
make_eexpr_of_ast e1 typ_var typ_fun>>= fun (expr1,_) ->
make_einstr_of_ast i1 typ_var typ_fun ret_typ>>= fun inst1 ->
OK(Iwhile(expr1, inst1))
| Node(t,li) when t = Tblock ->
list_map_res (fun i -> make_einstr_of_ast i) li >>= fun inst_res ->
list_map_res (fun i -> make_einstr_of_ast i typ_var typ_fun ret_typ) li >>= fun inst_res ->
OK(Iblock(inst_res))
| Node(t,[e1]) when tag_is_unary_inst t ->
make_eexpr_of_ast e1 >>= fun expr1 ->
OK(uniinst_of_tag expr1 t)
| Node(t,[e1]) when t = Treturn ->
make_eexpr_of_ast e1 typ_var typ_fun>>= fun (expr1,ty) ->
(match are_types_compatible ret_typ ty with
| OK(t) -> OK(Ireturn expr1)
| Error q-> Error (Format.sprintf "Bad return type"))
| _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s"
(string_of_ast a))
......@@ -128,19 +186,31 @@ 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, [Node(t,[]);s]) ->
let* t = is_type t in
OK (string_of_stringleaf 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 (a: tree) (typ_fun: (string, typ list * typ) Hashtbl.t): (string * efun) option res =
match a with
| Node (Tfundef, [StringLeaf fname; Node (Tfunargs, fargs); fbody]) ->
| Node (Tfundef, [Node(retTyp,[]); StringLeaf fname; Node (Tfunargs, fargs); fbody]) ->
is_type retTyp >>= fun retTyp ->
list_map_res make_ident fargs >>= fun fargs ->
make_einstr_of_ast fbody >>= fun fbody ->
OK((fname, {funargs= fargs; funbody = fbody}))
let typ_var = Hashtbl.of_list fargs in
Hashtbl.replace typ_fun fname ((snd (List.split fargs)), retTyp);
(match fbody with
| NullLeaf -> OK(None)
| _ -> make_einstr_of_ast fbody typ_var typ_fun retTyp>>= fun fbodye ->
OK(Some (fname, {
funargs= fargs;
funbody = fbodye;
funvartyp = typ_var;
funrettype = retTyp;
})))
| _ ->
Error (Printf.sprintf "make_fundef_of_ast: Expected a Tfundef, got %s."
(string_of_ast a))
......@@ -148,7 +218,15 @@ 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_filter (fun a -> make_fundef_of_ast a fun_typ >>= fun efun_option ->
match efun_option with
| Some (fname, efun) -> OK (Some (fname, Gfun efun))
| _ -> OK(None)
) l
| _ ->
Error (Printf.sprintf "make_fundef_of_ast: Expected a Tlistglobdef, got %s."
(string_of_ast a))
......
......@@ -27,7 +27,7 @@ let rec dump_eexpr = function
| Eint i -> Printf.sprintf "%d" i
| Evar s -> Printf.sprintf "%s" s
| Ecall (name,expr_list) -> Printf.sprintf "%s(%s)" name (String.concat ", " (List.map dump_eexpr expr_list))
| Echar c -> Printf.sprintf "'%c'" c
let indent_size = 2
let spaces n =
......@@ -60,7 +60,7 @@ let rec dump_einstr_rec indent oc i =
| Iprint(e) ->
print_spaces oc indent;
Format.fprintf oc "print %s;\n" (dump_eexpr e)
| Icall (name,expr_list) -> Format.fprintf oc "%s(%s)\n" name (String.concat ", " (List.map dump_eexpr expr_list))
| Icall (name,expr_list) -> Format.fprintf oc "%s(%s);\n" name (String.concat ", " (List.map dump_eexpr expr_list))
let dump_einstr oc i = dump_einstr_rec 0 oc i
......@@ -69,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 "," (fst (List.split funargs)))
dump_einstr funbody
let dump_eprog oc = dump_prog dump_efun oc
......
......@@ -48,13 +48,14 @@ let rec eval_eexpr oc (ep: eprog) st (e : expr) : (int * int Prog.state) res =
| None -> Error (Format.sprintf "Unknown variable %s\n" str)
| Some(name) -> OK(name, st))
| Eint(n) -> OK(n, st)
| Echar c -> OK(Char.code c,st)
| Ecall(name,expr_list) ->
let* (args, st) = List.fold_left (fun acc expr ->
let* (expr_l, st) = acc in
let* (arg_expr, st) = eval_eexpr oc ep st expr in
OK(expr_l@[arg_expr], st)
) (OK([], st)) expr_list in
match find_function ep name with
(match find_function ep name with
| OK f ->
let* (res,st) = eval_efun oc ep st f name args in
(match res with
......@@ -62,9 +63,9 @@ let rec eval_eexpr oc (ep: eprog) st (e : expr) : (int * int Prog.state) res =
| None -> Error (Format.sprintf "Error with function %s" name))
| Error _ ->
let* ret = do_builtin oc st.mem name args in
match ret with
(match ret with
| Some n -> OK(n, st)
| None -> Error (Format.sprintf "Error: %s doesn't return anything" name)
| None -> Error (Format.sprintf "Error: %s doesn't return anything" name)))
(* [eval_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st].
......@@ -147,7 +148,7 @@ and eval_efun oc (ep: eprog) (st: int state) ({ 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 v -> Hashtbl.replace env a v) (fst (List.split funargs)) vargs with
| () ->
eval_einstr oc ep { st with env } funbody >>= fun (v, st') ->
OK (v, { st' with env = env_save })
......@@ -182,6 +183,6 @@ let eval_eprog oc (ep: eprog) (memsize: int) (params: int list)
let params = take n params in
let { env } = st in
let { funargs } = f in
List.iter2 (fun argname argval -> Hashtbl.replace env argname argval) funargs params;
List.iter2 (fun argname argval -> Hashtbl.replace env argname argval) (fst (List.split funargs)) params;
eval_efun oc ep st f "main" params >>= fun (v, st) ->
OK v
......@@ -67,3 +67,14 @@ 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)
type typ =
Tint
| Tchar
| Tvoid
let string_of_typ t =
match t with
| Tint -> "int"
| Tchar -> "char"
| Tvoid -> "void"
\ No newline at end of file
......@@ -246,6 +246,15 @@ let list_map_res f l =
OK (acc@[e])
) (OK []) l
let list_map_res_filter f l =
List.fold_left (fun acc e ->
acc >>= fun acc ->
f e >>= fun e ->
match e with
| None -> OK acc
| Some o -> OK (acc@[o])
) (OK []) l
let list_map_resi f l =
List.fold_lefti (fun acc i e ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment