function info refactor

lib/ast/normalize.ml

@@ -45,7 +45,6 @@ let empty_context : context = { parent_type = ""; identifier = None; is_assignme
 let rec program (loc , { Ast'.Program.statements; _ }) : m Program.t = 
   let body = List.flatten (List.map (normalize_statement empty_context) statements) in
   let program = Program.build (loc_f loc) body in
-  Program.set_function_info program; 
   program;
 
 

lib/ast/structures/grammar.ml

@@ -29,50 +29,71 @@ end
 
 type m = Location.t;;
 
-module FunctionInfo = struct
+module rec FunctionsInfo : sig
   type info = {
     id     : int;
     params : string list;
-    funcs  : info HashTable.t;
+    context  : FunctionsInfo.t;
   }
 
+  type context = string list
+  type t = info HashTable.t
+
+  (* ---- primitive functions ----- *)
+  val create   : int -> t
+  val get_info : t -> string -> info
+  val find_opt : t -> string -> info option
+  val add : t -> string -> int -> string list -> t
+  val iter : (string -> info -> unit) -> t -> unit
+
+  val get_func_names : t -> string list
+  val get_param_name_opt : t -> string -> int -> string option
+  val get_param_name : t list -> string -> int -> string
+
+end = struct
+  type info = {
+    id     : int;
+    params : string list;
+    context  : FunctionsInfo.t;
+  }
+
+  type context = string list
   type t = info HashTable.t
 
   (* ------- S T R U C T U R E   F U N C T I O N S ------- *)
   let create = HashTable.create
   let get_info : t -> string -> info = HashTable.find
   let find_opt : t -> string -> info option = HashTable.find_opt
-  let get_func_names (info : t) : string list = List.of_seq (HashTable.to_seq_keys info)
 
-  let rec add (context : string list) (info : t) (func : string) (id' : int) (params' : string list) : unit = 
-    match context with
-      | [] -> (* add information to the currnt context *)
-        let func_info : info = {
-          id = id';
-          params = params';
-          funcs = create 5;
-        } in 
-        HashTable.replace info func func_info
-      | top::rest -> (* traverse the context *)
-        let new_info = get_info info top in 
-        add rest new_info.funcs func id' params'
+  let add (info : t) (func : string) (id' : int) (params' : string list) : t = 
+    let new_context = create 5 in
+    let func_info : info = {
+      id = id';
+      params = params';
+      context = new_context;
+    } in 
+
+    HashTable.replace info func func_info;
+    new_context
 
   let iter : (string -> info -> unit) -> t -> unit = HashTable.iter
 
-  let rec print (functions : t) : unit =
-    iter (print_info) functions
-  and print_info (func : string )( info : info) : unit =  print_endline (func ^ " : " ^ (String.concat ", " info.params ))
 
   (* ------- I N F O   M A N I P U L A T I O N ------- *)
+  let get_func_names (info : t) : string list = List.of_seq (HashTable.to_seq_keys info)
+
   let get_param_name_opt (functions : t) (identifier : string) (index : int) : string option =
     map_default (fun {params; _} -> List.nth_opt params index) None (find_opt functions identifier)
 
-    let get_param_name (functions : t) (identifier : string) (index : int) : string =
-    let info = find_opt functions identifier in 
-    if Option.is_some info
-      then let info = Option.get info in 
-               List.nth info.params index
-      else (failwith "function name wasn't found")
+  let rec get_param_name (functions : t list) (identifier : string) (index : int) : string =
+    match functions with 
+      | [] -> failwith "function name wasn't found"
+      | context::rest -> 
+        let info = find_opt context identifier in 
+        if Option.is_some info
+          then let info = Option.get info in 
+                  List.nth info.params index
+          else get_param_name rest identifier index
 end
 
 module Operator = struct
@@ -1450,36 +1471,33 @@ end
 and Program : sig
   type 'M t' = {
     body : 'M Statement.t list;
-    functions : FunctionInfo.t
+    functions : FunctionsInfo.t
   }
 
   type 'M t = 'M * 'M t'
   val build :  'M -> 'M Statement.t list -> 'M t
-  val set_function_info : 'M t -> unit
 
 end = struct
   type 'M t' = {
     body : 'M Statement.t list;
-    functions : FunctionInfo.t
+    functions : FunctionsInfo.t
   }
 
   type 'M t = 'M * 'M t'
-  let build (metadata : 'M) (stmts : 'M Statement.t list) : 'M t = 
-    (metadata, { body = stmts; functions = FunctionInfo.create 20 });; 
 
-  let set_function_info ((_, {body; functions}) : 'M t) : unit =
-    let rec traverse_body (context : string list) (stmts : 'M Statement.t list) : unit =
+  let build_function_info (body : 'M Statement.t list) : FunctionsInfo.t =
+    let rec traverse_body (context : FunctionsInfo.t) (stmts : 'M Statement.t list) : unit =
       List.iter (search_functions context) stmts
 
-      and search_functions (context : string list) (stmt : 'M Statement.t) : unit =
+    and search_functions (context : FunctionsInfo.t) (stmt : 'M Statement.t) : unit =
       match stmt with
         | _, Statement.AssignFunction {id; left; params; body; _} -> 
           (* add function information *)
           let left' = Identifier.get_name left in 
           let params' = List.map (fun (_, {Statement.AssignFunction.Param.argument; _}) -> Identifier.get_name argument) params in
 
-          FunctionInfo.add context functions left' id params';
-          traverse_body (context @ [left']) body;         
+          let new_context = FunctionsInfo.add context left' id params' in 
+          traverse_body new_context body;         
 
         (* --------- traverse ast --------- *)
         | _, Statement.If {consequent; alternate; _} -> 
@@ -1497,7 +1515,7 @@ end = struct
         | _, Statement.With    {body;_ } -> traverse_body context body
         | _, Statement.Labeled {body; _} -> traverse_body context body
 
-        | _, Statement.Try     {body; handler; finalizer} -> 
+        | _, Statement.Try {body; handler; finalizer} -> 
           traverse_body context body;
           option_may (fun (_, {Statement.Try.Catch.body; _}) -> traverse_body context body) handler;
           option_may (traverse_body context) finalizer;
@@ -1507,6 +1525,11 @@ end = struct
 
     in
 
-    traverse_body [] body
+    let funcs_info = FunctionsInfo.create 20 in 
+    traverse_body funcs_info body;
+    funcs_info
+
+  let build (metadata : 'M) (stmts : 'M Statement.t list) : 'M t = 
+    (metadata, { body = stmts; functions = build_function_info stmts});; 
 
 end

lib/mdg/analyse.ml

@@ -2,6 +2,7 @@
 module Graph = Graph'
 open Ast.Grammar
 open Auxiliary.Functions
+open Auxiliary.Structures
 open Structures
 open State
 
@@ -11,16 +12,19 @@ let verbose = ref false;;
 
 let rec program (is_verbose : bool) ((_, program) : m Program.t) : Graph.t * Store.t = 
   verbose := is_verbose;
-  let state = empty_state program.functions in 
+  let state = empty_state in 
+  let state' = initialize_functions state program.functions in
 
-  initialize_functions state;
-  analyse_sequence state program.body;
-  state.graph, state.store
+  print_endline (string_of_int (HashTable.length state'.functions));
+
+  analyse_sequence state' program.body;
+  state'.graph, state'.store
 
 and analyse (state : state) (statement : m Statement.t) : unit =
   let graph = state.graph in 
   let store = state.store in 
   let funcs = state.functions in 
+  let contx = state.context in
 
   (* aliases *)
   let eval_expr = eval_expr store state.this in 
@@ -37,7 +41,8 @@ and analyse (state : state) (statement : m Statement.t) : unit =
   let lookup = Graph.lookup graph in  
   let new_version = Graph.staticNewVersion graph in 
   let new_version' = Graph.dynamicNewVersion graph in 
-  let get_param_name = FunctionInfo.get_param_name funcs in 
+  let get_param_name = FunctionsInfo.get_param_name contx in 
+
 
   (match statement with
     (* -------- A S S I G N - E X P R -------- *)
@@ -47,12 +52,12 @@ and analyse (state : state) (statement : m Statement.t) : unit =
 
     | _, AssignFunction {id; left; body; _} -> 
       let func_name = Identifier.get_name left in 
-      let info = FunctionInfo.get_info funcs func_name in
+      let info = FunctionsInfo.get_info funcs func_name in
       if (info.id = id) then (
         let param_locs = Graph.get_param_locations graph func_name in 
         let new_store = Store.empty in 
         List.iteri (fun i loc -> Store.update' new_store (List.nth info.params i) (LocationSet.singleton loc)) param_locs;
-        let new_state = {state with store = new_store; } in
+        let new_state = {state with store = new_store; context = info.context :: contx} in
         analyse_sequence new_state body;
       );
 
@@ -239,37 +244,38 @@ and property_lookup_name (left : m Identifier.t) (_object : m Expression.t) (pro
   let obj_prop = Expression.get_id _object ^ "." ^ property in 
   if Identifier.is_generated left then obj_prop else Identifier.get_name left ^ ", " ^ obj_prop
 
-and initialize_functions (state : state) : unit =
-  let graph = state.graph in 
-  let func_info = state.functions in 
-
-  let add_func_node = Graph.add_func_node graph in
-  let add_param_node = Graph.add_param_node graph in
-  let add_param_edge = Graph.add_param_edge graph in 
-
-  let rec initizalize_context (state: state) (funcs : string list) (funcs_info : FunctionInfo.t) : unit = 
-    match funcs with
-      | [] -> ()
-      | func::rest -> 
-        let info = FunctionInfo.get_info funcs_info func in 
-        let l_f = Graph.alloc_function graph in 
-        add_func_node l_f func;
-
-        (* add this param node and edge*)
-        let l_p = Graph.alloc_param graph in
-
-        add_param_node l_p "this";
-        add_param_edge l_f l_p "this";
-
-        (* add param nodes and edges *)
-        List.iteri (fun i param -> 
-          let l_p = Graph.alloc_param graph in 
-          add_param_node l_p param;
-          add_param_edge l_f l_p (Int.to_string i)
-        ) info.params;
-
-        initizalize_context state (FunctionInfo.get_func_names info.funcs) info.funcs;
-        initizalize_context state rest funcs_info;
+and initialize_functions (state : state) (funcs_info : FunctionsInfo.t) : state =
+
+  let rec initialize_functions' (state : state) (to_process : FunctionsInfo.t list) : unit = 
+    match to_process with
+    | context::rest ->
+      let to_process = ref rest in 
+      FunctionsInfo.iter (fun func info -> 
+        initilize_function' state func info;
+        to_process := info.context :: !to_process;
+        ) context;
+        initialize_functions' state !to_process
+    | [] -> ()
+
+  and initilize_function' (state : state) (func_name : string) (info : FunctionsInfo.info) : unit =
+    let graph = state.graph in
+
+    let l_f = Graph.alloc_function graph in 
+    Graph.add_func_node graph l_f func_name;
+
+    (* add this param node and edge*)
+    let l_p = Graph.alloc_param graph in
+
+    Graph.add_param_node graph l_p "this";
+    Graph.add_param_edge graph l_f l_p "this";
+
+    (* add param nodes and edges *)
+    List.iteri (fun i param -> 
+      let l_p = Graph.alloc_param graph in 
+      Graph.add_param_node graph l_p param;
+      Graph.add_param_edge graph l_f l_p (Int.to_string i)
+    ) info.params;
   in
 
-  initizalize_context state (FunctionInfo.get_func_names func_info) func_info;
+  initialize_functions' state [funcs_info];
+  {state with functions = funcs_info; context = [funcs_info] }

lib/mdg/structures/state.ml

@@ -21,14 +21,18 @@ type state = {
   graph : Graph.t;
   store : Store.t;
   this  : LocationSet.t;
-  functions : FunctionInfo.t;
+  (* function information *)
+  functions : FunctionsInfo.t;
+  context   : FunctionsInfo.t list;
 }
 
-let empty_state (functions : FunctionInfo.t) = { 
+let empty_state = { 
   graph = Graph.empty register; 
   store = Store.empty; 
   this  = Store.this_loc;
-  functions = functions;
+  (* function information *)
+  functions =  FunctionsInfo.create 1;
+  context   = [];
 }
 
 let copy ({graph; store; _} as state : state) : state =