diff --git a/lib/ast/structures/functions.ml b/lib/ast/structures/functions.ml index 90924cd..ee1d78e 100644 --- a/lib/ast/structures/functions.ml +++ b/lib/ast/structures/functions.ml @@ -36,12 +36,14 @@ module rec Info : sig } (* ---- primitive functions ----- *) - val empty : t - val find : t -> Id.t -> info - val create : int -> t - val iter : (Id.t -> info -> unit) -> t -> unit + val empty : t + val find : t -> Id.t -> info + val find_opt : t -> Id.t -> info option + val create : int -> t + val iter : (Id.t -> info -> unit) -> t -> unit val add : t -> Id.t -> Id.t option -> string list -> unit val get_func_id : t -> string -> Id.t option -> Id.t option + val get_params : info -> string list @@ -60,6 +62,7 @@ end = struct let empty = {top_lvl = ref []; functions = FuncTable.create 1} let create (size : int) : t = { top_lvl = ref []; functions = FuncTable.create size } let find (info : t) : Id.t -> info = FuncTable.find info.functions + let find_opt (info : t) : Id.t -> info option = FuncTable.find_opt info.functions let replace (info : t) : Id.t -> info -> unit = FuncTable.replace info.functions let remove (info : t) (func_id : Id.t) : unit = let top_lvl = info.top_lvl in @@ -111,6 +114,8 @@ end = struct (* add found node information to its parent *) add_nested info parent_id func_id + let get_params (info : info) : string list = info.params + end module Context = struct @@ -123,27 +128,34 @@ module Context = struct let create (functions' : Info.t) : t = { path = []; functions = functions'} let visit (context : t) (id : Id.t) : t = {context with path = id :: context.path} - let get_func_id (context : t) (func_name : string) : Id.t = + let get_func_id (context : t) (func_name : string) : Id.t option = let get_func_info_id = Info.get_func_id context.functions in - let rec aux (path : Id.t list) : Id.t = + let rec aux (path : Id.t list) : Id.t option = let parent_id = hd_opt path in let id = get_func_info_id func_name parent_id in - if Option.is_some id then Option.get id (* found function nested inside parent id *) + if Option.is_some id then id (* found function nested inside parent id *) else if Option.is_some parent_id then aux (List.tl path) (* function not found yet but there is more parents to search *) - else failwith "function not found" (* function name wasnt found in any parent's nested list *) + else None (* function name wasnt found in any parent's nested list *) in aux context.path - let get_func_info (context : t) (func_name : string) : Info.info = + let get_func_info' (context : t) (func_id : Id.t) : Info.info = + Info.find context.functions func_id + + let get_func_info (context : t) (func_name : string) : Info.info option = let func_id = get_func_id context func_name in - Info.find context.functions func_id + Option.bind func_id (Option.some << get_func_info' context) - let get_param_names (context : t) (func_name : string) : string list = - let func_info = get_func_info context func_name in + let get_param_names' (contents : t) (func_id : Id.t) : string list = + let func_info = get_func_info' contents func_id in func_info.params + let get_param_names (context : t) (func_name : string) : string list option = + let func_info = get_func_info context func_name in + Option.map (Info.get_params) func_info + let is_last_definition (context : t) (id : Id.t) : bool = let get_func_info_id = Info.get_func_id context.functions in let parent_id = hd_opt context.path in diff --git a/lib/mdg/analyse.ml b/lib/mdg/analyse.ml index 8748636..41c4247 100644 --- a/lib/mdg/analyse.ml +++ b/lib/mdg/analyse.ml @@ -39,7 +39,7 @@ and analyse (state : state) (statement : m Statement.t) : unit = let new_version = Graph.staticNewVersion graph in let new_version' = Graph.dynamicNewVersion graph in let get_param_locs = Graph.get_param_locations graph in - let get_param_names = Functions.Context.get_param_names contx in + let get_param_names = Functions.Context.get_param_names' contx in let get_func_id = Functions.Context.get_func_id contx in let is_last_definition = Functions.Context.is_last_definition contx in let visit = Functions.Context.visit contx in @@ -128,27 +128,35 @@ and analyse (state : state) (statement : m Statement.t) : unit = (* -------- C A L L -------- *) | _, AssignNewCall {left; callee; arguments; id_call; id_retn; _} | _, AssignFunCall {left; callee; arguments; id_call; id_retn; _} -> - let f = Identifier.get_name callee in let _Lss = List.map eval_expr arguments in let l_call = alloc id_call in + let l_retn = alloc id_retn in + + (* get function definition information *) + let f = Identifier.get_name callee in + let f_id = get_func_id f in + + (* node information *) + add_node l_call (f ^ "()"); + add_node l_retn (Identifier.get_name left); + (* argument edges *) - let params = get_param_names f in + let params = map_default get_param_names [] f_id in List.iteri ( fun i _Ls -> - let param_name = List.nth params i in + let param_name = Option.value (List.nth_opt params i) ~default:"undefined" in LocationSet.iter (fun l -> add_arg_edge l l_call i param_name) _Ls ) _Lss; - - (* call edge *) - let l_f = Graph.get_func_node graph (get_func_id f) in - add_call_edge l_call (Option.get l_f); - add_node l_call (f ^ "()"); - (* add return edge *) - let l_retn = alloc id_retn in + (* return edge *) add_ret_edge l_call l_retn; - add_node l_retn (Identifier.get_name left); store_update left (LocationSet.singleton l_retn); + (* call edge to function definition (if defined) *) + option_may (fun id -> + let l_f = Graph.get_func_node graph id in + add_call_edge l_call (Option.get l_f) + ) f_id; + (* -------- I F -------- *) | _, If {consequent; alternate; _} -> let state' = State.copy state in diff --git a/lib/mdg/structures/graph'.ml b/lib/mdg/structures/graph'.ml index 3ecaf5d..9ca2098 100644 --- a/lib/mdg/structures/graph'.ml +++ b/lib/mdg/structures/graph'.ml @@ -180,7 +180,7 @@ let iter (f : location -> EdgeSet.t -> Node.t option -> unit) (graph : t) = Hash (* ------- A U X I L I A R Y F U N C T I O N S -------*) let get_edges (graph : t) (origin : location) : EdgeSet.t = - map_default identity EdgeSet.empty (find_edges_opt graph origin) + Option.value (find_edges_opt graph origin) ~default:EdgeSet.empty let is_version_edge (_to : location) (edge : Edge.t) : bool = Edge.is_version edge && Edge.get_to edge = _to diff --git a/lib/mdg/structures/store.ml b/lib/mdg/structures/store.ml index 40ed0fc..5440bf9 100644 --- a/lib/mdg/structures/store.ml +++ b/lib/mdg/structures/store.ml @@ -1,8 +1,6 @@ open Structures open Ast.Grammar open Auxiliary.Structures -open Auxiliary.Functions - type t = LocationSet.t HashTable.t @@ -31,7 +29,7 @@ let equal (store : t) (store' : t) : bool = HashTable.equals (LocationSet.equal) (* ------- A U X I L I A R Y F U N C T I O N S -------*) let get_locations (store : t) (id : location) : LocationSet.t = - map_default identity LocationSet.empty (find_opt store id) + Option.value (find_opt store id) ~default:LocationSet.empty (* ------- S T O R E M A N I P U L A T I O N ------- *) let get (store : t) ((_, {name; _}) : m Identifier.t) : LocationSet.t =