diff --git a/bin/main.ml b/bin/main.ml index ca2041cb..0641c4bf 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -45,7 +45,7 @@ let setup_node (mode : string) : string = script -let main (filename : string) (output_path : string) (config_path : string) (mode : string) (generate_mdg : bool) (verbose : bool) : int = +let main (filename : string) (output_path : string) (config_path : string) (mode : string) (generate_mdg : bool) (no_dot : bool) (verbose : bool) : int = (* SETUP *) let script = setup_node mode in @@ -107,7 +107,8 @@ let main (filename : string) (output_path : string) (config_path : string) (mode if generate_mdg then ( let main = DependencyTree.get_main dep_tree in let graph = ModuleGraphs.get module_graphs main in - Mdg.Pp.Dot.output graph_dir graph; + if not no_dot then + Mdg.Pp.Dot.output graph_dir graph; Mdg.Pp.CSV.output graph_dir graph; ); @@ -134,6 +135,10 @@ let mdg : bool Term.t = let doc = "Generates Multiversion Dependency Graph." in Arg.(value & flag & info ["mdg"] ~doc) +let no_dot : bool Term.t = + let doc = "Dont generate .dot and .svg graph representation." in + Arg.(value & flag & info ["noDot"] ~doc) + let output_path : string Term.t = let doc = "Path to store all output files." in let default_path = "graphjs-results" in @@ -149,7 +154,7 @@ let verbose : bool Term.t = Arg.(value & flag & info ["v"; "verbose"] ~doc) let cli = - let cmd = Term.(const main $ input_file $ output_path $ config_path $ mode $ mdg $ verbose) in + let cmd = Term.(const main $ input_file $ output_path $ config_path $ mode $ mdg $ no_dot $ verbose) in let info = Cmd.info "ast_gen" in Cmd.v info cmd diff --git a/lib/ast/normalize.ml b/lib/ast/normalize.ml index 46bbd25e..9bd0bf11 100644 --- a/lib/ast/normalize.ml +++ b/lib/ast/normalize.ml @@ -58,7 +58,7 @@ and normalize_statement (context : context) (stmt : ('M, 'T) Ast'.Statement.t) : let loc_f = Location.convert_flow_loc !file_path in let nec = normalize_expression in - + match stmt with (* --------- B L O C K --------- *) | _, Ast'.Statement.Block {body; _} -> @@ -196,9 +196,7 @@ and normalize_statement (context : context) (stmt : ('M, 'T) Ast'.Statement.t) : (* --------- V A R I A B L E D E C L A R A T I O N --------- *) | loc, Ast'.Statement.VariableDeclaration {kind; declarations; _} -> - let kind' : Statement.VarDecl.kind = match kind with - | Var -> _var | Let -> _let | Const -> _const - in + let kind' = translate_kind kind in let new_context = {context with is_declaration = true} in let assign_stmts, ids = List.split (List.map @@ -455,10 +453,19 @@ and normalize_expression (context : context) (expr : ('M, 'T) Ast'.Expression.t) (* --------- Y I E L D --------- *) | loc, Ast'.Expression.Yield {argument; delegate; _} -> + let loc = loc_f loc in + let id = if not context.has_op then get_identifier loc context.identifier else Identifier.build_random loc in + let arg_stmts, arg_expr = map_default ne ([], None) argument in - let yield = Statement.Yield.build (loc_f loc) arg_expr delegate in + let yield = Statement.AssignYield.build loc id arg_expr delegate in + + (* check if yield is done as a statement or an expression *) + if not context.is_assignment || context.has_op then + let _, decl = createVariableDeclaration None loc ~objId:(Id id) in + (decl @ arg_stmts @ [yield] , Some (Identifier.to_expression id)) + else + arg_stmts @ [yield], Some (Identifier.to_expression id) - arg_stmts @ [yield], None (* --------- C O N D I T I O N A L --------- *) | loc, Ast'.Expression.Conditional {test; consequent; alternate; _} -> @@ -486,17 +493,15 @@ and normalize_expression (context : context) (expr : ('M, 'T) Ast'.Expression.t) (* --------- A S S I G N S I M P L E --------- *) | _, Ast'.Expression.Assignment {operator; left; right; _} -> - let operator' = Option.map Operator.Assignment.translate operator in - let assign_stmts, _ = normalize_assignment context left operator' right in + let assign_stmts, _ = normalize_assignment {context with is_statement = false} left operator' right in (* check if the assignment is done as a statement or an expression *) - let stmts, expr = if not context.is_statement - then get_pattern_expr left - else [], None - in - - assign_stmts @ stmts, expr + if context.is_statement + then assign_stmts, None + else + let norm_stmts, norm_expr = get_pattern_expr left in + assign_stmts @ norm_stmts, norm_expr (* --------- A S S I G N A R R A Y ---------*) | loc, Ast'.Expression.Array {elements; _} -> @@ -748,7 +753,7 @@ and get_pattern_expr (pattern : ('M, 'T) Ast'.Pattern.t) : norm_expr_t = | _, Identifier {name; _} -> [], Some ((Identifier.to_expression << normalize_identifier) name) - | _, Expression (loc, Member {_object; property; _}) -> + | _, Expression (loc, Member {_object; property; _}) -> let loc = loc_f loc in let id, decl = createVariableDeclaration None loc in @@ -850,12 +855,17 @@ and normalize_imp_specifiers (loc : m) (source : string) (specifier : ('M, 'T) A [import] and normalize_for_left (left : ('M, 'T) generic_left) : norm_stmt_t * m Statement.VarDecl.t = - let ns = normalize_statement empty_context in match left with - | LeftDeclaration (loc, decl) -> - let decl_stmts = ns (loc, Ast'.Statement.VariableDeclaration decl) in - [], to_var_decl (List.hd decl_stmts) - + | LeftDeclaration (_, { Ast'.Statement.VariableDeclaration.kind; declarations; _}) -> + let kind' = translate_kind kind in + let declaration = List.hd declarations in + let pattern = match declaration with _, {id; _} -> id in + + let id, decl_stmts = createVariableDeclaration None (Location.empty ()) ~kind:kind' in + let stmts, _ = normalize_pattern (Identifier.to_expression id) pattern None false in + stmts, to_var_decl (List.hd decl_stmts) + + | LeftPattern pattern -> let id, decl_stmts = createVariableDeclaration None (Location.empty ()) in let stmts, _ = normalize_pattern (Identifier.to_expression id) pattern None false in @@ -1141,6 +1151,8 @@ and is_special_assignment ((_, expr) : ('M, 'T) Ast'.Expression.t) : bool = | Ast'.Expression.Logical _ | Ast'.Expression.Update _ | Ast'.Expression.Unary _ + (* -- ASSIGN YIELD -- *) + | Ast'.Expression.Yield _ (* -- ASSIGN NEW -- *) | Ast'.Expression.New _ (* -- ASSIGN CALL -- *) @@ -1175,6 +1187,12 @@ and change_kind (kind' : Statement.VarDecl.kind) ((loc, stmt) : m Statement.t) : | VarDecl decl -> let decl' = Statement.VarDecl {decl with kind = kind'} in (loc, decl') | _ -> failwith "[ERROR] Tried to change the kind of non-declaration statement" + +and translate_kind (kind : Ast'.Variable.kind): Statement.VarDecl.kind = + match kind with + | Var -> _var + | Let -> _let + | Const -> _const and is_declaration ((_, stmt) : m Statement.t) : bool = match stmt with diff --git a/lib/ast/pp.ml b/lib/ast/pp.ml index abd8ca24..b6abe88e 100644 --- a/lib/ast/pp.ml +++ b/lib/ast/pp.ml @@ -91,10 +91,6 @@ module Js = struct let label' = map_default ((^) " " << print_identifier) "" label in identation_str ^ "break" ^ label' ^ ";\n" - | _, Yield {argument; _ } -> - let argument' = map_default ((^) " " << print_expr) "" argument in - identation_str ^ "yield" ^ argument' ^ ";\n" - | _, Continue {label} -> let label' = map_default ((^) " " << print_identifier) "" label in identation_str ^ "continue" ^ label' ^ ";\n" @@ -162,6 +158,11 @@ module Js = struct let argument' = print_expr argument in identation_str ^ left' ^ " = " ^ operator' ^ argument' ^ ";\n" + | _, AssignYield {left; argument; _ } -> + let left' = print_identifier left in + let argument' = map_default ((^) " " << print_expr) "" argument in + identation_str ^ left' ^ " = yield" ^ argument' ^ ";\n" + | _, AssignArray {left; _} -> let left' = print_identifier left in identation_str ^ left' ^ " = [];\n" diff --git a/lib/ast/structures/grammar.ml b/lib/ast/structures/grammar.ml index fb7eafc0..2c06dd4f 100644 --- a/lib/ast/structures/grammar.ml +++ b/lib/ast/structures/grammar.ml @@ -291,15 +291,6 @@ and Statement : sig val build : 'M -> 'M Identifier.t option -> 'M Statement.t end - module Yield : sig - type 'M t = { - argument : 'M Expression.t option; - delegate : bool - } - - val build : 'M -> 'M Expression.t option -> bool -> 'M Statement.t - end - module Continue : sig type 'M t = { label : 'M Identifier.t option } val build : 'M -> 'M Identifier.t option -> 'M Statement.t @@ -379,6 +370,18 @@ and Statement : sig val build : 'M -> 'M Identifier.t -> Operator.Unary.t -> 'M Expression.t -> 'M Statement.t end + module AssignYield : sig + type 'M t = { + id : int; + left : 'M Identifier.t; + (* -- right -- *) + argument : 'M Expression.t option; + delegate : bool + } + + val build : 'M -> 'M Identifier.t -> 'M Expression.t option -> bool -> 'M Statement.t + end + module AssignArray : sig type 'M t = { id : int; @@ -542,7 +545,6 @@ and Statement : sig | Return of 'M Return.t | Throw of 'M Throw.t | Break of 'M Break.t - | Yield of 'M Yield.t | Continue of 'M Continue.t | Debugger of Debugger.t @@ -555,6 +557,7 @@ and Statement : sig | AssignSimple of 'M AssignSimple.t | AssignBinary of 'M AssignBinary.t | AssignUnary of 'M AssignUnary.t + | AssignYield of 'M AssignYield.t | AssignArray of 'M AssignArray.t | AssignObject of 'M AssignObject.t | StaticUpdate of 'M StaticUpdate.t @@ -567,8 +570,7 @@ and Statement : sig | AssignMetCallDynmic of 'M AssignMetCallDynmic.t | AssignFunction of 'M AssignFunction.t - type 'M t = 'M * 'M t' - + type 'M t = 'M * 'M t' end = struct @@ -790,20 +792,6 @@ end = struct (metadata, break_info) end - module Yield = struct - type 'M t = { - argument : 'M Expression.t option; - delegate : bool - } - - let build (metadata : 'M) (argument' : 'M Expression.t option) (delegate': bool) : 'M Statement.t = - let yield_info = Statement.Yield { - argument = argument'; - delegate = delegate' - } in - (metadata, yield_info) - end - module Continue = struct type 'M t = { label : 'M Identifier.t option } @@ -949,6 +937,25 @@ end = struct (metadata, assign_info) end + module AssignYield = struct + type 'M t = { + id : int; + left : 'M Identifier.t; + (* -- right -- *) + argument : 'M Expression.t option; + delegate : bool + } + + let build (metadata : 'M) (left' : 'M Identifier.t) (argument' : 'M Expression.t option) (delegate': bool) : 'M Statement.t = + let yield_info = Statement.AssignYield { + id = get_id (); + left = left'; + argument = argument'; + delegate = delegate' + } in + (metadata, yield_info) + end + module AssignObject = struct type 'M t = { @@ -1188,7 +1195,6 @@ end = struct | Return of 'M Return.t | Throw of 'M Throw.t | Break of 'M Break.t - | Yield of 'M Yield.t | Continue of 'M Continue.t | Debugger of Debugger.t @@ -1201,6 +1207,7 @@ end = struct | AssignSimple of 'M AssignSimple.t | AssignBinary of 'M AssignBinary.t | AssignUnary of 'M AssignUnary.t + | AssignYield of 'M AssignYield.t | AssignArray of 'M AssignArray.t | AssignObject of 'M AssignObject.t | StaticUpdate of 'M StaticUpdate.t @@ -1266,7 +1273,6 @@ and Expression : sig val build : 'M -> 'M Expression.t end - val get_id : 'M Expression.t -> string val get_id_opt : 'M Expression.t -> string option type 'M t' = @@ -1340,12 +1346,6 @@ end = struct let build (metadata: 'M) : 'M Expression.t = (metadata, Expression.This ()) end - - let get_id (expr : 'M Expression.t) : string = - match expr with - | _, Identifier {name; _} -> name - | _, This _ -> "this" - | _ -> failwith "[ERROR] Expression cannot be converted into an id" let get_id_opt (expr : 'M Expression.t) : string option = match expr with diff --git a/lib/auxiliary/functions.ml b/lib/auxiliary/functions.ml index 4f351a2a..b373bead 100644 --- a/lib/auxiliary/functions.ml +++ b/lib/auxiliary/functions.ml @@ -21,4 +21,10 @@ let option_may f x : unit = let hd_opt (lst : 'a list) : 'a option = match lst with | [] -> None - | fst::_ -> Some fst \ No newline at end of file + | fst::_ -> Some fst + +let split3 (lst : ('a * 'b * 'c) list) : 'a list * 'b list * 'c list = + let rec aux lst (xs, ys, zs) = match lst with + | [] -> (xs, ys, zs) + | (x, y, z)::tail -> aux tail (x::xs, y::ys, z::zs) + in aux lst ([], [], []) \ No newline at end of file diff --git a/lib/mdg/analyse.ml b/lib/mdg/analyse.ml index 168963e6..03bc6be9 100644 --- a/lib/mdg/analyse.ml +++ b/lib/mdg/analyse.ml @@ -208,7 +208,7 @@ module GraphConstrunction (Auxiliary : AbstractAnalysis.T) = struct (* -------- S T A T I C P R O P E R T Y U P D A T E -------- *) | loc, StaticUpdate {_object; property; right; id; _} -> - let add_node' : location -> unit = fun abs_loc -> add_node abs_loc (Expression.get_id _object) loc in + let add_node' : location -> unit = fun abs_loc -> add_node abs_loc (Option.value (Expression.get_id_opt _object) ~default:"*") loc in let _L1, _L2 = eval_expr _object, eval_expr right in let _L1' = new_version store _L1 property id add_node' in @@ -218,9 +218,9 @@ module GraphConstrunction (Auxiliary : AbstractAnalysis.T) = struct ) _L2 ) _L1'; - (* -------- D Y N A M I C P R O P E R T Y U P D A T E -------- *) + (* -------- D Y N A M I C P R O P E§ R T Y U P D A T E -------- *) | loc, DynmicUpdate {_object; property; right; id} -> - let add_node' : location -> unit = fun abs_loc -> add_node abs_loc (Expression.get_id _object) loc in + let add_node' : location -> unit = fun abs_loc -> add_node abs_loc (Option.value (Expression.get_id_opt _object) ~default:"*") loc in let _L1, _L2, _L3 = eval_expr _object, eval_expr property, @@ -292,21 +292,27 @@ module GraphConstrunction (Auxiliary : AbstractAnalysis.T) = struct add_ret_node l_retn loc; + | _, AssignYield _ (* -------- O T H E R C O N S T R U C T S -------- *) + | _, ExportDefaultDecl _ + | _, ExportNamedDecl _ + | _, ImportDecl _ + | _, VarDecl _ | _, Throw _ | _, Break _ - | _, Yield _ | _, Continue _ | _, Debugger _ -> () | _ -> failwith "[ERROR] Statement node analysis not defined"); + analysis := Auxiliary.analyse !analysis state statement; and property_lookup_name (left : m Identifier.t) (_object : m Expression.t) (property : string) : string = - let obj_prop = Expression.get_id _object ^ "." ^ property in + let obj_name = Option.value (Expression.get_id_opt _object) ~default:"*" in + let obj_prop = obj_name ^ "." ^ property in if Identifier.is_generated left then obj_prop else Identifier.get_name left ^ ", " ^ obj_prop and analyse_method_call (state : State.t) (loc : Location.t) (left : m Identifier.t) (_object : m Expression.t) (property : property) (arguments : m Expression.t list) (id_call : int) (id_retn : int) : unit = @@ -332,7 +338,8 @@ module GraphConstrunction (Auxiliary : AbstractAnalysis.T) = struct let l_retn = alloc id_retn in (* get function definition information *) - let f = Expression.get_id _object ^ "." ^ property in + let obj_name = Option.value (Expression.get_id_opt _object) ~default:"*" in + let f = obj_name ^ "." ^ property in (* node information *) add_cnode l_call f loc; @@ -532,7 +539,7 @@ and construct_object (state : State.t) (loc : LocationSet.t) : ExportedObject.t else if LocationSet.is_empty loc then ExportedObject.empty () - else failwith "exported object has a property with multiple locations" + else failwith "[ERROR] exported object has a property with multiple locations" ;; diff --git a/lib/mdg/analysis/collectExternalCalls.ml b/lib/mdg/analysis/collectExternalCalls.ml index bec82be7..c9b29b2b 100644 --- a/lib/mdg/analysis/collectExternalCalls.ml +++ b/lib/mdg/analysis/collectExternalCalls.ml @@ -49,20 +49,21 @@ module Analysis : AbstractAnalysis.T = struct if Identifier.get_name callee = "require" then ( (* get module name *) let module_arg = List.nth_opt arguments 0 in - let module_name = match module_arg with + match module_arg with | Some (_, Literal {value = String module_name; _}) -> - if String.starts_with ~prefix:"./" module_name + let module_name = if String.starts_with ~prefix:"./" module_name then String.sub module_name 2 (String.length module_name - 2) - else module_name - - | _ -> failwith "[ERROR] Failed to obtain require module name" - in - - let loc = eval_expr (Identifier.to_expression left) in - let external_reference = create_ext_ref module_name [] in - add_ext_ref info loc external_reference) - - else ( + else module_name + in + + let loc = eval_expr (Identifier.to_expression left) in + let external_reference = create_ext_ref module_name [] in + add_ext_ref info loc external_reference + + (* do nothing the fist argument is dynamic *) + | _ -> info + + ) else ( (* check if callee is an external call *) let l_call = LocationSet.singleton (alloc id_call) in let callee = eval_expr (Identifier.to_expression callee) in diff --git a/lib/mdg/pp/pp.ml b/lib/mdg/pp/pp.ml index 4753d99c..30aaa3dc 100644 --- a/lib/mdg/pp/pp.ml +++ b/lib/mdg/pp/pp.ml @@ -59,6 +59,7 @@ end let svg_file = file_path ^ "graph.svg" in let file = open_out_bin dot_file in + Dot.set_info graph.nodes; Dot.output_graph file (convert_graph graph); Out_channel.close file;