functions : CFG

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_run.ml

@@ -100,7 +100,7 @@ and eval_einstr oc (st: int state) (ep: eprog) (ins: instr) :
    | Iif (e, i1, i2) -> 
       (match eval_eexpr oc st ep e with 
       | Error msg -> Error msg
-      | OK (v, st') -> if v = 1 then eval_einstr oc st' ep i1 else eval_einstr oc st' ep 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 oc st ep e with
          | Error msg -> Error msg