CFG Funcall OK

expr_grammar_action.g

@@ -91,7 +91,7 @@ FACTOR -> IDENTIFIER VAR_OR_FUNCALL {
 FACTOR -> SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS {$2}
 
 VAR_OR_FUNCALL -> FUNCALL {Funcall $1}
-VAR_OR_FUNCALL -> { AssignVar NullLeaf }
+VAR_OR_FUNCALL -> {AssignVar NullLeaf}
 
 
 MUL_EXPRS -> SYM_ASTERISK MUL_EXPR MUL_EXPRS { (Tmul,$2) :: $3 }

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,6 +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 (fname,args,s)) -> Set.singleton s
 
 
 (* [preds cfg n] donne l'ensemble des prédécesseurs d'un nœud [n] dans un CFG [cfg]
@@ -43,11 +46,15 @@ let preds cfgfunbody n =
   Hashtbl.fold (fun m m' acc ->
       match m' with
       | Cassign (_, _, s)
+      | Ccall (_, _, s)
       | Cprint (_, s)
       | Cnop 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
+       
 
 
 let size_binop _ e1 e2 =
@@ -62,6 +69,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 (fun acc arg -> acc + size_expr arg ) 0 args
 
 let size_instr (i: cfg_node) : int =
   match (i : cfg_node) with
@@ -70,6 +78,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 (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,7 @@ 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 (fname, args) -> OK (Ecall(fname,(List.map (fun arg -> cfg_expr_of_eexpr arg >>! fun expr -> expr) args)))
 
 (* [cfg_node_of_einstr next cfg succ i] builds the CFG node(s) that correspond
    to the E instruction [i].
@@ -70,6 +71,8 @@ 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 (fname,args) -> let list_of_cfg_args = List.map (fun arg -> cfg_expr_of_eexpr arg >>! fun expr -> expr) args in
+    Hashtbl.replace cfg next (Ccall (fname,list_of_cfg_args,next)) ; 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
@@ -82,10 +85,12 @@ let rec reachable_nodes n (cfg: (int,cfg_node) Hashtbl.t) =
       | None -> reach
       | Some (Cnop succ)
       | Some (Cprint (_, succ))
+      | Some (Ccall (_,_,succ))
       | Some (Cassign (_, _, succ)) -> reachable_aux succ reach
       | Some (Creturn _) -> reach
       | Some (Ccmp (_, s1, s2)) ->
         reachable_aux s1 (reachable_aux s2 reach)
+
   in reachable_aux n Set.empty
 
 (* [cfg_fun_of_efun f] builds the CFG for E function [f]. *)

src/cfg_liveness.ml

@@ -11,6 +11,7 @@ let rec vars_in_expr (e: expr) : string Set.t = (*Type de sortie rajouté par mo
    | Eunop (u,e) -> vars_in_expr e
    | Eint i -> Set.empty
    | Evar s -> Set.singleton s
+   | Ecall (fname,args) -> List.fold (fun acc arg -> Set.union acc (vars_in_expr arg)) Set.empty 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,
@@ -36,6 +37,10 @@ let live_cfg_node (node: cfg_node) (live_after: string Set.t) =
    | Cprint (e,i) -> Set.union (vars_in_expr e) live_after
    | Ccmp (e,i1,i2) -> Set.union (vars_in_expr e) live_after
    | Cnop i -> Set.empty
+   | Ccall (fname,args,s) -> 
+      (List.fold (fun acc arg -> Set.union acc (vars_in_expr arg)) Set.empty args) 
+
+
    
 
 (* [live_cfg_nodes cfg lives] effectue une itération du calcul de point fixe.

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 (fname, args) -> Printf.sprintf "%s(%s)" fname (String.concat "," (List.map dump_cfgexpr args))
 
 let dump_list_cfgexpr l =
   l |> List.map dump_cfgexpr |> String.concat ", "
@@ -23,6 +24,7 @@ let dump_arrows oc fname n (node: cfg_node) =
   | Ccmp (_, succ1, succ2) ->
     Format.fprintf oc "n_%s_%d -> n_%s_%d [label=\"then\"]\n" fname n fname succ1;
     Format.fprintf oc "n_%s_%d -> n_%s_%d [label=\"else\"]\n" fname n fname succ2
+  | Ccall (fname,args,s) -> ()
 
 
 let dump_cfg_node oc (node: cfg_node) =
@@ -32,6 +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 (fname,args,s) -> Format.fprintf oc "%s = %s" fname ((String.concat "," (List.map dump_cfgexpr args)))
 
 
 let dump_liveness_state oc ht state =

src/cfg_run.ml

@@ -7,15 +7,15 @@ open Cfg
 open Utils
 open Builtins
 
-let rec eval_cfgexpr st (e: expr) : int res =
+let rec eval_cfgexpr cp oc st (e: expr) : int res =
   match e with
   | Ebinop(b, e1, e2) ->
-    eval_cfgexpr st e1 >>= fun v1 ->
-    eval_cfgexpr st e2 >>= fun v2 ->
+    eval_cfgexpr cp oc st e1 >>= fun v1 ->
+    eval_cfgexpr cp oc st e2 >>= fun v2 ->
     let v = eval_binop b v1 v2 in
     OK v
   | Eunop(u, e) ->
-    eval_cfgexpr st e >>= fun v1 ->
+    eval_cfgexpr cp oc st e >>= fun v1 ->
     let v = (eval_unop u v1) in
     OK v
   | Eint i -> OK i
@@ -24,47 +24,59 @@ let rec eval_cfgexpr st (e: expr) : int res =
       | Some v -> OK v
       | None -> Error (Printf.sprintf "Unknown variable %s\n" s)
     end
+    | Ecall (fname, args) -> 
+      find_function cp fname >>! fun f -> (
+      eval_cfgfun cp oc st fname f (List.map (fun arg -> eval_cfgexpr cp oc st arg >>! fun valeur -> valeur) args)
+      >>!(fun (fun_result, new_state) ->  
+        (match fun_result with 
+        | Some result -> OK (result)
+        | None -> Error ("On attend une valeur de retour pour cet appel de fonction"))))
 
-let rec eval_cfginstr oc st ht (n: int): (int * int state) res =
+and eval_cfginstr cp oc st 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 cp oc st ht succ
     | Cassign(v, e, succ) ->
-      eval_cfgexpr st e >>= fun i ->
+      eval_cfgexpr cp oc st e >>= fun i ->
       Hashtbl.replace st.env v i;
-      eval_cfginstr oc st ht succ
+      eval_cfginstr cp oc st 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 cp oc st cond >>= fun i ->
+      if i = 0 then eval_cfginstr cp oc st ht i2 else eval_cfginstr cp oc st ht i1
     | Creturn(e) ->
-      eval_cfgexpr st e >>= fun e ->
+      eval_cfgexpr cp oc st e >>= fun e ->
       OK (e, st)
     | Cprint(e, succ) ->
-      eval_cfgexpr st e >>= fun e ->
+      eval_cfgexpr cp oc st e >>= fun e ->
       Format.fprintf oc "%d\n" e;
-      eval_cfginstr oc st ht succ
+      eval_cfginstr cp oc st ht succ
+    | Ccall (funame,args,s) -> find_function cp funame >>! (fun f ->
+      eval_cfgfun cp oc st funame f (List.map (fun arg -> eval_cfgexpr cp oc st arg >>! fun valeur -> valeur) args) >>! 
+      (fun (fun_result, new_state) -> 
+          OK (s,new_state)
+            ))
 
-let eval_cfgfun oc st cfgfunname { cfgfunargs;
+and eval_cfgfun cp oc st 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 cp oc st' 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"
              cfgfunname (List.length vargs) (List.length cfgfunargs)
           )
 
-let eval_cfgprog oc cp memsize params =
+let eval_cfgprog  oc cp memsize params =
   let st = init_state memsize in
   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 cp oc st "main" f params >>= fun (v, st) ->
   OK v
 
 

src/elang_gen.ml

@@ -48,7 +48,7 @@ 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 (Tcall,StringLeaf(funname):: [Node(Targs, args)]) -> 
+    | Node (Tcall,[StringLeaf(funname); Node(Targs, args)]) -> 
       OK ( Ecall (funname, List.map (fun arg -> make_eexpr_of_ast arg >>! fun expr -> expr) args))
     | Node(Tneg,[e]) -> make_eexpr_of_ast e >>= fun expr -> OK (Eunop (Eneg,expr ))
     | Node (Tint,[IntLeaf(a)]) -> OK (Eint a)