diff --git a/src/elang.ml b/src/elang.ml
index 72b8e18b5c4a94b0226063a502ed274af1822d59..3e6fcf012826f4a0714f8c1d2398dc0a2381ec66 100644
--- a/src/elang.ml
+++ b/src/elang.ml
@@ -6,7 +6,7 @@ type unop = Eneg
type expr =
Ebinop of binop * expr * expr
- | Eunop of unop * expr
+ | Eunop of unop * expr (*unused*)
| Eint of int
| Evar of string
diff --git a/src/elang_gen.ml b/src/elang_gen.ml
index be904b1e67d18e2c0f25d8896b1610cc1dbe287e..86761b7c4a9e47be776d2524366983f78a0b6712 100644
--- a/src/elang_gen.ml
+++ b/src/elang_gen.ml
@@ -44,10 +44,18 @@ let binop_of_tag =
let rec make_eexpr_of_ast (a: tree) : expr res =
let res =
match a with
+ (* TODO *)
+ | IntLeaf i -> OK (Eint i)
+ | StringLeaf s -> OK (Evar s)
| Node(t, [e1; e2]) when tag_is_binop t ->
- Error (Printf.sprintf "Unacceptable ast in make_eexpr_of_ast %s"
- (string_of_ast a))
- | _ -> Error (Printf.sprintf "Unacceptable ast in make_eexpr_of_ast %s"
+ (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)))
+ | _ ->
+ Error (Printf.sprintf "Unacceptable ast in make_eexpr_of_ast %s"
(string_of_ast a))
in
match res with
@@ -59,6 +67,43 @@ let rec make_einstr_of_ast (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)
+ | 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)))
+ | 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))
+ | 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)
+ | 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)
+ | NullLeaf -> OK (Iblock [])
| _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s"
(string_of_ast a))
in
@@ -76,10 +121,11 @@ let make_ident (a: tree) : string res =
let make_fundef_of_ast (a: tree) : (string * efun) res =
match a with
- | Node (Tfundef, [StringLeaf fname; Node (Tfunargs, fargs); fbody]) ->
+ | Node (Tfundef, [Node(Tfunname, [StringLeaf fname]); Node (Tfunargs, fargs); Node(Tfunbody, [fbody])]) ->
list_map_res make_ident fargs >>= fun fargs ->
(* TODO *)
- Error "make_fundef_of_ast: Not implemented, yet."
+ make_einstr_of_ast fbody >>= fun fbody ->
+ OK (fname, {funargs = fargs; funbody = fbody})
| _ ->
Error (Printf.sprintf "make_fundef_of_ast: Expected a Tfundef, got %s."
(string_of_ast a))
diff --git a/src/elang_run.ml b/src/elang_run.ml
index 494b2c6ac0da84d327a4e1016b7da8f57b3ae57e..13afe7c5df8d3890b2e4eaf6ef834bd4235c1723 100644
--- a/src/elang_run.ml
+++ b/src/elang_run.ml
@@ -9,17 +9,46 @@ let binop_bool_to_int f x y = if f x y then 1 else 0
et [y]. *)
let eval_binop (b: binop) : int -> int -> int =
match b with
- | _ -> fun x y -> 0
+ | Eadd -> fun x y -> x + y
+ | Emul -> fun x y -> x * y
+ | Emod -> fun x y -> x mod y
+ | Exor -> fun x y -> x lxor y
+ | Ediv -> fun x y -> x / y
+ | Esub -> fun x y -> x - y
+ | Eclt -> fun x y -> if x < y then 1 else 0
+ | Ecle -> fun x y -> if x <= y then 1 else 0
+ | Ecgt -> fun x y -> if x > y then 1 else 0
+ | Ecge -> fun x y -> if x >= y then 1 else 0
+ | Eceq -> fun x y -> if x = y then 1 else 0
+ | Ecne -> fun x y -> if x != y then 1 else 0
+
(* [eval_unop u x] évalue l'opération unaire [u] sur l'argument [x]. *)
let eval_unop (u: unop) : int -> int =
match u with
- | _ -> fun x -> 0
+ | Eneg -> fun x -> -x
(* [eval_eexpr st e] évalue l'expression [e] dans l'état [st]. Renvoie une
erreur si besoin. *)
let rec eval_eexpr st (e : expr) : int res =
- Error "eval_eexpr not implemented yet."
+ match e with
+ | Eint i -> OK i
+ | Evar s ->
+ (match Hashtbl.find_option st.env s with
+ | Some i -> OK i
+ | None -> Error "Variable is not defined")
+ | Ebinop (b, ex, ey) ->
+ (let res_x = eval_eexpr st ex
+ in let res_y = eval_eexpr st ey
+ in match res_x, res_y with
+ | Error msg, _ -> Error msg
+ | _, Error msg -> Error msg
+ | OK x, OK y -> OK (eval_binop b x y))
+ | Eunop (u, ex) ->
+ (let res_x = eval_eexpr st ex
+ in match res_x with
+ | Error msg -> Error msg
+ | OK x -> OK (eval_unop u x ))
(* [eval_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st].
@@ -35,7 +64,50 @@ let rec eval_eexpr st (e : expr) : int res =
- [st'] est l'état mis à jour. *)
let rec eval_einstr oc (st: int state) (ins: instr) :
(int option * int state) res =
- Error "eval_einstr not implemented yet."
+ match ins with
+ | Iassign (s, e) ->
+ (match eval_eexpr st e with
+ | Error msg -> Error msg
+ | OK v ->
+ 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))
+ | Iif (e, i1, i2) ->
+ (match eval_eexpr st e with
+ | Error msg -> Error msg
+ | OK v -> if v=1 then eval_einstr oc st i1 else eval_einstr oc st i2)
+ | Iwhile (e, i) ->
+ (match eval_eexpr st e with
+ | Error msg -> Error msg
+ | OK v ->
+ if v=1
+ then (let res_i = eval_einstr oc st 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 (Iwhile (e, i))
+ | Some r -> OK (r_opt, next_st))
+ else OK(None, st))
+ | Iblock i_list ->
+ (match i_list with
+ | [] -> OK (None, st)
+ | i::rest ->
+ match eval_einstr oc st 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 (Iblock rest))
+ | Ireturn e ->
+ (match eval_eexpr st e with
+ | Error msg -> Error msg
+ | OK v -> OK(Some v, st))
+ | Iprint e ->
+ (match eval_eexpr st e with
+ | Error msg -> Error msg
+ | OK v ->
+ Format.fprintf oc "%d\n" v;
+ 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].