expr_grammar_action.g

@@ -10,6 +10,9 @@ non-terminals ADD_EXPRS ADD_EXPR
 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
+
 axiom S
 {
 
@@ -20,6 +23,10 @@ axiom S
   open Batteries
   open Utils
 
+  type after_id =
+  | Assign of tree
+  | Funcall of tree list
+  | Nothing
 
   (* TODO *)
   let rec resolve_associativity (term : tree) (other : (tag * tree) list) =
@@ -40,6 +47,11 @@ LPARAMS -> { [] }
 REST_PARAMS -> SYM_COMMA LPARAMS { $2 }
 REST_PARAMS -> { [] }
 
+LARGS -> EXPR REST_ARGS { $1::$2 }
+LARGS -> { [] }
+REST_ARGS -> SYM_COMMA LARGS { $2 }
+REST_ARGS -> { [] }
+
 LINSTRS -> INSTR INSTRS { Node(Tblock, $1::$2) }
 LINSTRS -> { NullLeaf }
 INSTRS -> INSTR INSTRS { $1::$2 }
@@ -49,9 +61,18 @@ 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 SYM_ASSIGN EXPR SYM_SEMICOLON { Node(Tassign, [$1; $3]) }
+INSTR -> IDENTIFIER AFTER_IDENTIFIER SYM_SEMICOLON { 
+  match $2 with
+  | Assign exp -> Node(Tassign, [$1; exp]) 
+  | Funcall args -> Node(Tcall, [$1; Node(Targs, args)]) 
+  | _ -> $1 
+}
 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 }
+
 ELSE -> SYM_ELSE SYM_LBRACE LINSTRS SYM_RBRACE { $3 }
 ELSE -> { NullLeaf }
 
@@ -59,6 +80,8 @@ EXPR -> EQ_EXPR EQ_EXPRS { resolve_associativity $1 $2 }
 EQ_EXPR -> CMP_EXPR CMP_EXPRS { resolve_associativity $1 $2 }
 CMP_EXPR -> ADD_EXPR ADD_EXPRS { resolve_associativity $1 $2 }
 ADD_EXPR -> MUL_EXPR MUL_EXPRS { resolve_associativity $1 $2 }
+ADD_EXPR -> SYM_MINUS MUL_EXPR MUL_EXPRS { resolve_associativity (Node(Tneg, [$2])) $3 }
+ADD_EXPR -> SYM_PLUS MUL_EXPR MUL_EXPRS { resolve_associativity $2 $3 }
 MUL_EXPR -> FACTOR { $1 }
 
 EQ_EXPRS -> SYM_EQUALITY EQ_EXPR EQ_EXPRS { (Tceq, $2)::$3 } 
@@ -81,7 +104,12 @@ MUL_EXPRS -> SYM_MOD MUL_EXPR MUL_EXPRS { (Tmod, $2)::$3 }
 MUL_EXPRS -> { [] }
 
 FACTOR -> INTEGER { $1 }
-FACTOR -> IDENTIFIER { $1 }
+FACTOR -> IDENTIFIER AFTER_IDENTIFIER { 
+  match $2 with
+  | Funcall args -> Node(Tcall, [$1; Node(Targs, args)])
+  | Nothing -> $1
+  | _ -> $1
+}
 FACTOR -> SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS { $2 }
 
 IDENTIFIER -> SYM_IDENTIFIER {StringLeaf $1}

src/ast.ml

@@ -28,9 +28,9 @@ type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tprint
          | Tclt | Tcgt | Tcle | Tcge | Tceq | Tne
          | Tneg
          | Tlistglobdef
-         | Tfundef | Tfunname | Tfunargs | Tfunbody
+         | Tfundef | Tfunname | Tfunargs | Tfunbody | Tcall
          | Tassignvar
-         | Targ
+         | Targ | Targs
 
 type tree = | Node of tag * tree list
             | StringLeaf of string
@@ -73,7 +73,8 @@ let string_of_tag = function
   | Tfunbody -> "Tfunbody"
   | Tassignvar -> "Tassignvar"
   | Targ -> "Targ"
-
+  | Tcall -> "Tcall"
+  | Targs -> "Targs"
 
 (* Écrit un fichier .dot qui correspond à un AST *)
 let rec draw_ast a next =

src/cfg.ml

@@ -8,6 +8,7 @@ type expr =
   | Eunop of unop * expr
   | Eint of int
   | Evar of string
+  | Ecall of string * expr list
 
 type cfg_node =
   | Cassign of string * expr * int
@@ -15,6 +16,7 @@ type cfg_node =
   | Cprint of expr * int
   | Ccmp of expr * int * int
   | Cnop of int
+  | Ccall of string * expr list * int
 
 type cfg_fun = {
   cfgfunargs: string list;
@@ -35,7 +37,7 @@ let succs cfg n =
   | Some (Creturn _) -> Set.empty
   | Some (Ccmp (_, s1, s2)) -> Set.of_list [s1;s2]
   | Some (Cnop s) -> Set.singleton s
-
+  | Some (Ccall (_, _, s)) -> Set.singleton s
 
 (* [preds cfg n] donne l'ensemble des prédécesseurs d'un nœud [n] dans un CFG [cfg]
    *)
@@ -44,7 +46,8 @@ let preds cfgfunbody n =
       match m' with
       | Cassign (_, _, s)
       | Cprint (_, s)
-      | Cnop s -> if s = n then Set.add m acc else acc
+      | Cnop s 
+      | Ccall (_, _, s) -> if s = n then Set.add m acc else acc
       | Creturn _ -> acc
       | Ccmp (_, s1, s2) -> if s1 = n || s2 = n then Set.add m acc else acc
     ) cfgfunbody Set.empty
@@ -62,6 +65,7 @@ let rec size_expr (e: expr) : int =
   | Eunop (u, e) -> size_unop u (size_expr e)
   | Eint _ -> 1
   | Evar _ -> 1
+  | Ecall (_, args) -> 1 + List.fold_left (fun acc arg -> acc + size_expr arg) 0 args
 
 let size_instr (i: cfg_node) : int =
   match (i : cfg_node) with
@@ -70,6 +74,7 @@ let size_instr (i: cfg_node) : int =
   | 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
 
 let size_fun f =
   Hashtbl.fold (fun _ v acc -> acc + size_instr v) f 0

src/cfg_gen.ml

@@ -25,6 +25,9 @@ let rec cfg_expr_of_eexpr (e: Elang.expr) : expr res =
   | Elang.Eint i -> OK (Eint i)
   | Elang.Evar v ->
     OK (Evar v)
+  | Elang.Ecall (f, args) -> 
+    list_map_res cfg_expr_of_eexpr args >>= fun es ->
+    OK (Ecall (f, es))
 
 (* [cfg_node_of_einstr next cfg succ i] builds the CFG node(s) that correspond
    to the E instruction [i].
@@ -70,6 +73,11 @@ let rec cfg_node_of_einstr (next: int) (cfg : (int, cfg_node) Hashtbl.t)
     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));
+    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
@@ -86,6 +94,7 @@ let rec reachable_nodes n (cfg: (int,cfg_node) Hashtbl.t) =
       | Some (Creturn _) -> reach
       | Some (Ccmp (_, s1, s2)) ->
         reachable_aux s1 (reachable_aux s2 reach)
+      | Some (Ccall (_, _, succ)) -> reachable_aux succ reach
   in reachable_aux n Set.empty
 
 (* [cfg_fun_of_efun f] builds the CFG for E function [f]. *)

src/cfg_liveness.ml

@@ -12,6 +12,7 @@ let rec vars_in_expr (e: expr) =
    | Evar s -> Set.singleton s
    | Ebinop (b, e1, e2) -> Set.union (vars_in_expr e1) (vars_in_expr e2)
    | Eunop (u, e) -> vars_in_expr e
+   | Ecall (f, args) -> set_concat (List.map vars_in_expr args)
 
 (* [live_after_node cfg n] renvoie l'ensemble des variables vivantes après le
    nœud [n] dans un CFG [cfg]. [lives] est l'état courant de l'analyse,
@@ -34,6 +35,7 @@ let live_cfg_node (node: cfg_node) (live_after: string Set.t) =
          | 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))
       in let def node =
             match node with
             | Cassign (s, e, i) -> Set.singleton s

src/cfg_nop_elim.ml

@@ -67,7 +67,8 @@ let replace_succs nop_succs (n: cfg_node) =
    | 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)
-   | _ -> n
+   | Creturn e -> Creturn e
+   | Ccall (f, args, i) -> Ccall (f, args, replace_succ nop_succs i)
 
 (* [nop_elim_fun f] applique la fonction [replace_succs] à chaque nœud du CFG. *)
 let nop_elim_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =

src/cfg_print.ml

@@ -8,6 +8,7 @@ let rec dump_cfgexpr : expr -> string = function
   | Eunop(u, e) -> Format.sprintf "(%s %s)" (dump_unop u) (dump_cfgexpr e)
   | Eint i -> Format.sprintf "%d" i
   | Evar s -> Format.sprintf "%s" s
+  | Ecall (f, args) -> Format.sprintf "%s(%s)" f (String.concat ", " (List.map dump_cfgexpr args))
 
 let dump_list_cfgexpr l =
   l |> List.map dump_cfgexpr |> String.concat ", "
@@ -17,7 +18,8 @@ let dump_arrows oc fname n (node: cfg_node) =
   match node with
   | Cassign (_, _, succ)
   | Cprint (_, succ)
-  | Cnop succ ->
+  | Cnop succ 
+  | Ccall (_, _, succ) ->
     Format.fprintf oc "n_%s_%d -> n_%s_%d\n" fname n fname succ
   | Creturn _ -> ()
   | Ccmp (_, succ1, succ2) ->
@@ -32,7 +34,7 @@ let dump_cfg_node oc (node: cfg_node) =
   | Creturn e -> Format.fprintf oc "return %s" (dump_cfgexpr e)
   | Ccmp (e, _, _) -> Format.fprintf oc "%s" (dump_cfgexpr e)
   | Cnop _ -> Format.fprintf oc "nop"
-
+  | Ccall (f, args, _) -> Format.fprintf oc "%s(%s)" f (String.concat ", " (List.map dump_cfgexpr args))
 
 let dump_liveness_state oc ht state =
   Hashtbl.iter (fun n cn ->

src/cfg_run.ml

@@ -7,52 +7,81 @@ open Cfg
 open Utils
 open Builtins
 
-let rec eval_cfgexpr st (e: expr) : int res =
+let rec eval_cfgexpr oc st cp (e: expr) : (int * int state) res =
   match e with
   | Ebinop(b, e1, e2) ->
-    eval_cfgexpr st e1 >>= fun v1 ->
-    eval_cfgexpr st e2 >>= fun v2 ->
+    eval_cfgexpr oc st cp e1 >>= fun (v1, st') ->
+    eval_cfgexpr oc st' cp e2 >>= fun (v2, st'') ->
     let v = eval_binop b v1 v2 in
-    OK v
+    OK (v, st'')
   | Eunop(u, e) ->
-    eval_cfgexpr st e >>= fun v1 ->
+    eval_cfgexpr oc st cp e >>= fun (v1, st') ->
     let v = (eval_unop u v1) in
-    OK v
-  | Eint i -> OK i
+    OK (v, st')
+  | Eint i -> OK (i, st)
   | Evar s ->
     begin match Hashtbl.find_option st.env s with
-      | Some v -> OK v
+      | Some v -> OK (v, st)
       | None -> Error (Printf.sprintf "Unknown variable %s\n" s)
     end
-
-let rec eval_cfginstr oc st ht (n: int): (int * int state) res =
+  | Ecall (f, args) ->
+      List.fold_left (
+        fun (acc : (int list * int state) res) (arg : expr) -> 
+        match acc with
+        | Error msg -> Error msg
+        | OK (l, st') -> 
+            match eval_cfgexpr oc st' cp arg with
+            | 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'')
+  
+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")
   | Some node ->
     match node with
     | Cnop succ ->
-      eval_cfginstr oc st ht succ
+      eval_cfginstr oc st cp ht succ
     | Cassign(v, e, succ) ->
-      eval_cfgexpr st e >>= fun i ->
-      Hashtbl.replace st.env v i;
-      eval_cfginstr oc st ht succ
+      eval_cfgexpr oc st cp e >>= fun (i, st') ->
+      Hashtbl.replace st'.env v i;
+      eval_cfginstr oc st' cp ht succ
     | Ccmp(cond, i1, i2) ->
-      eval_cfgexpr st cond >>= fun i ->
-      if i = 0 then eval_cfginstr oc st ht i2 else eval_cfginstr oc st ht i1
+      eval_cfgexpr oc st cp cond >>= fun (i, st') ->
+      if i = 0 then eval_cfginstr oc st' cp ht i2 else eval_cfginstr oc st' cp ht i1
     | Creturn(e) ->
-      eval_cfgexpr st e >>= fun e ->
-      OK (e, st)
+      eval_cfgexpr oc st cp e >>= fun (e, st') ->
+      OK (e, st')
     | Cprint(e, succ) ->
-      eval_cfgexpr st e >>= fun e ->
+      eval_cfgexpr oc st cp e >>= fun (e, st') ->
       Format.fprintf oc "%d\n" e;
-      eval_cfginstr oc st ht succ
+      eval_cfginstr oc st' cp ht succ
+    | Ccall (f, args, succ) ->
+      List.fold_left (
+        fun (acc : (int list * int state) res) (arg : expr) -> 
+        match acc with
+        | Error msg -> Error msg
+        | OK (l, st') -> 
+            match eval_cfgexpr oc st' cp arg with
+            | 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 ->
+              eval_cfgfun oc st' cp f found_f int_args >>= fun (ret, st'') -> 
+              eval_cfginstr oc st'' cp ht succ
 
-let eval_cfgfun oc st cfgfunname { cfgfunargs;
+and eval_cfgfun oc st cp cfgfunname { cfgfunargs;
                                       cfgfunbody;
                                       cfgentry} vargs =
   let st' = { st with env = Hashtbl.create 17 } in
   match List.iter2 (fun a v -> Hashtbl.replace st'.env a v) cfgfunargs vargs with
-  | () -> eval_cfginstr oc st' cfgfunbody cfgentry >>= fun (v, st') ->
+  | () -> eval_cfginstr oc st' cp cfgfunbody cfgentry >>= fun (v, st') ->
     OK (Some v, {st' with env = st.env})
   | exception Invalid_argument _ ->
     Error (Format.sprintf "CFG: Called function %s with %d arguments, expected %d.\n"
@@ -64,7 +93,7 @@ let eval_cfgprog oc cp memsize params =
   find_function cp "main" >>= fun f ->
   let n = List.length f.cfgfunargs in
   let params = take n params in
-  eval_cfgfun oc st "main" f params >>= fun (v, st) ->
+  eval_cfgfun oc st cp "main" f params >>= fun (v, st) ->
   OK v
 
 

src/elang.ml

@@ -6,9 +6,10 @@ type unop = Eneg
 
 type expr =
     Ebinop of binop * expr * expr
-  | Eunop of unop * expr (*unused in grammar*)
+  | Eunop of unop * expr
   | Eint of int
   | Evar of string
+  | Ecall of string * expr list
 
 type instr =
   | Iassign of string * expr
@@ -17,6 +18,7 @@ type instr =
   | Iblock of instr list
   | Ireturn of expr
   | Iprint of expr
+  | Icall of string * expr list
 
 type efun = {
   funargs: ( string ) list;

src/elang_gen.ml

@@ -54,6 +54,16 @@ let rec make_eexpr_of_ast (a: tree) : expr res =
             | Error msg, _ -> Error msg
             | _, Error msg -> Error msg
             | OK expr1, OK 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)))
+    | 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)))
     | _ -> 
         Error (Printf.sprintf "Unacceptable ast in make_eexpr_of_ast %s"
                     (string_of_ast a))
@@ -103,6 +113,11 @@ let rec make_einstr_of_ast (a: tree) : instr res =
         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
+        | Error msg -> Error msg
+        | OK exprs -> OK (Icall (f, exprs)))
     | NullLeaf -> OK (Iblock [])
     | _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s"
                     (string_of_ast a))

src/elang_print.ml

@@ -26,6 +26,7 @@ let rec dump_eexpr = function
   | Eunop(u, e) -> Printf.sprintf "(%s %s)" (dump_unop u) (dump_eexpr e)
   | 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))
 
 let indent_size = 2
 let spaces n =
@@ -58,6 +59,10 @@ let rec dump_einstr_rec indent oc i =
   | 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))
+
 
 let dump_einstr oc i = dump_einstr_rec 0 oc i
 

src/elang_run.ml

@@ -30,26 +30,49 @@ 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 st (e : expr) : int res =
+let rec eval_eexpr oc st (ep: eprog) (e : expr) : (int * int state) res =
    match e with
-   | Eint i -> OK i
+   | Eint i -> OK (i, st)
    | Evar s -> 
       (match Hashtbl.find_option st.env s with
-      | Some i -> OK i
+      | Some i -> OK (i, st)
       | 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))
+      (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''))
    | Eunop (u, ex) ->
-      (let res_x = eval_eexpr st ex
+      (let res_x = eval_eexpr oc st ep ex
          in match res_x with
          | Error msg -> Error msg
-         | OK x -> OK (eval_unop u x ))
-
+         | OK (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') -> 
+            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
+               | 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_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st].
 
    Le paramètre [oc] est un "output channel", dans lequel la fonction "print"
@@ -62,59 +85,78 @@ let rec eval_eexpr st (e : expr) : int res =
    lieu et que l'exécution doit continuer.
 
    - [st'] est l'état mis à jour. *)
-let rec eval_einstr oc (st: int state) (ins: instr) :
+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 st e with
+      (match eval_eexpr oc st ep e with
          | Error msg -> Error msg
-         | OK v -> 
+         | OK (v, st') -> 
             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))
+               in OK (None, replace st' s v))
    | Iif (e, i1, i2) -> 
-      (match eval_eexpr st e with 
+      (match eval_eexpr oc st ep e with 
       | Error msg -> Error msg
-      | OK v -> if v=1 then eval_einstr oc st i1 else eval_einstr oc st i2)
+      | OK (v, st') -> if v = 0 then eval_einstr oc st' ep i2 else eval_einstr oc st' ep i1)
    | Iwhile (e, i) -> 
-      (match eval_eexpr st e with
+      (match eval_eexpr oc st ep e with
          | Error msg -> Error msg
-         | OK v ->
-            if v=1 
-               then (let res_i = eval_einstr oc st i
+         | 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 (Iwhile (e, i))
+                     | None -> eval_einstr oc next_st ep (Iwhile (e, i))
                      | Some r -> OK (r_opt, next_st)) 
-               else OK(None, st))
+               else OK(None, st'))
    | Iblock i_list -> 
       (match i_list with
       | [] -> OK (None, st)
       | i::rest -> 
-         match eval_einstr oc st i with
+         match eval_einstr oc st ep 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))
+         | OK (None, next_st) -> eval_einstr oc next_st ep (Iblock rest))
    | Ireturn e -> 
-      (match eval_eexpr st e with
+      (match eval_eexpr oc st ep e with
       | Error msg -> Error msg
-      | OK v -> OK(Some v, st))  
+      | OK (v, st') -> OK(Some v, st'))  
    | Iprint e -> 
-      (match eval_eexpr st e with
+      (match eval_eexpr oc st ep e with
       | Error msg -> Error msg
-      | OK v -> 
+      | OK (v, st') -> 
          Format.fprintf oc "%d\n" v;
-         OK(None, st))
+         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) -> 
+            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') -> 
+            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
+               | Error msg -> Error msg
+               | OK (_, st'') -> 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].
 
    Cette fonction renvoie un couple (ret, st') avec la même signification que
    pour [eval_einstr]. *)
-let eval_efun oc (st: int state) ({ funargs; funbody}: efun)
+and eval_efun oc (st: int state) ep ({ funargs; funbody}: efun)
     (fname: string) (vargs: int list)
   : (int option * int state) res =
   (* L'environnement d'une fonction (mapping des variables locales vers leurs
@@ -126,7 +168,7 @@ let eval_efun oc (st: int state) ({ funargs; funbody}: efun)
   let env = Hashtbl.create 17 in
   match List.iter2 (fun a v -> Hashtbl.replace env a v) funargs vargs with
   | () ->
-    eval_einstr oc { st with env } funbody >>= fun (v, st') ->
+    eval_einstr oc { st with env } ep funbody >>= fun (v, st') ->
     OK (v, { st' with env = env_save })
   | exception Invalid_argument _ ->
     Error (Format.sprintf
@@ -157,5 +199,5 @@ 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 f "main" params >>= fun (v, _) ->
+  eval_efun oc st ep f "main" params >>= fun (v, _) ->
   OK v

src/linear_gen.ml

@@ -19,23 +19,41 @@ let rec succs_of_rtl_instrs il : int list =
 
 (* effectue un tri topologique des blocs.  *)
 let sort_blocks (nodes: (int, rtl_instr list) Hashtbl.t) entry =
-  let rec add_block order n =
-   (* TODO *)
-   List.of_enum (Hashtbl.keys nodes)
+  let rec add_block order visited n =
+    (* TODO *)
+    List.of_enum (Hashtbl.keys nodes)
+    (*if Set.mem n visited 
+      then order
+      else let succs = succs_of_rtl_instrs (Hashtbl.find nodes n) 
+        in List.concat( (order@[n]) :: List.map (add_block [] (Set.add n visited)) succs )*)
   in
-  add_block [] entry
+  add_block [] Set.empty entry
 
 
 (* Supprime les jumps inutiles (Jmp à un label défini juste en dessous). *)
 let rec remove_useless_jumps (l: rtl_instr list) =
-   (* TODO *)
-   l
+  (* TODO *)
+  l
+  (*match l with
+  | [] -> []
+  | Rjmp l1::Rlabel l2::rest -> 
+      if l1=l2 
+        then Rlabel l2::remove_useless_jumps rest 
+        else Rjmp l1::Rlabel l2::remove_useless_jumps rest
+  | i::rest -> i::remove_useless_jumps rest*)
 
 
 (* Remove labels that are never jumped to. *)
 let remove_useless_labels (l: rtl_instr list) =
-   (* TODO *)
-   l
+  (* TODO *)
+  l
+  (*List.filter (function 
+    Rlabel i -> List.exists (
+      function 
+      Rbranch(_, _, _, j) -> j = i 
+      | Rjmp j -> j = i
+      | _ -> false) l
+    | _ -> true) l*)
 
 let linear_of_rtl_fun
     ({ rtlfunargs; rtlfunbody; rtlfunentry; rtlfuninfo }: rtl_fun) =

src/regalloc.ml

@@ -55,7 +55,7 @@ let regalloc_on_stack_fun (f: linear_fun) : ((reg, loc) Hashtbl.t * int)=
    avec le registre-clé. Cela correspond à la relation d'adjacence dans le
    graphe d'interférence. *)
 
-(* La fonction [add_to_interf rig x y] ajoute [y] à la liste des registres qui
+(* La fonction [add_to_interf rig x y] ajoute [y] à la liste des regiNosstres qui
    interfèrent avec [x] dans le graphe [rig].
 
    On pourra utiliser la fonction [Hashtbl.modify_def] qui permet de modifier la
@@ -79,7 +79,8 @@ let regalloc_on_stack_fun (f: linear_fun) : ((reg, loc) Hashtbl.t * int)=
 
 let add_interf (rig : (reg, reg Set.t) Hashtbl.t) (x: reg) (y: reg) : unit =
     (* TODO *)
-    ()
+    Hashtbl.modify_def Set.empty x (Set.add y) rig;
+    Hashtbl.modify_def Set.empty y (Set.add x) rig
 
 
 (* [make_interf_live rig live] ajoute des arcs dans le graphe d'interférence
@@ -89,8 +90,9 @@ let make_interf_live
     (rig: (reg, reg Set.t) Hashtbl.t)
     (live : (int, reg Set.t) Hashtbl.t) : unit =
     (* TODO *)
-   ()
+    Hashtbl.iter (fun i regs -> Set.iter (fun x -> Set.iter (fun y -> if x < y then add_interf rig x y) regs) regs) live
 
+      
 (* [build_interference_graph live_out] construit, en utilisant les fonctions que
    vous avez écrites, le graphe d'interférence en fonction de la vivacité des
    variables à la sortie des nœuds donné par [live_out].
@@ -120,9 +122,9 @@ let build_interference_graph (live_out : (int, reg Set.t) Hashtbl.t) code : (reg
 (* [remove_from_rig rig v] supprime le sommet [v] du graphe d'interférences
    [rig]. *)
 let remove_from_rig (rig : (reg, reg Set.t) Hashtbl.t)  (v: reg) : unit =
-   (* TODO *)
-   ()
-
+    (* TODO *)
+    Hashtbl.remove rig v;
+    Hashtbl.iter (fun x regs -> Hashtbl.modify x (Set.remove v) rig) rig
 
 (* Type représentant les différentes décisions qui peuvent être prises par
    l'allocateur de registres.
@@ -159,8 +161,8 @@ type regalloc_decision =
    possédant strictement moins de [n] voisins. Retourne [None] si aucun sommet
    ne satisfait cette condition. *)
 let pick_node_with_fewer_than_n_neighbors (rig : (reg, reg Set.t) Hashtbl.t) (n: int) : reg option =
-   (* TODO *)
-   None
+    (* TODO *)
+    Hashtbl.fold (fun x regs acc -> if (Set.cardinal regs) < n then Some x else acc) rig None
 
 (* Lorsque la fonction précédente échoue (i.e. aucun sommet n'a moins de [n]
    voisins), on choisit un pseudo-registre à évincer.
@@ -171,24 +173,30 @@ let pick_node_with_fewer_than_n_neighbors (rig : (reg, reg Set.t) Hashtbl.t) (n:
    [pick_spilling_candidate rig] retourne donc le pseudo-registre [r] qui a le
    plus de voisins dans [rig], ou [None] si [rig] est vide. *)
 let pick_spilling_candidate (rig : (reg, reg Set.t) Hashtbl.t)  : reg option =
-   (* TODO *)
-   None
+    (* TODO *)
+    let candidate_number_of_neighbours = Hashtbl.fold (fun x regs acc -> 
+      match acc with
+      | None -> Some (x, Set.cardinal regs)
+      | Some (y, k) -> if Set.cardinal regs > k then Some (x, Set.cardinal regs) else acc
+    ) rig None 
+        in match candidate_number_of_neighbours with
+        | None -> None
+        | Some (y, k) -> Some y
 
 (* [make_stack rig stack ncolors] construit la pile, selon l'algorithme vu en
    cours (slide 26 du cours "Allocation de registres"
    présent sur Edunao.) *)
 let rec make_stack (rig : (reg, reg Set.t) Hashtbl.t)  (stack : regalloc_decision list) (ncolors: int) : regalloc_decision list =
-   (* TODO *)
-   stack
+    (* TODO *)
+    match pick_node_with_fewer_than_n_neighbors rig ncolors with
+    | Some r -> remove_from_rig rig r; make_stack rig (NoSpill r :: stack) ncolors
+    | None -> 
+      match pick_spilling_candidate rig with
+      | Some r -> remove_from_rig rig r; make_stack rig (Spill r :: stack) ncolors
+      | None -> stack
 
 (* Maintenant que nous avons une pile de [regalloc_decision], il est temps de
-   colorer notre graphe, i.e. associer une couleur (un numéro de registre
-   physique) à chaque pseudo-registre. Nous allons parcourir la pile et pour
-   chaque décision :
-
-   -  [Spill r] : associer un emplacement sur la pile au pseudo-registre [r]. On
-   choisira l'emplacement [next_stack_slot].
-
+   colorer notre graphe, i.e. associer une couleur (un numéro de restack@[NoSpill r]
    - [NoSpill r] : associer une couleur (un registre) physique au
    pseudo-registre [r]. On choisira une couleur qui n'est pas déjà associée à un
    voisin de [r] dans [rig].
@@ -218,8 +226,18 @@ let allocate (allocation: (reg, loc) Hashtbl.t) (rig: (reg, reg Set.t) Hashtbl.t
     (all_colors: int Set.t)
     (next_stack_slot: int) (decision: regalloc_decision)
   : int =
-   (* TODO *)
-   next_stack_slot
+    (* TODO *)
+    match decision with
+    | Spill r -> Hashtbl.add allocation r (Stk next_stack_slot); next_stack_slot-1
+    | NoSpill r -> let neighbours = Hashtbl.find rig r
+      in let neighbour_colors = Set.filter_map (
+        fun neighbour -> match Hashtbl.find_opt allocation neighbour with
+        | Some (Reg color) -> Some color
+        | _ -> None
+      ) neighbours  
+        in let available_colors = Set.diff all_colors neighbour_colors 
+          in let chosen_color = Set.choose available_colors
+            in Hashtbl.add allocation r (Reg chosen_color); next_stack_slot
 
 (* [regalloc_fun f live_out all_colors] effectue l'allocation de registres pour
    la fonction [f].

src/rtl_gen.ml

@@ -43,7 +43,16 @@ let find_var (next_reg, var2reg) v =
    - [var2reg] est la nouvelle association nom de variable/registre.
 *)
 let rec rtl_instrs_of_cfg_expr (next_reg, var2reg) (e: expr) =
-   (next_reg, [], next_reg, var2reg)
+  match e with
+  | Evar v -> let r, next_reg', var2reg' = find_var (next_reg, var2reg) v in (r, [], next_reg', var2reg')
+  | Eint i -> (next_reg, [Rconst(next_reg, i)], next_reg+1, var2reg)
+  | Ebinop (b, e1, e2) -> 
+    let r1, l1, next_reg1, var2reg1 = rtl_instrs_of_cfg_expr (next_reg, var2reg) e1
+      in let r2, l2, next_reg2, var2reg2 = rtl_instrs_of_cfg_expr (next_reg1, var2reg1) e2
+        in (next_reg2, l1@l2@[Rbinop(b, next_reg2, r1, r2)], next_reg2+1, var2reg2)
+  | Eunop (u, e) ->
+    let r, l, next_reg', var2reg' = rtl_instrs_of_cfg_expr (next_reg, var2reg) e
+        in (next_reg', l@[Runop(u, next_reg', r)], next_reg'+1, var2reg')
 
 let is_cmp_op =
   function Eclt -> Some Rclt
@@ -64,8 +73,24 @@ let rtl_cmp_of_cfg_expr (e: expr) =
 
 
 let rtl_instrs_of_cfg_node ((next_reg:int), (var2reg: (string*int) list)) (c: cfg_node) =
-   (* TODO *)
-   ([], next_reg, var2reg)
+    (* TODO *)
+  match c with
+  | Cassign (s, e, i) -> 
+    let r_e, l, next_reg1, var2reg1 = rtl_instrs_of_cfg_expr (next_reg, var2reg) e
+      in let r_s, next_reg2, var2reg2 = find_var (next_reg1, var2reg1) s
+        in (l@[Rmov(r_s, r_e); Rjmp i], next_reg2, var2reg2)
+  | 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
+        in let r2, l2, next_reg2, var2reg2 = rtl_instrs_of_cfg_expr (next_reg1, var2reg1) e2
+          in (l1@l2@[Rbranch(cmp, r1, r2, i1)]@[Rjmp i2], next_reg2, var2reg2)
+  | Cnop i -> ([Rjmp i], next_reg, var2reg)
 
 let rtl_instrs_of_cfg_fun cfgfunname ({ cfgfunargs; cfgfunbody; cfgentry }: cfg_fun) =
   let (rargs, next_reg, var2reg) =

tests/Makefile

 # 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),basic/*.e)
+FILES := $(if $(DIR),$(DIR),funcall/*.e)
 
 OPTS := $(if $(OPTS), $(OPTS),)
 

tests/funcall/argswap.e.expect_lexer

@@ -5,12 +5,12 @@ SYM_COMMA
 SYM_IDENTIFIER(b)
 SYM_RPARENTHESIS
 SYM_LBRACE
-SYM_IDENTIFIER(print)
+SYM_PRINT
 SYM_LPARENTHESIS
 SYM_IDENTIFIER(a)
 SYM_RPARENTHESIS
 SYM_SEMICOLON
-SYM_IDENTIFIER(print)
+SYM_PRINT
 SYM_LPARENTHESIS
 SYM_IDENTIFIER(b)
 SYM_RPARENTHESIS
@@ -30,12 +30,12 @@ SYM_COMMA
 SYM_IDENTIFIER(b)
 SYM_RPARENTHESIS
 SYM_LBRACE
-SYM_IDENTIFIER(print)
+SYM_PRINT
 SYM_LPARENTHESIS
 SYM_IDENTIFIER(a)
 SYM_RPARENTHESIS
 SYM_SEMICOLON
-SYM_IDENTIFIER(print)
+SYM_PRINT
 SYM_LPARENTHESIS
 SYM_IDENTIFIER(b)
 SYM_RPARENTHESIS

tests/funcall/print_and_fun.e.expect_lexer

@@ -21,12 +21,12 @@ SYM_LPARENTHESIS
 SYM_INTEGER(8)
 SYM_RPARENTHESIS
 SYM_SEMICOLON
-SYM_IDENTIFIER(print)
+SYM_PRINT
 SYM_LPARENTHESIS
 SYM_IDENTIFIER(a)
 SYM_RPARENTHESIS
 SYM_SEMICOLON
-SYM_IDENTIFIER(print)
+SYM_PRINT
 SYM_LPARENTHESIS
 SYM_IDENTIFIER(b)
 SYM_RPARENTHESIS