From 6eecad5705e26a09bfe24bef7090d0addf3beb3d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tom=C3=A1s=20Tavares?= Date: Tue, 28 May 2024 15:38:45 +0100 Subject: [PATCH] function info refactor --- lib/ast/normalize.ml | 1 - lib/ast/structures/grammar.ml | 95 ++++++++++++++++++++++------------- lib/mdg/analyse.ml | 84 +++++++++++++++++-------------- lib/mdg/structures/state.ml | 10 ++-- 4 files changed, 111 insertions(+), 79 deletions(-) diff --git a/lib/ast/normalize.ml b/lib/ast/normalize.ml index eadd8c2..383c9a1 100644 --- a/lib/ast/normalize.ml +++ b/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; diff --git a/lib/ast/structures/grammar.ml b/lib/ast/structures/grammar.ml index 0951595..f6f451b 100644 --- a/lib/ast/structures/grammar.ml +++ b/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 \ No newline at end of file diff --git a/lib/mdg/analyse.ml b/lib/mdg/analyse.ml index 187a857..2441469 100644 --- a/lib/mdg/analyse.ml +++ b/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; \ No newline at end of file + initialize_functions' state [funcs_info]; + {state with functions = funcs_info; context = [funcs_info] } \ No newline at end of file diff --git a/lib/mdg/structures/state.ml b/lib/mdg/structures/state.ml index 984ed46..9726b21 100644 --- a/lib/mdg/structures/state.ml +++ b/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 =