From cc030f2faaa82cd95d1e7ea98a9ad0252daa4f2d Mon Sep 17 00:00:00 2001 From: pad Date: Tue, 4 Feb 2020 18:22:29 +0100 Subject: [PATCH] BIG refactoring, add far more tokens in the different ASTs and AST generic Description: sgrep sometimes fails with an OCaml exception about an empty list of tokens (either FakeTok error or min_max_ii error) because a metavariable may match something (an expr or stmt) that does not contain any token information. This in turns mean we can not display location information for this matched thing. This diff should help fix https://github.com/returntocorp/sgrep/issues/73 and https://github.com/returntocorp/sgrep/issues/52 because it adds lots of token information in the different ASTs. I originally skipped those tokens because I wanted an AST, not a CST, but in the ends it bites back and we want many of those tokens (at least enough token so we never get the error above). See ast_generic.ml for the rational. test plan: make test --- h_program-lang/ast_generic.ml | 107 ++++++++++------- lang_GENERIC/analyze/controlflow.ml | 11 +- lang_GENERIC/analyze/controlflow.mli | 2 +- lang_GENERIC/analyze/controlflow_build.ml | 20 ++-- lang_GENERIC/analyze/controlflow_visitor.ml | 2 +- lang_GENERIC/analyze/lrvalue.ml | 18 +-- lang_GENERIC/parsing/map_ast.ml | 120 ++++++++++++++------ lang_GENERIC/parsing/meta_ast.ml | 119 ++++++++++++------- lang_GENERIC/parsing/visitor_ast.ml | 96 ++++++++++++---- lang_c/analyze/c_to_generic.ml | 54 ++++----- lang_c/analyze/datalog_c.ml | 6 +- lang_c/analyze/graph_code_c.ml | 26 +++-- lang_c/parsing/ast_c.ml | 30 ++--- lang_c/parsing/ast_c_build.ml | 55 +++++---- lang_c/parsing/meta_ast_c.ml | 67 +++++++---- lang_c/parsing/visitor_c.ml | 54 ++++++--- lang_cpp/parsing/cst_cpp.ml | 1 + lang_go/analyze/go_to_generic.ml | 106 ++++++++--------- lang_go/analyze/highlight_go.ml | 12 +- lang_go/analyze/resolve_go.ml | 9 +- lang_go/parsing/ast_go.ml | 38 ++++--- lang_go/parsing/meta_ast_go.ml | 88 +++++++++----- lang_go/parsing/parser_go.mly | 89 ++++++++------- lang_go/parsing/visitor_go.ml | 53 ++++++--- lang_java/analyze/graph_code_java.ml | 34 +++--- lang_java/analyze/java_to_generic.ml | 63 +++++----- lang_java/parsing/ast_java.ml | 36 +++--- lang_java/parsing/meta_ast_java.ml | 80 ++++++++----- lang_java/parsing/parser_java.mly | 50 ++++---- lang_java/parsing/visitor_java.ml | 52 +++++++-- lang_js/analyze/ast_js.ml | 35 +++--- lang_js/analyze/ast_js_build.ml | 75 ++++++------ lang_js/analyze/graph_code_js.ml | 34 +++--- lang_js/analyze/js_to_generic.ml | 64 ++++++----- lang_js/analyze/map_ast_js.ml | 72 ++++++++---- lang_js/analyze/meta_ast_js.ml | 74 +++++++----- lang_js/analyze/transpile_js.ml | 11 +- lang_js/analyze/visitor_ast_js.ml | 62 +++++++--- lang_ml/analyze/ast_ml.ml | 16 ++- lang_ml/analyze/ast_ml_build.ml | 34 +++--- lang_ml/analyze/ml_to_generic.ml | 28 ++--- lang_python/analyze/highlight_python.ml | 8 +- lang_python/analyze/python_to_generic.ml | 94 +++++++-------- lang_python/analyze/resolve_python.ml | 10 +- lang_python/parsing/ast_python.ml | 57 ++++++---- lang_python/parsing/meta_ast_python.ml | 113 +++++++++++------- lang_python/parsing/parser_python.mly | 109 +++++++++--------- lang_python/parsing/visitor_python.ml | 88 ++++++++++---- 48 files changed, 1514 insertions(+), 968 deletions(-) diff --git a/h_program-lang/ast_generic.ml b/h_program-lang/ast_generic.ml index 31f30afab..c8c03462f 100644 --- a/h_program-lang/ast_generic.ml +++ b/h_program-lang/ast_generic.ml @@ -1,6 +1,6 @@ (* Yoann Padioleau * - * Copyright (C) 2019 r2c + * Copyright (C) 2019-2020 r2c * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -63,23 +63,27 @@ * * design choices to have a generic data structure: * - add some 'a, 'b, 'c around expr/stmt/... - * - functorize and add some type hole (type tstmt; type texpr; ...) - * - data-type a la carte like in github-semantic but Seems too high-level + * - data-type a la carte like in github-semantic but IMHO too high-level * with astronaut-style architecture (too abstract, too advanced features). * - the OtherXxx strategy used in this file (simple) + * - functorize and add some type hole (type tstmt; type texpr; ...), + * todo? not a bad idea if later we want to add type information on each + * expression nodes * * history: * - started with crossproduct of Javascript, Python, PHP, Java, and C * (and a bit of OCaml) after wanting to port checked_return from Js to * Python and got the idea to factorize things * - * invariants: + * INVARIANTS: * - all the other_xxx types should contain only simple constructors (enums) * without any parameter. I rely on that to simplify the code * of the generic mapper and matcher. - * - each language should add the VarDefs that defines the locals - * used in a function (instead of having the first Assign play the role - * of a VarDef, as done in Python for example). + * Same for keyword_attribute. + * - each expression or statement must have at least one token in it + * so that sgrep can report correctly ranges (e.g., 'Return of expr option' + * is not enough because with no expr, there is no location information + * for this return, so it must be 'Return of tok * expr option' instead) * - to correctly compute a CFG (Control Flow Graph), the stmt type * should list all constructs that contains other statements and * try to avoid to use the very generic OtherXxx of any @@ -87,6 +91,9 @@ * introduce a new variable should have a relevant comment 'newvar:' * - to correctly resolve names, each constructs that introduce a new scope * should have a relevant comment 'newscope:' + * - TODO each language should add the VarDefs that defines the locals + * used in a function (instead of having the first Assign play the role + * of a VarDef, as done in Python for example). * * See also pfff/lang_GENERIC/ *) @@ -106,6 +113,14 @@ type tok = Parse_info.t type 'a wrap = 'a * tok (* with tarzan *) +(* Use for round(), square[], curly{}, and angle<> brackets. + * note: in theory we should not care about those tokens in an AST, + * but they are useful to report correct ranges in sgrep when we match + * something that can just be those brackets (e.g., an empty container). + *) +type 'a bracket = tok * 'a * tok + (* with tarzan *) + (*****************************************************************************) (* Names *) (*****************************************************************************) @@ -172,11 +187,11 @@ and expr = | L of literal (* composite values *) - | Container of container_operator * expr list - | Tuple of expr list (* special case of Container *) + | Container of container_operator * expr list bracket + | Tuple of expr list (* special case of Container, at least 2 elements *) (* And-type (field.vinit should be a Some) *) - | Record of field list + | Record of field list bracket (* Or-type (could be used instead of Container, Cons, Nil, etc.) *) | Constructor of name * expr list (* see also Call(IdSpecial (New,_), [ArgType _;...] for other values *) @@ -186,7 +201,7 @@ and expr = (* usually an argument of a New (used in Java, Javascript) *) | AnonClass of class_definition - | Nop (* less: could be merged with L Unit *) + | Nop (* less: could be merged with L Unit, TODO: remove? *) (* todo: newvar: sometimes abused to also introduce a newvar (as in Python) * but ultimately those cases should be rewritten to first introduce a @@ -225,26 +240,27 @@ and expr = *) | DotAccess of expr * tok (* ., ::, ->, # *) * ident (* in Js this is used for ObjAccess with a computed field name *) - | ArrayAccess of expr * expr (* less: slice *) + | ArrayAccess of expr * expr (* could also use ArrayAccess with a Tuple rhs, or use a special *) | SliceAccess of expr * expr option (* lower *) * expr option (* upper *) * expr option (* step*) - | Conditional of expr * expr * expr (* a.k.a ternary expression *) + (* a.k.a ternary expression, or regular if in ML *) + | Conditional of expr * expr * expr | MatchPattern of expr * action list (* less: TryFunctional *) - | Yield of expr * bool - | Await of expr + | Yield of tok * expr option * bool (* 'from' for Python *) + | Await of tok * expr (* Send/Recv of Go are currently in OtherExpr *) | Cast of type_ * expr (* less: should be in statement *) - | Seq of expr list + | Seq of expr list (* at least 2 elements *) (* less: could be in Special *) - | Ref of expr (* &, address of *) - | DeRef of expr (* '*' *) + | Ref of tok (* &, address of *) * expr + | DeRef of tok (* '*' in C, '!' or '<-' in ML *) * expr | Ellipsis of tok (* sgrep: ... in args, stmts, and also types in Python *) @@ -373,27 +389,29 @@ and stmt = | DirectiveStmt of directive (* newscope: in C++/Java/Go *) - | Block of stmt list - (* EmptyStmt = Block [] *) + | Block of stmt list (* TODO: bracket *) + (* EmptyStmt = Block [], or separate so can not be matched by $S? *) - | If of expr * stmt * stmt - | While of expr * stmt - | DoWhile of stmt * expr + | If of tok (* 'if' or 'elif' *) * expr * stmt * stmt + | While of tok * expr * stmt + | DoWhile of tok * stmt * expr (* newscope: *) - | For of for_header * stmt + | For of tok * for_header * stmt (* less: could be merged with ExprStmt (MatchPattern ...) *) | Switch of tok (* switch or also Select in Go *) * expr * case_and_body list - | Return of expr option - | Continue of expr option | Break of expr option (* todo? switch to label? *) + | Return of tok * expr option + (* less: switch to label? but PHP accept integers no? *) + | Continue of tok * expr option + | Break of tok * expr option | Label of label * stmt - | Goto of label + | Goto of tok * label - | Throw of expr (* a.k.a raise *) - | Try of stmt * catch list * finally option - | Assert of expr * expr option (* message *) + | Throw of tok * expr (* a.k.a raise *) + | Try of tok * stmt * catch list * finally option + | Assert of tok * expr * expr option (* message *) (* this is important to correctly compute a CFG *) | OtherStmtWithStmt of other_stmt_with_stmt_operator * expr * stmt @@ -409,8 +427,8 @@ and stmt = *) and case_and_body = case list * stmt and case = - | Case of pattern - | Default + | Case of tok * pattern + | Default of tok (* newvar: newscope: *) and catch = pattern * stmt @@ -463,14 +481,14 @@ and pattern = (* Or-Type *) | PatConstructor of name * pattern list (* And-Type *) - | PatRecord of field_pattern list + | PatRecord of field_pattern list (* TODO: bracket *) (* newvar:! *) | PatVar of ident * id_info (* Always Local or Param *) (* special cases of PatConstructor *) | PatTuple of pattern list - | PatList of pattern list + | PatList of pattern list (* TODO bracket *) | PatKeyVal of pattern * pattern (* a kind of PatTuple *) (* special case of PatVar *) @@ -514,7 +532,7 @@ and type_ = (* a special case of TApply, also a special case of TPointer *) | TyArray of (* const_expr *) expr option * type_ - | TyPointer of type_ + | TyPointer of tok * type_ | TyTuple of type_ list | TyQuestion of type_ (* option type *) @@ -682,8 +700,10 @@ and type_definition = { and type_definition_kind = | OrType of or_type_element list (* enum/ADTs *) - (* field.vtype should be defined here *) - | AndType of field list (* record/struct (for class see class_definition *) + (* field.vtype should be defined here + * record/struct (for class see class_definition + *) + | AndType of field list (* TODO bracket *) (* a.k.a typedef in C (and alias type in Go) *) | AliasType of type_ @@ -714,7 +734,7 @@ and type_definition = { | FieldMethod of entity * function_definition | FieldDynamic of expr (* dynamic name *) * attribute list * expr (*value*) - | FieldSpread of expr (* usually a Name *) + | FieldSpread of tok (* ... *) * expr (* usually a Name *) | FieldStmt of stmt @@ -733,7 +753,7 @@ and class_definition = { cextends: type_ list; (* usually just one parent *) cimplements: type_ list; (* newscope: *) - cbody: field list; + cbody: field list; (* TODO bracket *) } and class_kind = | Class @@ -771,15 +791,16 @@ and macro_definition = { (*****************************************************************************) and directive = (* newvar: *) - | ImportFrom of module_name * alias list (* less: unfold the list? *) - | ImportAs of module_name * ident option (* as name *) + | ImportFrom of tok (* 'import' or 'from' *) * module_name * alias list + (* less: unfold the alias list? *) + | ImportAs of tok * module_name * ident option (* as name *) (* bad practice! hard to resolve name locally *) - | ImportAll of module_name * tok (* '.' in Go, '*' in Java/Python *) + | ImportAll of tok * module_name * tok (* '.' in Go, '*' in Java/Python *) (* packages are different from modules in that multiple files can reuse * the same package name; they are agglomarated in the same package *) - | Package of dotted_ident (* a.k.a namespace *) + | Package of tok * dotted_ident (* a.k.a namespace *) | OtherDirective of other_directive_operator * any list diff --git a/lang_GENERIC/analyze/controlflow.ml b/lang_GENERIC/analyze/controlflow.ml index 2656fd157..22433ffb9 100644 --- a/lang_GENERIC/analyze/controlflow.ml +++ b/lang_GENERIC/analyze/controlflow.ml @@ -109,7 +109,7 @@ type node = { | ExprStmt of expr | DefStmt of definition | DirectiveStmt of directive - | Assert of expr * expr option + | Assert of tok * expr * expr option | OtherStmt of other_stmt_operator * any list (* not part of Ast.stmt but useful to have in CFG for * dataflow analysis purpose *) @@ -182,21 +182,22 @@ let short_string_of_node node = let simple_node_of_stmt_opt stmt = match stmt with | A.ExprStmt e -> Some (ExprStmt e) - | A.Assert (e1, e2) -> Some (Assert (e1, e2)) + | A.Assert (t, e1, e2) -> Some (Assert (t, e1, e2)) | A.DefStmt x -> Some (DefStmt x) | A.DirectiveStmt x -> Some (DirectiveStmt x) | A.OtherStmt (a,b) -> Some (OtherStmt (a,b)) - | (A.Block _|A.If (_, _, _)|A.While (_, _)|A.DoWhile (_, _)|A.For (_, _) + | (A.Block _|A.If (_, _, _, _)|A.While (_, _, _)|A.DoWhile (_, _, _) + |A.For (_, _, _) |A.Switch (_, _, _) |A.Return _|A.Continue _|A.Break _|A.Label (_, _)|A.Goto _ - |A.Throw _|A.Try (_, _, _) + |A.Throw _|A.Try (_, _, _, _) |A.OtherStmtWithStmt _ ) -> None let any_of_simple_node = function | ExprStmt e -> A.S (A.ExprStmt e) - | Assert (e1, e2) -> A.S (A.Assert (e1, e2)) + | Assert (t, e1, e2) -> A.S (A.Assert (t, e1, e2)) | DefStmt x -> A.S (A.DefStmt x) | DirectiveStmt x -> A.S (A.DirectiveStmt x) | OtherStmt (a,b) -> A.S (A.OtherStmt (a,b)) diff --git a/lang_GENERIC/analyze/controlflow.mli b/lang_GENERIC/analyze/controlflow.mli index 5dccd94e1..0df0b0e48 100644 --- a/lang_GENERIC/analyze/controlflow.mli +++ b/lang_GENERIC/analyze/controlflow.mli @@ -30,7 +30,7 @@ type node = { | ExprStmt of expr | DefStmt of definition | DirectiveStmt of directive - | Assert of expr * expr option + | Assert of tok * expr * expr option (* The 'any' below should not containt stmts, otherwise the CFG will * be incomplete. Use other_stmt_with_stmt_operator instead. *) diff --git a/lang_GENERIC/analyze/controlflow_build.ml b/lang_GENERIC/analyze/controlflow_build.ml index 5ef177d3d..b0dd4d112 100644 --- a/lang_GENERIC/analyze/controlflow_build.ml +++ b/lang_GENERIC/analyze/controlflow_build.ml @@ -145,9 +145,9 @@ let rec (cfg_stmt: state -> F.nodei option -> stmt -> F.nodei option) = *) let node, stmt = (match stmt with - | While (e, stmt) -> + | While (_, e, stmt) -> F.WhileHeader (e), stmt - | For (forheader, stmt) -> + | For (_, forheader, stmt) -> (match forheader with | ForClassic _ -> raise Todo | ForEach (pat, e) -> F.ForeachHeader (pat, e) @@ -274,7 +274,7 @@ let rec (cfg_stmt: state -> F.nodei option -> stmt -> F.nodei option) = * (whereas While can't return None). But if we return None, certainly * sign of buggy code. *) - | DoWhile (st, e) -> + | DoWhile (_, st, e) -> (* previ -> doi ---> ... ---> finalthen (opt) ---> taili * |--------- newfakethen ----------------| |-> newfakelse *) @@ -303,7 +303,7 @@ let rec (cfg_stmt: state -> F.nodei option -> stmt -> F.nodei option) = Some newfakeelse ) - | If (e, st_then, st_else) -> + | If (_, e, st_then, st_else) -> (* previ -> newi ---> newfakethen -> ... -> finalthen --> lasti -> * | | * |-> newfakeelse -> ... -> finalelse -| @@ -338,7 +338,7 @@ let rec (cfg_stmt: state -> F.nodei option -> stmt -> F.nodei option) = Some lasti ) - | Return (e) -> + | Return (_, e) -> let newi = state.g#add_node { F.n = F.Return e;i=i() } in state.g |> add_arc_opt (previ, newi); state.g |> add_arc (newi, state.exiti); @@ -346,7 +346,7 @@ let rec (cfg_stmt: state -> F.nodei option -> stmt -> F.nodei option) = * this new node *) None - | Continue (eopt) | Break (eopt) -> + | Continue (_, eopt) | Break (_, eopt) -> let is_continue, node = match stmt with @@ -413,7 +413,7 @@ let rec (cfg_stmt: state -> F.nodei option -> stmt -> F.nodei option) = *) if (not (cases_and_body |> List.exists (fun (cases, _body) -> cases |> List.exists (function - | Ast.Default -> true | _ -> false)))) + | Ast.Default _ -> true | _ -> false)))) then begin state.g |> add_arc (newi, endi); end; @@ -482,7 +482,7 @@ let rec (cfg_stmt: state -> F.nodei option -> stmt -> F.nodei option) = * *) - | Try(body, catches, _finallys) -> + | Try(_, body, catches, _finallys) -> (* TODO Task #3622443: Update the logic below to account for "finally" clauses *) let newi = state.g#add_node { F.n = F.TryHeader;i=i() } in @@ -557,7 +557,7 @@ let rec (cfg_stmt: state -> F.nodei option -> stmt -> F.nodei option) = * path sensitive analysis to be more precise (so that we would remove * certain edges) *) - | Throw (e) -> + | Throw (_, e) -> let newi = state.g#add_node { F.n = F.Throw e; i=i() } in state.g |> add_arc_opt (previ, newi); @@ -656,7 +656,7 @@ and (cfg_cases: let node = (* TODO: attach expressions there *) match cases with - | [Default] -> F.Default + | [Default _] -> F.Default | _ -> F.Case in diff --git a/lang_GENERIC/analyze/controlflow_visitor.ml b/lang_GENERIC/analyze/controlflow_visitor.ml index 2c0565a17..a3d14fcfb 100644 --- a/lang_GENERIC/analyze/controlflow_visitor.ml +++ b/lang_GENERIC/analyze/controlflow_visitor.ml @@ -98,7 +98,7 @@ let exprs_of_node node = | SimpleNode x -> (match x with | ExprStmt e -> [e] - | Assert (e, eopt) -> e::Common.opt_to_list eopt + | Assert (_, e, eopt) -> e::Common.opt_to_list eopt (* TODO: should transform VarDef in it in Assign *) | DefStmt _ -> [] | DirectiveStmt _ -> [] diff --git a/lang_GENERIC/analyze/lrvalue.ml b/lang_GENERIC/analyze/lrvalue.ml index 6170555fc..e3ea755ec 100644 --- a/lang_GENERIC/analyze/lrvalue.ml +++ b/lang_GENERIC/analyze/lrvalue.ml @@ -46,6 +46,8 @@ let error_todo any = pr2 s; failwith ("Dataflow_visitor:error_todo ") +let unbracket (_, x, _) = x + (*****************************************************************************) (* Main algorithm *) (*****************************************************************************) @@ -108,9 +110,9 @@ let rec visit_expr hook lhs expr = | Container (typ, xs) -> (match typ with (* used on lhs? *) - | Array | List -> xs |> List.iter recl + | Array | List -> xs |> unbracket |> List.iter recl (* never used on lhs *) - | Set | Dict -> xs |> List.iter recr + | Set | Dict -> xs |> unbracket |> List.iter recr ) (* composite lvalues that are actually not themselves lvalues *) @@ -123,11 +125,11 @@ let rec visit_expr hook lhs expr = recr e1; recr e; | SliceAccess (e, e1, e2, e3) -> - [e1;e2;e3] |> List.map Ast_generic.opt_to_nop |> List.iter recr; + [e1;e2;e3] |> List.map opt_to_nop |> List.iter recr; recr e - | DeRef e -> recr e - | Ref e -> recr e + | DeRef (_, e) -> recr e + | Ref (_, e) -> recr e (* otherwise regular recurse (could use a visitor) *) @@ -182,11 +184,11 @@ let rec visit_expr hook lhs expr = | AnonClass _ -> () - | Yield (e, _is_yield_from) -> recr e - | Await e -> recr e + | Yield (_, e, _is_yield_from) -> recr (opt_to_nop e) + | Await (_, e) -> recr e | Record xs -> - xs |> List.iter (fun field -> + xs |> unbracket |> List.iter (fun field -> anyhook hook Rhs (Fld field) ) diff --git a/lang_GENERIC/parsing/map_ast.ml b/lang_GENERIC/parsing/map_ast.ml index fee2526c3..9e74f28f4 100644 --- a/lang_GENERIC/parsing/map_ast.ml +++ b/lang_GENERIC/parsing/map_ast.ml @@ -69,6 +69,10 @@ let rec map_tok v = and map_wrap:'a. ('a -> 'a) -> 'a wrap -> 'a wrap = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = map_tok v2 in (v1, v2) +and map_bracket:'a. ('a -> 'a) -> 'a bracket -> 'a bracket = + fun of_a (v1, v2, v3) -> + let v1 = map_tok v1 and v2 = of_a v2 and v3 = map_tok v3 in (v1, v2, v3) + and map_ident v = map_wrap map_of_string v and map_dotted_ident v = map_of_list map_ident v @@ -118,10 +122,13 @@ and map_expr x = | L v1 -> let v1 = map_literal v1 in L ((v1)) | Container ((v1, v2)) -> let v1 = map_container_operator v1 - and v2 = map_of_list map_expr v2 + and v2 = map_bracket (map_of_list map_expr) v2 in Container ((v1, v2)) - | Tuple v1 -> let v1 = map_of_list map_expr v1 in Tuple ((v1)) - | Record v1 -> let v1 = map_of_list map_field v1 in Record ((v1)) + | Tuple v1 -> + let v1 = map_of_list map_expr v1 in Tuple ((v1)) + | Record v1 -> + let v1 = map_bracket (map_of_list map_field) v1 in + Record ((v1)) | Constructor ((v1, v2)) -> let v1 = map_name v1 and v2 = map_of_list map_expr v2 @@ -167,13 +174,24 @@ and map_expr x = let v1 = map_expr v1 and v2 = map_of_list map_action v2 in MatchPattern ((v1, v2)) - | Yield ((v1, v2)) -> let v1 = map_expr v1 and v2 = map_of_bool v2 in Yield ((v1, v2)) - | Await v1 -> let v1 = map_expr v1 in Await ((v1)) + | Yield ((t, v1, v2)) -> + let t = map_tok t in + let v1 = map_of_option map_expr v1 and + v2 = map_of_bool v2 in + Yield ((t, v1, v2)) + | Await (t, v1) -> + let t = map_tok t in + let v1 = map_expr v1 in Await ((t, v1)) | Cast ((v1, v2)) -> let v1 = map_type_ v1 and v2 = map_expr v2 in Cast ((v1, v2)) - | Seq v1 -> let v1 = map_of_list map_expr v1 in Seq ((v1)) - | Ref v1 -> let v1 = map_expr v1 in Ref ((v1)) - | DeRef v1 -> let v1 = map_expr v1 in DeRef ((v1)) + | Seq (v1) -> + let v1 = map_of_list map_expr v1 in Seq ((v1)) + | Ref (t, v1) -> + let t = map_tok t in + let v1 = map_expr v1 in Ref ((t, v1)) + | DeRef (t, v1) -> + let t = map_tok t in + let v1 = map_expr v1 in DeRef ((t, v1)) | Ellipsis v1 -> let v1 = map_tok v1 in Ellipsis ((v1)) | OtherExpr ((v1, v2)) -> let v1 = map_other_expr_operator v1 @@ -257,7 +275,9 @@ and map_type_ = let v1 = map_of_option map_expr v1 and v2 = map_type_ v2 in TyArray ((v1, v2)) - | TyPointer v1 -> let v1 = map_type_ v1 in TyPointer ((v1)) + | TyPointer (t, v1) -> + let t = map_tok t in + let v1 = map_type_ v1 in TyPointer ((t, v1)) | TyTuple v1 -> let v1 = map_of_list map_type_ v1 in TyTuple ((v1)) | TyQuestion v1 -> let v1 = map_type_ v1 in TyQuestion ((v1)) | OtherType ((v1, v2)) -> @@ -309,38 +329,54 @@ and map_stmt x = | DefStmt v1 -> let v1 = map_definition v1 in DefStmt ((v1)) | DirectiveStmt v1 -> let v1 = map_directive v1 in DirectiveStmt ((v1)) | Block v1 -> let v1 = map_of_list map_stmt v1 in Block ((v1)) - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = map_tok t in let v1 = map_expr v1 and v2 = map_stmt v2 and v3 = map_stmt v3 - in If ((v1, v2, v3)) - | While ((v1, v2)) -> - let v1 = map_expr v1 and v2 = map_stmt v2 in While ((v1, v2)) - | DoWhile ((v1, v2)) -> - let v1 = map_stmt v1 and v2 = map_expr v2 in DoWhile ((v1, v2)) - | For ((v1, v2)) -> - let v1 = map_for_header v1 and v2 = map_stmt v2 in For ((v1, v2)) + in If ((t, v1, v2, v3)) + | While ((t, v1, v2)) -> + let t = map_tok t in + let v1 = map_expr v1 and v2 = map_stmt v2 in While ((t, v1, v2)) + | DoWhile ((t, v1, v2)) -> + let t = map_tok t in + let v1 = map_stmt v1 and v2 = map_expr v2 in DoWhile ((t, v1, v2)) + | For ((t, v1, v2)) -> + let t = map_tok t in + let v1 = map_for_header v1 and v2 = map_stmt v2 in For ((t, v1, v2)) | Switch ((v0, v1, v2)) -> let v0 = map_tok v0 in let v1 = map_expr v1 and v2 = map_of_list map_case_and_body v2 in Switch ((v0, v1, v2)) - | Return v1 -> let v1 = map_of_option map_expr v1 in Return ((v1)) - | Continue v1 -> let v1 = map_of_option map_expr v1 in Continue ((v1)) - | Break v1 -> let v1 = map_of_option map_expr v1 in Break ((v1)) + | Return (t, v1) -> + let t = map_tok t in + let v1 = map_of_option map_expr v1 in Return ((t, v1)) + | Continue (t, v1) -> + let t = map_tok t in + let v1 = map_of_option map_expr v1 in Continue ((t, v1)) + | Break (t, v1) -> + let t = map_tok t in + let v1 = map_of_option map_expr v1 in Break ((t, v1)) | Label ((v1, v2)) -> let v1 = map_label v1 and v2 = map_stmt v2 in Label ((v1, v2)) - | Goto v1 -> let v1 = map_label v1 in Goto ((v1)) - | Throw v1 -> let v1 = map_expr v1 in Throw ((v1)) - | Try ((v1, v2, v3)) -> + | Goto (t, v1) -> + let t = map_tok t in + let v1 = map_label v1 in Goto ((t, v1)) + | Throw (t, v1) -> + let t = map_tok t in + let v1 = map_expr v1 in Throw ((t, v1)) + | Try ((t, v1, v2, v3)) -> + let t = map_tok t in let v1 = map_stmt v1 and v2 = map_of_list map_catch v2 and v3 = map_of_option map_finally v3 - in Try ((v1, v2, v3)) - | Assert ((v1, v2)) -> + in Try ((t, v1, v2, v3)) + | Assert ((t, v1, v2)) -> + let t = map_tok t in let v1 = map_expr v1 and v2 = map_of_option map_expr v2 - in Assert ((v1, v2)) + in Assert ((t, v1, v2)) | OtherStmtWithStmt ((v1, v2, v3)) -> let v1 = map_other_stmt_with_stmt_operator v1 and v2 = map_expr v2 @@ -360,8 +396,12 @@ and map_case_and_body (v1, v2) = and map_case = function - | Case v1 -> let v1 = map_pattern v1 in Case ((v1)) - | Default -> Default + | Case (t, v1) -> + let t = map_tok t in + let v1 = map_pattern v1 in Case ((t, v1)) + | Default t -> + let t = map_tok t in + Default t and map_catch (v1, v2) = let v1 = map_pattern v1 and v2 = map_stmt v2 in (v1, v2) @@ -566,7 +606,9 @@ and map_field = and v2 = map_of_list map_attribute v2 and v3 = map_expr v3 in FieldDynamic ((v1, v2, v3)) - | FieldSpread v1 -> let v1 = map_expr v1 in FieldSpread ((v1)) + | FieldSpread (t, v1) -> + let t = map_tok t in + let v1 = map_expr v1 in FieldSpread ((t, v1)) | FieldStmt v1 -> let v1 = map_stmt v1 in FieldStmt ((v1)) and map_type_definition { tbody = v_tbody } = @@ -629,25 +671,29 @@ and map_class_kind = and map_directive = function - | ImportFrom ((v1, v2)) -> + | ImportFrom ((t, v1, v2)) -> + let t = map_tok t in let v1 = map_module_name v1 and v2 = map_of_list map_alias v2 - in ImportFrom ((v1, v2)) - | ImportAs ((v1, v2)) -> + in ImportFrom ((t, v1, v2)) + | ImportAs ((t, v1, v2)) -> + let t = map_tok t in let v1 = map_module_name v1 and v2 = map_of_option map_ident v2 - in ImportAs ((v1, v2)) - | ImportAll ((v1, v2)) -> + in ImportAs ((t, v1, v2)) + | ImportAll ((t, v1, v2)) -> + let t = map_tok t in let v1 = map_module_name v1 and v2 = map_tok v2 - in ImportAll ((v1, v2)) + in ImportAll ((t, v1, v2)) | OtherDirective ((v1, v2)) -> let v1 = map_other_directive_operator v1 and v2 = map_of_list map_any v2 in OtherDirective ((v1, v2)) - | Package ((v1)) -> + | Package ((t, v1)) -> + let t = map_tok t in let v1 = map_dotted_ident v1 - in Package ((v1)) + in Package ((t, v1)) and map_alias (v1, v2) = let v1 = map_ident v1 and v2 = map_of_option map_ident v2 in (v1, v2) diff --git a/lang_GENERIC/parsing/meta_ast.ml b/lang_GENERIC/parsing/meta_ast.ml index 6f72cec46..803745fd9 100644 --- a/lang_GENERIC/parsing/meta_ast.ml +++ b/lang_GENERIC/parsing/meta_ast.ml @@ -7,6 +7,9 @@ let vof_tok v = Meta_parse_info.vof_info_adjustable_precision v let vof_wrap _of_a (v1, v2) = let v1 = _of_a v1 and v2 = vof_tok v2 in Ocaml.VTuple [ v1; v2 ] + +let vof_bracket of_a (_t1, x, _t2) = + of_a x let vof_ident v = vof_wrap Ocaml.vof_string v @@ -74,12 +77,13 @@ and vof_expr = | L v1 -> let v1 = vof_literal v1 in Ocaml.VSum (("L", [ v1 ])) | Container ((v1, v2)) -> let v1 = vof_container_operator v1 - and v2 = Ocaml.vof_list vof_expr v2 + and v2 = vof_bracket (Ocaml.vof_list vof_expr) v2 in Ocaml.VSum (("Container", [ v1; v2 ])) | Tuple v1 -> let v1 = Ocaml.vof_list vof_expr v1 in Ocaml.VSum (("Tuple", [ v1 ])) | Record v1 -> - let v1 = Ocaml.vof_list vof_field v1 in Ocaml.VSum (("Record", [ v1 ])) + let v1 = vof_bracket (Ocaml.vof_list vof_field) v1 in + Ocaml.VSum (("Record", [ v1 ])) | Constructor ((v1, v2)) -> let v1 = vof_name v1 and v2 = Ocaml.vof_list vof_expr v2 @@ -139,16 +143,25 @@ and vof_expr = let v1 = vof_expr v1 and v2 = Ocaml.vof_list vof_action v2 in Ocaml.VSum (("MatchPattern", [ v1; v2 ])) - | Yield ((v1, v2)) -> let v1 = vof_expr v1 and v2 = Ocaml.vof_bool v2 in Ocaml.VSum (("Yield", [ v1; v2 ])) - | Await v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Await", [ v1 ])) + | Yield ((t, v1, v2)) -> + let t = vof_tok t in + let v1 = Ocaml.vof_option vof_expr v1 and v2 = Ocaml.vof_bool v2 in + Ocaml.VSum (("Yield", [ t; v1; v2 ])) + | Await (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("Await", [ t; v1 ])) | Cast ((v1, v2)) -> let v1 = vof_type_ v1 and v2 = vof_expr v2 in Ocaml.VSum (("Cast", [ v1; v2 ])) | Seq v1 -> let v1 = Ocaml.vof_list vof_expr v1 in Ocaml.VSum (("Seq", [ v1 ])) - | Ref v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Ref", [ v1 ])) - | DeRef v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("DeRef", [ v1 ])) + | Ref (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("Ref", [ t; v1 ])) + | DeRef (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("DeRef", [ t; v1 ])) | Ellipsis v1 -> let v1 = vof_tok v1 in Ocaml.VSum (("Ellipsis", [ v1 ])) | OtherExpr ((v1, v2)) -> let v1 = vof_other_expr_operator v1 @@ -322,8 +335,9 @@ and vof_type_ = let v1 = Ocaml.vof_option vof_expr v1 and v2 = vof_type_ v2 in Ocaml.VSum (("TyArray", [ v1; v2 ])) - | TyPointer v1 -> - let v1 = vof_type_ v1 in Ocaml.VSum (("TyPointer", [ v1 ])) + | TyPointer (t, v1) -> + let t = vof_tok t in + let v1 = vof_type_ v1 in Ocaml.VSum (("TyPointer", [ t; v1 ])) | TyTuple v1 -> let v1 = Ocaml.vof_list vof_type_ v1 in Ocaml.VSum (("TyTuple", [ v1 ])) @@ -405,50 +419,65 @@ and vof_stmt = let v1 = vof_directive v1 in Ocaml.VSum (("DirectiveStmt", [ v1 ])) | Block v1 -> let v1 = Ocaml.vof_list vof_stmt v1 in Ocaml.VSum (("Block", [ v1 ])) - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = vof_stmt v2 and v3 = vof_stmt v3 - in Ocaml.VSum (("If", [ v1; v2; v3 ])) - | While ((v1, v2)) -> + in Ocaml.VSum (("If", [ t; v1; v2; v3 ])) + | While ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = vof_stmt v2 - in Ocaml.VSum (("While", [ v1; v2 ])) - | DoWhile ((v1, v2)) -> + in Ocaml.VSum (("While", [ t; v1; v2 ])) + | DoWhile ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_stmt v1 and v2 = vof_expr v2 - in Ocaml.VSum (("DoWhile", [ v1; v2 ])) - | For ((v1, v2)) -> + in Ocaml.VSum (("DoWhile", [ t; v1; v2 ])) + | For ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_for_header v1 and v2 = vof_stmt v2 - in Ocaml.VSum (("For", [ v1; v2 ])) + in Ocaml.VSum (("For", [ t; v1; v2 ])) | Switch ((v0, v1, v2)) -> let v0 = vof_tok v0 in let v1 = vof_expr v1 and v2 = Ocaml.vof_list vof_case_and_body v2 in Ocaml.VSum (("Switch", [ v0; v1; v2 ])) - | Return v1 -> let v1 = Ocaml.vof_option vof_expr v1 in - Ocaml.VSum (("Return", [ v1 ])) - | Continue v1 -> + | Return (t, v1) -> + let t = vof_tok t in + let v1 = Ocaml.vof_option vof_expr v1 in + Ocaml.VSum (("Return", [ t; v1 ])) + | Continue (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_expr v1 - in Ocaml.VSum (("Continue", [ v1 ])) - | Break v1 -> - let v1 = Ocaml.vof_option vof_expr v1 in Ocaml.VSum (("Break", [ v1 ])) + in Ocaml.VSum (("Continue", [ t; v1 ])) + | Break (t, v1) -> + let t = vof_tok t in + let v1 = Ocaml.vof_option vof_expr v1 in + Ocaml.VSum (("Break", [ t; v1 ])) | Label ((v1, v2)) -> let v1 = vof_label v1 and v2 = vof_stmt v2 in Ocaml.VSum (("Label", [ v1; v2 ])) - | Goto v1 -> let v1 = vof_label v1 in Ocaml.VSum (("Goto", [ v1 ])) - | Throw v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Throw", [ v1 ])) - | Try ((v1, v2, v3)) -> + | Goto (t, v1) -> + let t = vof_tok t in + let v1 = vof_label v1 in Ocaml.VSum (("Goto", [ t; v1 ])) + | Throw (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("Throw", [ t; v1 ])) + | Try ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_stmt v1 and v2 = Ocaml.vof_list vof_catch v2 and v3 = Ocaml.vof_option vof_finally v3 - in Ocaml.VSum (("Try", [ v1; v2; v3 ])) - | Assert ((v1, v2)) -> + in Ocaml.VSum (("Try", [ t; v1; v2; v3 ])) + | Assert ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = Ocaml.vof_option vof_expr v2 - in Ocaml.VSum (("Assert", [ v1; v2 ])) + in Ocaml.VSum (("Assert", [ t; v1; v2 ])) | OtherStmtWithStmt ((v1, v2, v3)) -> let v1 = vof_other_stmt_with_stmt_operator v1 and v2 = vof_expr v2 @@ -467,8 +496,13 @@ and vof_case_and_body (v1, v2) = in Ocaml.VTuple [ v1; v2 ] and vof_case = function - | Case v1 -> let v1 = vof_pattern v1 in Ocaml.VSum (("Case", [ v1 ])) - | Default -> Ocaml.VSum (("Default", [])) + | Case (t, v1) -> + let t = vof_tok t in + let v1 = vof_pattern v1 in + Ocaml.VSum (("Case", [ t; v1 ])) + | Default t -> + let t = vof_tok t in + Ocaml.VSum (("Default", [t])) and vof_catch (v1, v2) = let v1 = vof_pattern v1 and v2 = vof_stmt v2 in Ocaml.VTuple [ v1; v2 ] and vof_finally v = vof_stmt v @@ -736,8 +770,9 @@ and vof_field = and v2 = Ocaml.vof_list vof_attribute v2 and v3 = vof_expr v3 in Ocaml.VSum (("FieldDynamic", [ v1; v2; v3 ])) - | FieldSpread v1 -> - let v1 = vof_expr v1 in Ocaml.VSum (("FieldSpread", [ v1 ])) + | FieldSpread (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("FieldSpread", [ t; v1 ])) | FieldStmt v1 -> let v1 = vof_stmt v1 in Ocaml.VSum (("FieldStmt", [ v1 ])) and vof_type_definition { tbody = v_tbody } = @@ -814,21 +849,25 @@ and vof_class_kind = | Trait -> Ocaml.VSum (("Trait", [])) and vof_directive = function - | ImportFrom ((v1, v2)) -> + | ImportFrom ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_module_name v1 and v2 = Ocaml.vof_list vof_alias v2 - in Ocaml.VSum (("ImportFrom", [ v1; v2 ])) - | ImportAs ((v1, v2)) -> + in Ocaml.VSum (("ImportFrom", [ t; v1; v2 ])) + | ImportAs ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_module_name v1 and v2 = Ocaml.vof_option vof_ident v2 - in Ocaml.VSum (("ImportAs", [ v1; v2 ])) - | ImportAll ((v1, v2)) -> + in Ocaml.VSum (("ImportAs", [ t; v1; v2 ])) + | ImportAll ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_module_name v1 and v2 = vof_tok v2 - in Ocaml.VSum (("ImportAll", [ v1; v2 ])) - | Package ((v1)) -> + in Ocaml.VSum (("ImportAll", [ t; v1; v2 ])) + | Package ((t, v1)) -> + let t = vof_tok t in let v1 = vof_dotted_ident v1 - in Ocaml.VSum (("Package", [ v1 ])) + in Ocaml.VSum (("Package", [ t; v1 ])) | OtherDirective ((v1, v2)) -> let v1 = vof_other_directive_operator v1 and v2 = Ocaml.vof_list vof_any v2 diff --git a/lang_GENERIC/parsing/visitor_ast.ml b/lang_GENERIC/parsing/visitor_ast.ml index 92a88abdc..6981e95e9 100644 --- a/lang_GENERIC/parsing/visitor_ast.ml +++ b/lang_GENERIC/parsing/visitor_ast.ml @@ -84,6 +84,10 @@ and v_tok v = v_info v and v_wrap: 'a. ('a -> unit) -> 'a wrap -> unit = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = v_info v2 in () +and v_bracket: 'a. ('a -> unit) -> 'a bracket -> unit = + fun of_a (v1, v2, v3) -> + let v1 = v_info v1 and v2 = of_a v2 and v3 = v_info v3 in () + and v_ident v = let k x = v_wrap v_string x @@ -135,9 +139,10 @@ and v_expr x = | L v1 -> let v1 = v_literal v1 in () | Ellipsis v1 -> let v1 = v_tok v1 in () | Container ((v1, v2)) -> - let v1 = v_container_operator v1 and v2 = v_list v_expr v2 in () + let v1 = v_container_operator v1 and v2 = v_bracket (v_list v_expr) v2 + in () | Tuple v1 -> let v1 = v_list v_expr v1 in () - | Record v1 -> let v1 = v_list v_field v1 in () + | Record v1 -> let v1 = v_bracket (v_list v_field) v1 in () | Constructor ((v1, v2)) -> let v1 = v_name v1 and v2 = v_list v_expr v2 in () | Lambda ((v1)) -> let v1 = v_function_definition v1 in () @@ -173,12 +178,20 @@ and v_expr x = v_list (fun (v1, v2) -> let v1 = v_pattern v1 and v2 = v_expr v2 in ()) v2 in () - | Yield ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_bool v2 in () - | Await v1 -> let v1 = v_expr v1 in () + | Yield ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_option v_expr v1 and v2 = v_bool v2 in () + | Await (t, v1) -> + let t = v_tok t in + let v1 = v_expr v1 in () | Cast ((v1, v2)) -> let v1 = v_type_ v1 and v2 = v_expr v2 in () | Seq v1 -> let v1 = v_list v_expr v1 in () - | Ref v1 -> let v1 = v_expr v1 in () - | DeRef v1 -> let v1 = v_expr v1 in () + | Ref (t, v1) -> + let t = v_tok t in + let v1 = v_expr v1 in () + | DeRef (t, v1) -> + let t = v_tok t in + let v1 = v_expr v1 in () | OtherExpr ((v1, v2)) -> let v1 = v_other_expr_operator v1 and v2 = v_list v_any v2 in () in @@ -243,7 +256,9 @@ and v_type_ x = | TyVar v1 -> let v1 = v_ident v1 in () | TyArray ((v1, v2)) -> let v1 = v_option v_expr v1 and v2 = v_type_ v2 in () - | TyPointer v1 -> let v1 = v_type_ v1 in () + | TyPointer (t, v1) -> + let t = v_tok t in + let v1 = v_type_ v1 in () | TyTuple v1 -> let v1 = v_list v_type_ v1 in () | TyQuestion v1 -> let v1 = v_type_ v1 in () | OtherType ((v1, v2)) -> @@ -298,11 +313,18 @@ and v_stmt x = | DefStmt v1 -> let v1 = v_def v1 in () | DirectiveStmt v1 -> let v1 = v_directive v1 in () | Block v1 -> let v1 = v_stmts v1 in () - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = v_tok t in let v1 = v_expr v1 and v2 = v_stmt v2 and v3 = v_stmt v3 in () - | While ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_stmt v2 in () - | DoWhile ((v1, v2)) -> let v1 = v_stmt v1 and v2 = v_expr v2 in () - | For ((v1, v2)) -> let v1 = v_for_header v1 and v2 = v_stmt v2 in () + | While ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_expr v1 and v2 = v_stmt v2 in () + | DoWhile ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_stmt v1 and v2 = v_expr v2 in () + | For ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_for_header v1 and v2 = v_stmt v2 in () | Switch ((v0, v1, v2)) -> let v0 = v_tok v0 in let v1 = v_expr v1 @@ -311,18 +333,31 @@ and v_stmt x = (fun (v1, v2) -> let v1 = v_list v_case v1 and v2 = v_stmt v2 in ()) v2 in () - | Return v1 -> let v1 = v_option v_expr v1 in () - | Continue v1 -> let v1 = v_option v_expr v1 in () - | Break v1 -> let v1 = v_option v_expr v1 in () + | Return (t, v1) -> + let t = v_tok t in + let v1 = v_option v_expr v1 in () + | Continue (t, v1) -> + let t = v_tok t in + let v1 = v_option v_expr v1 in () + | Break (t, v1) -> + let t = v_tok t in + let v1 = v_option v_expr v1 in () | Label ((v1, v2)) -> let v1 = v_label v1 and v2 = v_stmt v2 in () - | Goto v1 -> let v1 = v_label v1 in () - | Throw v1 -> let v1 = v_expr v1 in () - | Try ((v1, v2, v3)) -> + | Goto (t, v1) -> + let t = v_tok t in + let v1 = v_label v1 in () + | Throw (t, v1) -> + let t = v_tok t in + let v1 = v_expr v1 in () + | Try ((t, v1, v2, v3)) -> + let t = v_tok t in let v1 = v_stmt v1 and v2 = v_list v_catch v2 and v3 = v_option v_finally v3 in () - | Assert ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_option v_expr v2 in () + | Assert ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_expr v1 and v2 = v_option v_expr v2 in () | OtherStmtWithStmt ((v1, v2, v3)) -> let v1 = v_other_stmt_with_stmt_operator v1 and v2 = v_expr v2 @@ -334,7 +369,14 @@ and v_stmt x = vin.kstmt (k, all_functions) x and v_other_stmt_with_stmt_operator _ = () -and v_case = function | Case v1 -> let v1 = v_pattern v1 in () | Default -> () +and v_case = function + | Case (t, v1) -> + let t = v_tok t in + let v1 = v_pattern v1 in () + | Default t -> + let t = v_tok t in + () + and v_catch (v1, v2) = let v1 = v_pattern v1 and v2 = v_stmt v2 in () and v_finally v = v_stmt v and v_label v = v_ident v @@ -470,7 +512,9 @@ and v_field = and v2 = v_list v_attribute v2 and v3 = v_expr v3 in () - | FieldSpread v1 -> let v1 = v_expr v1 in () + | FieldSpread (t, v1) -> + let t = v_tok t in + let v1 = v_expr v1 in () | FieldStmt v1 -> let v1 = v_stmt v1 in () and v_type_definition { tbody = v_tbody } = @@ -533,13 +577,17 @@ and and v_directive x = let k x = match x with - | ImportFrom ((v1, v2)) -> + | ImportFrom ((t, v1, v2)) -> + let t = v_tok t in let v1 = v_module_name v1 and v2 = v_list v_alias v2 in () - | ImportAs ((v1, v2)) -> + | ImportAs ((t, v1, v2)) -> + let t = v_tok t in let v1 = v_module_name v1 and v2 = v_option v_ident v2 in () - | ImportAll ((v1, v2)) -> + | ImportAll ((t, v1, v2)) -> + let t = v_tok t in let v1 = v_module_name v1 and v2 = v_tok v2 in () - | Package ((v1)) -> + | Package ((t, v1)) -> + let t = v_tok t in let v1 = v_dotted_ident v1 in () | OtherDirective ((v1, v2)) -> let v1 = v_other_directive_operator v1 and v2 = v_list v_any v2 in () diff --git a/lang_c/analyze/c_to_generic.ml b/lang_c/analyze/c_to_generic.ml index fa236996e..cfef57b94 100644 --- a/lang_c/analyze/c_to_generic.ml +++ b/lang_c/analyze/c_to_generic.ml @@ -57,13 +57,15 @@ let wrap = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = info v2 in (v1, v2) +let bracket of_a (t1, x, t2) = (info t1, of_a x, info t2) + let name v = wrap string v let rec unaryOp (a, tok) = match a with - | GetRef -> (fun e -> G.Ref e) - | DeRef -> (fun e -> G.DeRef e) + | GetRef -> (fun e -> G.Ref (tok,e)) + | DeRef -> (fun e -> G.DeRef (tok, e)) | UnPlus -> (fun e -> G.Call (G.IdSpecial (G.ArithOp G.Plus, tok), [G.Arg e])) | UnMinus -> (fun e -> @@ -110,7 +112,7 @@ and logicalOp = let rec type_ = function | TBase v1 -> let v1 = name v1 in G.TyBuiltin v1 - | TPointer v1 -> let v1 = type_ v1 in G.TyPointer v1 + | TPointer (t, v1) -> let v1 = type_ v1 in G.TyPointer (t, v1) | TArray ((v1, v2)) -> let v1 = option const_expr v1 and v2 = type_ v2 in G.TyArray (v1, v2) @@ -164,7 +166,7 @@ and expr = G.ArrayAccess (v1, v2) | RecordPtAccess ((v1, t, v2)) -> let v1 = expr v1 and t = info t and v2 = name v2 in - G.DotAccess (G.DeRef v1, t, v2) + G.DotAccess (G.DeRef (t, v1), t, v2) | Cast ((v1, v2)) -> let v1 = type_ v1 and v2 = expr v2 in G.Cast (v1, v2) | Postfix ((v1, (v2, v3))) -> @@ -194,7 +196,7 @@ and expr = )) | ArrayInit v1 -> let v1 = - list + bracket (list (fun (v1, v2) -> let v1 = option expr v1 and v2 = expr v2 in (match v1 with @@ -202,16 +204,16 @@ and expr = | Some e -> G.OtherExpr (G.OE_ArrayInitDesignator, [G.E e; G.E v2]) ) - ) + )) v1 in G.Container (G.Array, v1) | RecordInit v1 -> let v1 = - list (fun (v1, v2) -> let v1 = name v1 and v2 = expr v2 in + bracket (list (fun (v1, v2) -> let v1 = name v1 and v2 = expr v2 in let entity = G.basic_entity v1 [] in let vdef = { G.vinit = Some v2; vtype = None } in G.FieldVar (entity, vdef) - ) + )) v1 in G.Record v1 | GccConstructor ((v1, v2)) -> let v1 = type_ v1 and v2 = expr v2 in @@ -229,18 +231,18 @@ let rec stmt = function | ExprSt v1 -> let v1 = expr v1 in G.ExprStmt v1 | Block v1 -> let v1 = list stmt v1 in G.Block v1 - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> let v1 = expr v1 and v2 = stmt v2 and v3 = stmt v3 in - G.If (v1, v2, v3) + G.If (t, v1, v2, v3) | Switch ((v0, v1, v2)) -> let v0 = info v0 in let v1 = expr v1 and v2 = list case v2 in G.Switch (v0, v1, v2) - | While ((v1, v2)) -> let v1 = expr v1 and v2 = stmt v2 in - G.While (v1, v2) - | DoWhile ((v1, v2)) -> let v1 = stmt v1 and v2 = expr v2 in - G.DoWhile (v1, v2) - | For ((v1, v2, v3, v4)) -> + | While ((t, v1, v2)) -> let v1 = expr v1 and v2 = stmt v2 in + G.While (t, v1, v2) + | DoWhile ((t, v1, v2)) -> let v1 = stmt v1 and v2 = expr v2 in + G.DoWhile (t, v1, v2) + | For ((t, v1, v2, v3, v4)) -> let v1 = option expr v1 and v2 = option expr v2 and v3 = option expr v3 @@ -250,13 +252,13 @@ let rec stmt = G.ForClassic ([G.ForInitExpr (G.opt_to_nop v1)], G.opt_to_nop v2, G.opt_to_nop v3) in - G.For (header, v4) - | Return v1 -> let v1 = option expr v1 in G.Return v1 - | Continue -> G.Continue None - | Break -> G.Break None + G.For (t, header, v4) + | Return (t, v1) -> let v1 = option expr v1 in G.Return (t, v1) + | Continue t -> G.Continue (t, None) + | Break t -> G.Break (t, None) | Label ((v1, v2)) -> let v1 = name v1 and v2 = stmt v2 in G.Label (v1, v2) - | Goto v1 -> let v1 = name v1 in G.Goto v1 + | Goto (t, v1) -> let v1 = name v1 in G.Goto (t, v1) | Vars v1 -> let v1 = list var_decl v1 in G.stmt1 (v1 |> List.map (fun v -> G.DefStmt v)) | Asm v1 -> let v1 = list expr v1 in @@ -264,10 +266,10 @@ let rec stmt = and case = function - | Case ((v1, v2)) -> let v1 = expr v1 and v2 = list stmt v2 in - [G.Case (G.expr_to_pattern v1)], G.stmt1 v2 - | Default v1 -> let v1 = list stmt v1 in - [G.Default], G.stmt1 v1 + | Case ((t, v1, v2)) -> let v1 = expr v1 and v2 = list stmt v2 in + [G.Case (t, G.expr_to_pattern v1)], G.stmt1 v2 + | Default (t, v1) -> let v1 = list stmt v1 in + [G.Default t], G.stmt1 v1 and var_decl { v_name = xname; @@ -353,8 +355,8 @@ let define_body = let toplevel = function - | Include v1 -> let v1 = wrap string v1 in - G.DirectiveStmt (G.ImportAs (G.FileName v1, None)) + | Include (t, v1) -> let v1 = wrap string v1 in + G.DirectiveStmt (G.ImportAs (t, G.FileName v1, None)) | Define ((v1, v2)) -> let v1 = name v1 and v2 = define_body v2 in let ent = G.basic_entity v1 [] in diff --git a/lang_c/analyze/datalog_c.ml b/lang_c/analyze/datalog_c.ml index 651073653..bc7225af8 100644 --- a/lang_c/analyze/datalog_c.ml +++ b/lang_c/analyze/datalog_c.ml @@ -116,6 +116,8 @@ let string_of_op _str = let is_local env s = (Common.find_opt (fun (x, _) -> x =$= s) !(env.locals)) <> None +let unbracket (_, x, _) = x + (*****************************************************************************) (* Normalize *) (*****************************************************************************) @@ -169,7 +171,7 @@ let instrs_of_expr env e = (* todo: actually an alloc is hidden there! *) | A.Assign (op, e1, A.ArrayInit xs) -> - let ys = xs |> List.map (fun (idxopt, value) -> + let ys = xs |> unbracket |> List.map (fun (idxopt, value) -> (* less? recompute e1 each time? should store in intermediate val? *) let access = match idxopt with @@ -184,7 +186,7 @@ let instrs_of_expr env e = (* todo: actually an alloc is hidden there! *) | A.Assign (op, e1, A.RecordInit xs) -> - let ys = xs |> List.map (fun (name, value) -> + let ys = xs |> unbracket |> List.map (fun (name, value) -> (* less? recompute e1 each time? should store in intermediate val? *) let access = A.RecordPtAccess diff --git a/lang_c/analyze/graph_code_c.ml b/lang_c/analyze/graph_code_c.ml index 8924cdf2c..adc21171c 100644 --- a/lang_c/analyze/graph_code_c.ml +++ b/lang_c/analyze/graph_code_c.ml @@ -221,7 +221,7 @@ let rec expand_typedefs env t = then t else expand_typedefs env t' else t - | TPointer x -> TPointer (expand_typedefs env x) + | TPointer (t, x) -> TPointer (t, expand_typedefs env x) (* less: eopt could contain some sizeof(typedefs) that we should expand * but does not matter probably *) @@ -295,6 +295,8 @@ let find_existing_node_opt env name candidates last_resort = let is_local env s = (Common.find_opt (fun (x, _) -> x =$= s) !(env.locals)) <> None +let unbracket (_, x, _) = x + (*****************************************************************************) (* For datalog *) (*****************************************************************************) @@ -747,26 +749,26 @@ and stmt env = function | ExprSt e -> expr_toplevel env e | Block xs -> stmts env xs | Asm xs -> List.iter (expr_toplevel env) xs - | If (e, st1, st2) -> + | If (_, e, st1, st2) -> expr_toplevel env e; stmts env [st1; st2] | Switch (_, e, xs) -> expr_toplevel env e; cases env xs - | While (e, st) | DoWhile (st, e) -> + | While (_, e, st) | DoWhile (_, st, e) -> expr_toplevel env e; stmt env st - | For (e1, e2, e3, st) -> + | For (_, e1, e2, e3, st) -> Common2.opt (expr_toplevel env) e1; Common2.opt (expr_toplevel env) e2; Common2.opt (expr_toplevel env) e3; stmt env st - | Return eopt -> + | Return (_, eopt) -> Common2.opt (expr_toplevel { env with in_return = true }) eopt; - | Continue | Break -> () + | Continue _ | Break _ -> () | Label (_name, st) -> stmt env st - | Goto _name -> + | Goto (_, _name) -> () | Vars xs -> @@ -786,10 +788,10 @@ and stmt env = function ) and case env = function - | Case (e, xs) -> + | Case (_, e, xs) -> expr_toplevel env e; stmts env xs - | Default xs -> + | Default (_, xs) -> stmts env xs and stmts env xs = List.iter (stmt env) xs @@ -894,12 +896,12 @@ and expr env = function | Sequence (e1, e2) -> exprs env [e1;e2] | ArrayInit xs -> - xs |> List.iter (fun (eopt, init) -> + xs |> unbracket |> List.iter (fun (eopt, init) -> Common2.opt (expr env) eopt; expr env init ) (* todo: add deps on field *) - | RecordInit xs -> xs |> List.map snd |> exprs env + | RecordInit xs -> xs |> unbracket |> List.map snd |> exprs env | SizeOf x -> (match x with @@ -974,7 +976,7 @@ and type_ env typ = else env.pr2_and_log (spf "typedef not found: %s (%s)" s (Parse_info.string_of_info (snd name))) - | TPointer x -> aux x + | TPointer (_, x) -> aux x | TArray (eopt, x) -> Common2.opt (expr env) eopt; aux x diff --git a/lang_c/parsing/ast_c.ml b/lang_c/parsing/ast_c.ml index 156de13ea..70efaac56 100644 --- a/lang_c/parsing/ast_c.ml +++ b/lang_c/parsing/ast_c.ml @@ -81,6 +81,10 @@ type tok = Parse_info.t type 'a wrap = 'a * tok (* with tarzan *) +(* round(), square[], curly{}, angle<> brackets *) +type 'a bracket = tok * 'a * tok + (* with tarzan *) + (* ------------------------------------------------------------------------- *) (* Name *) (* ------------------------------------------------------------------------- *) @@ -95,7 +99,7 @@ type name = string wrap (* less: qualifier (const/volatile) *) type type_ = | TBase of name (* int, float, etc *) - | TPointer of type_ + | TPointer of tok * type_ | TArray of const_expr option * type_ | TFunction of function_type | TStructName of struct_kind * name @@ -158,8 +162,8 @@ and expr = | SizeOf of (expr, type_) Common.either (* should appear only in a variable initializer, or after GccConstructor *) - | ArrayInit of (expr option * expr) list - | RecordInit of (name * expr) list + | ArrayInit of (expr option * expr) list bracket + | RecordInit of (name * expr) list bracket (* gccext: kenccext: *) | GccConstructor of type_ * expr (* always an ArrayInit (or RecordInit?) *) @@ -180,26 +184,26 @@ type stmt = | ExprSt of expr | Block of stmt list - | If of expr * stmt * stmt + | If of tok * expr * stmt * stmt | Switch of tok * expr * case list - | While of expr * stmt - | DoWhile of stmt * expr - | For of expr option * expr option * expr option * stmt + | While of tok * expr * stmt + | DoWhile of tok * stmt * expr + | For of tok * expr option * expr option * expr option * stmt - | Return of expr option - | Continue | Break + | Return of tok * expr option + | Continue of tok | Break of tok | Label of name * stmt - | Goto of name + | Goto of tok * name | Vars of var_decl list (* todo: it's actually a special kind of format, not just an expr *) | Asm of expr list and case = - | Case of expr * stmt list - | Default of stmt list + | Case of tok * expr * stmt list + | Default of tok * stmt list (* ------------------------------------------------------------------------- *) (* Variables *) @@ -270,7 +274,7 @@ type define_body = (* Program *) (* ------------------------------------------------------------------------- *) type toplevel = - | Include of string wrap (* path *) + | Include of tok * string wrap (* path *) | Define of name * define_body | Macro of name * (name list) * define_body diff --git a/lang_c/parsing/ast_c_build.ml b/lang_c/parsing/ast_c_build.ml index 06b8da7fc..245c41004 100644 --- a/lang_c/parsing/ast_c_build.ml +++ b/lang_c/parsing/ast_c_build.ml @@ -112,6 +112,8 @@ let rec ifdef_skipper xs f = ) ) +let bracket_keep of_a (t1, x, t2) = (t1, of_a x, t2) + (*****************************************************************************) (* Main entry point *) (*****************************************************************************) @@ -297,23 +299,23 @@ and initialiser env x = (match xs |> unbrace |> uncomma with | [] -> debug (Init x); raise Impossible | (InitDesignators ([DesignatorField (_, _)], _, _init))::_ -> - A.RecordInit ( - xs |> unbrace |> uncomma |> List.map (function + A.RecordInit (bracket_keep (fun xs -> + xs |> uncomma |> List.map (function | InitDesignators ([DesignatorField (_, ident)], _, init) -> ident, initialiser env init | _ -> debug (Init x); raise Todo - )) + )) xs) | _ -> - A.ArrayInit ((xs |> unbrace |> uncomma) |> List.map (function + A.ArrayInit (bracket_keep (fun xs -> + xs |> uncomma |> List.map (function (* less: todo? *) | InitIndexOld ((_, idx, _), ini) -> Some (expr env idx), initialiser env ini | InitDesignators([DesignatorIndex((_, idx, _))], _, ini) -> Some (expr env idx), initialiser env ini | x -> None, initialiser env x - )) + )) xs) ) - (* should be covered by caller *) | InitDesignators _ -> debug (Init x); raise Todo | InitIndexOld _ | InitFieldOld _ -> debug (Init x); raise Todo @@ -354,7 +356,7 @@ and cpp_directive env x = | Standard -> "<" ^ path ^ ">" | Weird -> debug (Cpp x); raise Todo in - [A.Include (s, tok)] + [A.Include (tok, (s, tok))] | Undef _ -> debug (Cpp x); raise Todo | PragmaAndCo _ -> [] @@ -388,19 +390,19 @@ and stmt env x = | Compound x -> A.Block (compound env x) | Selection s -> (match s with - | If (_, (_, e, _), st1, _, st2) -> - A.If (expr env e, stmt env st1, stmt env st2) + | If (t, (_, e, _), st1, _, st2) -> + A.If (t, expr env e, stmt env st1, stmt env st2) | Switch (tok, (_, e, _), st) -> A.Switch (tok, expr env e, cases env st) ) | Iteration i -> (match i with - | While (_, (_, e, _), st) -> - A.While (expr env e, stmt env st) - | DoWhile (_, st, _, (_, e, _), _) -> - A.DoWhile (stmt env st, expr env e) - | For (_, (_, ((est1, _), (est2, _), (est3, _)), _), st) -> - A.For ( + | While (t, (_, e, _), st) -> + A.While (t, expr env e, stmt env st) + | DoWhile (t, st, _, (_, e, _), _) -> + A.DoWhile (t, stmt env st, expr env e) + | For (t, (_, ((est1, _), (est2, _), (est3, _)), _), st) -> + A.For (t, Common2.fmap (expr env) est1, Common2.fmap (expr env) est2, Common2.fmap (expr env) est3, @@ -426,12 +428,13 @@ and stmt env x = debug (Stmt x); raise CaseOutsideSwitch ) | Jump j -> + let tok = List.hd ii in (match j with - | Goto s -> A.Goto ((s, List.hd ii)) - | Return -> A.Return None; - | ReturnExpr e -> A.Return (Some (expr env e)) - | Continue -> A.Continue - | Break -> A.Break + | Goto s -> A.Goto (tok, (s, tok)) + | Return -> A.Return (tok, None); + | ReturnExpr e -> A.Return (tok, Some (expr env e)) + | Continue -> A.Continue tok + | Break -> A.Break tok | GotoComputed _ -> debug (Stmt x); raise Todo ) @@ -481,10 +484,12 @@ and cases env x = raise MacroInCase ) xs' in (match x with - | StmtElem ((Labeled (Case (e, _))), _) -> - A.Case (expr env e, stmts) - | StmtElem ((Labeled (Default _st)), _) -> - A.Default (stmts) + | StmtElem ((Labeled (Case (e, _))), ii) -> + let tok = List.hd ii in + A.Case (tok, expr env e, stmts) + | StmtElem ((Labeled (Default _st)), ii) -> + let tok = List.hd ii in + A.Default (tok, stmts) | _ -> raise Impossible )::aux rest | x -> debug (Body (l, [x], r)); raise Todo @@ -606,7 +611,7 @@ and argument env x = and full_type env x = let (_qu, (t, ii)) = x in match t with - | Pointer t -> A.TPointer (full_type env t) + | Pointer t -> A.TPointer (List.hd ii, full_type env t) | BaseType t -> let s = (match t with diff --git a/lang_c/parsing/meta_ast_c.ml b/lang_c/parsing/meta_ast_c.ml index 20f7e521e..d91bdba52 100644 --- a/lang_c/parsing/meta_ast_c.ml +++ b/lang_c/parsing/meta_ast_c.ml @@ -10,6 +10,9 @@ let vof_wrap _of_a (v1, v2) = in Ocaml.VTuple [ v1 (* ; v2 *) ] +let vof_bracket of_a (_t1, x, _t2) = + of_a x + and vof_unaryOp = function | Cst_cpp.GetRef -> Ocaml.VSum (("GetRef", [])) @@ -63,7 +66,9 @@ let vof_name v = vof_wrap Ocaml.vof_string v let rec vof_type_ = function | TBase v1 -> let v1 = vof_name v1 in Ocaml.VSum (("TBase", [ v1 ])) - | TPointer v1 -> let v1 = vof_type_ v1 in Ocaml.VSum (("TPointer", [ v1 ])) + | TPointer (t, v1) -> + let t = vof_tok t in + let v1 = vof_type_ v1 in Ocaml.VSum (("TPointer", [ t; v1 ])) | TArray ((v1, v2)) -> let v1 = Ocaml.vof_option vof_const_expr v1 and v2 = vof_type_ v2 @@ -161,20 +166,20 @@ and vof_expr = in Ocaml.VSum (("SizeOf", [ v1 ])) | ArrayInit v1 -> let v1 = - Ocaml.vof_list + vof_bracket (Ocaml.vof_list (fun (v1, v2) -> let v1 = Ocaml.vof_option vof_expr v1 and v2 = vof_expr v2 - in Ocaml.VTuple [ v1; v2 ]) + in Ocaml.VTuple [ v1; v2 ])) v1 in Ocaml.VSum (("ArrayInit", [ v1 ])) | RecordInit v1 -> let v1 = - Ocaml.vof_list + vof_bracket (Ocaml.vof_list (fun (v1, v2) -> let v1 = vof_name v1 and v2 = vof_expr v2 - in Ocaml.VTuple [ v1; v2 ]) + in Ocaml.VTuple [ v1; v2 ])) v1 in Ocaml.VSum (("RecordInit", [ v1 ])) | GccConstructor ((v1, v2)) -> @@ -187,40 +192,51 @@ let rec vof_stmt = | ExprSt v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("ExprSt", [ v1 ])) | Block v1 -> let v1 = Ocaml.vof_list vof_stmt v1 in Ocaml.VSum (("Block", [ v1 ])) - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = vof_stmt v2 and v3 = vof_stmt v3 - in Ocaml.VSum (("If", [ v1; v2; v3 ])) + in Ocaml.VSum (("If", [ t; v1; v2; v3 ])) | Switch ((v0, v1, v2)) -> let v0 = vof_tok v0 in let v1 = vof_expr v1 and v2 = Ocaml.vof_list vof_case v2 in Ocaml.VSum (("Switch", [ v0; v1; v2 ])) - | While ((v1, v2)) -> + | While ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = vof_stmt v2 - in Ocaml.VSum (("While", [ v1; v2 ])) - | DoWhile ((v1, v2)) -> + in Ocaml.VSum (("While", [ t; v1; v2 ])) + | DoWhile ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_stmt v1 and v2 = vof_expr v2 - in Ocaml.VSum (("DoWhile", [ v1; v2 ])) - | For ((v1, v2, v3, v4)) -> + in Ocaml.VSum (("DoWhile", [ t; v1; v2 ])) + | For ((t, v1, v2, v3, v4)) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_expr v1 and v2 = Ocaml.vof_option vof_expr v2 and v3 = Ocaml.vof_option vof_expr v3 and v4 = vof_stmt v4 - in Ocaml.VSum (("For", [ v1; v2; v3; v4 ])) - | Return v1 -> + in Ocaml.VSum (("For", [ t; v1; v2; v3; v4 ])) + | Return (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_expr v1 - in Ocaml.VSum (("Return", [ v1 ])) - | Continue -> Ocaml.VSum (("Continue", [])) - | Break -> Ocaml.VSum (("Break", [])) + in Ocaml.VSum (("Return", [ t; v1 ])) + | Continue t -> + let t = vof_tok t in + Ocaml.VSum (("Continue", [t])) + | Break t -> + let t = vof_tok t in + Ocaml.VSum (("Break", [t])) | Label ((v1, v2)) -> let v1 = vof_name v1 and v2 = vof_stmt v2 in Ocaml.VSum (("Label", [ v1; v2 ])) - | Goto v1 -> let v1 = vof_name v1 in Ocaml.VSum (("Goto", [ v1 ])) + | Goto (t, v1) -> + let t = vof_tok t in + let v1 = vof_name v1 in Ocaml.VSum (("Goto", [ t; v1 ])) | Vars v1 -> let v1 = Ocaml.vof_list vof_var_decl v1 in Ocaml.VSum (("Vars", [ v1 ])) @@ -228,12 +244,14 @@ let rec vof_stmt = let v1 = Ocaml.vof_list vof_expr v1 in Ocaml.VSum (("Asm", [ v1 ])) and vof_case = function - | Case ((v1, v2)) -> + | Case ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = Ocaml.vof_list vof_stmt v2 - in Ocaml.VSum (("Case", [ v1; v2 ])) - | Default v1 -> - let v1 = Ocaml.vof_list vof_stmt v1 in Ocaml.VSum (("Default", [ v1 ])) + in Ocaml.VSum (("Case", [ t; v1; v2 ])) + | Default (t, v1) -> + let t = vof_tok t in + let v1 = Ocaml.vof_list vof_stmt v1 in Ocaml.VSum (("Default", [ t; v1 ])) and vof_var_decl { v_name = v_v_name; @@ -328,9 +346,10 @@ let vof_toplevel = and v2 = vof_define_body v2 in Ocaml.VSum (("Define", [ v1; v2 ])) (* | Undef v1 -> let v1 = vof_name v1 in Ocaml.VSum (("Undef", [ v1 ])) *) - | Include v1 -> + | Include (t, v1) -> + let t = vof_tok t in let v1 = vof_wrap Ocaml.vof_string v1 - in Ocaml.VSum (("Include", [ v1 ])) + in Ocaml.VSum (("Include", [ t; v1 ])) | Macro ((v1, v2, v3)) -> let v1 = vof_name v1 and v2 = Ocaml.vof_list vof_name v2 diff --git a/lang_c/parsing/visitor_c.ml b/lang_c/parsing/visitor_c.ml index 23400d2d3..eebd42a5f 100644 --- a/lang_c/parsing/visitor_c.ml +++ b/lang_c/parsing/visitor_c.ml @@ -53,12 +53,16 @@ and v_wrap:'a. ('a -> unit) -> 'a wrap -> unit = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = v_info v2 in () +and v_bracket: 'a. ('a -> unit) -> 'a bracket -> unit = + fun of_a (v1, v2, v3) -> + let v1 = v_info v1 and v2 = of_a v2 and v3 = v_info v3 in () + and v_name v = v_wrap v_string v and v_type_ = function | TBase v1 -> let v1 = v_name v1 in () - | TPointer v1 -> let v1 = v_type_ v1 in () + | TPointer (t, v1) -> let t = v_info t in let v1 = v_type_ v1 in () | TArray ((v1, v2)) -> let v1 = v_option v_const_expr v1 and v2 = v_type_ v2 in () | TFunction v1 -> let v1 = v_function_type v1 in () @@ -108,14 +112,14 @@ and v_expr x = | SizeOf v1 -> let v1 = Ocaml.v_either v_expr v_type_ v1 in () | ArrayInit v1 -> let v1 = - v_list + v_bracket (v_list (fun (v1, v2) -> - let v1 = v_option v_expr v1 and v2 = v_expr v2 in ()) + let v1 = v_option v_expr v1 and v2 = v_expr v2 in ())) v1 in () | RecordInit v1 -> let v1 = - v_list (fun (v1, v2) -> let v1 = v_name v1 and v2 = v_expr v2 in ()) + v_bracket (v_list (fun (v1, v2) -> let v1 = v_name v1 and v2 = v_expr v2 in ())) v1 in () | GccConstructor ((v1, v2)) -> let v1 = v_type_ v1 and v2 = v_expr v2 in () @@ -127,31 +131,49 @@ and v_stmt = function | ExprSt v1 -> let v1 = v_expr v1 in () | Block v1 -> let v1 = v_list v_stmt v1 in () - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = v_info t in let v1 = v_expr v1 and v2 = v_stmt v2 and v3 = v_stmt v3 in () | Switch ((v0, v1, v2)) -> let v0 = v_info v0 in let v1 = v_expr v1 and v2 = v_list v_case v2 in () - | While ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_stmt v2 in () - | DoWhile ((v1, v2)) -> let v1 = v_stmt v1 and v2 = v_expr v2 in () - | For ((v1, v2, v3, v4)) -> + | While ((t, v1, v2)) -> + let t = v_info t in + let v1 = v_expr v1 and v2 = v_stmt v2 in () + | DoWhile ((t, v1, v2)) -> + let t = v_info t in + let v1 = v_stmt v1 and v2 = v_expr v2 in () + | For ((t, v1, v2, v3, v4)) -> + let t = v_info t in let v1 = v_option v_expr v1 and v2 = v_option v_expr v2 and v3 = v_option v_expr v3 and v4 = v_stmt v4 in () - | Return v1 -> let v1 = v_option v_expr v1 in () - | Continue -> () - | Break -> () + | Return (t, v1) -> + let t = v_info t in + let v1 = v_option v_expr v1 in () + | Continue t -> + let t = v_info t in + () + | Break t -> + let t = v_info t in + () | Label ((v1, v2)) -> let v1 = v_name v1 and v2 = v_stmt v2 in () - | Goto v1 -> let v1 = v_name v1 in () + | Goto (t, v1) -> + let t = v_info t in + let v1 = v_name v1 in () | Vars v1 -> let v1 = v_list v_var_decl v1 in () | Asm v1 -> let v1 = v_list v_expr v1 in () and v_case = function - | Case ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_list v_stmt v2 in () - | Default v1 -> let v1 = v_list v_stmt v1 in () + | Case ((t, v1, v2)) -> + let t = v_info t in + let v1 = v_expr v1 and v2 = v_list v_stmt v2 in () + | Default (t, v1) -> + let t = v_info t in + let v1 = v_list v_stmt v1 in () and v_var_decl { v_name = v_v_name; @@ -191,7 +213,9 @@ and v_define_body = and v_toplevel = function - | Include v1 -> let v1 = v_wrap v_string v1 in () + | Include (t, v1) -> + let t = v_info t in + let v1 = v_wrap v_string v1 in () | Define ((v1, v2)) -> let v1 = v_name v1 and v2 = v_define_body v2 in () | Macro ((v1, v2, v3)) -> let v1 = v_name v1 diff --git a/lang_cpp/parsing/cst_cpp.ml b/lang_cpp/parsing/cst_cpp.ml index 9873d86f8..3d6ee00e1 100644 --- a/lang_cpp/parsing/cst_cpp.ml +++ b/lang_cpp/parsing/cst_cpp.ml @@ -654,6 +654,7 @@ and class_definition = { (* ------------------------------------------------------------------------- *) and cpp_directive = | Define of tok (* #define*) * simple_ident * define_kind * define_val + (* TODO: should split tok in 2 *) | Include of tok (* #include s *) * inc_kind * string (* path *) | Undef of simple_ident (* #undef xxx *) | PragmaAndCo of tok diff --git a/lang_go/analyze/go_to_generic.ml b/lang_go/analyze/go_to_generic.ml index c8977a222..ce255b1fd 100644 --- a/lang_go/analyze/go_to_generic.ml +++ b/lang_go/analyze/go_to_generic.ml @@ -46,6 +46,7 @@ let name_of_qualified_ident = function let fake s = Parse_info.fake_info s let fake_name s = (s, fake s), G.empty_name_info +let mk_name s tok = (s, tok), G.empty_name_info let ii_of_any = Lib_parsing_go.ii_of_any @@ -90,6 +91,8 @@ let wrap _of_a (v1, v2) = let v1 = _of_a v1 and v2 = tok v2 in (v1, v2) +let bracket of_a (t1, x, t2) = (tok t1, of_a x, tok t2) + let ident v = wrap string v let qualified_ident v = @@ -110,8 +113,8 @@ let rec type_ = function | TName v1 -> let v1 = qualified_ident v1 in G.TyApply (name_of_qualified_ident v1, []) - | TPtr v1 -> let v1 = type_ v1 in - G.TyPointer v1 + | TPtr (t, v1) -> let v1 = type_ v1 in + G.TyPointer (t, v1) | TArray ((v1, v2)) -> let v1 = expr v1 and v2 = type_ v2 in G.TyArray (Some v1, v2) | TSlice v1 -> let v1 = type_ v1 in @@ -125,26 +128,26 @@ let rec type_ = | Some t -> t in G.TyFun (params, ret) - | TMap ((v1, v2)) -> let v1 = type_ v1 and v2 = type_ v2 in - G.TyApply (fake_name "map", [G.TypeArg v1; G.TypeArg v2]) - | TChan ((v1, v2)) -> let v1 = chan_dir v1 and v2 = type_ v2 in - G.TyApply (fake_name "chan", [G.TypeArg v1; G.TypeArg v2]) + | TMap ((t, v1, v2)) -> let v1 = type_ v1 and v2 = type_ v2 in + G.TyApply (mk_name "map" t, [G.TypeArg v1; G.TypeArg v2]) + | TChan ((t, v1, v2)) -> let v1 = chan_dir v1 and v2 = type_ v2 in + G.TyApply (mk_name "chan" t, [G.TypeArg v1; G.TypeArg v2]) - | TStruct v1 -> let v1 = list struct_field v1 in + | TStruct (t, v1) -> let (_t1, v1, _t2) = bracket (list struct_field) v1 in (* could also use StructName *) let s = gensym () in - let ent = G.basic_entity (s, fake s) [] in + let ent = G.basic_entity (s, t) [] in let def = G.TypeDef { G.tbody = G.AndType v1 } in Common.push (ent, def) anon_types; - G.TyApply (fake_name s, []) - | TInterface v1 -> let v1 = list interface_field v1 in + G.TyApply (mk_name s t, []) + | TInterface (t, v1) -> let (_t1, v1, _t2) = bracket (list interface_field) v1 in let s = gensym () in - let ent = G.basic_entity (s, fake s) [] in + let ent = G.basic_entity (s, t) [] in let def = G.ClassDef { G.ckind = G.Interface; cextends = []; cimplements = []; cbody = v1; } in Common.push (ent, def) anon_types; - G.TyApply (fake_name s, []) + G.TyApply (mk_name s t, []) and chan_dir = function | TSend -> G.TyApply (fake_name "send", []) @@ -178,7 +181,7 @@ and struct_field_kind = | EmbeddedField ((v1, v2)) -> let _v1TODO = option tok v1 and v2 = qualified_ident v2 in let name = name_of_qualified_ident v2 in - G.FieldSpread (G.Name (name, G.empty_id_info())) + G.FieldSpread (fake "...", G.Name (name, G.empty_id_info())) and tag v = wrap string v @@ -191,7 +194,7 @@ and interface_field = G.FieldMethod (ent, mk_func_def params ret (G.Block [])) | EmbeddedInterface v1 -> let v1 = qualified_ident v1 in let name = name_of_qualified_ident v1 in - G.FieldSpread (G.Name (name, G.empty_id_info())) + G.FieldSpread (fake "...", G.Name (name, G.empty_id_info())) and expr_or_type v = either expr type_ v @@ -213,10 +216,10 @@ and expr = G.Call (e, args) | Cast ((v1, v2)) -> let v1 = type_ v1 and v2 = expr v2 in G.Cast (v1, v2) - | Deref ((v1, v2)) -> let _v1 = tok v1 and v2 = expr v2 in - G.DeRef v2 - | Ref ((v1, v2)) -> let _v1 = tok v1 and v2 = expr v2 in - G.Ref v2 + | Deref ((v1, v2)) -> let v1 = tok v1 and v2 = expr v2 in + G.DeRef (v1, v2) + | Ref ((v1, v2)) -> let v1 = tok v1 and v2 = expr v2 in + G.Ref (v1, v2) | Unary ((v1, v2)) -> let (v1, tok) = wrap arithmetic_operator v1 and v2 = expr v2 @@ -229,7 +232,7 @@ and expr = in G.Call (G.IdSpecial (G.ArithOp v2, tok), [v1;v3] |> List.map G.expr_to_arg) | CompositeLit ((v1, v2)) -> - let v1 = type_ v1 and v2 = list init v2 in + let v1 = type_ v1 and (_t1, v2, _t2) = bracket (list init) v2 in G.Call (G.IdSpecial (G.New, fake "new"), (G.ArgType v1)::(v2 |> List.map G.expr_to_arg)) | Slice ((v1, v2)) -> @@ -293,7 +296,7 @@ and init = | InitKeyValue ((v1, v2, v3)) -> let v1 = init v1 and _v2 = tok v2 and v3 = init v3 in G.Tuple [v1; v3] - | InitBraces v1 -> let v1 = list init v1 in + | InitBraces v1 -> let v1 = bracket (list init) v1 in G.Container (G.List, v1) and constant_expr v = expr v @@ -348,14 +351,14 @@ and stmt = | SimpleStmt v1 -> let v1 = simple v1 in G.ExprStmt v1 - | If ((v1, v2, v3, v4)) -> + | If ((t, v1, v2, v3, v4)) -> let v1 = option simple v1 and v2 = expr v2 and v3 = stmt v3 and v4 = option stmt v4 in wrap_init_in_block_maybe v1 - (G.If (v2, v3, G.opt_to_empty v4)) + (G.If (t, v2, v3, G.opt_to_empty v4)) | Switch ((v0, v1, v2, v3)) -> let v0 = tok v0 in let v1 = option simple v1 @@ -382,19 +385,19 @@ and stmt = | Select ((v1, v2)) -> let v1 = tok v1 and v2 = list comm_clause v2 in G.Switch (v1, G.Nop, v2) - | For ((v1, v2, v3), v4) -> + | For (t, (v1, v2, v3), v4) -> let v1 = option simple v1 and v2 = option expr v2 and v3 = option simple v3 and v4 = stmt v4 in (* TODO: some of v1 are really ForInitVar *) - G.For (G.ForClassic ( + G.For (t, G.ForClassic ( (match v1 with None -> [] | Some e -> [G.ForInitExpr e]), G.opt_to_nop v2, G.opt_to_nop v3), v4) - | Range ((v1, v2, v3, v4)) -> + | Range ((t, v1, v2, v3, v4)) -> let opt = option (fun (v1, v2) -> let v1 = list expr v1 and v2 = tok v2 in v1, v2) v1 @@ -405,25 +408,25 @@ and stmt = (match opt with | None -> let pattern = G.PatUnderscore (fake "_") in - G.For (G.ForEach (pattern, v3), v4) + G.For (t, G.ForEach (pattern, v3), v4) | Some (xs, _tokEqOrColonEqTODO) -> let pattern = G.PatTuple (xs |> List.map G.expr_to_pattern) in - G.For (G.ForEach (pattern, v3), v4) + G.For (t, G.ForEach (pattern, v3), v4) ) | Return ((v1, v2)) -> - let _v1 = tok v1 and v2 = option (list expr) v2 in - G.Return (v2 |> Common.map_opt (list_to_tuple_or_expr)) + let v1 = tok v1 and v2 = option (list expr) v2 in + G.Return (v1, v2 |> Common.map_opt (list_to_tuple_or_expr)) | Break ((v1, v2)) -> - let _v1 = tok v1 and v2 = option ident v2 in - G.Break (v2 |> Common.map_opt ident_to_expr) + let v1 = tok v1 and v2 = option ident v2 in + G.Break (v1, v2 |> Common.map_opt ident_to_expr) | Continue ((v1, v2)) -> - let _v1 = tok v1 and v2 = option ident v2 in - G.Continue (v2 |> Common.map_opt ident_to_expr) + let v1 = tok v1 and v2 = option ident v2 in + G.Continue (v1, v2 |> Common.map_opt ident_to_expr) | Goto ((v1, v2)) -> - let _v1 = tok v1 and v2 = ident v2 in - G.Goto v2 + let v1 = tok v1 and v2 = ident v2 in + G.Goto (v1, v2) | Fallthrough v1 -> - let _v1 = tok v1 in + let v1 = tok v1 in G.OtherStmt (G.OS_Fallthrough, [G.Tk v1]) | Label ((v1, v2)) -> let v1 = ident v1 and v2 = stmt v2 in @@ -439,26 +442,26 @@ and case_clause (v1, v2) = let v1 = case_kind v1 and v2 = stmt v2 in v1, v2 and case_kind = function - | CaseExprs v1 -> + | CaseExprs (tok, v1) -> v1 |> List.map (function | Left (ParenType t) -> let t = type_ t in - G.Case (G.PatType t) + G.Case (tok, G.PatType t) | Left e -> let e = expr e in - G.Case (G.expr_to_pattern e) + G.Case (tok, G.expr_to_pattern e) | Right t -> let t = type_ t in - G.Case (G.PatType t) + G.Case (tok, G.PatType t) ) - | CaseAssign ((v1, v2, v3)) -> + | CaseAssign ((_t, v1, v2, v3)) -> let _v1 = list expr_or_type v1 and v2 = tok v2 and _v3 = expr v3 in error v2 "TODO: CaseAssign" - | CaseDefault v1 -> let _v1 = tok v1 in - [G.Default] + | CaseDefault v1 -> let v1 = tok v1 in + [G.Default v1] and comm_clause v = case_clause v @@ -509,24 +512,25 @@ and top_decl = | D v1 -> let v1 = decl v1 in v1 -and import { i_path = i_path; i_kind = i_kind } = +and import { i_path = i_path; i_kind = i_kind; i_tok } = let module_name = G.FileName (wrap string i_path) in let (s,tok) = i_path in - import_kind i_kind module_name (Filename.basename s, tok) + import_kind i_tok i_kind module_name (Filename.basename s, tok) -and import_kind kind module_name id = +and import_kind itok kind module_name id = match kind with | ImportOrig -> (* in Go, import "a/b/c" is really equivalent to import c "a/b/c" *) - G.ImportAs (module_name, Some id) + G.ImportAs (itok, module_name, Some id) | ImportNamed v1 -> let v1 = ident v1 in - G.ImportAs (module_name, Some v1) + G.ImportAs (itok, module_name, Some v1) | ImportDot v1 -> let v1 = tok v1 in - G.ImportAll (module_name, v1) + G.ImportAll (itok, module_name, v1) -and program { package = package; imports = imports; decls = decls } = +and program { package = pack; imports = imports; decls = decls } = anon_types := []; - let arg1 = ident package |> (fun x -> G.DirectiveStmt (G.Package [x])) in + let (t1, id) = pack in + let arg1 = ident id |> (fun x -> G.DirectiveStmt (G.Package (t1, [x]))) in let arg2 = list import imports |> List.map (fun x -> G.DirectiveStmt x) in let arg3 = list top_decl decls in let arg_types = !anon_types |> List.map (fun x -> G.DefStmt x) in diff --git a/lang_go/analyze/highlight_go.ml b/lang_go/analyze/highlight_go.ml index b8c0624bd..f390b51e6 100644 --- a/lang_go/analyze/highlight_go.ml +++ b/lang_go/analyze/highlight_go.ml @@ -68,6 +68,8 @@ let builtin_functions = Common.hashset_of_list [ "len"; ] +let unbracket (_, x, _) = x + (*****************************************************************************) (* Code highlighter *) (*****************************************************************************) @@ -124,7 +126,7 @@ let visit_program ~tag_hook _prefs (program, toks) = (* defs *) V.kprogram = (fun (k, _) x -> - tag_ident x.package (Entity (E.Module, def2)); + tag_ident (snd x.package) (Entity (E.Module, def2)); x.imports |> List.iter (fun import -> tag_ident import.i_path (Entity (E.Module, use2)); match import.i_kind with @@ -187,16 +189,16 @@ let visit_program ~tag_hook _prefs (program, toks) = ), ii]) -> tag ii TypeInt | TName qid -> tag_qid qid (Entity (E.Type, use2)) - | TStruct flds -> - flds |> List.iter (fun (fld, tag_opt) -> + | TStruct (_, flds) -> + flds |> unbracket |> List.iter (fun (fld, tag_opt) -> tag_opt |> Common.do_option (fun tag -> tag_ident tag Attribute); (match fld with | Field (id, _) -> tag_ident id (Entity (E.Field, def2)); | EmbeddedField (_, qid) -> tag_qid qid (Entity (E.Type, use2)) ); ); - | TInterface flds -> - flds |> List.iter (function + | TInterface (_, flds) -> + flds |> unbracket |> List.iter (function | Method (id, _) -> tag_ident id (Entity (E.Method, def2)) | EmbeddedInterface qid -> tag_qid qid (Entity (E.Type, use2)) ); diff --git a/lang_go/analyze/resolve_go.ml b/lang_go/analyze/resolve_go.ml index e33ddf4e9..f966854c9 100644 --- a/lang_go/analyze/resolve_go.ml +++ b/lang_go/analyze/resolve_go.ml @@ -97,9 +97,10 @@ let resolve prog = (* defs *) V.kprogram = (fun (k, _) x -> - let file = Parse_info.file_of_info (snd x.package), snd x.package in - add_name_env x.package (G.ImportedModule (G.FileName file)) env; - x.imports |> List.iter (fun { i_path = (path, ii); i_kind = kind } -> + let file = Parse_info.file_of_info (fst x.package), fst x.package in + let packid = snd x.package in + add_name_env packid (G.ImportedModule (G.FileName file)) env; + x.imports |> List.iter (fun { i_path = (path, ii); i_kind = kind; _ } -> match kind with | ImportOrig -> add_name_env (Filename.basename path, ii) @@ -144,7 +145,7 @@ let resolve prog = ); V.kstmt = (fun (k, _) x -> (match x with - | SimpleStmt (DShortVars (xs, _, _)) | Range (Some (xs, _), _, _, _) -> + | SimpleStmt (DShortVars (xs, _, _)) | Range (_, Some (xs, _),_, _, _) -> xs |> List.iter (function | Id (id, _) -> env |> add_name_env id (local_or_global env id) | _ -> () diff --git a/lang_go/parsing/ast_go.ml b/lang_go/parsing/ast_go.ml index f1d775ec3..1f922842a 100644 --- a/lang_go/parsing/ast_go.ml +++ b/lang_go/parsing/ast_go.ml @@ -42,6 +42,10 @@ type tok = Parse_info.t type 'a wrap = 'a * tok (* with tarzan *) +(* round(), square[], curly{}, angle<> brackets *) +type 'a bracket = tok * 'a * tok + (* with tarzan *) + (* ------------------------------------------------------------------------- *) (* Ident, qualifier *) (* ------------------------------------------------------------------------- *) @@ -62,7 +66,7 @@ type qualified_ident = ident list (* 1 or 2 elements *) (*****************************************************************************) type type_ = | TName of qualified_ident (* included the basic types: bool/int/... *) - | TPtr of type_ + | TPtr of tok * type_ | TArray of expr * type_ | TSlice of type_ @@ -70,11 +74,11 @@ type type_ = | TArrayEllipsis of tok (* ... *) * type_ | TFunc of func_type - | TMap of type_ * type_ - | TChan of chan_dir * type_ + | TMap of tok * type_ * type_ + | TChan of tok * chan_dir * type_ - | TStruct of struct_field list - | TInterface of interface_field list + | TStruct of tok * struct_field list bracket + | TInterface of tok * interface_field list bracket and chan_dir = TSend | TRecv | TBidirectional and func_type = { @@ -107,7 +111,7 @@ and expr = | BasicLit of literal (* less: the type of TarrayEllipsis ( [...]{...}) in a CompositeLit * could be transformed in TArray (length {...}) *) - | CompositeLit of type_ * init list + | CompositeLit of type_ * init list bracket (* This Id can actually denotes sometimes a type (e.g., in Arg), or * a package (e.g., in Selector). @@ -187,7 +191,7 @@ and expr = and init = | InitExpr of expr (* can be Id, which have special meaning for Key *) | InitKeyValue of init * tok (* : *) * init - | InitBraces of init list + | InitBraces of init list bracket and constant_expr = expr @@ -203,7 +207,7 @@ and stmt = | SimpleStmt of simple - | If of simple option (* init *) * expr * stmt * stmt option + | If of tok * simple option (* init *) * expr * stmt * stmt option (* todo: cond should be an expr, except for TypeSwitch where it can also * be x := expr *) @@ -213,16 +217,17 @@ and stmt = | Select of tok * comm_clause list (* note: no While or DoWhile, just For and Foreach (Range) *) - | For of (simple option * expr option * simple option) * stmt + | For of tok * (simple option * expr option * simple option) * stmt (* todo: should impose (expr * tok * expr option) for key/value *) - | Range of (expr list * tok (* = or := *)) option (* key/value pattern *) * - tok (* 'range' *) * expr * stmt + | Range of tok * + (expr list * tok (* = or := *)) option (* key/value pattern *) * + tok (* 'range' *) * expr * stmt | Return of tok * expr list option (* was put together in a Branch in ast.go, but better to split *) - | Break of tok * ident option + | Break of tok * ident option | Continue of tok * ident option - | Goto of tok * ident + | Goto of tok * ident | Fallthrough of tok | Label of ident * stmt @@ -233,8 +238,8 @@ and stmt = (* todo: split in case_clause_expr and case_clause_type *) and case_clause = case_kind * stmt (* can be Empty*) and case_kind = - | CaseExprs of expr_or_type list - | CaseAssign of expr_or_type list * tok (* = or := *) * expr + | CaseExprs of tok * expr_or_type list + | CaseAssign of tok * expr_or_type list * tok (* = or := *) * expr | CaseDefault of tok (* TODO: stmt (* Send or Receive *) * stmt (* can be empty *) *) and comm_clause = case_clause @@ -287,6 +292,7 @@ type top_decl = (* Import *) (*****************************************************************************) type import = { + i_tok: tok; i_path: string wrap; i_kind: import_kind; } @@ -303,7 +309,7 @@ type import = { (*****************************************************************************) type program = { - package: ident; + package: tok * ident; imports: import list; decls: top_decl list; } diff --git a/lang_go/parsing/meta_ast_go.ml b/lang_go/parsing/meta_ast_go.ml index 7ebae42b0..2b1d55570 100644 --- a/lang_go/parsing/meta_ast_go.ml +++ b/lang_go/parsing/meta_ast_go.ml @@ -6,6 +6,9 @@ let vof_tok v = Meta_parse_info.vof_info_adjustable_precision v let vof_wrap _of_a (v1, v2) = let v1 = _of_a v1 and v2 = vof_tok v2 in Ocaml.VTuple [ v1; v2 ] + +let vof_bracket of_a (_t1, x, _t2) = + of_a x let vof_ident v = vof_wrap Ocaml.vof_string v @@ -15,36 +18,46 @@ let rec vof_type_ = function | TName v1 -> let v1 = vof_qualified_ident v1 in Ocaml.VSum (("TName", [ v1 ])) - | TPtr v1 -> let v1 = vof_type_ v1 in Ocaml.VSum (("TPtr", [ v1 ])) + | TPtr (t, v1) -> + let t = vof_tok t in + let v1 = vof_type_ v1 in Ocaml.VSum (("TPtr", [ t; v1 ])) | TArray ((v1, v2)) -> let v1 = vof_expr v1 and v2 = vof_type_ v2 in Ocaml.VSum (("TArray", [ v1; v2 ])) - | TSlice v1 -> let v1 = vof_type_ v1 in Ocaml.VSum (("TSlice", [ v1 ])) + | TSlice v1 -> + let v1 = vof_type_ v1 in Ocaml.VSum (("TSlice", [ v1 ])) | TArrayEllipsis ((v1, v2)) -> let v1 = vof_tok v1 and v2 = vof_type_ v2 in Ocaml.VSum (("TArrayEllipsis", [ v1; v2 ])) - | TFunc v1 -> let v1 = vof_func_type v1 in Ocaml.VSum (("TFunc", [ v1 ])) - | TMap ((v1, v2)) -> + | TFunc v1 -> + let v1 = vof_func_type v1 in Ocaml.VSum (("TFunc", [ v1 ])) + | TMap ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_type_ v1 and v2 = vof_type_ v2 - in Ocaml.VSum (("TMap", [ v1; v2 ])) - | TChan ((v1, v2)) -> + in Ocaml.VSum (("TMap", [ t; v1; v2 ])) + | TChan ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_chan_dir v1 and v2 = vof_type_ v2 - in Ocaml.VSum (("TChan", [ v1; v2 ])) - | TStruct v1 -> - let v1 = Ocaml.vof_list vof_struct_field v1 - in Ocaml.VSum (("TStruct", [ v1 ])) - | TInterface v1 -> - let v1 = Ocaml.vof_list vof_interface_field v1 - in Ocaml.VSum (("TInterface", [ v1 ])) + in Ocaml.VSum (("TChan", [ t; v1; v2 ])) + | TStruct (t, v1) -> + let t = vof_tok t in + let v1 = vof_bracket (Ocaml.vof_list vof_struct_field) v1 + in Ocaml.VSum (("TStruct", [ t; v1 ])) + | TInterface (t, v1) -> + let t = vof_tok t in + let v1 = vof_bracket (Ocaml.vof_list vof_interface_field) v1 + in Ocaml.VSum (("TInterface", [ t; v1 ])) + and vof_chan_dir = function | TSend -> Ocaml.VSum (("TSend", [])) | TRecv -> Ocaml.VSum (("TRecv", [])) | TBidirectional -> Ocaml.VSum (("TBidirectional", [])) + and vof_func_type { fparams = v_fparams; fresults = v_fresults } = let bnds = [] in let arg = Ocaml.vof_list vof_parameter v_fresults in @@ -93,7 +106,7 @@ and vof_expr = let v1 = vof_literal v1 in Ocaml.VSum (("BasicLit", [ v1 ])) | CompositeLit ((v1, v2)) -> let v1 = vof_type_ v1 - and v2 = Ocaml.vof_list vof_init v2 + and v2 = vof_bracket (Ocaml.vof_list vof_init) v2 in Ocaml.VSum (("CompositeLit", [ v1; v2 ])) | Id (v1, _IGNORED) -> let v1 = vof_ident v1 in Ocaml.VSum (("Id", [ v1 ])) | Selector ((v1, v2, v3)) -> @@ -192,7 +205,7 @@ and vof_init = and v3 = vof_init v3 in Ocaml.VSum (("InitKeyValue", [ v1; v2; v3 ])) | InitBraces v1 -> - let v1 = Ocaml.vof_list vof_init v1 + let v1 = vof_bracket (Ocaml.vof_list vof_init) v1 in Ocaml.VSum (("InitBraces", [ v1 ])) and vof_constant_expr v = vof_expr v and vof_stmt = @@ -205,12 +218,13 @@ and vof_stmt = | Empty -> Ocaml.VSum (("Empty", [])) | SimpleStmt v1 -> let v1 = vof_simple v1 in Ocaml.VSum (("SimpleStmt", [ v1 ])) - | If ((v1, v2, v3, v4)) -> + | If ((t, v1, v2, v3, v4)) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_simple v1 and v2 = vof_expr v2 and v3 = vof_stmt v3 and v4 = Ocaml.vof_option vof_stmt v4 - in Ocaml.VSum (("If", [ v1; v2; v3; v4 ])) + in Ocaml.VSum (("If", [ t; v1; v2; v3; v4 ])) | Switch ((v0, v1, v2, v3)) -> let v0 = vof_tok v0 in let v1 = Ocaml.vof_option vof_simple v1 @@ -221,7 +235,8 @@ and vof_stmt = let v1 = vof_tok v1 and v2 = Ocaml.vof_list vof_comm_clause v2 in Ocaml.VSum (("Select", [ v1; v2 ])) - | For ((v1, v2)) -> + | For ((t, v1, v2)) -> + let t = vof_tok t in let v1 = (match v1 with | (v1, v2, v3) -> @@ -230,8 +245,9 @@ and vof_stmt = and v3 = Ocaml.vof_option vof_simple v3 in Ocaml.VTuple [ v1; v2; v3 ]) and v2 = vof_stmt v2 - in Ocaml.VSum (("For", [ v1; v2 ])) - | Range ((v1, v2, v3, v4)) -> + in Ocaml.VSum (("For", [ t; v1; v2 ])) + | Range ((t, v1, v2, v3, v4)) -> + let t = vof_tok t in let v1 = Ocaml.vof_option (fun (v1, v2) -> @@ -242,7 +258,7 @@ and vof_stmt = and v2 = vof_tok v2 and v3 = vof_expr v3 and v4 = vof_stmt v4 - in Ocaml.VSum (("Range", [ v1; v2; v3; v4 ])) + in Ocaml.VSum (("Range", [ t; v1; v2; v3; v4 ])) | Return ((v1, v2)) -> let v1 = vof_tok v1 and v2 = Ocaml.vof_option (Ocaml.vof_list vof_expr) v2 @@ -302,19 +318,23 @@ and vof_case_clause (v1, v2) = let v1 = vof_case_kind v1 and v2 = vof_stmt v2 in Ocaml.VTuple [ v1; v2 ] and vof_case_kind = function - | CaseExprs v1 -> + | CaseExprs (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_list vof_expr_or_type v1 - in Ocaml.VSum (("CaseExprs", [ v1 ])) - | CaseAssign ((v1, v2, v3)) -> + in Ocaml.VSum (("CaseExprs", [ t; v1 ])) + | CaseAssign ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = Ocaml.vof_list vof_expr_or_type v1 and v2 = vof_tok v2 and v3 = vof_expr v3 - in Ocaml.VSum (("CaseAssign", [ v1; v2; v3 ])) + in Ocaml.VSum (("CaseAssign", [ t; v1; v2; v3 ])) | CaseDefault v1 -> let v1 = vof_tok v1 in Ocaml.VSum (("CaseDefault", [ v1 ])) + and vof_comm_clause v = vof_case_clause v and vof_call_expr (v1, v2) = let v1 = vof_expr v1 and v2 = vof_arguments v2 in Ocaml.VTuple [ v1; v2 ] + and vof_decl = function | DConst ((v1, v2, v3)) -> @@ -356,20 +376,30 @@ let vof_top_decl = in Ocaml.VSum (("DMethod", [ v1; v2; v3 ])) | D v1 -> let v1 = vof_decl v1 in Ocaml.VSum (("D", [ v1 ])) -let rec vof_import { i_path = v_i_path; i_kind = v_i_kind } = +let rec vof_import { i_tok = tok; i_path = v_i_path; i_kind = v_i_kind } = let bnds = [] in let arg = vof_import_kind v_i_kind in let bnd = ("i_kind", arg) in let bnds = bnd :: bnds in let arg = vof_wrap Ocaml.vof_string v_i_path in - let bnd = ("i_path", arg) in let bnds = bnd :: bnds in Ocaml.VDict bnds + let bnd = ("i_path", arg) in + let bnds = bnd :: bnds in + let arg = vof_tok tok in + let bnd = ("i_tok", arg) in + let bnds = bnd :: bnds + in Ocaml.VDict bnds and vof_import_kind = function | ImportOrig -> Ocaml.VSum (("ImportOrig", [])) | ImportNamed v1 -> let v1 = vof_ident v1 in Ocaml.VSum (("ImportNamed", [ v1 ])) | ImportDot v1 -> let v1 = vof_tok v1 in Ocaml.VSum (("ImportDot", [ v1 ])) - + +let vof_package (v1, v2) = + let v1 = vof_tok v1 in + let v2 = vof_ident v2 in + Ocaml.VTuple [v1;v2] + let vof_program { package = v_package; imports = v_imports; decls = v_decls } = let bnds = [] in @@ -379,7 +409,7 @@ let vof_program { package = v_package; imports = v_imports; decls = v_decls } let arg = Ocaml.vof_list vof_import v_imports in let bnd = ("imports", arg) in let bnds = bnd :: bnds in - let arg = vof_ident v_package in + let arg = vof_package v_package in let bnd = ("package", arg) in let bnds = bnd :: bnds in Ocaml.VDict bnds let vof_any = diff --git a/lang_go/parsing/parser_go.mly b/lang_go/parsing/parser_go.mly index ae8836cd8..1fa93884a 100644 --- a/lang_go/parsing/parser_go.mly +++ b/lang_go/parsing/parser_go.mly @@ -77,14 +77,14 @@ let condition_of_stmt tok stmt = let mk_else elseifs else_ = let elseifs = List.rev elseifs in List.fold_right (fun elseif accu -> - let ((stopt, cond), body) = elseif in - Some (If (stopt, cond, body, accu)) + let ((tok, stopt, cond), body) = elseif in + Some (If (tok, stopt, cond, body, accu)) ) elseifs else_ let rec expr_to_type tok e = match e with | Id (id, _) -> TName [id] - | Deref (_, e) -> TPtr (expr_to_type tok e) + | Deref (t, e) -> TPtr (t, expr_to_type tok e) | Selector (Id (id1, _), _, id2) -> TName [id1;id2] | ParenType t -> t | _ -> @@ -250,7 +250,7 @@ let adjust_signatures params = file: package imports xdcl_list EOF { { package = $1; imports = List.rev $2; decls = List.rev $3 } } -package: LPACKAGE sym LSEMICOLON { $2 } +package: LPACKAGE sym LSEMICOLON { $1, $2 } sgrep_spatch_pattern: | expr EOF { E $1 } @@ -262,17 +262,22 @@ sgrep_spatch_pattern: /*(*************************************************************************)*/ import: -| LIMPORT import_stmt { [$2] } -| LIMPORT LPAREN import_stmt_list osemi RPAREN { List.rev $3 } +| LIMPORT import_stmt + { [$2 $1] } +| LIMPORT LPAREN import_stmt_list osemi RPAREN + { List.rev $3 |> List.map (fun f -> f $1) } | LIMPORT LPAREN RPAREN { [] } import_stmt: | LSTR - { { i_path = $1; i_kind = ImportOrig } (*// import with original name*) } + { fun i_tok -> { i_tok; i_path = $1; i_kind = ImportOrig } + (*// import with original name*) } | sym LSTR - { { i_path = $2; i_kind = ImportNamed $1 }(*// import with given name*) } + { fun i_tok -> { i_tok; i_path = $2; i_kind = ImportNamed $1 } + (*// import with given name*) } | LDOT LSTR - { { i_path = $2; i_kind = ImportDot $1 }(*// import into my name space *) } + { fun i_tok -> { i_tok; i_path = $2; i_kind = ImportDot $1 } + (*// import into my name space *) } /*(*************************************************************************)*/ /*(*1 Declarations *)*/ @@ -366,8 +371,10 @@ simple_stmt: /*(* IF cond body (ELSE IF cond body)* (ELSE block)? *) */ if_stmt: LIF if_header loop_body elseif_list else_ { match $2 with - | stopt, Some st -> If (stopt, condition_of_stmt $1 st, $3,mk_else $4 $5) - | _, None -> error $1 "missing condition in if statement" + | stopt, Some st -> + If ($1, stopt, condition_of_stmt $1 st, $3, mk_else $4 $5) + | _, None -> + error $1 "missing condition in if statement" } if_header: @@ -377,8 +384,10 @@ if_header: elseif: LELSE LIF if_header loop_body { match $3 with - | stopt, Some st -> (stopt, condition_of_stmt $2 st), $4 - | _, None -> error $2 "missing condition in if statement" + | stopt, Some st -> + ($2, stopt, condition_of_stmt $2 st), $4 + | _, None -> + error $2 "missing condition in if statement" } else_: @@ -388,18 +397,18 @@ else_: for_stmt: | LFOR osimple_stmt LSEMICOLON osimple_stmt LSEMICOLON osimple_stmt loop_body - { For (($2, Common.map_opt (condition_of_stmt $1) $4, $6), $7) } + { For ($1, ($2, Common.map_opt (condition_of_stmt $1) $4, $6), $7) } | LFOR osimple_stmt loop_body { match $2 with - | None -> For ((None, None, None), $3) - | Some st -> For ((None, Some (condition_of_stmt $1 st), None), $3) + | None -> For ($1, (None, None, None), $3) + | Some st -> For ($1, (None, Some (condition_of_stmt $1 st), None), $3) } | LFOR expr_list LEQ LRANGE expr loop_body - { Range (Some (List.rev $2, $3), $4, $5, $6) } + { Range ($1, Some (List.rev $2, $3), $4, $5, $6) } | LFOR expr_list LCOLAS LRANGE expr loop_body - { Range (Some (List.rev $2, $3), $4, $5, $6) } + { Range ($1, Some (List.rev $2, $3), $4, $5, $6) } | LFOR LRANGE expr loop_body - { Range (None, $2, $3, $4) } + { Range ($1, None, $2, $3, $4) } loop_body: LBODY stmt_list RBRACE { Block (List.rev $2) } @@ -415,9 +424,9 @@ select_stmt: LSELECT LBODY caseblock_list RBRACE { Select ($1, List.rev $3) } case: -| LCASE expr_or_type_list LCOLON { CaseExprs $2 } -| LCASE expr_or_type_list LEQ expr LCOLON { CaseAssign ($2, $3, $4) } -| LCASE expr_or_type_list LCOLAS expr LCOLON { CaseAssign ($2, $3, $4) } +| LCASE expr_or_type_list LCOLON { CaseExprs ($1, $2) } +| LCASE expr_or_type_list LEQ expr LCOLON { CaseAssign ($1, $2, $3, $4) } +| LCASE expr_or_type_list LCOLAS expr LCOLON { CaseAssign ($1, $2, $3, $4) } | LDEFAULT LCOLON { CaseDefault $1 } caseblock: case stmt_list @@ -538,9 +547,9 @@ pexpr_no_paren: | convtype LPAREN expr ocomma RPAREN { Cast ($1, $3) } | comptype lbrace braced_keyval_list RBRACE - { CompositeLit ($1, $3) } + { CompositeLit ($1, ($2, $3, $4)) } | pexpr_no_paren LBRACE braced_keyval_list RBRACE - { CompositeLit (expr_to_type $2 $1, $3) } + { CompositeLit (expr_to_type $2 $1, ($2, $3, $4)) } | fnliteral { $1 } @@ -592,11 +601,11 @@ keyval: complitexpr LCOLON complitexpr { InitKeyValue ($1, $2, $3) } complitexpr: | expr { InitExpr $1 } -| LBRACE braced_keyval_list RBRACE { InitBraces ($2) } +| LBRACE braced_keyval_list RBRACE { InitBraces ($1, $2, $3) } bare_complitexpr: | expr { InitExpr $1 } -| LBRACE braced_keyval_list RBRACE { InitBraces $2 } +| LBRACE braced_keyval_list RBRACE { InitBraces ($1, $2, $3) } @@ -604,8 +613,8 @@ bare_complitexpr: /*(* less: I don't think we need that with a good fix_tokens_lbody *)*/ lbrace: -| LBODY { } -| LBRACE { } +| LBODY { $1 } +| LBRACE { $1 } /*(*************************************************************************)*/ /*(*1 Names *)*/ @@ -686,9 +695,9 @@ non_recvchantype: | LPAREN ntype RPAREN { $2 } -ptrtype: LMULT ntype { TPtr $2 } +ptrtype: LMULT ntype { TPtr ($1, $2) } -recvchantype: LCOMM LCHAN ntype { TChan (TRecv, $3) } +recvchantype: LCOMM LCHAN ntype { TChan ($2, TRecv, $3) } fntype: LFUNC LPAREN oarg_type_list_ocomma RPAREN fnres { { fparams = $3; fresults = $5 } } @@ -716,10 +725,10 @@ othertype: | LBRACKET LDDD RBRACKET ntype { TArrayEllipsis ($2, $4) } -| LCHAN non_recvchantype { TChan (TBidirectional, $2) } -| LCHAN LCOMM ntype { TChan (TSend, $3) } +| LCHAN non_recvchantype { TChan ($1, TBidirectional, $2) } +| LCHAN LCOMM ntype { TChan ($1, TSend, $3) } -| LMAP LBRACKET ntype RBRACKET ntype { TMap ($3, $5) } +| LMAP LBRACKET ntype RBRACKET ntype { TMap ($1, $3, $5) } | structtype { $1 } | interfacetype { $1 } @@ -745,15 +754,17 @@ non_expr_type: | fntype { TFunc $1 } | recvchantype { $1 } | othertype { $1 } -| LMULT non_expr_type { TPtr ($2) } +| LMULT non_expr_type { TPtr ($1, $2) } /*(*************************************************************************)*/ /*(*1 Struct/Interface *)*/ /*(*************************************************************************)*/ structtype: -| LSTRUCT lbrace structdcl_list osemi RBRACE { TStruct (List.rev $3) } -| LSTRUCT lbrace RBRACE { TStruct [] } +| LSTRUCT lbrace structdcl_list osemi RBRACE + { TStruct ($1, ($2, List.rev $3, $5)) } +| LSTRUCT lbrace RBRACE + { TStruct ($1, ($2, [], $3)) } structdcl: | new_name_list ntype oliteral @@ -763,8 +774,10 @@ structdcl: interfacetype: - LINTERFACE lbrace interfacedcl_list osemi RBRACE { TInterface(List.rev $3)} -| LINTERFACE lbrace RBRACE { TInterface [] } + LINTERFACE lbrace interfacedcl_list osemi RBRACE + { TInterface ($1, ($2, List.rev $3, $5)) } +| LINTERFACE lbrace RBRACE + { TInterface ($1, ($2, [], $3)) } interfacedcl: | new_name indcl { Method ($1, $2) } diff --git a/lang_go/parsing/visitor_go.ml b/lang_go/parsing/visitor_go.ml index 1712fdb13..0ca5551e3 100644 --- a/lang_go/parsing/visitor_go.ml +++ b/lang_go/parsing/visitor_go.ml @@ -72,6 +72,10 @@ let (mk_visitor: visitor_in -> visitor_out) = fun vin -> let rec v_wrap: 'a. ('a -> unit) -> 'a wrap -> unit = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = v_info v2 in () +and v_bracket: 'a. ('a -> unit) -> 'a bracket -> unit = + fun of_a (v1, v2, v3) -> + let v1 = v_info v1 and v2 = of_a v2 and v3 = v_info v3 in () + and v_info x = let k _x = () in vin.kinfo (k, all_functions) x @@ -90,15 +94,25 @@ and v_type_ x = let k = function | TName v1 -> let v1 = v_qualified_ident v1 in () - | TPtr v1 -> let v1 = v_type_ v1 in () + | TPtr (t, v1) -> + let t = v_tok t in + let v1 = v_type_ v1 in () | TArray ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_type_ v2 in () | TSlice v1 -> let v1 = v_type_ v1 in () | TArrayEllipsis ((v1, v2)) -> let v1 = v_tok v1 and v2 = v_type_ v2 in () | TFunc v1 -> let v1 = v_func_type v1 in () - | TMap ((v1, v2)) -> let v1 = v_type_ v1 and v2 = v_type_ v2 in () - | TChan ((v1, v2)) -> let v1 = v_chan_dir v1 and v2 = v_type_ v2 in () - | TStruct v1 -> let v1 = v_list v_struct_field v1 in () - | TInterface v1 -> let v1 = v_list v_interface_field v1 in () + | TMap ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_type_ v1 and v2 = v_type_ v2 in () + | TChan ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_chan_dir v1 and v2 = v_type_ v2 in () + | TStruct (t, v1) -> + let t = v_tok t in + let v1 = v_bracket (v_list v_struct_field) v1 in () + | TInterface (t, v1) -> + let t = v_tok t in + let v1 = v_bracket (v_list v_interface_field) v1 in () in vin.ktype (k, all_functions) x @@ -131,7 +145,7 @@ and v_expr x = function | BasicLit v1 -> let v1 = v_literal v1 in () | CompositeLit ((v1, v2)) -> - let v1 = v_type_ v1 and v2 = v_list v_init v2 in () + let v1 = v_type_ v1 and v2 = v_bracket (v_list v_init) v2 in () | Id (v1, _IGNORED) -> let v1 = v_ident v1 in () | Selector ((v1, v2, v3)) -> let v1 = v_expr v1 and v2 = v_tok v2 and v3 = v_ident v3 in () @@ -190,7 +204,7 @@ and v_init x = | InitExpr v1 -> let v1 = v_expr v1 in () | InitKeyValue ((v1, v2, v3)) -> let v1 = v_init v1 and v2 = v_tok v2 and v3 = v_init v3 in () - | InitBraces v1 -> let v1 = v_list v_init v1 in () + | InitBraces v1 -> let v1 = v_bracket (v_list v_init) v1 in () in vin.kinit (k, all_functions) x and v_constant_expr v = v_expr v @@ -203,7 +217,8 @@ and v_stmt x = | Empty -> () | SimpleStmt v1 -> v_simple v1 - | If ((v1, v2, v3, v4)) -> + | If ((t, v1, v2, v3, v4)) -> + let t = v_tok t in let v1 = v_option v_simple v1 and v2 = v_expr v2 and v3 = v_stmt v3 @@ -217,7 +232,8 @@ and v_stmt x = in () | Select ((v1, v2)) -> let v1 = v_tok v1 and v2 = v_list v_comm_clause v2 in () - | For ((v1, v2)) -> + | For ((t, v1, v2)) -> + let t = v_tok t in let v1 = (match v1 with | (v1, v2, v3) -> @@ -227,7 +243,8 @@ and v_stmt x = in ()) and v2 = v_stmt v2 in () - | Range ((v1, v2, v3, v4)) -> + | Range ((t, v1, v2, v3, v4)) -> + let t = v_tok t in let v1 = v_option (fun (v1, v2) -> let v1 = v_list v_expr v1 and v2 = v_tok v2 in ()) @@ -275,13 +292,17 @@ and v_simple = function and v_case_clause (v1, v2) = let v1 = v_case_kind v1 and v2 = v_stmt v2 in () and v_case_kind = function - | CaseExprs v1 -> let v1 = v_list v_expr_or_type v1 in () - | CaseAssign ((v1, v2, v3)) -> + | CaseExprs (t, v1) -> + let t = v_tok t in + let v1 = v_list v_expr_or_type v1 in () + | CaseAssign ((t, v1, v2, v3)) -> + let t = v_tok t in let v1 = v_list v_expr_or_type v1 and v2 = v_tok v2 and v3 = v_expr v3 in () | CaseDefault v1 -> let v1 = v_tok v1 in () + and v_comm_clause v = v_case_clause v and v_call_expr (v1, v2) = let v1 = v_expr v1 and v2 = v_arguments v2 in () @@ -333,9 +354,13 @@ and v_import_kind = | ImportNamed v1 -> let v1 = v_ident v1 in () | ImportDot v1 -> let v1 = v_tok v1 in () +and v_package (v1, v2) = + let v1 = v_tok v1 in + let v2 = v_ident v2 in + () and v_program x = - let k { package = v_package; imports = v_imports; decls = v_decls } = - let arg = v_ident v_package in + let k { package = pack; imports = v_imports; decls = v_decls } = + let arg = v_package pack in let arg = v_list v_import v_imports in let arg = v_list v_top_decl v_decls in () in diff --git a/lang_java/analyze/graph_code_java.ml b/lang_java/analyze/graph_code_java.ml index 01308959f..fc27fa817 100644 --- a/lang_java/analyze/graph_code_java.ml +++ b/lang_java/analyze/graph_code_java.ml @@ -124,6 +124,8 @@ let str_of_name xs = xs |> List.map (fun (_tyarg_todo, ident) -> Ast.unwrap ident) |> Common.join "." +let unbracket (_, x, _) = x + (* helper to build entries in env.params_or_locals *) let p_or_l v = Ast.unwrap v.name, Ast.is_final v.mods @@ -303,20 +305,20 @@ let rec extract_defs_uses ~phase ~g ~ast ~readable ~lookup_fails = current = (match ast.package with - | Some long_ident -> (str_of_qualified_ident long_ident, E.Package) + | Some (_, long_ident) -> (str_of_qualified_ident long_ident, E.Package) | None -> (readable, E.File) ); current_qualifier = (match ast.package with | None -> [] - | Some long_ident -> long_ident + | Some (_, long_ident) -> long_ident ); params_or_locals = []; type_parameters = []; imported_namespace = (match ast.package with (* we automatically import the current.package.* *) - | Some long_ident -> [List.map Ast.unwrap long_ident @ ["*"]] + | Some (_, long_ident) -> [List.map Ast.unwrap long_ident @ ["*"]] | None -> [] ) @ ((ast.imports |> List.map (fun (_is_static, _import) -> @@ -349,7 +351,7 @@ let rec extract_defs_uses ~phase ~g ~ast ~readable ~lookup_fails = G.create_intermediate_directories_if_not_present g dir; g |> G.add_node (readable, E.File); g |> G.add_edge ((dir, E.Dir), (readable, E.File)) G.Has; - | Some long_ident -> + | Some (_, long_ident) -> create_intermediate_packages_if_not_present g G.root long_ident; end; (* double check if we can find some of the imports @@ -580,7 +582,7 @@ and stmt env = function | Empty -> () | Block xs -> stmts env xs | Expr e -> expr env e - | If (e, st1, st2) -> + | If (_, e, st1, st2) -> expr env e; stmt env st1; stmt env st2; @@ -590,13 +592,13 @@ and stmt env = function cases env cs; stmts env sts ) - | While (e, st) -> + | While (_, e, st) -> expr env e; stmt env st; - | Do (st, e) -> + | Do (_, st, e) -> expr env e; stmt env st; - | For (x, st) -> + | For (_, x, st) -> let env = match x with | Foreach (v, e) -> @@ -629,17 +631,17 @@ and stmt env = function * so not that useful *) | Label (_id, st) -> stmt env st - | Break _idopt | Continue _idopt -> () - | Return eopt -> exprs env (Common2.option_to_list eopt) + | Break (_, _idopt) | Continue (_, _idopt) -> () + | Return (_, eopt) -> exprs env (Common2.option_to_list eopt) | Sync (e, st) -> expr env e; stmt env st; - | Try (st, xs, stopt) -> + | Try (_, st, xs, stopt) -> stmt env st; catches env xs; stmts env (Common2.option_to_list stopt); - | Throw e -> expr env e - | Assert (e, eopt) -> + | Throw (_, e) -> expr env e + | Assert (_, e, eopt) -> exprs env (e::Common2.option_to_list eopt) (* The modification of env.params_locals is done in decls() *) | LocalVar f -> field env f @@ -664,8 +666,8 @@ and stmts env xs = and cases env xs = List.iter (case env) xs and case env = function - | Case e -> expr env e - | Default -> () + | Case (_, e) -> expr env e + | Default _ -> () and catches env xs = List.iter (catch env) xs and catch env (v, st) = @@ -789,7 +791,7 @@ and expr env = function and exprs env xs = List.iter (expr env) xs and init env = function | ExprInit e -> expr env e - | ArrayInit xs -> List.iter (init env) xs + | ArrayInit xs -> List.iter (init env) (unbracket xs) and init_opt env opt = match opt with | None -> () diff --git a/lang_java/analyze/java_to_generic.ml b/lang_java/analyze/java_to_generic.ml index 4f5296360..28779e2c0 100644 --- a/lang_java/analyze/java_to_generic.ml +++ b/lang_java/analyze/java_to_generic.ml @@ -57,6 +57,8 @@ let wrap = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = info v2 in (v1, v2) +let bracket of_a (t1, x, t2) = (info t1, of_a x, info t2) + let list1 _of_a = list _of_a let ident v = wrap string v @@ -294,9 +296,9 @@ and stmt = | Empty -> G.Block [] | Block v1 -> let v1 = stmts v1 in G.Block v1 | Expr v1 -> let v1 = expr v1 in G.ExprStmt v1 - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> let v1 = expr v1 and v2 = stmt v2 and v3 = stmt v3 in - G.If (v1, v2, v3) + G.If (t, v1, v2, v3) | Switch ((v0, v1, v2)) -> let v0 = info v0 in let v1 = expr v1 @@ -307,37 +309,37 @@ and stmt = ) v2 in G.Switch (v0, v1, v2) - | While ((v1, v2)) -> let v1 = expr v1 and v2 = stmt v2 in - G.While (v1, v2) - | Do ((v1, v2)) -> let v1 = stmt v1 and v2 = expr v2 in - G.DoWhile (v1, v2) - | For ((v1, v2)) -> let v1 = for_control v1 and v2 = stmt v2 in - G.For (v1, v2) - | Break v1 -> let v1 = option ident_label v1 in - G.Break v1 - | Continue v1 -> let v1 = option ident_label v1 in - G.Continue v1 - | Return v1 -> let v1 = option expr v1 in - G.Return v1 + | While ((t, v1, v2)) -> let v1 = expr v1 and v2 = stmt v2 in + G.While (t, v1, v2) + | Do ((t, v1, v2)) -> let v1 = stmt v1 and v2 = expr v2 in + G.DoWhile (t, v1, v2) + | For ((t, v1, v2)) -> let v1 = for_control v1 and v2 = stmt v2 in + G.For (t, v1, v2) + | Break (t, v1) -> let v1 = option ident_label v1 in + G.Break (t, v1) + | Continue (t, v1) -> let v1 = option ident_label v1 in + G.Continue (t, v1) + | Return (t, v1) -> let v1 = option expr v1 in + G.Return (t, v1) | Label ((v1, v2)) -> let v1 = ident v1 and v2 = stmt v2 in G.Label (v1, v2) | Sync ((v1, v2)) -> let v1 = expr v1 and v2 = stmt v2 in G.OtherStmt (G.OS_Sync, [G.E v1; G.S v2]) - | Try ((v1, v2, v3)) -> + | Try ((t, v1, v2, v3)) -> let v1 = stmt v1 and v2 = catches v2 and v3 = option stmt v3 in - G.Try (v1, v2, v3) - | Throw v1 -> let v1 = expr v1 in - G.Throw v1 + G.Try (t,v1, v2, v3) + | Throw (t, v1) -> let v1 = expr v1 in + G.Throw (t, v1) | LocalVar v1 -> let (ent, v) = var_with_init v1 in G.DefStmt (ent, G.VarDef v) | LocalClass v1 -> let (ent, cdef) = class_decl v1 in G.DefStmt (ent, G.ClassDef cdef) - | Assert ((v1, v2)) -> let v1 = expr v1 and v2 = option expr v2 in - G.Assert (v1, v2) + | Assert ((t, v1, v2)) -> let v1 = expr v1 and v2 = option expr v2 in + G.Assert (t, v1, v2) and ident_label x = let x = ident x in @@ -346,8 +348,8 @@ and ident_label x = and stmts v = list stmt v and case = function - | Case v1 -> let v1 = expr v1 in G.Case (G.expr_to_pattern v1) - | Default -> G.Default + | Case (t, v1) -> let v1 = expr v1 in G.Case (t, G.expr_to_pattern v1) + | Default t -> G.Default t and cases v = list case v @@ -393,7 +395,7 @@ and init = function | ExprInit v1 -> let v1 = expr v1 in v1 - | ArrayInit v1 -> let v1 = list init v1 in + | ArrayInit v1 -> let v1 = bracket (list init) v1 in G.Container (G.Array, v1) and params v = @@ -495,17 +497,20 @@ and decl decl = and decls v = list decl v and import = function - | ImportAll (xs, tok) -> G.ImportAll (G.DottedName xs, tok) - | ImportFrom (xs, id) -> + | ImportAll (t, xs, tok) -> G.ImportAll (t, G.DottedName xs, tok) + | ImportFrom (t, xs, id) -> let id = ident id in - G.ImportFrom (G.DottedName xs, [id, None]) + G.ImportFrom (t, G.DottedName xs, [id, None]) + +let package (t, qu) = + t, qualified_ident qu -let compilation_unit { package = package; +let compilation_unit { package = pack; imports = imports; decls = xdecls } = - let v1 = option qualified_ident package in + let v1 = option package pack in let v2 = list (fun (v1, v2) -> let _v1static = bool v1 and v2 = import v2 in v2) imports @@ -516,7 +521,7 @@ let compilation_unit { package = package; let package = match v1 with | None -> items @ imports - | Some x -> [G.DirectiveStmt (G.Package x)] + | Some (t, x) -> [G.DirectiveStmt (G.Package (t, x))] in package @ imports @ items diff --git a/lang_java/parsing/ast_java.ml b/lang_java/parsing/ast_java.ml index eb5b014fb..92237b47b 100644 --- a/lang_java/parsing/ast_java.ml +++ b/lang_java/parsing/ast_java.ml @@ -43,6 +43,10 @@ type 'a wrap = 'a * tok type 'a list1 = 'a list (* really should be 'a * 'a list *) (* with tarzan *) +(* round(), square[], curly{}, angle<> brackets *) +type 'a bracket = tok * 'a * tok + (* with tarzan *) + (* ------------------------------------------------------------------------- *) (* Ident, qualifier *) (* ------------------------------------------------------------------------- *) @@ -223,22 +227,22 @@ and stmt = | Block of stmts | Expr of expr - | If of expr * stmt * stmt + | If of tok * expr * stmt * stmt | Switch of tok * expr * (cases * stmts) list - | While of expr * stmt - | Do of stmt * expr - | For of for_control * stmt + | While of tok * expr * stmt + | Do of tok * stmt * expr + | For of tok * for_control * stmt - | Break of ident option - | Continue of ident option - | Return of expr option + | Break of tok * ident option + | Continue of tok * ident option + | Return of tok * expr option | Label of ident * stmt | Sync of expr * stmt - | Try of stmt * catches * stmt option - | Throw of expr + | Try of tok * stmt * catches * stmt option + | Throw of tok * expr (* decl as statement *) | LocalVar of var_with_init @@ -246,13 +250,13 @@ and stmt = | LocalClass of class_decl (* javaext: http://java.sun.com/j2se/1.4.2/docs/guide/lang/assert.html *) - | Assert of expr * expr option (* assert e or assert e : e2 *) + | Assert of tok * expr * expr option (* assert e or assert e : e2 *) and stmts = stmt list and case = - | Case of expr - | Default + | Case of (tok * expr) + | Default of tok and cases = case list and for_control = @@ -292,7 +296,7 @@ and var_with_init = { (* less: could merge with expr *) and init = | ExprInit of expr - | ArrayInit of init list + | ArrayInit of init list bracket (* ------------------------------------------------------------------------- *) (* Methods, fields *) @@ -379,11 +383,11 @@ and decls = decl list (* Toplevel *) (*****************************************************************************) type import = - | ImportAll of qualified_ident * tok (* * *) - | ImportFrom of qualified_ident * ident + | ImportAll of tok * qualified_ident * tok (* * *) + | ImportFrom of tok * qualified_ident * ident type compilation_unit = { - package: qualified_ident option; + package: (tok * qualified_ident) option; (* The qualified ident can also contain "*" at the very end. * The bool is for static import (javaext:) *) diff --git a/lang_java/parsing/meta_ast_java.ml b/lang_java/parsing/meta_ast_java.ml index 95bdd640e..a39e8f3f3 100644 --- a/lang_java/parsing/meta_ast_java.ml +++ b/lang_java/parsing/meta_ast_java.ml @@ -7,6 +7,9 @@ and vof_wrap _of_a (v1, v2) = let v1 = _of_a v1 and v2 = vof_tok v2 in Ocaml.VTuple [ v1; v2 ] and vof_list1 _of_a = Ocaml.vof_list _of_a +let vof_bracket of_a (_t1, x, _t2) = + of_a x + let vof_ident v = vof_wrap Ocaml.vof_string v let vof_qualified_ident v = Ocaml.vof_list vof_ident v @@ -219,11 +222,12 @@ and vof_stmt = | Empty -> Ocaml.VSum (("Empty", [])) | Block v1 -> let v1 = vof_stmts v1 in Ocaml.VSum (("Block", [ v1 ])) | Expr v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Expr", [ v1 ])) - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = vof_stmt v2 and v3 = vof_stmt v3 - in Ocaml.VSum (("If", [ v1; v2; v3 ])) + in Ocaml.VSum (("If", [ t; v1; v2; v3 ])) | Switch ((v0, v1, v2)) -> let v0 = vof_tok v0 in let v1 = vof_expr v1 @@ -235,27 +239,33 @@ and vof_stmt = in Ocaml.VTuple [ v1; v2 ]) v2 in Ocaml.VSum (("Switch", [ v0; v1; v2 ])) - | While ((v1, v2)) -> + | While ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = vof_stmt v2 - in Ocaml.VSum (("While", [ v1; v2 ])) - | Do ((v1, v2)) -> + in Ocaml.VSum (("While", [ t; v1; v2 ])) + | Do ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_stmt v1 and v2 = vof_expr v2 - in Ocaml.VSum (("Do", [ v1; v2 ])) - | For ((v1, v2)) -> + in Ocaml.VSum (("Do", [ t; v1; v2 ])) + | For ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_for_control v1 and v2 = vof_stmt v2 - in Ocaml.VSum (("For", [ v1; v2 ])) - | Break v1 -> + in Ocaml.VSum (("For", [ t; v1; v2 ])) + | Break (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_ident v1 - in Ocaml.VSum (("Break", [ v1 ])) - | Continue v1 -> + in Ocaml.VSum (("Break", [ t; v1 ])) + | Continue (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_ident v1 - in Ocaml.VSum (("Continue", [ v1 ])) - | Return v1 -> + in Ocaml.VSum (("Continue", [ t; v1 ])) + | Return (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_expr v1 - in Ocaml.VSum (("Return", [ v1 ])) + in Ocaml.VSum (("Return", [ t; v1 ])) | Label ((v1, v2)) -> let v1 = vof_ident v1 and v2 = vof_stmt v2 @@ -264,25 +274,33 @@ and vof_stmt = let v1 = vof_expr v1 and v2 = vof_stmt v2 in Ocaml.VSum (("Sync", [ v1; v2 ])) - | Try ((v1, v2, v3)) -> + | Try ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_stmt v1 and v2 = vof_catches v2 and v3 = Ocaml.vof_option vof_stmt v3 - in Ocaml.VSum (("Try", [ v1; v2; v3 ])) - | Throw v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Throw", [ v1 ])) + in Ocaml.VSum (("Try", [ t; v1; v2; v3 ])) + | Throw (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("Throw", [ t; v1 ])) | LocalVar v1 -> let v1 = vof_var_with_init v1 in Ocaml.VSum (("LocalVar", [ v1 ])) | LocalClass v1 -> let v1 = vof_class_decl v1 in Ocaml.VSum (("LocalClass", [ v1 ])) - | Assert ((v1, v2)) -> + | Assert ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = Ocaml.vof_option vof_expr v2 - in Ocaml.VSum (("Assert", [ v1; v2 ])) + in Ocaml.VSum (("Assert", [ t; v1; v2 ])) and vof_stmts v = Ocaml.vof_list vof_stmt v and vof_case = function - | Case v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Case", [ v1 ])) - | Default -> Ocaml.VSum (("Default", [])) + | Case (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("Case", [ t; v1 ])) + | Default t -> + let t = vof_tok t in + Ocaml.VSum (("Default", [t])) and vof_cases v = Ocaml.vof_list vof_case v and vof_for_control = function @@ -329,7 +347,7 @@ and vof_init = function | ExprInit v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("ExprInit", [ v1 ])) | ArrayInit v1 -> - let v1 = Ocaml.vof_list vof_init v1 + let v1 = vof_bracket (Ocaml.vof_list vof_init) v1 in Ocaml.VSum (("ArrayInit", [ v1 ])) and vof_method_decl { @@ -436,14 +454,21 @@ and vof_decl = and vof_decls v = Ocaml.vof_list vof_decl v and vof_import = function - | ImportAll (v1, v2) -> + | ImportAll (t, v1, v2) -> + let t = vof_tok t in let v1 = vof_qualified_ident v1 in let v2 = vof_tok v2 in - Ocaml.VSum ("ImportAll", [v1;v2]) - | ImportFrom (v1, v2) -> + Ocaml.VSum ("ImportAll", [t; v1;v2]) + | ImportFrom (t, v1, v2) -> + let t = vof_tok t in let v1 = vof_qualified_ident v1 in let v2 = vof_ident v2 in - Ocaml.VSum ("ImportFrom", [v1;v2]) + Ocaml.VSum ("ImportFrom", [t; v1;v2]) + +let vof_package (v1, v2) = + let v1 = vof_tok v1 in + let v2 = vof_qualified_ident v2 in + Ocaml.VTuple [v1; v2] let vof_compilation_unit { package = v_package; @@ -463,9 +488,10 @@ let vof_compilation_unit { v_imports in let bnd = ("imports", arg) in let bnds = bnd :: bnds in - let arg = Ocaml.vof_option vof_qualified_ident v_package in + let arg = Ocaml.vof_option vof_package v_package in let bnd = ("package", arg) in let bnds = bnd :: bnds in Ocaml.VDict bnds + let vof_program v = vof_compilation_unit v let vof_any = diff --git a/lang_java/parsing/parser_java.mly b/lang_java/parsing/parser_java.mly index ddaae5340..fcdcaf146 100644 --- a/lang_java/parsing/parser_java.mly +++ b/lang_java/parsing/parser_java.mly @@ -287,20 +287,20 @@ sgrep_spatch_pattern: /*(* ident_list *)*/ package_declaration: - | PACKAGE qualified_ident SM { $2 } + | PACKAGE qualified_ident SM { $1, $2 } /*(* always annotations *)*/ - | modifiers PACKAGE qualified_ident SM { $3 } + | modifiers PACKAGE qualified_ident SM { $2, $3 (* TODO $1 *) } /*(* javaext: static_opt 1.? *)*/ import_declaration: | IMPORT static_opt name SM { $2, (match List.rev (qualified_ident $3) with - | x::xs -> ImportFrom (List.rev xs, x) + | x::xs -> ImportFrom ($1, List.rev xs, x) | [] -> raise Impossible ) } | IMPORT static_opt name DOT TIMES SM - { $2, ImportAll (qualified_ident $3, $5)} + { $2, ImportAll ($1, qualified_ident $3, $5)} type_declaration: | class_declaration { [Class $1] } @@ -748,8 +748,8 @@ statement_without_trailing_substatement: | throw_statement { $1 } | try_statement { $1 } /*(* javaext: *)*/ - | ASSERT expression SM { Assert ($2, None) } - | ASSERT expression COLON expression SM { Assert ($2, Some $4) } + | ASSERT expression SM { Assert ($1, $2, None) } + | ASSERT expression COLON expression SM { Assert ($1, $2, Some $4) } block: LC block_statements_opt RC { Block $2 } @@ -791,10 +791,10 @@ statement_expression: if_then_statement: IF LP expression RP statement - { If ($3, $5, Empty) } + { If ($1, $3, $5, Empty) } if_then_else_statement: IF LP expression RP statement_no_short_if ELSE statement - { If ($3, $5, $7) } + { If ($1, $3, $5, $7) } switch_statement: SWITCH LP expression RP switch_block @@ -810,15 +810,15 @@ switch_block: switch_block_statement_group: switch_labels block_statements {List.rev $1, $2} switch_label: - | CASE constant_expression COLON { Case $2 } - | DEFAULT_COLON COLON { Default } + | CASE constant_expression COLON { Case ($1, $2) } + | DEFAULT_COLON COLON { Default $1 } while_statement: WHILE LP expression RP statement - { While ($3, $5) } + { While ($1, $3, $5) } do_statement: DO statement WHILE LP expression RP SM - { Do ($2, $5) } + { Do ($1, $2, $5) } /*(*----------------------------*)*/ /*(*2 For *)*/ @@ -826,7 +826,7 @@ do_statement: DO statement WHILE LP expression RP SM for_statement: FOR LP for_control RP statement - { For ($3, $5) } + { For ($1, $3, $5) } for_control: | for_init_opt SM expression_opt SM for_update_opt @@ -860,9 +860,9 @@ for_var_control_rest: COLON expression { $2 } /*(*2 Other *)*/ /*(*----------------------------*)*/ -break_statement: BREAK identifier_opt SM { Break $2 } -continue_statement: CONTINUE identifier_opt SM { Continue $2 } -return_statement: RETURN expression_opt SM { Return $2 } +break_statement: BREAK identifier_opt SM { Break ($1, $2) } +continue_statement: CONTINUE identifier_opt SM { Continue ($1, $2) } +return_statement: RETURN expression_opt SM { Return ($1, $2) } synchronized_statement: SYNCHRONIZED LP expression RP block { Sync ($3, $5) } @@ -870,15 +870,15 @@ synchronized_statement: SYNCHRONIZED LP expression RP block { Sync ($3, $5) } /*(*2 Exceptions *)*/ /*(*----------------------------*)*/ -throw_statement: THROW expression SM { Throw $2 } +throw_statement: THROW expression SM { Throw ($1, $2) } try_statement: - | TRY block catches { Try ($2, List.rev $3, None) } - | TRY block catches_opt finally { Try ($2, $3, Some $4) } + | TRY block catches { Try ($1, $2, List.rev $3, None) } + | TRY block catches_opt finally { Try ($1, $2, $3, Some $4) } /*(* javaext: ? *)*/ | TRY resource_specification block catches_opt finally_opt { (* TODO $2 *) - Try ($3, $4, $5) + Try ($1, $3, $4, $5) } finally: FINALLY block { $2 } @@ -933,14 +933,14 @@ labeled_statement_no_short_if: identifier COLON statement_no_short_if if_then_else_statement_no_short_if: IF LP expression RP statement_no_short_if ELSE statement_no_short_if - { If ($3, $5, $7) } + { If ($1, $3, $5, $7) } while_statement_no_short_if: WHILE LP expression RP statement_no_short_if - { While ($3, $5) } + { While ($1, $3, $5) } for_statement_no_short_if: FOR LP for_control RP statement_no_short_if - { For ($3, $5) } + { For ($1, $3, $5) } /*(*************************************************************************)*/ /*(*1 Modifiers *)*/ @@ -1072,8 +1072,8 @@ variable_initializer: | array_initializer { $1 } array_initializer: - | LC comma_opt RC { ArrayInit [] } - | LC variable_initializers comma_opt RC { ArrayInit (List.rev $2) } + | LC comma_opt RC { ArrayInit ($1, [], $3) } + | LC variable_initializers comma_opt RC { ArrayInit ($1, List.rev $2, $4) } /*(*----------------------------*)*/ /*(*2 Method *)*/ diff --git a/lang_java/parsing/visitor_java.ml b/lang_java/parsing/visitor_java.ml index b543b3b03..c6c1eafa6 100644 --- a/lang_java/parsing/visitor_java.ml +++ b/lang_java/parsing/visitor_java.ml @@ -63,6 +63,10 @@ let (mk_visitor: visitor_in -> visitor_out) = fun vin -> let rec v_wrap: 'a. ('a -> unit) -> 'a wrap -> unit = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = v_info v2 in () +and v_bracket: 'a. ('a -> unit) -> 'a bracket -> unit = + fun of_a (v1, v2, v3) -> + let v1 = v_info v1 and v2 = of_a v2 and v3 = v_info v3 in () + and v_info x = let k _x = () in vin.kinfo (k, all_functions) x @@ -208,7 +212,8 @@ and v_stmt (x : stmt) = | Empty -> () | Block v1 -> let v1 = v_stmts v1 in () | Expr v1 -> let v1 = v_expr v1 in () - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = v_info t in let v1 = v_expr v1 and v2 = v_stmt v2 and v3 = v_stmt v3 in () | Switch ((v0, v1, v2)) -> let v0 = v_info v0 in @@ -217,28 +222,51 @@ and v_stmt (x : stmt) = v_list (fun (v1, v2) -> let v1 = v_cases v1 and v2 = v_stmts v2 in ()) v2 in () - | While ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_stmt v2 in () - | Do ((v1, v2)) -> let v1 = v_stmt v1 and v2 = v_expr v2 in () - | For ((v1, v2)) -> let v1 = v_for_control v1 and v2 = v_stmt v2 in () - | Break v1 -> let v1 = v_option v_ident v1 in () - | Continue v1 -> let v1 = v_option v_ident v1 in () - | Return v1 -> let v1 = v_option v_expr v1 in () + | While ((t, v1, v2)) -> + let t = v_info t in + let v1 = v_expr v1 and v2 = v_stmt v2 in () + | Do ((t, v1, v2)) -> + let t = v_info t in + let v1 = v_stmt v1 and v2 = v_expr v2 in () + | For ((t, v1, v2)) -> + let t = v_info t in + let v1 = v_for_control v1 and v2 = v_stmt v2 in () + | Break (t, v1) -> + let t = v_info t in + let v1 = v_option v_ident v1 in () + | Continue (t, v1) -> + let t = v_info t in + let v1 = v_option v_ident v1 in () + | Return (t, v1) -> + let t = v_info t in + let v1 = v_option v_expr v1 in () | Label ((v1, v2)) -> let v1 = v_ident v1 and v2 = v_stmt v2 in () | Sync ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_stmt v2 in () - | Try ((v1, v2, v3)) -> + | Try ((t, v1, v2, v3)) -> + let t = v_info t in let v1 = v_stmt v1 and v2 = v_catches v2 and v3 = v_option v_stmt v3 in () - | Throw v1 -> let v1 = v_expr v1 in () + | Throw (t, v1) -> + let t = v_info t in + let v1 = v_expr v1 in () | LocalVar v1 -> let v1 = v_var_with_init v1 in () | LocalClass v1 -> let v1 = v_class_decl v1 in () - | Assert ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_option v_expr v2 in () + | Assert ((t, v1, v2)) -> + let t = v_info t in + let v1 = v_expr v1 and v2 = v_option v_expr v2 in () in vin.kstmt (k, all_functions) x and v_stmts v = v_list v_stmt v -and v_case = function | Case v1 -> let v1 = v_expr v1 in () | Default -> () +and v_case = function + | Case (t, v1) -> + let t = v_tok t in + let v1 = v_expr v1 in () + | Default t -> + let t = v_tok t in + () and v_cases v = v_list v_case v and v_for_control = function @@ -270,7 +298,7 @@ and v_var_with_init { f_var = v_f_var; f_init = v_f_init } = and v_init (x : init) = let k x = match x with | ExprInit v1 -> let v1 = v_expr v1 in () - | ArrayInit v1 -> let v1 = v_list v_init v1 in () + | ArrayInit v1 -> let v1 = v_bracket (v_list v_init) v1 in () in vin.kinit (k, all_functions) x diff --git a/lang_js/analyze/ast_js.ml b/lang_js/analyze/ast_js.ml index 08842dbff..c04c2304b 100644 --- a/lang_js/analyze/ast_js.ml +++ b/lang_js/analyze/ast_js.ml @@ -71,6 +71,10 @@ type tok = Parse_info.t type 'a wrap = 'a * tok (* with tarzan *) +(* round(), square[], curly{}, angle<> brackets *) +type 'a bracket = tok * 'a * tok + (* with tarzan *) + (* ------------------------------------------------------------------------- *) (* Name *) (* ------------------------------------------------------------------------- *) @@ -169,12 +173,12 @@ and expr = | Assign of expr * tok * expr (* less: could be transformed in a series of Assign(ObjAccess, ...) *) - | Obj of obj_ + | Obj of obj_ | Class of class_ * name option (* when assigned in module.exports *) | ObjAccess of expr * tok * property_name (* we could transform it in an Obj but can be useful to remember * the difference in further analysis (e.g., in the abstract interpreter) *) - | Arr of expr list + | Arr of expr list bracket (* this can also be used to access object fields dynamically *) | ArrAccess of expr * expr @@ -196,18 +200,18 @@ and stmt = | Block of stmt list | ExprStmt of expr - | If of expr * stmt * stmt - | Do of stmt * expr | While of expr * stmt - | For of for_header * stmt + | If of tok * expr * stmt * stmt + | Do of tok * stmt * expr | While of tok * expr * stmt + | For of tok * for_header * stmt | Switch of tok * expr * case list - | Continue of label option | Break of label option - | Return of expr + | Continue of tok * label option | Break of tok * label option + | Return of tok * expr | Label of label * stmt - | Throw of expr - | Try of stmt * catch option * stmt option + | Throw of tok * expr + | Try of tok * stmt * catch option * stmt option (* less: ModuleDirective of module_directive * ES6 modules can appear only at the toplevel @@ -224,8 +228,8 @@ and stmt = and var_or_expr = (var, expr) Common.either and case = - | Case of expr * stmt - | Default of stmt + | Case of tok * expr * stmt + | Default of tok * stmt and catch = name * stmt @@ -257,7 +261,7 @@ and fun_ = { (* only inside classes *) | Get | Set -and obj_ = property list +and obj_ = property list bracket and class_ = { (* usually simply an Id *) @@ -269,7 +273,7 @@ and class_ = { (* expr is a Fun for methods *) | Field of property_name * property_prop wrap list * expr (* less: can unsugar? *) - | FieldSpread of expr + | FieldSpread of tok * expr and property_prop = | Static @@ -293,11 +297,12 @@ type module_directive = * when you do 'import "react"' to get a resolved path). * See Module_path_js to resolve paths. *) - | Import of name * name (* 'name1 as name2', often name1=name2 *) * filename + | Import of tok * name * name (* 'name1 as name2', often name1=name2 *) * + filename | Export of name (* hard to unsugar in Import because we do not have the list of names *) - | ModuleAlias of name * filename (* import * as 'name' from 'file' *) + | ModuleAlias of tok * name * filename (* import * as 'name' from 'file' *) | ImportCss of filename (* those should not exist *) diff --git a/lang_js/analyze/ast_js_build.ml b/lang_js/analyze/ast_js_build.ml index 337957e1b..ef83af862 100644 --- a/lang_js/analyze/ast_js_build.ml +++ b/lang_js/analyze/ast_js_build.ml @@ -63,6 +63,8 @@ let opt f env x = let fst3 (x, _, _) = x +let bracket_keep of_a (t1, x, t2) = (t1, of_a x, t2) + let noop = A.Block [] let not_resolved () = ref A.NotResolved @@ -144,11 +146,11 @@ and import env = function if file =~ ".*\\.css$" then [A.ImportCss (file, tok)] else [A.ImportEffect (file, tok)] - | C.ImportFrom ((default_opt, names_opt), (_, path)) -> + | C.ImportFrom ((default_opt, names_opt), (tok, path)) -> let file = path_to_file path in (match default_opt with | Some n -> - [A.Import ((A.default_entity, snd n), name env n, file)] + [A.Import (tok, (A.default_entity, snd n), name env n, file)] | None -> [] ) @ (match names_opt with @@ -157,7 +159,7 @@ and import env = function (match ni with | C.ImportNamespace (_star, _as, n1) -> let n1 = name env n1 in - [A.ModuleAlias (n1, file)] + [A.ModuleAlias (tok, n1, file)] | C.ImportNames xs -> xs |> C.unparen |> C.uncomma |> List.map (fun (n1, n2opt) -> let n1 = name env n1 in @@ -166,7 +168,7 @@ and import env = function | None -> n1 | Some (_, n2) -> name env n2 in - A.Import (n1, n2, file) + A.Import (tok, n1, n2, file) ) | C.ImportTypes (_tok, _xs) -> (* ignore for now *) @@ -208,12 +210,12 @@ and export env tok = function v_resolved = not_resolved () } in [A.V v; A.M (A.Export n2)] ) |> List.flatten - | C.ReExportNames (xs, (_from, path), _) -> + | C.ReExportNames (xs, (tok, path), _) -> xs |> C.unbrace |> C.uncomma |> List.map (fun (n1, n2opt) -> let n1 = name env n1 in let tmpname = ("!tmp_" ^ fst n1, snd n1) in let file = path_to_file path in - let import = A.Import (n1, tmpname, file) in + let import = A.Import (tok, n1, tmpname, file) in let id = A.Id (tmpname, not_resolved()) in match n2opt with | None -> @@ -314,7 +316,7 @@ and stmt env = function [A.ExprStmt (A.Apply(A.IdSpecial (A.UseStrict, tok), []))] | _ -> [A.ExprStmt e] ) - | C.If (_, e, then_, elseopt) -> + | C.If (t, e, then_, elseopt) -> let e = e |> C.unparen |> expr env in let then_ = stmt1 env then_ in let else_ = @@ -322,16 +324,16 @@ and stmt env = function | None -> noop | Some (_, st) -> stmt1 env st in - [A.If (e, then_, else_)] - | C.Do (_, st, _, e, _) -> + [A.If (t, e, then_, else_)] + | C.Do (t, st, _, e, _) -> let st = stmt1 env st in let e = e |> C.unparen |> expr env in - [A.Do (st, e)] - | C.While (_, e, st) -> + [A.Do (t, st, e)] + | C.While (t, e, st) -> let e = e |> C.unparen |> expr env in let st = stmt1 env st in - [A.While (e, st)] - | C.For (_, _, lhs_vars_opt, _, e2opt, _, e3opt, _, st) -> + [A.While (t, e, st)] + | C.For (t, _, lhs_vars_opt, _, e2opt, _, e3opt, _, st) -> let e1 = match lhs_vars_opt with | Some (C.LHS1 e) -> Right (expr env e) @@ -343,8 +345,8 @@ and stmt env = function let e2 = expr_opt env e2opt in let e3 = expr_opt env e3opt in let st = stmt1 env st in - [A.For (A.ForClassic (e1, e2, e3), st)] - | C.ForIn (_, _, lhs_var, _, e2, _, st) -> + [A.For (t, A.ForClassic (e1, e2, e3), st)] + | C.ForIn (t, _, lhs_var, _, e2, _, st) -> let e1 = match lhs_var with | C.LHS2 e -> Right (expr env e) @@ -357,8 +359,8 @@ and stmt env = function in let e2 = expr env e2 in let st = stmt1 env st in - [A.For (A.ForIn (e1, e2), st)] - | C.ForOf (_, _, lhs_var, tokof, e2, _, st) -> + [A.For (t, A.ForIn (e1, e2), st)] + | C.ForOf (_tTODO, _, lhs_var, tokof, e2, _, st) -> (try Transpile_js.forof (lhs_var, tokof, e2, st) (expr env, stmt env, var_binding env) @@ -369,22 +371,22 @@ and stmt env = function let e = e |> C.unparen |> expr env in let xs = xs |> C.unparen |> List.map (case_clause env) in [A.Switch (tok, e, xs)] - | C.Continue (_, lopt, _) -> - [A.Continue (opt label env lopt)] - | C.Break (_, lopt, _) -> - [A.Break (opt label env lopt)] - | C.Return (_, eopt, _) -> - [A.Return (expr_opt env eopt)] + | C.Continue (t, lopt, _) -> + [A.Continue (t, opt label env lopt)] + | C.Break (t, lopt, _) -> + [A.Break (t, opt label env lopt)] + | C.Return (t, eopt, _) -> + [A.Return (t, expr_opt env eopt)] | C.With (tok, _e, _st) -> raise (TodoConstruct ("with", tok)) | C.Labeled (lbl, _, st) -> let lbl = label env lbl in let st = stmt1 env st in [A.Label (lbl, st)] - | C.Throw (_, e, _) -> + | C.Throw (t, e, _) -> let e = expr env e in - [A.Throw e] - | C.Try (_, st, catchopt, finally_opt) -> + [A.Throw (t, e)] + | C.Try (t, st, catchopt, finally_opt) -> let st = stmt1 env st in let catchopt = opt (fun env (_, arg, st) -> let arg = name env (C.unparen arg) in @@ -392,7 +394,7 @@ and stmt env = function (arg, st) ) env catchopt in let finally_opt = opt (fun env (_, st) -> stmt1 env st) env finally_opt in - [A.Try (st, catchopt, finally_opt)] + [A.Try (t, st, catchopt, finally_opt)] and stmt_of_stmts xs = match xs with @@ -404,10 +406,10 @@ and stmt1 env st = stmt env st |> stmt_of_stmts and case_clause env = function - | C.Default (_, _, xs) -> A.Default (stmt1_item_list env xs) - | C.Case (_, e, _, xs) -> + | C.Default (t, _, xs) -> A.Default (t, stmt1_item_list env xs) + | C.Case (t, e, _, xs) -> let e = expr env e in - A.Case (e, stmt1_item_list env xs) + A.Case (t, e, stmt1_item_list env xs) and stmt_item_list env items = let rec aux acc env = function @@ -484,10 +486,11 @@ and expr env = function let e2 = expr env (C.unparen e2) in A.ArrAccess (e, e2) | C.Object xs -> - A.Obj (xs |> C.unparen |> C.uncomma |> List.map (property env)) - | C.Array (tok, xs, _) -> + A.Obj (bracket_keep + (fun xs -> xs |> C.uncomma |> List.map (property env)) xs) + | C.Array (xs) -> (* A.Obj (array_obj env 0 tok xs) *) - A.Arr (array_arr env tok xs) + A.Arr (bracket_keep (array_arr env (fst3 xs)) xs) | C.Apply (e, es) -> let e = expr env e in let es = List.map (expr env) (es |> C.unparen |> C.uncomma) in @@ -732,7 +735,7 @@ and arrow_func env x = let xs = match x.C.a_body with (* Javascript has implicit returns for arrows like that *) - | C.AExpr e -> [A.Return (expr env e)] + | C.AExpr e -> [A.Return (fake "return", expr env e)] | C.ABody xs -> stmt_item_list env (xs |> C.unparen) in let body = stmt_of_stmts (vars @ xs) in @@ -750,9 +753,9 @@ and property env = function | C.P_shorthand n -> let n = name env n in A.Field (A.PN n, [], A.Id (n, not_resolved ())) - | C.P_spread (_, e) -> + | C.P_spread (t, e) -> let e = expr env e in - A.FieldSpread e + A.FieldSpread (t, e) and _array_obj env idx tok xs = match xs with diff --git a/lang_js/analyze/graph_code_js.ml b/lang_js/analyze/graph_code_js.ml index 56e83d648..07fc65a4c 100644 --- a/lang_js/analyze/graph_code_js.ml +++ b/lang_js/analyze/graph_code_js.ml @@ -139,6 +139,8 @@ let is_undefined_ok (src, _kindsrc) (dst, _kinddst) = let fake s = Parse_info.fake_info s +let unbracket (_, x, _) = x + (*****************************************************************************) (* Qualified Name *) (*****************************************************************************) @@ -330,7 +332,7 @@ and toplevel env x = and module_directive env x = match x with - | Import (name1, name2, (file, tok)) -> + | Import (_, name1, name2, (file, tok)) -> if env.phase = Uses then begin let str1 = s_of_n name1 in let str2 = s_of_n name2 in @@ -358,7 +360,7 @@ and module_directive env x = let str = s_of_n name in Hashtbl.replace env.exports env.file_readable (str::exports) end - | ModuleAlias (name, _fileTODO) -> + | ModuleAlias (_, name, _fileTODO) -> (* for now just add name as a local; anyway we do not * generate dependencies for fields yet *) @@ -390,34 +392,34 @@ and stmt env = function expr env v.v_init | Block xs -> stmts env xs | ExprStmt e -> expr env e - | If (e, st1, st2) -> + | If (_, e, st1, st2) -> expr env e; stmt env st1; stmt env st2 - | Do (st, e) -> + | Do (_, st, e) -> stmt env st; expr env e; - | While (e, st) -> + | While (_, e, st) -> expr env e; stmt env st - | For (header, st) -> + | For (_, header, st) -> let env = for_header env header in stmt env st | Switch (_tok, e, xs) -> expr env e; cases env xs - | Continue lopt -> + | Continue (_, lopt) -> Common.opt (label env) lopt - | Break lopt -> + | Break (_, lopt) -> Common.opt (label env) lopt - | Return e -> + | Return (_, e) -> expr env e | Label (l, st) -> label env l; stmt env st - | Throw e -> + | Throw (_, e) -> expr env e - | Try (st1, catchopt, finalopt) -> + | Try (_, st1, catchopt, finalopt) -> stmt env st1; catchopt |> Common.opt (fun (n, st) -> let v = { v_name = n; v_kind = Let, fake "let"; @@ -464,10 +466,10 @@ and label _env _lbl = and cases env xs = List.iter (case env) xs and case env = function - | Case (e, st) -> + | Case (_, e, st) -> expr env e; stmt env st - | Default st -> + | Default (_, st) -> stmt env st and stmts env xs = @@ -506,7 +508,7 @@ and expr env e = | Obj o -> obj_ env o | Arr xs -> - List.iter (expr env) xs + xs |> unbracket |> List.iter (expr env) | Class (c, nopt) -> let env = match nopt with @@ -570,7 +572,7 @@ and expr env e = (* todo: create nodes if global var? *) and obj_ env xs = - List.iter (property env) xs + xs |> unbracket |> List.iter (property env) and class_ env c = Common.opt (expr env) c.c_extends; @@ -580,7 +582,7 @@ and property env = function | Field (pname, _props, e) -> property_name env pname; expr env e - | FieldSpread e -> + | FieldSpread (_, e) -> expr env e and property_name env = function diff --git a/lang_js/analyze/js_to_generic.ml b/lang_js/analyze/js_to_generic.ml index 676ccabde..582064f9b 100644 --- a/lang_js/analyze/js_to_generic.ml +++ b/lang_js/analyze/js_to_generic.ml @@ -51,6 +51,8 @@ let wrap = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = info v2 in (v1, v2) +let bracket of_a (t1, x, t2) = (info t1, of_a x, info t2) + let name v = wrap id v let filename v = wrap string v @@ -97,13 +99,13 @@ let special (x, tok) = | Spread -> SR_Special G.Spread | Yield -> SR_NeedArgs (fun args -> match args with - | [e] -> G.Yield (e, false) + | [e] -> G.Yield (tok, Some e, false) | _ -> error tok "Impossible: Too many arguments to Yield" ) | YieldStar -> SR_Other G.OE_YieldStar | Await -> SR_NeedArgs (fun args -> match args with - | [e] -> G.Await e + | [e] -> G.Await (tok, e) | _ -> error tok "Impossible: Too many arguments to Await" ) | Encaps v1 -> @@ -185,7 +187,7 @@ and expr (x: expr) = ) | Apply ((v1, v2)) -> let v1 = expr v1 and v2 = list expr v2 in G.Call (v1, v2 |> List.map (fun e -> G.Arg e)) - | Arr ((v1)) -> let v1 = list expr v1 in G.Container (G.Array, v1) + | Arr ((v1)) -> let v1 = bracket (list expr) v1 in G.Container (G.Array, v1) | Conditional ((v1, v2, v3)) -> let v1 = expr v1 and v2 = expr v2 and v3 = expr v3 in G.Conditional (v1, v2, v3) @@ -195,30 +197,32 @@ and stmt x = | VarDecl v1 -> let v1 = def_of_var v1 in G.DefStmt (v1) | Block v1 -> let v1 = list stmt v1 in G.Block v1 | ExprStmt v1 -> let v1 = expr v1 in G.ExprStmt v1 - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> let v1 = expr v1 and v2 = stmt v2 and v3 = stmt v3 in - G.If (v1, v2, v3) - | Do ((v1, v2)) -> let v1 = stmt v1 and v2 = expr v2 in - G.DoWhile (v1, v2) - | While ((v1, v2)) -> let v1 = expr v1 and v2 = stmt v2 in - G.While (v1, v2) - | For ((v1, v2)) -> let v1 = for_header v1 and v2 = stmt v2 in - G.For (v1, v2) + G.If (t, v1, v2, v3) + | Do ((t, v1, v2)) -> let v1 = stmt v1 and v2 = expr v2 in + G.DoWhile (t, v1, v2) + | While ((t, v1, v2)) -> let v1 = expr v1 and v2 = stmt v2 in + G.While (t, v1, v2) + | For ((t, v1, v2)) -> let v1 = for_header v1 and v2 = stmt v2 in + G.For (t, v1, v2) | Switch ((v0, v1, v2)) -> let v0 = info v0 in let v1 = expr v1 and v2 = list case v2 in G.Switch (v0, v1, v2) - | Continue v1 -> let v1 = option label v1 in - G.Continue (v1 |> option (fun n -> + | Continue (t, v1) -> let v1 = option label v1 in + G.Continue (t, v1 |> option (fun n -> G.Name ((n, G.empty_name_info), G.empty_id_info ()))) - | Break v1 -> let v1 = option label v1 in - G.Break (v1 |> option (fun n -> + | Break (t, v1) -> let v1 = option label v1 in + G.Break (t, v1 |> option (fun n -> G.Name ((n, G.empty_name_info), G.empty_id_info ()))) - | Return v1 -> let v1 = expr v1 in G.Return (Some v1) + | Return (t, v1) -> + let v1 = expr v1 in + G.Return (t, Some v1) | Label ((v1, v2)) -> let v1 = label v1 and v2 = stmt v2 in G.Label (v1, v2) - | Throw v1 -> let v1 = expr v1 in G.Throw v1 - | Try ((v1, v2, v3)) -> + | Throw (t, v1) -> let v1 = expr v1 in G.Throw (t, v1) + | Try ((t, v1, v2, v3)) -> let v1 = stmt v1 and v2 = option (fun (v1, v2) -> @@ -226,7 +230,7 @@ and stmt x = G.PatVar (v1, G.empty_id_info()), v2 ) v2 and v3 = option stmt v3 in - G.Try (v1, Common.opt_to_list v2, v3) + G.Try (t, v1, Common.opt_to_list v2, v3) and for_header = function @@ -261,10 +265,10 @@ and for_header = and case = function - | Case ((v1, v2)) -> let v1 = expr v1 and v2 = stmt v2 in - [G.Case (G.expr_to_pattern v1)], v2 - | Default v1 -> let v1 = stmt v1 in - [G.Default], v1 + | Case ((t, v1, v2)) -> let v1 = expr v1 and v2 = stmt v2 in + [G.Case (t, G.expr_to_pattern v1)], v2 + | Default (t, v1) -> let v1 = stmt v1 in + [G.Default t], v1 and def_of_var { v_name = x_name; v_kind = x_kind; v_init = x_init; v_resolved = x_resolved } = @@ -327,7 +331,7 @@ and fun_prop (x, tok) = | Generator -> G.attr G.Generator tok | Async -> G.attr G.Async tok -and obj_ v = list property v +and obj_ v = bracket (list property) v and class_ { c_extends = c_extends; c_body = c_body } = let v1 = option expr c_extends in @@ -354,9 +358,9 @@ and property x = | Right e -> G.FieldDynamic (e, v2, v3) ) - | FieldSpread v1 -> + | FieldSpread (t, v1) -> let v1 = expr v1 in - G.FieldSpread v1 + G.FieldSpread (t, v1) and property_prop (x, tok) = match x with @@ -375,12 +379,12 @@ let rec toplevel x = and module_directive x = match x with - | Import ((v1, v2, v3)) -> + | Import ((t, v1, v2, v3)) -> let v1 = name v1 and v2 = name v2 and v3 = filename v3 in - G.ImportFrom (G.FileName v3, [v1, Some v2]) - | ModuleAlias ((v1, v2)) -> + G.ImportFrom (t, G.FileName v3, [v1, Some v2]) + | ModuleAlias ((t, v1, v2)) -> let v1 = name v1 and v2 = filename v2 in - G.ImportAs (G.FileName v2, Some v1) + G.ImportAs (t, G.FileName v2, Some v1) | ImportCss ((v1)) -> let v1 = name v1 in G.OtherDirective (G.OI_ImportCss, [G.Id v1]) diff --git a/lang_js/analyze/map_ast_js.ml b/lang_js/analyze/map_ast_js.ml index c06d32779..a32905d44 100644 --- a/lang_js/analyze/map_ast_js.ml +++ b/lang_js/analyze/map_ast_js.ml @@ -74,6 +74,10 @@ let rec map_tok v = and map_wrap:'a. ('a -> 'a) -> 'a wrap -> 'a wrap = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = map_tok v2 in (v1, v2) + +and map_bracket:'a. ('a -> 'a) -> 'a bracket -> 'a bracket = + fun of_a (v1, v2, v3) -> + let v1 = map_tok v1 and v2 = of_a v2 and v3 = map_tok v3 in (v1, v2, v3) and map_name v = map_wrap map_of_string v @@ -152,7 +156,7 @@ and map_expr = and v2 = map_property_name v2 and t = map_tok t in ObjAccess ((v1, t, v2)) - | Arr v1 -> let v1 = map_of_list map_expr v1 in Arr ((v1)) + | Arr v1 -> let v1 = map_bracket (map_of_list map_expr) v1 in Arr ((v1)) | ArrAccess ((v1, v2)) -> let v1 = map_expr v1 and v2 = map_expr v2 in ArrAccess ((v1, v2)) | Fun ((v1, v2)) -> @@ -173,29 +177,42 @@ and map_stmt = | VarDecl v1 -> let v1 = map_var v1 in VarDecl ((v1)) | Block v1 -> let v1 = map_of_list map_stmt v1 in Block ((v1)) | ExprStmt v1 -> let v1 = map_expr v1 in ExprStmt ((v1)) - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = map_tok t in let v1 = map_expr v1 and v2 = map_stmt v2 and v3 = map_stmt v3 - in If ((v1, v2, v3)) - | Do ((v1, v2)) -> - let v1 = map_stmt v1 and v2 = map_expr v2 in Do ((v1, v2)) - | While ((v1, v2)) -> - let v1 = map_expr v1 and v2 = map_stmt v2 in While ((v1, v2)) - | For ((v1, v2)) -> - let v1 = map_for_header v1 and v2 = map_stmt v2 in For ((v1, v2)) + in If ((t, v1, v2, v3)) + | Do ((t, v1, v2)) -> + let t = map_tok t in + let v1 = map_stmt v1 and v2 = map_expr v2 in Do ((t, v1, v2)) + | While ((t, v1, v2)) -> + let t = map_tok t in + let v1 = map_expr v1 and v2 = map_stmt v2 in While ((t, v1, v2)) + | For ((t, v1, v2)) -> + let t = map_tok t in + let v1 = map_for_header v1 and v2 = map_stmt v2 in For ((t, v1, v2)) | Switch ((v0, v1, v2)) -> let v0 = map_tok v0 in let v1 = map_expr v1 and v2 = map_of_list map_case v2 in Switch ((v0, v1, v2)) - | Continue v1 -> let v1 = map_of_option map_label v1 in Continue ((v1)) - | Break v1 -> let v1 = map_of_option map_label v1 in Break ((v1)) - | Return v1 -> let v1 = map_expr v1 in Return ((v1)) + | Continue (t, v1) -> + let t = map_tok t in + let v1 = map_of_option map_label v1 in Continue ((t, v1)) + | Break (t, v1) -> + let t = map_tok t in + let v1 = map_of_option map_label v1 in Break ((t, v1)) + | Return (t, v1) -> + let t = map_tok t in + let v1 = map_expr v1 in Return ((t, v1)) | Label ((v1, v2)) -> let v1 = map_label v1 and v2 = map_stmt v2 in Label ((v1, v2)) - | Throw v1 -> let v1 = map_expr v1 in Throw ((v1)) - | Try ((v1, v2, v3)) -> + | Throw (t, v1) -> + let t = map_tok t in + let v1 = map_expr v1 in Throw ((t, v1)) + | Try ((t, v1, v2, v3)) -> + let t = map_tok t in let v1 = map_stmt v1 and v2 = map_of_option @@ -203,7 +220,8 @@ and map_stmt = let v1 = map_name v1 and v2 = map_stmt v2 in (v1, v2)) v2 and v3 = map_of_option map_stmt v3 - in Try ((v1, v2, v3)) + in Try ((t, v1, v2, v3)) + and map_for_header = function | ForClassic ((v1, v2, v3)) -> @@ -217,9 +235,12 @@ and map_for_header = in ForIn ((v1, v2)) and map_case = function - | Case ((v1, v2)) -> - let v1 = map_expr v1 and v2 = map_stmt v2 in Case ((v1, v2)) - | Default v1 -> let v1 = map_stmt v1 in Default ((v1)) + | Case ((t, v1, v2)) -> + let t = map_tok t in + let v1 = map_expr v1 and v2 = map_stmt v2 in Case ((t, v1, v2)) + | Default (t, v1) -> + let t = map_tok t in + let v1 = map_stmt v1 in Default ((t, v1)) and map_var { v_name = v_v_name; @@ -258,7 +279,7 @@ and map_fun_prop = | Set -> Set | Generator -> Generator | Async -> Async -and map_obj_ v = map_of_list map_property v +and map_obj_ v = map_bracket (map_of_list map_property) v and map_class_ { c_extends = v_c_extends; c_body = v_c_body } = let v_c_body = map_of_list map_property v_c_body in let v_c_extends = map_of_option map_expr v_c_extends in @@ -270,7 +291,8 @@ and map_property = and v2 = map_of_list (map_wrap map_property_prop) v2 and v3 = map_expr v3 in Field ((v1, v2, v3)) - | FieldSpread v1 -> let v1 = map_expr v1 in FieldSpread ((v1)) + | FieldSpread (t, v1) -> + let t = map_tok t in let v1 = map_expr v1 in FieldSpread ((t, v1)) and map_property_prop = function | Static -> Static @@ -286,21 +308,23 @@ and map_toplevel = and map_module_directive = function - | Import ((v1, v2, v3)) -> + | Import ((t, v1, v2, v3)) -> + let t = map_tok t in let v1 = map_name v1 and v2 = map_name v2 and v3 = map_filename v3 - in Import ((v1, v2, v3)) + in Import ((t, v1, v2, v3)) | ImportCss ((v1)) -> let v1 = map_name v1 in ImportCss ((v1)) | ImportEffect ((v1)) -> let v1 = map_name v1 in ImportEffect ((v1)) - | ModuleAlias ((v1, v2)) -> + | ModuleAlias ((t, v1, v2)) -> + let t = map_tok t in let v1 = map_name v1 and v2 = map_filename v2 - in ModuleAlias ((v1, v2)) + in ModuleAlias ((t, v1, v2)) | Export v1 -> let v1 = map_name v1 in Export ((v1)) and map_program v = map_of_list map_toplevel v diff --git a/lang_js/analyze/meta_ast_js.ml b/lang_js/analyze/meta_ast_js.ml index bd176ad1b..dc913f10a 100644 --- a/lang_js/analyze/meta_ast_js.ml +++ b/lang_js/analyze/meta_ast_js.ml @@ -12,6 +12,9 @@ and vof_wrap _of_a (v1, v2) = and _v2 = vof_tok v2 in (* Ocaml.VTuple [ v1; v2 ] *) v1 + +let vof_bracket of_a (_t1, x, _t2) = + of_a x let vof_name v = vof_wrap Ocaml.vof_string v @@ -67,7 +70,7 @@ let rec vof_property_name = and vof_expr = function | Arr v1 -> - let v1 = Ocaml.vof_list vof_expr v1 in Ocaml.VSum (("Arr", [v1])) + let v1 = vof_bracket (Ocaml.vof_list vof_expr) v1 in Ocaml.VSum (("Arr", [v1])) | Bool v1 -> let v1 = vof_wrap Ocaml.vof_bool v1 in Ocaml.VSum (("Bool", [ v1 ])) | Num v1 -> @@ -124,41 +127,52 @@ and vof_stmt = | Block v1 -> let v1 = Ocaml.vof_list vof_stmt v1 in Ocaml.VSum (("Block", [ v1 ])) | ExprStmt v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("ExprStmt", [ v1 ])) - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = vof_stmt v2 and v3 = vof_stmt v3 - in Ocaml.VSum (("If", [ v1; v2; v3 ])) - | Do ((v1, v2)) -> + in Ocaml.VSum (("If", [ t; v1; v2; v3 ])) + | Do ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_stmt v1 and v2 = vof_expr v2 - in Ocaml.VSum (("Do", [ v1; v2 ])) - | While ((v1, v2)) -> + in Ocaml.VSum (("Do", [ t; v1; v2 ])) + | While ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = vof_stmt v2 - in Ocaml.VSum (("While", [ v1; v2 ])) - | For ((v1, v2)) -> + in Ocaml.VSum (("While", [ t; v1; v2 ])) + | For ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_for_header v1 and v2 = vof_stmt v2 - in Ocaml.VSum (("For", [ v1; v2 ])) + in Ocaml.VSum (("For", [ t; v1; v2 ])) | Switch ((v0, v1, v2)) -> let v0 = vof_tok v0 in let v1 = vof_expr v1 and v2 = Ocaml.vof_list vof_case v2 in Ocaml.VSum (("Switch", [ v0; v1; v2 ])) - | Continue v1 -> + | Continue (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_label v1 - in Ocaml.VSum (("Continue", [ v1 ])) - | Break v1 -> + in Ocaml.VSum (("Continue", [ t; v1 ])) + | Break (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_label v1 - in Ocaml.VSum (("Break", [ v1 ])) - | Return v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Return", [ v1 ])) + in Ocaml.VSum (("Break", [ t; v1 ])) + | Return (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("Return", [ t; v1 ])) | Label ((v1, v2)) -> let v1 = vof_label v1 and v2 = vof_stmt v2 in Ocaml.VSum (("Label", [ v1; v2 ])) - | Throw v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Throw", [ v1 ])) - | Try ((v1, v2, v3)) -> + | Throw (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("Throw", [ t; v1 ])) + | Try ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_stmt v1 and v2 = Ocaml.vof_option @@ -168,7 +182,7 @@ and vof_stmt = in Ocaml.VTuple [ v1; v2 ]) v2 and v3 = Ocaml.vof_option vof_stmt v3 - in Ocaml.VSum (("Try", [ v1; v2; v3 ])) + in Ocaml.VSum (("Try", [ t; v1; v2; v3 ])) and vof_for_header = function | ForClassic ((v1, v2, v3)) -> @@ -182,11 +196,14 @@ and vof_for_header = in Ocaml.VSum (("ForIn", [ v1; v2 ])) and vof_case = function - | Case ((v1, v2)) -> + | Case ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = vof_stmt v2 - in Ocaml.VSum (("Case", [ v1; v2 ])) - | Default v1 -> let v1 = vof_stmt v1 in Ocaml.VSum (("Default", [ v1 ])) + in Ocaml.VSum (("Case", [ t; v1; v2 ])) + | Default (t, v1) -> + let t = vof_tok t in + let v1 = vof_stmt v1 in Ocaml.VSum (("Default", [ t; v1 ])) and vof_var { v_name = v_v_name; v_kind = v_v_kind; v_init = v_v_init; @@ -242,7 +259,7 @@ and vof_fun_prop = | Set -> Ocaml.VSum (("Set", [])) | Generator -> Ocaml.VSum (("Generator", [])) | Async -> Ocaml.VSum (("Async", [])) -and vof_obj_ v = Ocaml.vof_list vof_property v +and vof_obj_ v = vof_bracket (Ocaml.vof_list vof_property) v and vof_class_ { c_extends = v_c_extends; c_body = v_c_body } = let bnds = [] in let arg = Ocaml.vof_list vof_property v_c_body in @@ -257,8 +274,9 @@ and vof_property = and v2 = Ocaml.vof_list (vof_wrap vof_property_prop) v2 and v3 = vof_expr v3 in Ocaml.VSum (("Field", [ v1; v2; v3 ])) - | FieldSpread v1 -> - let v1 = vof_expr v1 in Ocaml.VSum (("FieldSpread", [ v1 ])) + | FieldSpread (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("FieldSpread", [ t; v1 ])) and vof_property_prop = function | Static -> Ocaml.VSum (("Static", [])) @@ -268,15 +286,17 @@ and vof_property_prop = let vof_module_directive = function - | Import ((v1, v2, v3)) -> + | Import ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_name v1 and v2 = vof_name v2 and v3 = vof_filename v3 - in Ocaml.VSum (("Import", [ v1; v2; v3 ])) - | ModuleAlias ((v1, v2)) -> + in Ocaml.VSum (("Import", [ t; v1; v2; v3 ])) + | ModuleAlias ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_name v1 and v2 = vof_filename v2 - in Ocaml.VSum (("ModuleAlias", [ v1; v2 ])) + in Ocaml.VSum (("ModuleAlias", [ t; v1; v2 ])) | ImportCss ((v1)) -> let v1 = vof_filename v1 in Ocaml.VSum (("ImportCss", [ v1 ])) diff --git a/lang_js/analyze/transpile_js.ml b/lang_js/analyze/transpile_js.ml index ffd2e2889..7e9dee82f 100644 --- a/lang_js/analyze/transpile_js.ml +++ b/lang_js/analyze/transpile_js.ml @@ -39,6 +39,7 @@ module G = Ast_generic (* Helpers *) (*****************************************************************************) let fake s = Parse_info.fake_info s +let fake_bracket x = fake "(", x, fake ")" (*****************************************************************************) (* Xhp *) @@ -56,10 +57,10 @@ let xhp_attr_value expr x = (* todo: should probably use Obj instead of tuples with string keys *) let xhp_attribute expr x = match x with - | C.XhpAttrNoValue (str) -> A.Arr [A.String str] + | C.XhpAttrNoValue (str) -> A.Arr (fake_bracket [A.String str]) | C.XhpAttrValue (str, _tok, attrval) -> let v = xhp_attr_value expr attrval in - A.Arr [A.String str; v] + A.Arr (fake_bracket [A.String str; v]) | C.XhpAttrSpread (_, (tokdot, e), _) -> A.Apply (A.IdSpecial (A.Spread, tokdot), [expr e]) @@ -70,12 +71,12 @@ let rec xhp expr x = let args1 = List.map (xhp_attribute expr) attrs in let args2 = [] in (* TODO: is it the actual result? good enough for codegraph for now *) - A.Apply(id, [A.Arr args1; A.Arr args2]) + A.Apply(id, [A.Arr (fake_bracket args1); A.Arr (fake_bracket args2)]) | C.Xhp (tag, attrs, _tok, body, _endtag_opt) -> let id = id_of_tag tag in let args1 = List.map (xhp_attribute expr) attrs in let args2 = List.map (xhp_body expr) body in - A.Apply (id, [A.Arr args1; A.Arr args2]) + A.Apply (id, [A.Arr (fake_bracket args1); A.Arr (fake_bracket args2)]) and xhp_body expr x = match x with (* todo: contain enclosing quote? *) @@ -276,4 +277,4 @@ let forof (lhs_var, tok, e2, st) (expr, stmt, var_binding) = var_binding vkind binding |> List.map (fun var -> A.VarDecl var) in let finalst = vars_or_assign_stmts @ st in - [A.For (A.ForClassic (for_init, for_cond, A.Nop), A.Block finalst)] + [A.For (fake "for", A.ForClassic (for_init, for_cond, A.Nop), A.Block finalst)] diff --git a/lang_js/analyze/visitor_ast_js.ml b/lang_js/analyze/visitor_ast_js.ml index 4ff60ef9e..cc760ccbc 100644 --- a/lang_js/analyze/visitor_ast_js.ml +++ b/lang_js/analyze/visitor_ast_js.ml @@ -60,8 +60,12 @@ let rec v_info x = and v_tok v = v_info v -and v_wrap: 'a. ('a -> unit) -> 'a wrap -> unit = fun _of_a (v1, v2) -> - let v1 = _of_a v1 and v2 = v_info v2 in () +and v_wrap: 'a. ('a -> unit) -> 'a wrap -> unit = fun of_a (v1, v2) -> + let v1 = of_a v1 and v2 = v_info v2 in () + +and v_bracket: 'a. ('a -> unit) -> 'a bracket -> unit = + fun of_a (v1, v2, v3) -> + let v1 = v_info v1 and v2 = of_a v2 and v3 = v_info v3 in () and v_name v = v_wrap v_string v @@ -128,7 +132,7 @@ and v_expr (x: expr) = () | Fun ((v1, v2)) -> let v1 = v_fun_ v1 and v2 = v_option v_name v2 in () | Apply ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_list v_expr v2 in () - | Arr ((v1)) -> let v1 = v_list v_expr v1 in () + | Arr ((v1)) -> let v1 = v_bracket (v_list v_expr) v1 in () | Conditional ((v1, v2, v3)) -> let v1 = v_expr v1 and v2 = v_expr v2 and v3 = v_expr v3 in () in @@ -140,20 +144,36 @@ and v_stmt x = | VarDecl v1 -> let v1 = v_var v1 in () | Block v1 -> let v1 = v_list v_stmt v1 in () | ExprStmt v1 -> let v1 = v_expr v1 in () - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = v_tok t in let v1 = v_expr v1 and v2 = v_stmt v2 and v3 = v_stmt v3 in () - | Do ((v1, v2)) -> let v1 = v_stmt v1 and v2 = v_expr v2 in () - | While ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_stmt v2 in () - | For ((v1, v2)) -> let v1 = v_for_header v1 and v2 = v_stmt v2 in () + | Do ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_stmt v1 and v2 = v_expr v2 in () + | While ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_expr v1 and v2 = v_stmt v2 in () + | For ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_for_header v1 and v2 = v_stmt v2 in () | Switch ((v0, v1, v2)) -> let v0 = v_tok v0 in let v1 = v_expr v1 and v2 = v_list v_case v2 in () - | Continue v1 -> let v1 = v_option v_label v1 in () - | Break v1 -> let v1 = v_option v_label v1 in () - | Return v1 -> let v1 = v_expr v1 in () + | Continue (t, v1) -> + let t = v_tok t in + let v1 = v_option v_label v1 in () + | Break (t, v1) -> + let t = v_tok t in + let v1 = v_option v_label v1 in () + | Return (t, v1) -> + let t = v_tok t in + let v1 = v_expr v1 in () | Label ((v1, v2)) -> let v1 = v_label v1 and v2 = v_stmt v2 in () - | Throw v1 -> let v1 = v_expr v1 in () - | Try ((v1, v2, v3)) -> + | Throw (t, v1) -> + let t = v_tok t in + let v1 = v_expr v1 in () + | Try ((t, v1, v2, v3)) -> + let t = v_tok t in let v1 = v_stmt v1 and v2 = v_option @@ -175,8 +195,12 @@ and v_for_header = and v_case = function - | Case ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_stmt v2 in () - | Default v1 -> let v1 = v_stmt v1 in () + | Case ((t, v1, v2)) -> + let t = v_tok t in + let v1 = v_expr v1 and v2 = v_stmt v2 in () + | Default (t, v1) -> + let t = v_tok t in + let v1 = v_stmt v1 in () and v_resolved_name _ = () @@ -206,7 +230,7 @@ and v_parameter x = and v_fun_prop = function | Get -> () | Set -> () | Generator -> () | Async -> () -and v_obj_ v = v_list v_property v +and v_obj_ v = v_bracket (v_list v_property) v and v_class_ { c_extends = v_c_extends; c_body = v_c_body } = let arg = v_option v_expr v_c_extends in let arg = v_list v_property v_c_body in () @@ -218,7 +242,7 @@ and v_property x = and v2 = v_list (v_wrap v_property_prop) v2 and v3 = v_expr v3 in () - | FieldSpread v1 -> let v1 = v_expr v1 in () + | FieldSpread (t, v1) -> let t = v_tok t in let v1 = v_expr v1 in () in vin.kprop (k, all_functions) x @@ -236,13 +260,15 @@ and v_toplevel x = and v_module_directive x = match x with - | Import ((v1, v2, v3)) -> + | Import ((t, v1, v2, v3)) -> + let t = v_tok t in let v1 = v_name v1 and v2 = v_name v2 and v3 = v_filename v3 in () | ImportCss ((v1)) -> let v1 = v_name v1 in () | ImportEffect ((v1)) -> let v1 = v_name v1 in () - | ModuleAlias ((v1, v2)) -> + | ModuleAlias ((t, v1, v2)) -> + let t = v_tok t in let v1 = v_name v1 and v2 = v_filename v2 in () | Export ((v1)) -> let v1 = v_name v1 in () diff --git a/lang_ml/analyze/ast_ml.ml b/lang_ml/analyze/ast_ml.ml index 64ef97acf..2b057de9e 100644 --- a/lang_ml/analyze/ast_ml.ml +++ b/lang_ml/analyze/ast_ml.ml @@ -36,6 +36,10 @@ type tok = Parse_info.t type 'a wrap = 'a * tok (* with tarzan *) +(* round(), square[], curly{}, angle<> brackets *) +type 'a bracket = tok * 'a * tok + (* with tarzan *) + (* ------------------------------------------------------------------------- *) (* Names *) (* ------------------------------------------------------------------------- *) @@ -74,7 +78,7 @@ type expr = | Constructor of name * expr option (* special case of Constr *) | Tuple of expr list - | List of expr list + | List of expr list bracket (* can be empty *) | Sequence of expr list @@ -92,7 +96,7 @@ type expr = | FieldAccess of expr * tok * name | FieldAssign of expr * tok * name * tok (* <- *) * expr - | Record of expr option (* with *) * (name * expr) list + | Record of expr option (* with *) * (name * expr) list bracket | New of tok * name | ObjAccess of expr * tok (* # *) * ident @@ -105,13 +109,13 @@ type expr = (* statement-like expressions *) | Nop (* for empty else *) - | If of expr * expr * expr + | If of tok * expr * expr * expr | Match of expr * match_case list - | Try of expr * match_case list + | Try of tok * expr * match_case list - | While of expr * expr - | For of ident * expr * for_direction * expr * expr + | While of tok * expr * expr + | For of tok * ident * expr * for_direction * expr * expr and literal = | Int of string wrap diff --git a/lang_ml/analyze/ast_ml_build.ml b/lang_ml/analyze/ast_ml_build.ml index 5e15f0e41..d236e99d8 100644 --- a/lang_ml/analyze/ast_ml_build.ml +++ b/lang_ml/analyze/ast_ml_build.ml @@ -35,6 +35,7 @@ let xxx_list of_a xs = let v_paren of_a (_, x, _) = of_a x let v_brace = v_paren let v_bracket = v_paren +let v_bracket_keep of_a (t1, x, t2) = (t1, of_a x, t2) let v_star_list = xxx_list let v_pipe_list = xxx_list @@ -148,7 +149,8 @@ and v_expr v = let v1 = v_long_name v1 and v2 = Common.map_opt v_expr v2 in A.Constructor (v1, v2) | Tuple v1 -> let v1 = v_comma_list v_expr v1 in A.Tuple v1 - | List v1 -> let v1 = v_bracket (v_semicolon_list v_expr) v1 in A.List v1 + | List v1 -> let v1 = v_bracket_keep (v_semicolon_list v_expr) v1 in + A.List v1 | ParenExpr v1 -> let v1 = v_paren v_expr v1 in v1 | Sequence v1 -> let v1 = v_paren v_seq_expr v1 in A.Sequence v1 | Prefix ((v1, v2)) -> @@ -180,7 +182,7 @@ and v_expr v = and v5 = v_expr v5 in A.FieldAssign (v1, v2, v3, v4, v5) - | Record v1 -> let (a,b) = v_brace v_record_expr v1 in + | Record v1 -> let (a,b) = v_record_expr v1 in A.Record (a,b) | ObjAccess ((v1, v2, v3)) -> let v1 = v_expr v1 and v2 = v_tok v2 and v3 = v_name v3 in @@ -204,7 +206,7 @@ and v_expr v = let _v1 = v_tok v1 and __v2 = v_pipe_list v_match_case v2 in raise Common.Todo | If ((v1, v2, v3, v4, v5)) -> - let _v1 = v_tok v1 + let v1 = v_tok v1 and v2 = v_seq_expr1 v2 and _v3 = v_tok v3 and v4 = v_expr v4 @@ -212,7 +214,7 @@ and v_expr v = Common.map_opt (fun (v1, v2) -> let _v1 = v_tok v1 and v2 = v_expr v2 in v2) v5 in - A.If (v2, v4, v5 |> opt_to_nop) + A.If (v1, v2, v4, v5 |> opt_to_nop) | Match ((v1, v2, v3, v4)) -> let _v1 = v_tok v1 and v2 = v_seq_expr1 v2 @@ -221,22 +223,22 @@ and v_expr v = in A.Match (v2, v4) | Try ((v1, v2, v3, v4)) -> - let _v1 = v_tok v1 + let v1 = v_tok v1 and v2 = v_seq_expr1 v2 and _v3 = v_tok v3 and v4 = v_pipe_list v_match_case v4 in - A.Try (v2, v4) + A.Try (v1, v2, v4) | While ((v1, v2, v3, v4, v5)) -> - let _v1 = v_tok v1 + let v1 = v_tok v1 and v2 = v_seq_expr1 v2 and _v3 = v_tok v3 and v4 = v_seq_expr1 v4 and _v5 = v_tok v5 in - A.While (v2, v4) + A.While (v1, v2, v4) | For ((v1, v2, v3, v4, v5, v6, v7, v8, v9)) -> - let _v1 = v_tok v1 + let v1 = v_tok v1 and v2 = v_name v2 and _v3 = v_tok v3 and v4 = v_seq_expr1 v4 @@ -246,7 +248,7 @@ and v_expr v = and v8 = v_seq_expr1 v8 and _v9 = v_tok v9 in - A.For (v2, v4, v5, v6, v8) + A.For (v1, v2, v4, v5, v6, v8) | ExprTodo -> failwith "ExprTodo" @@ -257,14 +259,16 @@ and v_constant = | Char v1 -> let v1 = v_wrap v_string v1 in A.Char v1 | String v1 -> let v1 = v_wrap v_string v1 in A.String v1 -and v_record_expr = - function - | RecordNormal v1 -> let v1 = v_semicolon_list v_field_and_expr v1 in - None, v1 +and v_record_expr (t1, x, t2) = + match x with + | RecordNormal v1 -> + let v1 = v_bracket_keep (v_semicolon_list v_field_and_expr) (t1, v1, t2) + in + None, v1 | RecordWith ((v1, v2, v3)) -> let v1 = v_expr v1 and _v2 = v_tok v2 - and v3 = v_semicolon_list v_field_and_expr v3 + and v3 = v_bracket_keep (v_semicolon_list v_field_and_expr) (t1, v3, t2) in Some v1, v3 diff --git a/lang_ml/analyze/ml_to_generic.ml b/lang_ml/analyze/ml_to_generic.ml index 5021363a9..f283bfa92 100644 --- a/lang_ml/analyze/ml_to_generic.ml +++ b/lang_ml/analyze/ml_to_generic.ml @@ -51,6 +51,8 @@ let wrap = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = info v2 in (v1, v2) +let bracket of_a (t1, x, t2) = (info t1, of_a x, info t2) + let rec ident v = wrap string v and name (v1, v2) = @@ -77,7 +79,7 @@ and expr = let v1 = name v1 and v2 = option expr v2 in G.Constructor (v1, Common.opt_to_list v2) | Tuple v1 -> let v1 = list expr v1 in G.Tuple v1 - | List v1 -> let v1 = list expr v1 in G.Container (G.List, v1) + | List v1 -> let v1 = bracket (list expr) v1 in G.Container (G.List, v1) | Sequence v1 -> let v1 = list expr v1 in G.Seq v1 | Prefix ((v1, v2)) -> let v1 = wrap string v1 and v2 = expr v2 in let n = v1, G.empty_name_info in @@ -90,11 +92,11 @@ and expr = | Call ((v1, v2)) -> let v1 = expr v1 and v2 = list argument v2 in G.Call (v1, v2) | RefAccess ((v1, v2)) -> - let _v1 = tok v1 and v2 = expr v2 in - G.DeRef (v2) + let v1 = tok v1 and v2 = expr v2 in + G.DeRef (v1, v2) | RefAssign ((v1, v2, v3)) -> let v1 = expr v1 and v2 = tok v2 and v3 = expr v3 in - G.Assign (G.DeRef v1, v2, v3) + G.Assign (G.DeRef (v2, v1), v2, v3) | FieldAccess ((v1, vtok, v2)) -> let v1 = expr v1 in let vtok = tok vtok in @@ -118,7 +120,7 @@ and expr = | Record ((v1, v2)) -> let v1 = option expr v1 and v2 = - list (fun (v1, v2) -> let v2 = expr v2 in + bracket (list (fun (v1, v2) -> let v2 = expr v2 in (match v1 with | [], id -> let id = ident id in let ent = G.basic_entity id [] in @@ -129,7 +131,7 @@ and expr = let st = G.ExprStmt e in G.FieldStmt (st) ) - ) + )) v2 in let obj = G.Record v2 in @@ -157,24 +159,24 @@ and expr = G.Lambda def | Nop -> G.Nop - | If ((v1, v2, v3)) -> + | If ((_t, v1, v2, v3)) -> let v1 = expr v1 and v2 = expr v2 and v3 = expr v3 in G.Conditional (v1, v2, v3) | Match ((v1, v2)) -> let v1 = expr v1 and v2 = list match_case v2 in G.MatchPattern (v1, v2) - | Try ((v1, v2)) -> + | Try ((t, v1, v2)) -> let v1 = expr v1 and v2 = list match_case v2 in let catches = v2 |> List.map (fun (pat, e) -> pat, G.ExprStmt e) in - let st = G.Try (G.ExprStmt v1, catches, None) in + let st = G.Try (t, G.ExprStmt v1, catches, None) in G.OtherExpr (G.OE_StmtExpr, [G.S st]) - | While ((v1, v2)) -> + | While ((t, v1, v2)) -> let v1 = expr v1 and v2 = expr v2 in - let st = G.While (v1, G.ExprStmt v2) in + let st = G.While (t, v1, G.ExprStmt v2) in G.OtherExpr (G.OE_StmtExpr, [G.S st]) - | For ((v1, v2, v3, v4, v5)) -> + | For ((t, v1, v2, v3, v4, v5)) -> let v1 = ident v1 and v2 = expr v2 and (tok, nextop, condop) = for_direction v3 @@ -189,7 +191,7 @@ and expr = [G.Arg n; G.Arg v4]) in let header = G.ForClassic ([G.ForInitVar (ent, var)], cond, next) in - let st = G.For (header, G.ExprStmt v5) in + let st = G.For (t, header, G.ExprStmt v5) in G.OtherExpr (G.OE_StmtExpr, [G.S st]) and literal = diff --git a/lang_python/analyze/highlight_python.ml b/lang_python/analyze/highlight_python.ml index 3d79881ec..39b70e25e 100644 --- a/lang_python/analyze/highlight_python.ml +++ b/lang_python/analyze/highlight_python.ml @@ -201,7 +201,7 @@ let visit_program ~tag_hook _prefs (program, toks) = tag_name name (Entity (kind, def2)); Common.save_excursion in_class true (fun () -> k x); - | ImportAs ((dotted_name, _dotsTODO), asname_opt) -> + | ImportAs (_, (dotted_name, _dotsTODO), asname_opt) -> let kind = E.Module in dotted_name |> List.iter (fun name -> tag_name name (Entity (kind, use2)); @@ -211,7 +211,7 @@ let visit_program ~tag_hook _prefs (program, toks) = ); k x - | ImportFrom ((dotted_name, _dotsTODO), aliases) -> + | ImportFrom (_, (dotted_name, _dotsTODO), aliases) -> let kind = E.Module in dotted_name |> List.iter (fun name -> tag_name name (Entity (kind, use2)); @@ -225,7 +225,7 @@ let visit_program ~tag_hook _prefs (program, toks) = ); k x - | With (_e, eopt, _stmts) -> + | With (_, _e, eopt, _stmts) -> eopt |> Common.do_option (fun e -> match e with | Name (name, _ctx, _res) -> @@ -234,7 +234,7 @@ let visit_program ~tag_hook _prefs (program, toks) = | _ -> () ); k x - | TryExcept (_stmts1, excepts, _stmts2) -> + | TryExcept (_, _stmts1, excepts, _stmts2) -> excepts |> List.iter (fun (ExceptHandler (_typ, e, _)) -> match e with | None -> () diff --git a/lang_python/analyze/python_to_generic.ml b/lang_python/analyze/python_to_generic.ml index 67955192d..a13fd6237 100644 --- a/lang_python/analyze/python_to_generic.ml +++ b/lang_python/analyze/python_to_generic.ml @@ -37,6 +37,7 @@ let string = id let bool = id let fake s = Parse_info.fake_info s +let fake_bracket x = fake "(", x, fake ")" (*****************************************************************************) (* Entry point *) @@ -48,6 +49,8 @@ let wrap = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = info v2 in (v1, v2) +let bracket of_a (t1, x, t2) = (info t1, of_a x, info t2) + let name v = wrap string v let dotted_name v = list name v @@ -114,7 +117,7 @@ let rec expr (x: expr) = id_resolved = v3 }) | Tuple ((CompList v1, v2)) -> - let v1 = list expr v1 + let (_, v1, _) = bracket (list expr) v1 and _v2TODO = expr_context v2 in G.Tuple v1 @@ -124,14 +127,14 @@ let rec expr (x: expr) = G.Tuple e1 | List ((CompList v1, v2)) -> - let v1 = list expr v1 + let v1 = bracket (list expr) v1 and _v2TODO = expr_context v2 in G.Container (G.List, v1) | List ((CompForIf (v1, v2), v3)) -> let e1 = comprehension expr v1 v2 in let _v3TODO = expr_context v3 in - G.Container (G.List, e1) + G.Container (G.List, fake_bracket e1) | Subscript ((v1, v2, v3)) -> let e = expr v1 @@ -160,13 +163,13 @@ let rec expr (x: expr) = G.DotAccess (v1, t, v2) | DictOrSet (CompList v) -> - let v = list dictorset_elt v in + let v = bracket (list dictorset_elt) v in (* less: could be a Set if alls are Key *) G.Container (G.Dict, v) | DictOrSet (CompForIf (v1, v2)) -> let e1 = comprehension2 dictorset_elt v1 v2 in - G.Container (G.Dict, e1) + G.Container (G.Dict, fake_bracket e1) | BoolOp (((v1,tok), v2)) -> let v1 = boolop v1 @@ -208,13 +211,13 @@ let rec expr (x: expr) = | IfExp ((v1, v2, v3)) -> let v1 = expr v1 and v2 = expr v2 and v3 = expr v3 in G.Conditional (v1, v2, v3) - | Yield ((v1, v2)) -> + | Yield ((t, v1, v2)) -> let v1 = option expr v1 and v2 = v2 in - G.Yield (G.opt_to_nop v1, v2) - | Await v1 -> let v1 = expr v1 in - G.Await v1 - | Repr v1 -> let v1 = expr v1 in + G.Yield (t, v1, v2) + | Await (t, v1) -> let v1 = expr v1 in + G.Await (t, v1) + | Repr v1 -> let (_, v1, _) = bracket expr v1 in G.OtherExpr (G.OE_Repr, [G.E v1]) and argument = function @@ -389,31 +392,31 @@ and stmt x = | AugAssign ((v1, (v2, tok), v3)) -> let v1 = expr v1 and v2 = operator v2 and v3 = expr v3 in G.ExprStmt (G.AssignOp (v1, (v2, tok), v3)) - | Return v1 -> let v1 = option expr v1 in - G.Return v1 + | Return (t, v1) -> let v1 = option expr v1 in + G.Return (t, v1) - | Delete v1 -> let v1 = list expr v1 in + | Delete (_t, v1) -> let v1 = list expr v1 in G.OtherStmt (G.OS_Delete, v1 |> List.map (fun x -> G.E x)) - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> let v1 = expr v1 and v2 = list_stmt1 v2 and v3 = list_stmt1 v3 in - G.If (v1, v2, v3) + G.If (t, v1, v2, v3) - | While ((v1, v2, v3)) -> + | While ((t, v1, v2, v3)) -> let v1 = expr v1 and v2 = list_stmt1 v2 and v3 = list stmt v3 in (match v3 with - | [] -> G.While (v1, v2) + | [] -> G.While (t, v1, v2) | _ -> G.Block [ - G.While (v1,v2); + G.While (t, v1,v2); G.OtherStmt (G.OS_WhileOrElse, v3 |> List.map (fun x -> G.S x))] ) - | For ((v1, v2, v3, v4)) -> + | For ((t, v1, v2, v3, v4)) -> let foreach = expr v1 and ins = expr v2 and body = list_stmt1 v3 @@ -421,12 +424,13 @@ and stmt x = in let header = G.ForEach (G.expr_to_pattern foreach, ins) in (match orelse with - | [] -> G.For (header, body) + | [] -> G.For (t, header, body) | _ -> G.Block [ - G.For (header, body); + G.For (t, header, body); G.OtherStmt (G.OS_ForOrElse, orelse|> List.map (fun x -> G.S x))] ) - | With ((v1, v2, v3)) -> + (* TODO: unsugar in sequence? *) + | With ((_t, v1, v2, v3)) -> let v1 = expr v1 and v2 = option expr v2 and v3 = list_stmt1 v3 @@ -438,72 +442,72 @@ and stmt x = in G.OtherStmtWithStmt (G.OSWS_With, e, v3) - | Raise (v1) -> + | Raise (t, v1) -> (match v1 with | Some (e, None) -> - let e = expr e in G.Throw e + let e = expr e in G.Throw (t, e) | Some (e, Some from) -> let e = expr e in let from = expr from in - let st = G.Throw e in + let st = G.Throw (t, e) in G.OtherStmt (G.OS_ThrowFrom, [G.E from; G.S st]) | None -> G.OtherStmt (G.OS_ThrowNothing, []) ) - | TryExcept ((v1, v2, v3)) -> + | TryExcept ((t, v1, v2, v3)) -> let v1 = list_stmt1 v1 and v2 = list excepthandler v2 and orelse = list stmt v3 in (match orelse with - | [] -> G.Try (v1, v2, None) + | [] -> G.Try (t, v1, v2, None) | _ -> G.Block [ - G.Try (v1, v2, None); + G.Try (t, v1, v2, None); G.OtherStmt (G.OS_TryOrElse, orelse |> List.map (fun x -> G.S x)) ] ) - | TryFinally ((v1, v2)) -> + | TryFinally ((t, v1, v2)) -> let v1 = list_stmt1 v1 and v2 = list_stmt1 v2 in (* could lift down the Try in v1 *) - G.Try (v1, [], Some v2) + G.Try (t, v1, [], Some v2) - | Assert ((v1, v2)) -> let v1 = expr v1 and v2 = option expr v2 in - G.Assert (v1, v2) + | Assert ((t, v1, v2)) -> let v1 = expr v1 and v2 = option expr v2 in + G.Assert (t, v1, v2) - | ImportAs ((v1, _dotsAlwaysNone), v2) -> + | ImportAs (t, (v1, _dotsAlwaysNone), v2) -> let dotted = dotted_name v1 and nopt = option name v2 in - G.DirectiveStmt (G.ImportAs (G.DottedName dotted, nopt)) - | ImportAll ((v1, _dotsAlwaysNone), v2) -> + G.DirectiveStmt (G.ImportAs (t, G.DottedName dotted, nopt)) + | ImportAll (t, (v1, _dotsAlwaysNone), v2) -> let dotted = dotted_name v1 and v2 = info v2 in - G.DirectiveStmt (G.ImportAll (G.DottedName dotted, v2)) + G.DirectiveStmt (G.ImportAll (t, G.DottedName dotted, v2)) - | ImportFrom (((v1, _dotsTODO), v2)) -> + | ImportFrom (t, (v1, _dotsTODO), v2) -> let v1 = dotted_name v1 and v2 = list alias v2 in - G.DirectiveStmt (G.ImportFrom (G.DottedName v1, v2)) + G.DirectiveStmt (G.ImportFrom (t, G.DottedName v1, v2)) - | Global v1 -> let v1 = list name v1 in + | Global (_t, v1) -> let v1 = list name v1 in G.OtherStmt (G.OS_Global, v1 |> List.map (fun x -> G.Id x)) - | NonLocal v1 -> let v1 = list name v1 in + | NonLocal (_t, v1) -> let v1 = list name v1 in G.OtherStmt (G.OS_NonLocal, v1 |> List.map (fun x -> G.Id x)) | ExprStmt v1 -> let v1 = expr v1 in G.ExprStmt v1 - | Async x -> + | Async (t, x) -> let x = stmt x in (match x with | G.DefStmt (ent, func) -> - G.DefStmt ({ ent with G.attrs = (G.attr G.Async (fake "async")) + G.DefStmt ({ ent with G.attrs = (G.attr G.Async t) ::ent.G.attrs}, func) | _ -> G.OtherStmt (G.OS_Async, [G.S x]) ) - | Pass -> G.OtherStmt (G.OS_Pass, []) - | Break -> G.Break (None) - | Continue -> G.Continue (None) + | Pass _t -> G.OtherStmt (G.OS_Pass, []) + | Break t -> G.Break (t, None) + | Continue t -> G.Continue (t, None) (* python2: *) | Print (tok, _dest, vals, _nl) -> diff --git a/lang_python/analyze/resolve_python.ml b/lang_python/analyze/resolve_python.ml index 960159819..a7a2d1a72 100644 --- a/lang_python/analyze/resolve_python.ml +++ b/lang_python/analyze/resolve_python.ml @@ -181,13 +181,13 @@ let resolve prog = k x ) - | ImportAs ((dotted_name, _dotsTODO), asname_opt) -> + | ImportAs (_, (dotted_name, _dotsTODO), asname_opt) -> asname_opt |> Common.do_option (fun asname -> env |> add_name_env asname (ImportedModule dotted_name) ); k x - | ImportFrom ((dotted_name, _dotsTODO), aliases) -> + | ImportFrom (_, (dotted_name, _dotsTODO), aliases) -> aliases |> List.iter (fun (name, asname_opt) -> let entity = dotted_name @ [name] in (match asname_opt with @@ -198,7 +198,7 @@ let resolve prog = ); ); k x - | With (e, eopt, stmts) -> + | With (_, e, eopt, stmts) -> v (Expr e); (match eopt with | None -> v (Stmts stmts) @@ -218,7 +218,7 @@ let resolve prog = v (Expr e); v (Stmts stmts) ) - | TryExcept (stmts1, excepts, stmts2) -> + | TryExcept (_, stmts1, excepts, stmts2) -> v (Stmts stmts1); excepts |> List.iter (fun (ExceptHandler (_typ, e, body)) -> match e with @@ -235,7 +235,7 @@ let resolve prog = ); v (Stmts stmts2); - | Global names -> + | Global (_, names) -> names |> List.iter (fun name -> env |> add_name_env name GlobalVar;) (* TODO: NonLocal!! *) diff --git a/lang_python/parsing/ast_python.ml b/lang_python/parsing/ast_python.ml index 72b402c15..26a214b31 100644 --- a/lang_python/parsing/ast_python.ml +++ b/lang_python/parsing/ast_python.ml @@ -73,6 +73,10 @@ type tok = Parse_info.t type 'a wrap = 'a * tok (* with tarzan *) +(* round(), square[], curly{}, angle<> brackets *) +type 'a bracket = tok * 'a * tok + (* with tarzan *) + (* ------------------------------------------------------------------------- *) (* Name *) (* ------------------------------------------------------------------------- *) @@ -116,8 +120,8 @@ type expr = (* introduce new vars when expr_context = Store *) | Name of name (* id *) * expr_context (* ctx *) * resolved_name ref - | Tuple of expr list_or_comprehension (* elts *) * expr_context (* ctx *) - | List of expr list_or_comprehension (* elts *) * expr_context (* ctx *) + | Tuple of expr list_or_comprehension * expr_context + | List of expr list_or_comprehension * expr_context | DictOrSet of dictorset_elt list_or_comprehension (* python3: *) @@ -147,11 +151,11 @@ type expr = | IfExp of expr (* test *) * expr (* body *) * expr (* orelse *) - | Yield of expr option (* value *) * bool (* is_yield_from *) + | Yield of tok * expr option (* value *) * bool (* is_yield_from *) (* python3: *) - | Await of expr + | Await of tok * expr - | Repr of expr (* value *) + | Repr of expr bracket (* `` *) (* =~ ObjAccess *) | Attribute of expr (* value *) * tok (* . *) * name (* attr *) * expr_context (* ctx *) @@ -188,7 +192,7 @@ type expr = and interpolated = expr and 'a list_or_comprehension = - | CompList of 'a list + | CompList of 'a list bracket | CompForIf of 'a comprehension and 'a comprehension = 'a * for_if list @@ -272,37 +276,42 @@ type stmt = | Assign of expr list (* targets *) * tok * expr (* value *) | AugAssign of expr (* target *) * operator wrap (* op *) * expr (* value *) - | For of pattern (* (pattern) introduce new vars *) * expr (* 'in' iter *) * + | For of tok * pattern (* (pattern) introduce new vars *) * + expr (* 'in' iter *) * stmt list (* body *) * stmt list (* orelse *) - | While of expr (* test *) * stmt list (* body *) * stmt list (* orelse *) - | If of expr (* test *) * stmt list (* body *) * stmt list (* orelse *) + | While of tok * expr (* test *) * stmt list (* body *) * + stmt list (* orelse *) + | If of tok * expr (* test *) * stmt list (* body *) * + stmt list (* orelse *) (* https://docs.python.org/2.5/whatsnew/pep-343.html *) - | With of expr (* context_expr *) * expr option (* optional_vars *) * stmt list (* body *) + | With of tok * expr (* context_expr *) * expr option (* optional_vars *) * + stmt list (* body *) - | Return of expr option (* value *) - | Break | Continue - | Pass + | Return of tok * expr option (* value *) + | Break of tok | Continue of tok + | Pass of tok - | Raise of (expr * expr option (* from *)) option - | TryExcept of stmt list (* body *) * excepthandler list (* handlers *) * stmt list (* orelse *) - | TryFinally of stmt list (* body *) * stmt list (* finalbody *) - | Assert of expr (* test *) * expr option (* msg *) + | Raise of tok * (expr * expr option (* from *)) option + | TryExcept of tok * stmt list (* body *) * excepthandler list (* handlers *) + * stmt list (* orelse *) + | TryFinally of tok * stmt list (* body *) * stmt list (* finalbody *) + | Assert of tok * expr (* test *) * expr option (* msg *) - | Global of name list (* names *) - | Delete of expr list (* targets *) + | Global of tok * name list (* names *) + | Delete of tok * expr list (* targets *) (* python3: *) - | NonLocal of name list (* names *) + | NonLocal of tok * name list (* names *) (* python2: *) | Print of tok * expr option (* dest *) * expr list (* values *) * bool (* nl *) | Exec of tok * expr (* body *) * expr option (* glob *) * expr option (* local *) (* python3: for With, For, and FunctionDef *) - | Async of stmt + | Async of tok * stmt - | ImportAs of module_name (* name *) * name option (* asname *) - | ImportAll of module_name * tok (* * *) - | ImportFrom of module_name (* module *) * alias list (* names *) + | ImportAs of tok * module_name (* name *) * name option (* asname *) + | ImportAll of tok * module_name * tok (* * *) + | ImportFrom of tok * module_name (* module *) * alias list (* names *) (* should be allowed just at the toplevel *) | FunctionDef of diff --git a/lang_python/parsing/meta_ast_python.ml b/lang_python/parsing/meta_ast_python.ml index d7a014662..cae793f7a 100644 --- a/lang_python/parsing/meta_ast_python.ml +++ b/lang_python/parsing/meta_ast_python.ml @@ -6,6 +6,9 @@ let vof_tok v = Meta_parse_info.vof_info_adjustable_precision v let vof_wrap _of_a (v1, v2) = let v1 = _of_a v1 and v2 = vof_tok v2 in Ocaml.VTuple [ v1; v2 ] + +let vof_bracket of_a (_t1, x, _t2) = + of_a x let vof_name v = vof_wrap Ocaml.vof_string v @@ -98,12 +101,16 @@ let rec vof_expr = and v2 = vof_expr v2 and v3 = vof_expr v3 in Ocaml.VSum (("IfExp", [ v1; v2; v3 ])) - | Yield ((v1, v2)) -> + | Yield ((t, v1, v2)) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_expr v1 and v2 = Ocaml.vof_bool v2 - in Ocaml.VSum (("Yield", [ v1; v2 ])) - | Await v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Await", [ v1 ])) - | Repr v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Repr", [ v1 ])) + in Ocaml.VSum (("Yield", [ t; v1; v2 ])) + | Await (t, v1) -> + let t = vof_tok t in + let v1 = vof_expr v1 in Ocaml.VSum (("Await", [ t; v1 ])) + | Repr (v1) -> + let v1 = vof_bracket vof_expr v1 in Ocaml.VSum (("Repr", [ v1 ])) | Attribute ((v1, t, v2, v3)) -> let v1 = vof_expr v1 and t = vof_tok t @@ -160,14 +167,16 @@ and vof_cmpop = and vof_list_or_comprehension _of_a = function | CompList v1 -> - let v1 = Ocaml.vof_list _of_a v1 in Ocaml.VSum (("CompList", [ v1 ])) + let v1 = vof_bracket (Ocaml.vof_list _of_a) v1 in + Ocaml.VSum (("CompList", [ v1 ])) | CompForIf v1 -> let v1 = vof_comprehension _of_a v1 in Ocaml.VSum (("CompForIf", [ v1 ])) and vof_list_or_comprehension2 _of_a = function | CompList v1 -> - let v1 = Ocaml.vof_list _of_a v1 in Ocaml.VSum (("CompList", [ v1 ])) + let v1 = vof_bracket (Ocaml.vof_list _of_a) v1 in + Ocaml.VSum (("CompList", [ v1 ])) | CompForIf v1 -> let v1 = vof_comprehension2 _of_a v1 in Ocaml.VSum (("CompForIf", [ v1 ])) @@ -274,34 +283,46 @@ let rec vof_stmt = and v2 = vof_wrap vof_operator v2 and v3 = vof_expr v3 in Ocaml.VSum (("AugAssign", [ v1; v2; v3 ])) - | For ((v1, v2, v3, v4)) -> + | For ((t, v1, v2, v3, v4)) -> + let t = vof_tok t in let v1 = vof_pattern v1 and v2 = vof_expr v2 and v3 = Ocaml.vof_list vof_stmt v3 and v4 = Ocaml.vof_list vof_stmt v4 - in Ocaml.VSum (("For", [ v1; v2; v3; v4 ])) - | While ((v1, v2, v3)) -> + in Ocaml.VSum (("For", [ t; v1; v2; v3; v4 ])) + | While ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = Ocaml.vof_list vof_stmt v2 and v3 = Ocaml.vof_list vof_stmt v3 - in Ocaml.VSum (("While", [ v1; v2; v3 ])) - | If ((v1, v2, v3)) -> + in Ocaml.VSum (("While", [ t; v1; v2; v3 ])) + | If ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = Ocaml.vof_list vof_stmt v2 and v3 = Ocaml.vof_list vof_stmt v3 - in Ocaml.VSum (("If", [ v1; v2; v3 ])) - | With ((v1, v2, v3)) -> + in Ocaml.VSum (("If", [ t; v1; v2; v3 ])) + | With ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = Ocaml.vof_option vof_expr v2 and v3 = Ocaml.vof_list vof_stmt v3 - in Ocaml.VSum (("With", [ v1; v2; v3 ])) - | Return v1 -> + in Ocaml.VSum (("With", [ t; v1; v2; v3 ])) + | Return (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_option vof_expr v1 - in Ocaml.VSum (("Return", [ v1 ])) - | Break -> Ocaml.VSum (("Break", [])) - | Continue -> Ocaml.VSum (("Continue", [])) - | Pass -> Ocaml.VSum (("Pass", [])) - | Raise v1 -> + in Ocaml.VSum (("Return", [ t; v1 ])) + | Break t -> + let t = vof_tok t in + Ocaml.VSum (("Break", [t])) + | Continue t -> + let t = vof_tok t in + Ocaml.VSum (("Continue", [t])) + | Pass t -> + let t = vof_tok t in + Ocaml.VSum (("Pass", [t])) + | Raise (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_option (fun (v1, v2) -> @@ -309,39 +330,51 @@ let rec vof_stmt = and v2 = Ocaml.vof_option vof_expr v2 in Ocaml.VTuple [ v1; v2 ]) v1 - in Ocaml.VSum (("Raise", [ v1 ])) - | TryExcept ((v1, v2, v3)) -> + in Ocaml.VSum (("Raise", [ t; v1 ])) + | TryExcept ((t, v1, v2, v3)) -> + let t = vof_tok t in let v1 = Ocaml.vof_list vof_stmt v1 and v2 = Ocaml.vof_list vof_excepthandler v2 and v3 = Ocaml.vof_list vof_stmt v3 - in Ocaml.VSum (("TryExcept", [ v1; v2; v3 ])) - | TryFinally ((v1, v2)) -> + in Ocaml.VSum (("TryExcept", [ t; v1; v2; v3 ])) + | TryFinally ((t, v1, v2)) -> + let t = vof_tok t in let v1 = Ocaml.vof_list vof_stmt v1 and v2 = Ocaml.vof_list vof_stmt v2 - in Ocaml.VSum (("TryFinally", [ v1; v2 ])) - | Assert ((v1, v2)) -> + in Ocaml.VSum (("TryFinally", [ t; v1; v2 ])) + | Assert ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_expr v1 and v2 = Ocaml.vof_option vof_expr v2 - in Ocaml.VSum (("Assert", [ v1; v2 ])) - | Global v1 -> - let v1 = Ocaml.vof_list vof_name v1 in Ocaml.VSum (("Global", [ v1 ])) - | Delete v1 -> - let v1 = Ocaml.vof_list vof_expr v1 in Ocaml.VSum (("Delete", [ v1 ])) - | NonLocal v1 -> + in Ocaml.VSum (("Assert", [ t; v1; v2 ])) + | Global (t, v1) -> + let t = vof_tok t in + let v1 = Ocaml.vof_list vof_name v1 in Ocaml.VSum (("Global", [ t; v1 ])) + | Delete (t, v1) -> + let t = vof_tok t in + let v1 = Ocaml.vof_list vof_expr v1 in Ocaml.VSum (("Delete", [ t; v1 ])) + | NonLocal (t, v1) -> + let t = vof_tok t in let v1 = Ocaml.vof_list vof_name v1 - in Ocaml.VSum (("NonLocal", [ v1 ])) - | Async v1 -> let v1 = vof_stmt v1 in Ocaml.VSum (("Async", [ v1 ])) - | ImportAs (v1, v2) -> + in Ocaml.VSum (("NonLocal", [ t; v1 ])) + | Async (t, v1) -> + let t = vof_tok t in + let v1 = vof_stmt v1 in Ocaml.VSum (("Async", [ t; v1 ])) + | ImportAs (t, v1, v2) -> + let t = vof_tok t in let v1 = vof_alias_dotted (v1, v2) - in Ocaml.VSum (("ImportAs", [ v1 ])) - | ImportAll (v1, v2) -> + in Ocaml.VSum (("ImportAs", [ t; v1 ])) + | ImportAll (t, v1, v2) -> + let t = vof_tok t in let v1 = vof_module_name v1 and v2 = vof_tok v2 - in Ocaml.VSum (("ImportAll", [v1; v2])) - | ImportFrom ((v1, v2)) -> + in Ocaml.VSum (("ImportAll", [t; v1; v2])) + | ImportFrom ((t, v1, v2)) -> + let t = vof_tok t in let v1 = vof_module_name v1 and v2 = Ocaml.vof_list vof_alias v2 - in Ocaml.VSum (("ImportFrom", [ v1; v2 ])) + in Ocaml.VSum (("ImportFrom", [ t; v1; v2 ])) + | FunctionDef ((v1, v2, v3, v4, v5)) -> let v1 = vof_name v1 and v2 = vof_parameters v2 diff --git a/lang_python/parsing/parser_python.mly b/lang_python/parsing/parser_python.mly index b68839bbc..0d36cc85b 100644 --- a/lang_python/parsing/parser_python.mly +++ b/lang_python/parsing/parser_python.mly @@ -30,6 +30,9 @@ open Common open Ast_python +let fake s = Parse_info.fake_info s +let fake_bracket x = fake "(", x, fake ")" + (* intermediate helper type *) type single_or_tuple = | Single of expr @@ -41,7 +44,7 @@ let cons e = function let tuple_expr = function | Single e -> e - | Tup l -> Tuple (CompList l, Load) + | Tup l -> Tuple (CompList (fake_bracket l), Load) let to_list = function | Single e -> [e] @@ -58,10 +61,10 @@ let rec set_expr_ctx ctx = function | Subscript (value, slice, _) -> Subscript (value, slice, ctx) - | List (CompList elts, _) -> - List (CompList (List.map (set_expr_ctx ctx) elts), ctx) - | Tuple (CompList elts, _) -> - Tuple (CompList (List.map (set_expr_ctx ctx) elts), ctx) + | List (CompList (t1, elts, t2), _) -> + List (CompList ((t1, List.map (set_expr_ctx ctx) elts, t2)), ctx) + | Tuple (CompList (t1, elts, t2), _) -> + Tuple (CompList ((t1, List.map (set_expr_ctx ctx) elts, t2)), ctx) | e -> e @@ -220,7 +223,7 @@ import_stmt: import_name: IMPORT dotted_as_name_list { $2 |> List.map (fun (v1, v2) -> let dots = None in - ImportAs ((v1, dots), v2)) } + ImportAs ($1, (v1, dots), v2)) } dotted_as_name: | dotted_name { $1, None } @@ -233,11 +236,11 @@ dotted_name: import_from: | FROM name_and_level IMPORT MULT - { [ImportAll ($2, $4)] } + { [ImportAll ($1, $2, $4)] } | FROM name_and_level IMPORT LPAREN import_as_name_list RPAREN - { [ImportFrom ($2, $5)] } + { [ImportFrom ($1, $2, $5)] } | FROM name_and_level IMPORT import_as_name_list - { [ImportFrom ($2, $4)] } + { [ImportFrom ($1, $2, $4)] } name_and_level: | dotted_name { $1, None } @@ -436,9 +439,9 @@ exec_stmt: | EXEC expr IN test COMMA test { Exec ($1, $2, Some $4, Some $6) } -del_stmt: DEL exprlist { Delete (List.map expr_del (to_list $2)) } +del_stmt: DEL exprlist { Delete ($1, List.map expr_del (to_list $2)) } -pass_stmt: PASS { Pass } +pass_stmt: PASS { Pass $1 } flow_stmt: @@ -448,30 +451,30 @@ flow_stmt: | raise_stmt { $1 } | yield_stmt { $1 } -break_stmt: BREAK { Break } -continue_stmt: CONTINUE { Continue } +break_stmt: BREAK { Break $1 } +continue_stmt: CONTINUE { Continue $1 } return_stmt: - | RETURN { Return (None) } - | RETURN testlist { Return (Some (tuple_expr $2)) } + | RETURN { Return ($1, None) } + | RETURN testlist { Return ($1, Some (tuple_expr $2)) } yield_stmt: yield_expr { ExprStmt ($1) } raise_stmt: - | RAISE { Raise (None) } - | RAISE test { Raise (Some ($2, None)) } + | RAISE { Raise ($1, None) } + | RAISE test { Raise ($1, Some ($2, None)) } /*(* python3-ext: *)*/ - | RAISE test FROM test { Raise (Some ($2, Some $4)) } + | RAISE test FROM test { Raise ($1, Some ($2, Some $4)) } -global_stmt: GLOBAL name_list { Global ($2) } +global_stmt: GLOBAL name_list { Global ($1, $2) } /*(* python3-ext: *)*/ -nonlocal_stmt: NONLOCAL name_list { NonLocal $2 } +nonlocal_stmt: NONLOCAL name_list { NonLocal ($1, $2) } assert_stmt: - | ASSERT test { Assert ($2, None) } - | ASSERT test COMMA test { Assert ($2, Some $4) } + | ASSERT test { Assert ($1, $2, None) } + | ASSERT test COMMA test { Assert ($1, $2, Some $4) } @@ -513,37 +516,37 @@ suite: | NEWLINE INDENT stmt_list DEDENT { $3 } -if_stmt: IF test COLON suite elif_stmt_list { If ($2, $4, $5) } +if_stmt: IF test COLON suite elif_stmt_list { If ($1, $2, $4, $5) } elif_stmt_list: | /*(*empty *)*/ { [] } - | ELIF test COLON suite elif_stmt_list { [If ($2, $4, $5)] } + | ELIF test COLON suite elif_stmt_list { [If ($1, $2, $4, $5)] } | ELSE COLON suite { $3 } while_stmt: - | WHILE test COLON suite { While ($2, $4, []) } - | WHILE test COLON suite ELSE COLON suite { While ($2, $4, $7) } + | WHILE test COLON suite { While ($1, $2, $4, []) } + | WHILE test COLON suite ELSE COLON suite { While ($1, $2, $4, $7) } for_stmt: | FOR exprlist IN testlist COLON suite - { For (tuple_expr_store $2, tuple_expr $4, $6, []) } + { For ($1, tuple_expr_store $2, tuple_expr $4, $6, []) } | FOR exprlist IN testlist COLON suite ELSE COLON suite - { For (tuple_expr_store $2, tuple_expr $4, $6, $9) } + { For ($1, tuple_expr_store $2, tuple_expr $4, $6, $9) } try_stmt: | TRY COLON suite excepthandler_list - { TryExcept ($3, $4, []) } + { TryExcept ($1, $3, $4, []) } | TRY COLON suite excepthandler_list ELSE COLON suite - { TryExcept ($3, $4, $7) } + { TryExcept ($1, $3, $4, $7) } | TRY COLON suite excepthandler_list ELSE COLON suite FINALLY COLON suite - { TryFinally ([TryExcept ($3, $4, $7)], $10) } + { TryFinally ($1, [TryExcept ($1, $3, $4, $7)], $10) } | TRY COLON suite excepthandler_list FINALLY COLON suite - { TryFinally ([TryExcept ($3, $4, [])], $7) } + { TryFinally ($1, [TryExcept ($1, $3, $4, [])], $7) } | TRY COLON suite FINALLY COLON suite - { TryFinally ($3, $6) } + { TryFinally ($1, $3, $6) } excepthandler: | EXCEPT COLON suite { ExceptHandler (None, None, $3) } @@ -552,19 +555,19 @@ excepthandler: | EXCEPT test COMMA test COLON suite { ExceptHandler (Some $2, Some (expr_store $4), $6) } with_stmt: - | WITH with_inner { $2 } + | WITH with_inner { $2 $1 } with_inner: - | test COLON suite { With ($1, None, $3) } - | test AS expr COLON suite { With ($1, Some $3, $5) } - | test COMMA with_inner { With ($1, None, [$3]) } - | test AS expr COMMA with_inner { With ($1, Some $3, [$5]) } + | test COLON suite { fun t -> With (t, $1, None, $3) } + | test AS expr COLON suite { fun t -> With (t, $1, Some $3, $5) } + | test COMMA with_inner { fun t -> With (t, $1, None, [$3 t]) } + | test AS expr COMMA with_inner { fun t -> With (t, $1, Some $3, [$5 t]) } /*(* python3-ext: *)*/ async_stmt: - | ASYNC funcdef { Async $2 } - | ASYNC with_stmt { Async $2 } - | ASYNC for_stmt { Async $2 } + | ASYNC funcdef { Async ($1, $2) } + | ASYNC with_stmt { Async ($1, $2) } + | ASYNC for_stmt { Async ($1, $2) } /*(*************************************************************************)*/ /*(*1 Expressions *)*/ @@ -622,7 +625,7 @@ power: atom_expr: | atom_and_trailers { $1 } - | AWAIT atom_and_trailers { Await $2 } + | AWAIT atom_and_trailers { Await ($1, $2) } atom_and_trailers: | atom { $1 } @@ -672,7 +675,7 @@ atom: /*(* typing-ext: sgrep-ext: *)*/ | ELLIPSES { Ellipsis $1 } -atom_repr: BACKQUOTE testlist1 BACKQUOTE { Repr (tuple_expr $2) } +atom_repr: BACKQUOTE testlist1 BACKQUOTE { Repr ($1, tuple_expr $2, $3) } /*(*----------------------------*)*/ /*(*2 strings *)*/ @@ -712,21 +715,21 @@ format_token: /*(*----------------------------*)*/ atom_tuple: - | LPAREN RPAREN { Tuple (CompList [], Load) } + | LPAREN RPAREN { Tuple (CompList ($1, [], $2), Load) } | LPAREN testlist_comp RPAREN { Tuple ($2, Load) } | LPAREN yield_expr RPAREN { $2 } atom_list: - | LBRACK RBRACK { List (CompList [], Load) } + | LBRACK RBRACK { List (CompList ($1, [], $2), Load) } | LBRACK testlist_comp RBRACK { List ($2, Load) } atom_dict: - | LBRACE RBRACE { DictOrSet (CompList []) } - | LBRACE dictorsetmaker RBRACE { DictOrSet ($2) } + | LBRACE RBRACE { DictOrSet (CompList ($1, [], $2)) } + | LBRACE dictorsetmaker RBRACE { DictOrSet ($2 ($1, $3)) } dictorsetmaker: - | dictorset_elem comp_for { CompForIf ($1, $2) } - | dictorset_elem_list { CompList $1 } + | dictorset_elem comp_for { fun _ -> CompForIf ($1, $2) } + | dictorset_elem_list { fun (t1, t2) -> CompList (t1, $1, t2) } dictorset_elem: | test COLON test { KeyVal ($1, $3) } @@ -792,9 +795,9 @@ star_expr: MULT expr { ExprStar $2 } yield_expr: - | YIELD { Yield (None, false) } - | YIELD FROM test { Yield (Some $3, true) } - | YIELD testlist { Yield (Some (tuple_expr $2), false) } + | YIELD { Yield ($1, None, false) } + | YIELD FROM test { Yield ($1, Some $3, true) } + | YIELD testlist { Yield ($1, Some (tuple_expr $2), false) } lambdadef: LAMBDA varargslist COLON test { Lambda ($2, $4) } @@ -804,7 +807,7 @@ lambdadef: LAMBDA varargslist COLON test { Lambda ($2, $4) } testlist_comp: | test_or_star_expr comp_for { CompForIf ($1, $2) } - | testlist_star_expr { CompList (to_list $1) } + | testlist_star_expr { CompList (fake_bracket (to_list $1)) } comp_for: | sync_comp_for { $1 } diff --git a/lang_python/parsing/visitor_python.ml b/lang_python/parsing/visitor_python.ml index 80e8738ec..276b0f086 100644 --- a/lang_python/parsing/visitor_python.ml +++ b/lang_python/parsing/visitor_python.ml @@ -65,6 +65,10 @@ and v_tok v = v_info v and v_wrap: 'a. ('a -> unit) -> 'a wrap -> unit = fun _of_a (v1, v2) -> let v1 = _of_a v1 and v2 = v_info v2 in () +and v_bracket: 'a. ('a -> unit) -> 'a bracket -> unit = + fun of_a (v1, v2, v3) -> + let v1 = v_info v1 and v2 = of_a v2 and v3 = v_info v3 in () + and v_name v = v_wrap v_string v and v_dotted_name v = v_list v_name v @@ -126,9 +130,14 @@ and v_expr (x: expr) = | Lambda ((v1, v2)) -> let v1 = v_parameters v1 and v2 = v_expr v2 in () | IfExp ((v1, v2, v3)) -> let v1 = v_expr v1 and v2 = v_expr v2 and v3 = v_expr v3 in () - | Yield ((v1, v2)) -> let v1 = v_option v_expr v1 and v2 = v_bool v2 in () - | Await v1 -> let v1 = v_expr v1 in () - | Repr v1 -> let v1 = v_expr v1 in () + | Yield ((t, v1, v2)) -> + let t = v_info t in + let v1 = v_option v_expr v1 and v2 = v_bool v2 in () + | Await (t, v1) -> + let t = v_info t in + let v1 = v_expr v1 in () + | Repr (v1) -> + let v1 = v_bracket v_expr v1 in () | Attribute ((v1, t, v2, v3)) -> let v1 = v_expr v1 and t = v_tok t and v2 = v_name v2 and v3 = v_expr_context v3 in () @@ -187,7 +196,7 @@ and v_cmpop = and v_list_or_comprehension: 'a. ('a -> unit) -> 'a list_or_comprehension -> unit = fun of_a -> function - | CompList v1 -> let v1 = v_list of_a v1 in () + | CompList v1 -> let v1 = v_bracket (v_list of_a) v1 in () | CompForIf v1 -> v_comprehension of_a v1 @@ -278,57 +287,88 @@ and v_stmt x = let v1 = v_list v_expr v1 and v2 = v_tok v2 and v3 = v_expr v3 in () | AugAssign ((v1, v2, v3)) -> let v1 = v_expr v1 and v2 = v_wrap v_operator v2 and v3 = v_expr v3 in () - | Return v1 -> let v1 = v_option v_expr v1 in () - | Delete v1 -> let v1 = v_list v_expr v1 in () - | Async v1 -> let v1 = v_stmt v1 in () - | For ((v1, v2, v3, v4)) -> + | Return (t, v1) -> + let t = v_info t in + let v1 = v_option v_expr v1 in () + | Delete (t, v1) -> + let t = v_info t in + let v1 = v_list v_expr v1 in () + | Async (t, v1) -> + let t = v_info t in + let v1 = v_stmt v1 in () + | For ((t, v1, v2, v3, v4)) -> + let t = v_info t in let v1 = v_expr v1 and v2 = v_expr v2 and v3 = v_list v_stmt v3 and v4 = v_list v_stmt v4 in () - | While ((v1, v2, v3)) -> + | While ((t, v1, v2, v3)) -> + let t = v_info t in let v1 = v_expr v1 and v2 = v_list v_stmt v2 and v3 = v_list v_stmt v3 in () - | If ((v1, v2, v3)) -> + | If ((t, v1, v2, v3)) -> + let t = v_info t in let v1 = v_expr v1 and v2 = v_list v_stmt v2 and v3 = v_list v_stmt v3 in () - | With ((v1, v2, v3)) -> + | With ((t, v1, v2, v3)) -> + let t = v_info t in let v1 = v_expr v1 and v2 = v_option v_expr v2 and v3 = v_list v_stmt v3 in () - | Raise v1 -> + | Raise (t, v1) -> + let t = v_info t in let v1 = v_option (fun (v1, v2) -> let v1 = v_expr v1 and v2 = v_option v_expr v2 in ()) v1 in () - | TryExcept ((v1, v2, v3)) -> + | TryExcept ((t, v1, v2, v3)) -> + let t = v_info t in let v1 = v_list v_stmt v1 and v2 = v_list v_excepthandler v2 and v3 = v_list v_stmt v3 in () - | TryFinally ((v1, v2)) -> + | TryFinally ((t, v1, v2)) -> + let t = v_info t in let v1 = v_list v_stmt v1 and v2 = v_list v_stmt v2 in () - | Assert ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_option v_expr v2 in () - | ImportAs (v1, v2) -> let v1 = v_alias2 (v1, v2) in () - | ImportAll (v1, v2) -> let v1 = v_module_name v1 and v2 = v_tok v2 in () - | ImportFrom ((v1, v2)) -> + | Assert ((t, v1, v2)) -> + let t = v_info t in + let v1 = v_expr v1 and v2 = v_option v_expr v2 in () + | ImportAs (t, v1, v2) -> + let t = v_info t in + let v1 = v_alias2 (v1, v2) in () + | ImportAll (t, v1, v2) -> + let t = v_info t in + let v1 = v_module_name v1 and v2 = v_tok v2 in () + | ImportFrom ((t, v1, v2)) -> + let t = v_info t in let v1 = v_module_name v1 and v2 = v_list v_alias v2 in () - | Global v1 -> let v1 = v_list v_name v1 in () - | NonLocal v1 -> let v1 = v_list v_name v1 in () - | ExprStmt v1 -> let v1 = v_expr v1 in () - | Pass -> () - | Break -> () - | Continue -> () + | Global (t, v1) -> + let t = v_info t in + let v1 = v_list v_name v1 in () + | NonLocal (t, v1) -> + let t = v_info t in + let v1 = v_list v_name v1 in () + | ExprStmt (v1) -> + let v1 = v_expr v1 in () + | Pass t -> + let t = v_info t in + () + | Break t -> + let t = v_info t in + () + | Continue t -> + let t = v_info t in + () in vin.kstmt (k, all_functions) x