Lexeur repare et tout est OK jusque debut TP4

opts.mk

 CONF_OPTS=
 
 # Use handwritten lexer
-#CONF_OPTS+=-l
+CONF_OPTS+=-l
 
 # Use ocamllex lexer
-CONF_OPTS+=-L
+#CONF_OPTS+=-L
 
 # Use alpaga parser
 CONF_OPTS+=-a

src/elang_gen.ml

@@ -48,10 +48,10 @@ let rec make_eexpr_of_ast (a: tree) : expr res =
       make_eexpr_of_ast e1 >>= (fun expr1 -> 
         make_eexpr_of_ast e2 >>= (fun expr2 ->
           OK (Ebinop (binop_of_tag t,expr1,expr2))))
-    | Node(t,[e]) -> make_eexpr_of_ast e >>= fun expr -> OK (Eunop (Eneg,expr ))
-
-    | IntLeaf (a) -> OK (Eint a)
-    | StringLeaf (s) -> OK(Evar s)
+    | Node(Tneg,[e]) -> make_eexpr_of_ast e >>= fun expr -> OK (Eunop (Eneg,expr ))
+    | Node (Tint,[IntLeaf(a)]) -> OK (Eint a)
+    | IntLeaf(a) -> OK (Eint a)
+    | StringLeaf(s) -> OK (Evar s )
     | _ -> Error (Printf.sprintf "Unacceptable ast in make_eexpr_of_ast %s"
                     (string_of_ast a))
   in
@@ -76,6 +76,10 @@ let rec make_einstr_of_ast (a: tree) : instr res =
         make_einstr_of_ast i1 >>= fun instr1 ->
           make_einstr_of_ast i2 >>= fun instr2 ->
             OK (Iif(expr, instr1, instr2 )))
+    |Node (Tif, [e;i]) -> 
+      make_eexpr_of_ast e >>= (fun expr ->
+        make_einstr_of_ast i >>= fun instr1 ->
+          OK (Iif(expr, instr1, Iblock [] )))
       
     | Node (Twhile,[e;i]) -> 
       make_eexpr_of_ast e >>= (fun expr ->

src/elang_run.ml

@@ -9,17 +9,44 @@ 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 -> binop_bool_to_int (fun x y -> x < y) x y
+   | Ecle -> fun x y -> binop_bool_to_int (fun x y -> x <= y) x y 
+   | Ecgt -> fun x y -> binop_bool_to_int (fun x y -> x > y) x y
+   | Ecge -> fun x y -> binop_bool_to_int (fun x y -> x >= y) x y
+   | Eceq -> fun x y -> binop_bool_to_int (fun x y -> x = y) x y
+   | Ecne -> fun x y -> binop_bool_to_int  (fun x y -> not(x = y)) x y 
 
 (* [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 x-> OK (x)
+   | Evar x -> 
+      begin 
+      match Hashtbl.find_option st.env x with
+         | Some a -> OK (a)
+         | None -> Error "Une erreur dans eval_expr"
+      end
+   | Ebinop (b, e1, e2) -> 
+      eval_eexpr st e1 >>! (fun expr1 -> 
+      eval_eexpr st e2 >>! (fun expr2 -> 
+      OK (eval_binop b expr1 expr2)))
+   | Eunop (b, e) -> 
+      eval_eexpr st e >>! (fun expr ->
+         OK (eval_unop b expr))
+      
+   | _ -> Error "Une erreur dans eval_expr"
 
 (* [eval_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st].
 
@@ -35,7 +62,38 @@ 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 (key, expr) -> 
+   begin
+   match (Hashtbl.find_option st.env key) with 
+   | Some v -> eval_eexpr st expr >>! fun expr_evaluated -> 
+      let _ = Hashtbl.replace st.env key (expr_evaluated) in OK (None,st)
+   | None -> eval_eexpr st expr >>! fun expr_evaluated -> 
+      let _ = Hashtbl.add st.env key expr_evaluated in OK (None, st)
+   end
+
+  | Iif (expr,i1,i2) -> 
+   if eval_eexpr st expr = OK (1) then eval_einstr oc st i1 else eval_einstr oc st i2
+
+  | Iwhile (expr,instr) -> if eval_eexpr st expr = OK(1) then 
+   eval_einstr oc st instr >>= fun (ret,nstate) -> 
+      if ret = None then eval_einstr oc nstate ins else OK (ret, nstate)
+   else OK (None, st)
+      
+  | Iblock (instr_list) -> 
+   begin
+   match instr_list with
+   | [] -> OK (None, st)
+   | i1::r -> eval_einstr oc st i1 >>= (fun (ret,new_state) ->
+         if ret = None then 
+            eval_einstr oc new_state (Iblock r) else 
+            OK (ret, new_state))
+            end
+  | Ireturn e -> eval_eexpr st (e) >>= fun expr_evaluated -> OK (Some (expr_evaluated), st)
+  | Iprint e ->  
+      let _ = eval_eexpr st e >>! fun expr_evaluated -> Format.fprintf oc "%d\n" (expr_evaluated) in 
+      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].

src/lexer_generator.ml

@@ -51,7 +51,7 @@ let cat_nfa n1 n2 =
    nfa_final = n2.nfa_final;
    nfa_step = fun q -> 
     if (List.mem q (List.map (fst) n1.nfa_final ))
-      then List.map (fun q -> (None,q)) n2.nfa_initial 
+      then (List.map (fun q -> (None,q)) n2.nfa_initial)@(n1.nfa_step q) 
   else
     n1.nfa_step q @ n2.nfa_step q 
 
@@ -76,7 +76,7 @@ let star_nfa n t =
    nfa_final = List.map (fun (q,tr) -> (q,t)) n.nfa_final;
    nfa_step = fun q -> 
     if (List.mem q (List.map (fst) n.nfa_final ))
-      then List.map (fun q -> (None,q)) n.nfa_initial
+      then (List.map (fun q -> (None,q)) n.nfa_initial)@n.nfa_step q
   else
     n.nfa_step q