Generic_vs_generic.ml

(* Yoann Padioleau
 *
 * Copyright (C) 2019-2021 r2c
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * version 2.1 as published by the Free Software Foundation, with the
 * special exception on linking described in file license.txt.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
 * license.txt for more details.
 *)
open Common

(* G is the pattern, and B the concrete source code. For now
 * we both use the same module but they may differ later
 * as the expressivity of the pattern language grows.
 *
 * You might be tempted to just open AST_generic and get rid of G and B,
 * but it's easy to be confused on what is a pattern and what is the target,
 * so at least using different G and B helps a bit.
 *
 * subtle: use 'b' to report errors, because 'a' is the sgrep pattern and it
 * has no file information usually.
 *)
module B = AST_generic
module G = AST_generic
module MV = Metavariable
module Flag = Flag_semgrep
module Config = Config_semgrep_t
module H = AST_generic_helpers
module T = Type_generic

(* optimisations *)
module CK = Caching.Cache_key
module Env = Metavariable_capture
open Matching_generic

let logger = Logging.get_logger [ __MODULE__ ]
let hook_find_possible_parents = ref None

(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(* AST generic vs AST generic code matcher.
 *
 * This module allows to match some AST elements against other AST elements in
 * a flexible way, providing a kind of grep but at a syntactical level.
 *
 * Most of the boilerplate code was generated by
 *    $ pfff/meta/gen_code -matcher_gen_all
 * using OCaml pad-style reflection (see commons/OCaml.ml) on
 * h_program-lang/AST_generic.ml.
 *
 * See pfff/matcher/fuzzy_vs_fuzzy.ml for another approach.
 *
 * There are four main features allowing a "pattern" to match some "code":
 *  - metavariables can match anything (see metavar: tag in this file)
 *  - '...' can match any sequence (see dots: tag)
 *  - simple constructs match complex constructs having more details
 *    (e.g., the absence of attribute in a pattern will still match functions
 *     having many attributes) (see less-is-ok: tag)
 *  - the underlying AST uses some normalization (!= is transformed in !(..=))
 *    to support certain code equivalences (see equivalence: tag)
 *  - we do not care about differences in spaces/indentations/comments.
 *    we work at the AST-level.
 *  - other equivalences using global analysis (see deep: tag)
 *
 * alternatives:
 *  - would it be simpler to work on a simpler AST, like a Term language,
 *    or even a Node/Leaf? or Ast_fuzzy? the "less-is-ok" would be
 *    difficult with that approach, because you need to know that some
 *    parts of the AST are attributes/annotations that can be skipped.
 *    In the same way, code equivalences like name resolution on the AST
 *    would be more difficult with an untyped-general tree.
 *)

(*****************************************************************************)
(* Extra Helpers *)
(*****************************************************************************)

let env_add_matched_stmt rightmost_stmt (tin : tin) =
  [ extend_stmts_match_span rightmost_stmt tin ]

(* equivalence: on different indentation
 * todo? work? was copy-pasted from XHP sgrep matcher
 *)
let m_string_xhp_text sa sb =
  if sa =$= sb || (sa =~ "^[\n ]+$" && sb =~ "^[\n ]+$") then return ()
  else fail ()

let has_ellipsis_and_filter_ellipsis_gen f xs =
  let has_ellipsis = ref false in
  let ys =
    xs
    |> Common.exclude (fun x ->
           let res = f x in
           if res then has_ellipsis := true;
           res)
  in
  (!has_ellipsis, ys)

let has_ellipsis_and_filter_ellipsis xs =
  has_ellipsis_and_filter_ellipsis_gen
    (function
      | { G.e = G.Ellipsis _; _ } -> true
      | _ -> false)
    xs

let has_xml_ellipsis_and_filter_ellipsis xs =
  has_ellipsis_and_filter_ellipsis_gen
    (function
      | G.XmlEllipsis _ -> true
      | _ -> false)
    xs

let has_case_ellipsis_and_filter_ellipsis xs =
  has_ellipsis_and_filter_ellipsis_gen
    (function
      | G.CaseEllipsis _ -> true
      | _ -> false)
    xs

let rec obj_and_dot_accesses_of_expr e =
  match e.G.e with
  | B.Call ({ e = B.DotAccess (e, tok, fld); _ }, args) ->
      let o, xs = obj_and_dot_accesses_of_expr e in
      (o, (fld, tok, Some args) :: xs)
  | B.DotAccess (e, tok, fld) ->
      let o, xs = obj_and_dot_accesses_of_expr e in
      (o, (fld, tok, None) :: xs)
  | _ -> (e, [])

let rec expr_of_obj_and_dot_accesses (obj, xs) =
  match xs with
  | [] -> obj
  | (fld, tok, Some args) :: xs ->
      let e = expr_of_obj_and_dot_accesses (obj, xs) in
      B.Call (B.DotAccess (e, tok, fld) |> G.e, args) |> G.e
  | (fld, tok, None) :: xs ->
      let e = expr_of_obj_and_dot_accesses (obj, xs) in
      B.DotAccess (e, tok, fld) |> G.e

let rec all_suffix_of_list xs =
  xs
  ::
  (match xs with
  | [] -> []
  | _x :: xs -> all_suffix_of_list xs)

let _ =
  Common2.example
    (all_suffix_of_list [ 1; 2; 3 ] = [ [ 1; 2; 3 ]; [ 2; 3 ]; [ 3 ]; [] ])

(* copy paste of pfff/lang_ml/analyze/module_ml.ml *)
let module_name_of_filename file =
  let _d, b, _e = Common2.dbe_of_filename file in
  let module_name = String.capitalize_ascii b in
  module_name

(*****************************************************************************)
(* Optimisations (caching, bloom filter) *)
(*****************************************************************************)

(* Getters and setters that were left abstract in the cache implementation. *)
let cache_access : tin Caching.Cache.access =
  {
    get_span_field = (fun tin -> tin.stmts_match_span);
    set_span_field = (fun tin x -> { tin with stmts_match_span = x });
    get_mv_field = (fun tin -> tin.mv);
    set_mv_field = (fun tin mv -> { tin with mv });
  }

let stmts_may_match pattern_stmts (stmts : G.stmt list) =
  (* We could gather all the strings from the stmts
     and perform one intersection, but this is quite slow.
     By iterating over each stmt, we can shortcircuit *)
  if not !Flag.use_bloom_filter then true
  else
    let pattern_strs =
      Bloom_annotation.set_of_pattern_strings (Ss pattern_stmts)
    in
    let pats_in_stmt pats (stmt : AST_generic.stmt) =
      match stmt.s_strings with
      | None -> true
      | Some strs -> Set_.subset pats strs
    in
    let rec patterns_in_any_stmt pats stmts acc =
      match stmts with
      | [] -> acc
      | stmt :: rest -> (
          match acc with
          | false -> patterns_in_any_stmt pats rest (pats_in_stmt pats stmt)
          | true -> acc)
    in
    patterns_in_any_stmt pattern_strs stmts true
  [@@profiling]

(*****************************************************************************)
(* Name *)
(*****************************************************************************)

(* coupling: modify also m_ident_and_id_info *)
(* You should prefer to use m_ident_and_id_info if you can *)
let m_ident a b =
  match (a, b) with
  (* metavar: *)
  | (str, tok), b when MV.is_metavar_name str ->
      envf (str, tok) (MV.Id (b, None))
  (* in some languages such as Javascript certain entities like
   * fields can use strings for identifiers (e.g., {"myfield": 1}),
   * which gives the opportunity to use regexp string for fields
   * (e.g., {"=~/.*field/": $X}).
   *)
  | (stra, _), (strb, _) when Pattern.is_regexp_string stra ->
      let re_match = Matching_generic.regexp_matcher_of_regexp_string stra in
      if re_match strb then return () else fail ()
  (* general case *)
  | a, b -> (m_wrap m_string) a b

let m_dotted_name a b =
  match (a, b) with
  (* TODO: [$X] should match any list *)
  | a, b -> (m_list m_ident) a b

(* This is for languages like Python where foo.arg.func is not parsed
 * as a qualified name but as a chain of DotAccess.
 *)
let make_dotted xs =
  match xs with
  | [] -> raise Impossible
  | x :: xs ->
      let base = B.N (B.Id (x, B.empty_id_info ())) |> G.e in
      List.fold_left
        (fun acc e ->
          let tok = Parse_info.fake_info (snd x) "." in
          B.DotAccess (acc, tok, B.FN (B.Id (e, B.empty_id_info ()))) |> G.e)
        base xs

(* similar to m_list_prefix but binding $X to the whole list *)
let rec m_dotted_name_prefix_ok a b =
  match (a, b) with
  | [], [] -> return ()
  | [ (s, t) ], [ x ] when MV.is_metavar_name s -> envf (s, t) (MV.Id (x, None))
  | [ (s, t) ], _ :: _ when MV.is_metavar_name s ->
      (* TODO: should we bind it instead to a MV.N IdQualified?
       * but it is actually just the qualifier part; the last id
       * is not here (even though make_dottd will not care about that)
       *)
      envf (s, t) (MV.E (make_dotted b))
  | xa :: aas, xb :: bbs ->
      let* () = m_ident xa xb in
      m_dotted_name_prefix_ok aas bbs
  (* prefix is ok *)
  | [], _ -> return ()
  | _ :: _, _ -> fail ()

(* less-is-ok: prefix matching is supported for imports, eg.:
 *  pattern: import foo.x should match: from foo.x.z.y
 *)
let m_module_name_prefix a b =
  match (a, b) with
  (* metavariable case *)
  | G.FileName ((a_str, _) as a1), B.FileName b1 when MV.is_metavar_name a_str
    ->
      (* Bind as a literal string expression so that pretty-printing works.
       * This also means that this metavar can match both literal strings and
       * filenames with the same string content. *)
      envf a1 (MV.E (B.L (B.String b1) |> G.e))
  (* dots: '...' on string or regexp *)
  | G.FileName a, B.FileName b ->
      m_string_ellipsis_or_metavar_or_default
      (* TODO figure out what prefix support means here *)
        ~m_string_for_default:m_filepath_prefix a b
  | G.DottedName a1, B.DottedName b1 -> m_dotted_name_prefix_ok a1 b1
  | G.FileName _, _
  | G.DottedName _, _ ->
      fail ()

let m_module_name a b =
  match (a, b) with
  | G.FileName a1, B.FileName b1 -> (m_wrap m_string) a1 b1
  | G.DottedName a1, B.DottedName b1 -> m_dotted_name a1 b1
  | G.FileName _, _
  | G.DottedName _, _ ->
      fail ()

let m_sid a b = if a =|= b then return () else fail ()

let m_resolved_name_kind a b =
  match (a, b) with
  | G.LocalVar, B.LocalVar -> return ()
  | G.EnclosedVar, B.EnclosedVar -> return ()
  | G.Parameter, B.Parameter -> return ()
  | G.Global, B.Global -> return ()
  | G.ImportedEntity a1, B.ImportedEntity b1 -> m_dotted_name a1 b1
  | G.ImportedModule a1, B.ImportedModule b1 -> m_module_name a1 b1
  | G.Macro, B.Macro -> return ()
  | G.EnumConstant, B.EnumConstant -> return ()
  | G.TypeName, B.TypeName -> return ()
  | G.LocalVar, _
  | G.Parameter, _
  | G.Global, _
  | G.EnclosedVar, _
  | G.Macro, _
  | G.EnumConstant, _
  | G.TypeName, _
  | G.ImportedEntity _, _
  | G.ImportedModule _, _
  | G.ResolvedName _, _ ->
      fail ()

let _m_resolved_name (a1, a2) (b1, b2) =
  let* () = m_resolved_name_kind a1 b1 in
  m_sid a2 b2

(* Supports deep expression matching, either when done explicitly
 * (e.g. with deep ellipsis) or implicitly.
 *
 * If "go_deeper_expr" is not enabled, reduces to `first_fun a b`.
 * If "go_deeper_expr" is enabled, will first run `first_fun a b`, and then
 * will match against all sub-expressions of b.
 *
 * See m_expr_deep for an example of usage.
 *
 * deep_fun: Matching function to use when matching sub-expressions
 * first_fun: Matching function to use when matching the whole (top-level)
 * expression
 * sub_fun: Function to use to extract sub-expressions from b
 * a: Pattern expression
 * b: Target node
 * 't: Type of the target node
 *
 * todo? now that we don't use >!> and always explore the subexprs,
 * we could probably refactor this code to not need so many arguments.
 *)
let m_deep (deep_fun : G.expr Matching_generic.matcher)
    (first_fun : G.expr -> 't -> tin -> tout) (sub_fun : 't -> G.expr list)
    (a : G.expr) (b : 't) =
  if_config
    (fun x -> not x.go_deeper_expr)
    ~then_:(first_fun a b)
    ~else_:
      (* bugfix: this used to be a >!> below, but this does not work! We need
       * to also explore subexprs, whatever the result of 'first_fun a b'.
       * Indeed, if the deep pattern was <... $X ...>, $X will always
       * match (unless it was binded before), but we actually need to
       * enumerate all possible subexprs and make $X bind to all
       * possibles subexprs.
       *)
      (first_fun a b
      >||>
      (* less: could use a fold *)
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | x :: xs -> deep_fun a x >||> aux xs
      in
      b |> sub_fun |> aux)

let m_with_symbolic_propagation f b =
  if_config
    (fun x -> x.Config.constant_propagation && x.Config.symbolic_propagation)
    ~then_:
      (match b.G.e with
      | G.N (G.Id (_, { id_svalue = { contents = Some (G.Sym b1) }; _ })) ->
          f b1
      | ___else___ -> fail ())
    ~else_:(fail ())

(* start of recursive need *)
(* TODO: factorize with metavariable and aliasing logic in m_expr
 * TODO: remove MV.Id and use always MV.N?
 *)
let rec m_name a b =
  let try_parents dotted =
    let parents =
      match !hook_find_possible_parents with
      | None -> []
      | Some f -> f dotted
    in
    (* less: use a fold *)
    let rec aux xs =
      match xs with
      | [] -> fail ()
      | x :: xs -> m_name a x >||> aux xs
    in
    aux parents
  in
  match (a, b) with
  (* equivalence: aliasing (name resolving) part 1 *)
  | ( a,
      B.Id
        ( idb,
          {
            B.id_resolved =
              {
                contents =
                  Some
                    ( ( B.ImportedEntity dotted
                      | B.ImportedModule (B.DottedName dotted)
                      | B.ResolvedName dotted ),
                      _sid );
              };
            _;
          } ) ) ->
      m_name a (B.Id (idb, B.empty_id_info ()))
      >||> (* try this time a match with the resolved entity *)
      m_name a (H.name_of_ids dotted)
      >||> (* Try the parents *)
      try_parents dotted
  | G.Id (a1, a2), B.Id (b1, b2) ->
      (* this will handle metavariables in Id *)
      m_ident_and_id_info (a1, a2) (b1, b2)
  | G.Id ((str, tok), _info), G.IdQualified _ when MV.is_metavar_name str ->
      envf (str, tok) (MV.N b)
  (* equivalence: aliasing (name resolving) part 2 (mostly for OCaml) *)
  | ( G.IdQualified _a1,
      B.IdQualified
        ({
           name_info =
             {
               B.id_resolved =
                 { contents = Some (B.ImportedEntity dotted, _sid) };
               _;
             };
           _;
         } as nameinfo) ) ->
      (* try without resolving anything *)
      m_name a (B.IdQualified { nameinfo with name_info = B.empty_id_info () })
      >||>
      (* try this time by replacing the qualifier by the resolved one *)
      let new_qualifier =
        match List.rev dotted with
        | [] -> raise Impossible
        | _x :: xs -> List.rev xs |> Common.map (fun id -> (id, None))
      in
      m_name a
        (B.IdQualified
           {
             nameinfo with
             name_middle = Some (B.QDots new_qualifier);
             name_info = B.empty_id_info ();
           })
  (* semantic! try to handle open in OCaml by querying LSP! The
   * target code is using an unqualified Id possibly because of some open!
   *)
  | G.IdQualified { name_last = ida, None; _ }, B.Id (idb, _infob)
    when fst ida = fst idb -> (
      match !Hooks.get_def idb with
      | None -> fail ()
      | Some file ->
          let m = module_name_of_filename file in
          let t = snd idb in
          pr2_gen m;
          let _n = H.name_of_ids [ (m, t); idb ] in
          (* retry with qualified target *)
          (* m_name a n *)
          return ())
  (* boilerplate *)
  | G.IdQualified a1, B.IdQualified b1 -> m_name_info a1 b1
  | ( G.Id _,
      G.IdQualified
        {
          name_info =
            {
              B.id_resolved =
                {
                  contents =
                    Some
                      ( ( B.ImportedEntity dotted
                        | B.ImportedModule (B.DottedName dotted)
                        | B.ResolvedName dotted ),
                        _sid );
                };
              _;
            };
          _;
        } ) ->
      try_parents dotted
  | G.Id _, _
  | G.IdQualified _, _ ->
      fail ()

and m_name_info a b =
  match (a, b) with
  | ( { G.name_last = a0; name_middle = a1; name_top = a2; name_info = a3 },
      { B.name_last = b0; name_middle = b1; name_top = b2; name_info = b3 } ) ->
      let* () = m_ident_and_type_arguments a0 b0 in
      let* () = (m_option m_qualifier) a1 b1 in
      let* () = (m_option m_tok) a2 b2 in
      let* () = m_id_info a3 b3 in
      return ()

and m_ident_and_type_arguments (a1, a2) (b1, b2) =
  let* () = m_ident a1 b1 in
  let* () = m_option m_type_arguments a2 b2 in
  return ()

and m_qualifier a b =
  match (a, b) with
  | G.QDots a, B.QDots b ->
      (* TODO? like for m_dotted_name, [$X] should match anything? *)
      m_list m_ident_and_type_arguments a b
  | G.QExpr (a1, a2), B.QExpr (b1, b2) -> m_expr a1 b1 >>= fun () -> m_tok a2 b2
  | G.QDots _, _
  | G.QExpr _, _ ->
      fail ()

(* semantic! try to handle typed metavariables by querying LSP
 * to get inferred type info (only for OCaml for now) *)
and m_type_option_with_hook idb taopt tbopt =
  match (taopt, tbopt) with
  | Some ta, Some tb -> m_type_ ta tb
  | Some ta, None -> (
      match !Hooks.get_type idb with
      | Some tb -> m_type_ ta tb
      | None -> fail ())
  (* less-is-ok:, like m_option_none_can_match_some *)
  | None, _ -> return ()

(* This is similar to m_ident, but it will also add the id_info in
 * the environment (via 'MV.Id (_, Some id_info)') when the pattern is
 * a metavariable. This id_info is useful to make sure multiple
 * occurences of the same metavariable binds to the same entity thanks
 * to the sid stored in the id_info.
 *)
and m_ident_and_id_info (a1, a2) (b1, b2) =
  (* metavar: *)
  match (a1, b1) with
  | (str, tok), b when MV.is_metavar_name str ->
      (* a bit OCaml specific, cos only ml_to_generic tags id_type in pattern *)
      m_type_option_with_hook b1 !(a2.G.id_type) !(b2.B.id_type) >>= fun () ->
      m_id_info a2 b2 >>= fun () -> envf (str, tok) (MV.Id (b, Some b2))
  (* same code than for m_ident *)
  (* in some languages such as Javascript certain entities like
   * fields can use strings for identifiers (e.g., {"myfield": 1}),
   * which gives the opportunity to use regexp string for fields
   * (e.g., {"=~/.*field/": $X}).
   *)
  | (stra, _), (strb, _) when Pattern.is_regexp_string stra ->
      let re_match = Matching_generic.regexp_matcher_of_regexp_string stra in
      if re_match strb then return () else fail ()
  (* general case *)
  | _, _ ->
      let* () = m_wrap m_string a1 b1 in
      m_id_info a2 b2

and m_ident_and_empty_id_info a1 b1 =
  let empty = G.empty_id_info () in
  m_ident_and_id_info (a1, empty) (b1, empty)

(* Currently m_id_info is a Nop because the Semgrep pattern
 * does not have correct name resolution (see the comment below).
 * However, we do use id_info in equal_ast() to check
 * whether two $X refers to the same code. In that case we are using
 * the id_resolved tag and sid!
 *)
and m_id_info a b =
  match (a, b) with
  | ( {
        G.id_resolved = _a1;
        id_type = _a2;
        id_svalue = _a3;
        id_hidden = _a4;
        id_info_id = _a5;
      },
      {
        B.id_resolved = _b1;
        id_type = _b2;
        id_svalue = _b3;
        id_hidden = _b4;
        id_info_id = _b5;
      } ) ->
      (* old: (m_ref m_resolved_name) a3 b3  >>= (fun () ->
       * but doing import flask in a source file means every reference
       * to flask.xxx will be tagged with a ImportedEntity, but
       * semgrep pattern will use flask.xxx directly, without the preceding
       * import, without this tag, which would prevent
       * matching. We need to correctly resolve names and always compare with
       * the resolved_name instead of the name used in the code
       * (which can be an alias)
       *
       * old: (m_ref (m_option m_type_)) a2 b2
       * the same is true for types! Now we sometimes propagate type annotations
       * in Naming_AST.ml, but we do that in the source file, not the pattern,
       * which would prevent a match.
       * More generally, id_info is something populated and used on the
       * generic AST of the source, not on the pattern, hence we should
       * not use it as a condition for matching here. Instead use
       * the information in the caller.
       *)
      return ()

(*****************************************************************************)
(* Expression *)
(*****************************************************************************)

(* possibly go deeper when someone wants that a pattern like
 *   'bar();'
 * match also an expression statement like
 *   'x = bar();'.
 *
 * This is very hacky.
 *
 * alternatives:
 *  - force the user to use 'if(... <expr> ...)' (isaac, jmelton)
 *  - do as in coccinelle and use 'if(<... <expr> ...>)'
 *  - CURRENT: impicitely go deep without requiring an extra syntax
 *
 * todo? we could restrict ourselves to only a few forms? see SubAST_generic.ml
 *   - x = <expr>,
 *   - <call>(<exprs).
 *)
(* experimental! *)
and m_expr_deep a b tin =
  let symbolic_propagation = tin.config.Config.symbolic_propagation in
  let subexprs_of_expr =
    SubAST_generic.subexprs_of_expr ~symbolic_propagation
  in
  m_deep m_expr_deep m_expr subexprs_of_expr a b tin

(* coupling: if you add special sgrep hooks here, you should probably
 * also add them in m_pattern
 *)
and m_expr a b =
  Trace_matching.(if on then print_expr_pair a b);
  match (a.G.e, b.G.e) with
  (* the order of the matches matters! take care! *)
  (* alias: match on the expr inside *)
  | G.Alias (_alias, a1), _ -> m_expr a1 b
  | _, G.Alias (_alias, b1) -> m_expr a b1
  (* equivalence: user-defined equivalence! *)
  | G.DisjExpr (a1, a2), _b -> m_expr a1 b >||> m_expr a2 b
  (* equivalence: name resolving! *)
  (* todo: it would be nice to factorize the aliasing code by just calling
   * m_name, but below we use make_dotted, which is different from what
   * we do in m_name.
   *)
  | ( _a,
      B.N
        (B.Id
          ( idb,
            {
              B.id_resolved =
                {
                  contents =
                    Some
                      ( ( B.ImportedEntity dotted
                        | B.ImportedModule (B.DottedName dotted) ),
                        _sid );
                };
              _;
            } )) ) ->
      (* We used to force to fully qualify entities in the pattern
       * (e.g., with org.foo(...)) but this is confusing for users.
       * We now allow an unqualified pattern like 'foo' to match resolved
       * entities like import org.foo; foo(), just like for attributes.
       *
       * bugfix: important to call with empty_id_info() below to avoid
       * infinite recursion.
       *)
      m_expr a (B.N (B.Id (idb, B.empty_id_info ())) |> G.e)
      >||> (* try this time a match with the resolved entity *)
      m_expr a (make_dotted dotted)
  (* equivalence: name resolving on qualified ids (for OCaml) *)
  (* Put this before the next case to prevent overly eager dealiasing *)
  | G.N (G.IdQualified _ as na), B.N ((B.IdQualified _ | B.Id _) as nb) ->
      m_name na nb
  (* Matches pattern
   *   a.b.C.x
   * to code
   *   import a.b.C
   *   C.x
   *)
  | ( G.N
        (G.IdQualified
          {
            G.name_last = alabel, None;
            name_middle = Some (G.QDots names);
            name_top = None;
            _;
          }),
      _b ) ->
      (* TODO: double check names does not have any type_args *)
      let full = (names |> Common.map fst) @ [ alabel ] in
      m_expr (make_dotted full) b
  | G.DotAccess (_, _, _), B.N b1 ->
      (* Reinterprets a DotAccess expression such as a.b.c as a name, when
       * a,b,c are all identifiers. Note that something like a.b.c could get
       * parsed as either DotAccess or IdQualified depending on the context
       * (e.g., in Python it is always a DotAccess *except* when it occurs
       * in an attribute). *)
      (match H.name_of_dot_access a with
      | None -> fail ()
      | Some a1 -> m_name a1 b1)
      >||> m_with_symbolic_propagation (fun b1 -> m_expr a b1) b
  (* $X should not match an IdSpecial in a call context,
   * otherwise $X(...) would match a+b because this is transformed in a
   * Call(IdSpecial Plus, ...).
   * bugfix: note that we must forbid that only in a Call context; we want
   * $THIS to match IdSpecial (This) for example.
   *)
  | ( G.Call ({ e = G.N (G.Id ((str, _tok), _id_info)); _ }, _argsa),
      B.Call ({ e = B.IdSpecial _; _ }, _argsb) )
    when MV.is_metavar_name str ->
      fail ()
  (* metavar: *)
  (* Matching a generic Id metavariable to an IdSpecial will fail as it is
   * missing the token info; instead the Id should match Call(IdSpecial _, _)
   *)
  | G.N (G.Id ((str, _), _)), B.IdSpecial (B.ConcatString _, _)
  | G.N (G.Id ((str, _), _)), B.IdSpecial (B.Instanceof, _)
    when MV.is_metavar_name str ->
      fail ()
  (* Important to bind to MV.Id when we can, so this must be before
   * the next case where we bind to the more general MV.E.
   * TODO: should be B.N (B.Id _ | B.IdQualified _)?
   *)
  | G.N (G.Id _ as na), B.N (B.Id _ as nb) ->
      m_name na nb >||> m_with_symbolic_propagation (fun b1 -> m_expr a b1) b
  | G.N (G.Id ((str, tok), _id_info)), _b when MV.is_metavar_name str ->
      envf (str, tok) (MV.E b)
  (* metavar: typed! *)
  | G.TypedMetavar ((str, tok), _, t), _b when MV.is_metavar_name str ->
      with_lang (fun lang -> m_compatible_type lang (str, tok) t b)
  (* dots: should be patterned-match before in arguments, or statements,
   * but this is useful for keyword parameters, as in f(..., foo=..., ...)
   *)
  | G.Ellipsis _a1, _ -> return ()
  | G.DeepEllipsis (_, a1, _), _b -> m_expr_deep a1 b
  (* must be before constant propagation case below *)
  | G.L a1, B.L b1 -> m_literal a1 b1
  (* equivalence: constant propagation and evaluation!
   * TODO: too late, must do that before 'metavar:' so that
   * const a = "foo"; ... a == "foo" would be catched by $X == $X.
   *)
  | G.L a1, _b ->
      if_config
        (fun x -> x.Config.constant_propagation)
        ~then_:
          (with_lang (fun lang ->
               match
                 Constant_propagation.constant_propagation_and_evaluate_literal
                   ~lang b
               with
               | Some b1 -> m_literal_svalue a1 b1
               | None -> fail ()))
        ~else_:(fail ())
  | G.Container (G.Array, a2), B.Container (B.Array, b2) ->
      (m_bracket m_container_ordered_elements) a2 b2
  | G.Container (G.List, a2), B.Container (B.List, b2) ->
      (m_bracket m_container_ordered_elements) a2 b2
  | G.Container (G.Tuple, a1), B.Container (B.Tuple, b1) ->
      (m_container_ordered_elements |> m_bracket) a1 b1
  | ( G.Container (((G.Set | G.Dict) as a1), (_, a2, _)),
      B.Container (((B.Set | B.Dict) as b1), (_, b2, _)) ) ->
      m_container_set_or_dict_unordered_elements (a1, a2) (b1, b2)
  (* dots: equivalence: Container and Comprehension *)
  | ( G.Container (akind, (_, [ { e = G.Ellipsis _; _ } ], _)),
      B.Comprehension (bkind, _) ) ->
      m_container_operator akind bkind
  (* dots '...' for string literal:
   * Interpolated strings are transformed into Call(Special(Concat, ...),
   * hence we want Python patterns like f"...{$X}...", which are expanded to
   * Call(Special(Concat, [L"..."; Id "$X"; L"..."])) to
   * match concrete code like f"foo{a}" such that "..." is seemingly
   * matching 0 or more literal expressions.
   * bugfix: note that we want to do that only when inside
   * Call(Special(Concat(...))), hence the special m_arguments_concat below,
   * otherwise regular call patterns like foo("...") would match code like
   * foo().
   *)
  | ( G.Call ({ e = G.IdSpecial (G.ConcatString akind, _a1); _ }, a2),
      B.Call ({ e = B.IdSpecial (B.ConcatString bkind, _b1); _ }, b2) ) ->
      m_concat_string_kind akind bkind >>= fun () ->
      m_bracket m_arguments_concat a2 b2
  (* The pattern '$X = 1 + 2 + ...' is parsed as '$X = (1 + 2) + ...', but
   * if the concrete code is 'foo = 1 + 2 + 3 + 4', this will naively not
   * match because (1+2)+... will be matched against ((1+2)+3)+4 and fails.
   * The ellipsis operator with binary operators should be more flexible
   * and allows any number of additional arguments, which when translated
   * in Call() means we need to go deeper.
   *)
  | ( G.Call
        ( { e = G.IdSpecial (G.Op aop, _toka); _ },
          (_, [ G.Arg a1; G.Arg { e = G.Ellipsis _tdots; _ } ], _) ),
      B.Call
        ( { e = B.IdSpecial (B.Op bop, _tokb); _ },
          (_, [ B.Arg b1; B.Arg _b2 ], _) ) )
  (* This applies to any binary operation! Associative operators (declared
   * in AST_generic_helpers.is_associative_operator) are better handled by
   * m_call_op below. *)
    when (not (H.is_associative_operator aop)) || aop <> bop ->
      m_arithmetic_operator aop bop >>= fun () ->
      m_expr a1 b1 >!> fun () ->
      (* try again deeper on b1 *)
      m_expr a b1
  | ( G.Call ({ e = G.IdSpecial (G.Op aop, toka); _ }, aargs),
      B.Call ({ e = B.IdSpecial (B.Op bop, tokb); _ }, bargs) ) ->
      m_call_op aop toka aargs bop tokb bargs
  (* TODO? should probably do some equivalence like allowing extra
   * paren in the pattern to still match code without parens
   *)
  | G.ParenExpr a1, B.ParenExpr b1 -> m_bracket m_expr a1 b1
  (* boilerplate *)
  | G.Call (a1, a2), B.Call (b1, b2) ->
      m_expr a1 b1 >>= fun () -> m_arguments a2 b2
  | G.New (_a0, a1, a2), B.New (_b0, b1, b2) ->
      m_type_ a1 b1 >>= fun () -> m_arguments a2 b2
  | G.Call _, _ -> m_with_symbolic_propagation (fun b1 -> m_expr a b1) b
  | G.New _, _ -> m_with_symbolic_propagation (fun b1 -> m_expr a b1) b
  | G.Assign (a1, at, a2), B.Assign (b1, bt, b2) -> (
      m_expr a1 b1
      >>= (fun () -> m_tok at bt >>= fun () -> m_expr a2 b2)
      (* If the code has tuples as b1 and b2 and the lengths of
       * the tuples are equal, create a tuple of (variable, value)
       * pairs and try to match the pattern with each entry in the tuple.
       * This should enable multiple assignments if the number of
       * variables and values are equal. *)
      >||>
      match (b1.e, b2.e) with
      | B.Container (B.Tuple, (_, vars, _)), B.Container (B.Tuple, (_, vals, _))
        when List.length vars = List.length vals ->
          let create_assigns expr1 expr2 = B.Assign (expr1, bt, expr2) |> G.e in
          let mult_assigns = List.map2 create_assigns vars vals in
          let rec aux xs =
            match xs with
            | [] -> fail ()
            | x :: xs -> m_expr a x >||> aux xs
          in
          aux mult_assigns
      | _, _ -> fail ())
  (* bugfix: we also want o. ... .foo() to match o.foo(), but
   * o. ... would be matched against just 'o', so we need this
   * extra case.
   *)
  | ( G.DotAccess (({ e = G.DotAccessEllipsis (a1_1, _a1_2); _ } as a1), at, a2),
      B.DotAccess (b1, bt, b2) ) ->
      let* () = m_expr a1 b1 >||> m_expr a1_1 b1 in
      let* () = m_tok at bt in
      m_field_name a2 b2
  | G.DotAccess (a1, at, a2), B.DotAccess (b1, bt, b2) ->
      m_expr a1 b1 >>= fun () ->
      m_tok at bt >>= fun () -> m_field_name a2 b2
  (* <a1> ... vs o.m1().m2().m3().
   * Remember than o.m1().m2().m3() is parsed as (((o.m1()).m2()).m3())
   *)
  | ( G.DotAccessEllipsis (a1, _a2),
      (B.DotAccess _ | B.Call ({ e = B.DotAccess _; _ }, _)) ) ->
      (* => o, [m3();m2();m1() *)
      let obj, ys = obj_and_dot_accesses_of_expr b in
      (* the method chain ellipsis can match 0 or more of those method calls *)
      let candidates = all_suffix_of_list ys in
      let rec aux xxs =
        match xxs with
        | [] -> fail ()
        | xs :: xxs ->
            let b = expr_of_obj_and_dot_accesses (obj, xs) in
            m_expr a1 b >||> aux xxs
      in
      aux candidates
  | G.ArrayAccess (a1, a2), B.ArrayAccess (b1, b2) ->
      m_expr a1 b1 >>= fun () -> m_bracket m_expr a2 b2
  | G.ArrayAccess _, _ -> m_with_symbolic_propagation (fun b1 -> m_expr a b1) b
  | G.Record a1, B.Record b1 -> (m_bracket m_fields) a1 b1
  | G.Constructor (a1, a2), B.Constructor (b1, b2) ->
      m_name a1 b1 >>= fun () -> m_bracket (m_list m_expr) a2 b2
  | G.Comprehension (a1, a2), B.Comprehension (b1, b2) ->
      let* () = m_container_operator a1 b1 in
      m_bracket m_comprehension a2 b2
  | G.Lambda a1, B.Lambda b1 ->
      m_function_definition a1 b1 >>= fun () -> return ()
  | G.AnonClass a1, B.AnonClass b1 -> m_class_definition a1 b1
  | G.IdSpecial a1, B.IdSpecial b1 -> m_wrap m_special a1 b1
  (* This is mainly for Go which generates an AssignOp (Eq)
   * for the x := a short variable declaration.
   * TODO: this should be a configurable equivalence: $X = $Y ==> $X := $Y.
   * Some people want it, some people may not want it.
   * At least we dont do the opposite (AssignOp matching Assign) so
   * using := in a pattern will not match code using just =
   * (but pattern using = will match both code using = or :=).
   *)
  | G.Assign (a1, a2, a3), B.AssignOp (b1, (B.Eq, b2), b3) ->
      m_expr (G.Assign (a1, a2, a3) |> G.e) (B.Assign (b1, b2, b3) |> G.e)
  | G.AssignOp (a1, a2, a3), B.AssignOp (b1, b2, b3) ->
      m_expr a1 b1 >>= fun () ->
      m_wrap m_arithmetic_operator a2 b2 >>= fun () -> m_expr a3 b3
  | G.Xml a1, B.Xml b1 -> m_xml a1 b1
  | G.LetPattern (a1, a2), B.LetPattern (b1, b2) ->
      m_pattern a1 b1 >>= fun () -> m_expr a2 b2
  | G.SliceAccess (a1, a2), B.SliceAccess (b1, b2) ->
      let f = m_option m_expr in
      m_expr a1 b1 >>= fun () -> m_bracket (m_tuple3 f f f) a2 b2
  | G.Conditional (a1, a2, a3), B.Conditional (b1, b2, b3) ->
      m_expr a1 b1 >>= fun () ->
      m_expr a2 b2 >>= fun () -> m_expr a3 b3
  | G.Yield (a0, a1, a2), B.Yield (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_option m_expr a1 b1 >>= fun () -> m_bool a2 b2
  | G.Await (a0, a1), B.Await (b0, b1) -> m_tok a0 b0 >>= fun () -> m_expr a1 b1
  | G.Cast (a1, at, a2), B.Cast (b1, bt, b2) ->
      m_type_ a1 b1 >>= fun () ->
      m_tok at bt >>= fun () -> m_expr a2 b2
  | G.Seq a1, B.Seq b1 -> (m_list m_expr) a1 b1
  | G.Ref (a0, a1), B.Ref (b0, b1) -> m_tok a0 b0 >>= fun () -> m_expr a1 b1
  | G.DeRef (a0, a1), B.DeRef (b0, b1) -> m_tok a0 b0 >>= fun () -> m_expr a1 b1
  | G.StmtExpr a1, B.StmtExpr b1 -> m_stmt a1 b1
  | G.OtherExpr (a1, a2), B.OtherExpr (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.N (G.Id _ as a), B.N (B.IdQualified _ as b) -> m_name a b
  | G.Container _, _
  | G.Comprehension _, _
  | G.Record _, _
  | G.Constructor _, _
  | G.Lambda _, _
  | G.AnonClass _, _
  | G.N _, _
  | G.IdSpecial _, _
  | G.ParenExpr _, _
  | G.Xml _, _
  | G.Assign _, _
  | G.AssignOp _, _
  | G.LetPattern _, _
  | G.DotAccess _, _
  | G.SliceAccess _, _
  | G.Conditional _, _
  | G.Yield _, _
  | G.Await _, _
  | G.Cast _, _
  | G.Seq _, _
  | G.Ref _, _
  | G.DeRef _, _
  | G.StmtExpr _, _
  | G.OtherExpr _, _
  | G.TypedMetavar _, _
  | G.DotAccessEllipsis _, _ ->
      fail ()

and m_entity_name a b =
  match (a, b) with
  | G.EN a1, B.EN b1 -> m_name a1 b1
  | G.EN (G.Id ((str, tok), _idinfoa)), B.EDynamic b1
    when MV.is_metavar_name str ->
      envf (str, tok) (MV.E b1)
  (* boilerplate *)
  | G.EDynamic a, B.EDynamic b -> m_expr a b
  | G.EPattern a, B.EPattern b -> m_pattern a b
  | G.OtherEntity (a1, a2), B.OtherEntity (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.EN _, _
  | G.EPattern _, _
  | G.OtherEntity _, _
  | G.EDynamic _, _ ->
      fail ()

and m_field_name a b =
  match (a, b) with
  | G.FN a1, B.FN b1 -> m_name a1 b1
  | G.FN (G.Id ((str, tok), _idinfoa)), B.FDynamic b1
    when MV.is_metavar_name str ->
      envf (str, tok) (MV.E b1)
  (* boilerplate *)
  | G.FDynamic a, B.FDynamic b -> m_expr a b
  | G.FN _, _
  | G.FDynamic _, _ ->
      fail ()

and m_label_ident a b =
  match (a, b) with
  | G.LNone, B.LNone -> return ()
  | G.LId a, B.LId b -> m_label a b
  | G.LInt a, B.LInt b -> m_wrap m_int a b
  | G.LDynamic a, B.LDynamic b -> m_expr a b
  | G.LNone, _
  | G.LId _, _
  | G.LInt _, _
  | G.LDynamic _, _ ->
      fail ()

and m_comprehension (a1, a2) (b1, b2) =
  let* () = m_expr a1 b1 in
  m_list m_for_or_if_comp a2 b2

and m_for_or_if_comp a b =
  match (a, b) with
  | G.CompFor (a1, a2, a3, a4), B.CompFor (b1, b2, b3, b4) ->
      let* () = m_tok a1 b1 in
      let* () = m_pattern a2 b2 in
      let* () = m_tok a3 b3 in
      let* () = m_expr a4 b4 in
      return ()
  | G.CompIf (a1, a2), B.CompIf (b1, b2) ->
      let* () = m_tok a1 b1 in
      let* () = m_expr a2 b2 in
      return ()
  | G.CompFor _, _
  | G.CompIf _, _ ->
      fail ()

and m_literal a b =
  Trace_matching.(if on then print_literal_pair a b);
  match (a, b) with
  (* dots: metavar: '...' and metavars on string/regexps/atoms *)
  | G.String a, B.String b -> m_string_ellipsis_or_metavar_or_default a b
  | G.Atom (_, a), B.Atom (_, b) -> m_ellipsis_or_metavar_or_string a b
  | G.Regexp (a1, a2), B.Regexp (b1, b2) -> (
      let* () = m_bracket m_ellipsis_or_metavar_or_string a1 b1 in
      match (a2, b2) with
      (* less_is_ok: *)
      | None, _ -> return ()
      | Some a, Some b -> m_ellipsis_or_metavar_or_string a b
      | Some _, None -> fail ())
  (* boilerplate *)
  | G.Unit a1, B.Unit b1 -> m_tok a1 b1
  | G.Bool a1, B.Bool b1 -> (m_wrap m_bool) a1 b1
  | G.Int a1, B.Int b1 -> m_wrap_m_int_opt a1 b1
  | G.Float a1, B.Float b1 -> m_wrap_m_float_opt a1 b1
  | G.Imag a1, B.Imag b1 -> (m_wrap m_string) a1 b1
  | G.Ratio a1, B.Ratio b1 -> (m_wrap m_string) a1 b1
  | G.Char a1, B.Char b1 -> (m_wrap m_string) a1 b1
  | G.Null a1, B.Null b1 -> m_tok a1 b1
  | G.Undefined a1, B.Undefined b1 -> m_tok a1 b1
  | G.Unit _, _
  | G.Bool _, _
  | G.Int _, _
  | G.Float _, _
  | G.Char _, _
  | G.String _, _
  | G.Regexp _, _
  | G.Null _, _
  | G.Undefined _, _
  | G.Imag _, _
  | G.Ratio _, _
  | G.Atom _, _ ->
      fail ()

and m_wrap_m_int_opt (a1, a2) (b1, b2) =
  match (a1, b1) with
  (* iso: semantic equivalence of value! 0x8 can match 8 *)
  | Some i1, Some i2 -> if i1 =|= i2 then return () else fail ()
  (* if the integers (or floats) were too large or were using
   * a syntax OCaml int_of_string could not parse,
   * we default to a string comparison *)
  | _ ->
      let a1 = Parse_info.str_of_info a2 in
      (* bugfix: not that with constant propagation, some integers don't have
       * a real token associated with them, so b2 may be a FakeTok, but
       * Parse_info.str_of_info does not raise an exn anymore on a FakeTok
       *)
      let b1 = Parse_info.str_of_info b2 in
      m_wrap m_string (a1, a2) (b1, b2)

and m_wrap_m_float_opt (a1, a2) (b1, b2) =
  match (a1, b1) with
  (* iso: semantic equivalence of value! 0x8 can match 8 *)
  | Some i1, Some i2 when i1 = i2 -> return ()
  | _ ->
      let a1 = Parse_info.str_of_info a2 in
      let b1 = Parse_info.str_of_info b2 in
      m_wrap m_string (a1, a2) (b1, b2)

and m_literal_svalue a b =
  match b with
  | B.Lit b1 -> m_literal a b1
  | B.Cst B.Cstr -> (
      match a with
      | G.String ("...", _) -> return ()
      | ___else___ -> fail ())
  | B.Cst _
  | B.Sym _
  | B.NotCst ->
      fail ()

and m_arithmetic_operator a b =
  Trace_matching.(if on then print_arithmetic_operator_pair a b);
  match (a, b) with
  | _ when a =*= b -> return ()
  | _ -> fail ()

and m_special a b =
  match (a, b) with
  | G.This, B.This -> return ()
  | G.Super, B.Super -> return ()
  | G.Self, B.Self -> return ()
  | G.Parent, B.Parent -> return ()
  | G.Eval, B.Eval -> return ()
  | G.Typeof, B.Typeof -> return ()
  | G.Instanceof, B.Instanceof -> return ()
  | G.Sizeof, B.Sizeof -> return ()
  | G.Defined, B.Defined -> return ()
  | G.ConcatString a, B.ConcatString b -> m_concat_string_kind a b
  | G.InterpolatedElement, B.InterpolatedElement -> return ()
  | G.Spread, B.Spread -> return ()
  | G.HashSplat, B.HashSplat -> return ()
  | G.ForOf, B.ForOf -> return ()
  | G.Op a1, B.Op b1 -> m_arithmetic_operator a1 b1
  | G.EncodedString a1, B.EncodedString b1 -> m_string a1 b1
  | G.IncrDecr (a1, a2), B.IncrDecr (b1, b2) ->
      m_eq a1 b1 >>= fun () -> m_eq a2 b2
  | G.NextArrayIndex, B.NextArrayIndex -> return ()
  | G.This, _
  | G.Super, _
  | G.Self, _
  | G.Parent, _
  | G.Eval, _
  | G.Typeof, _
  | G.Instanceof, _
  | G.Sizeof, _
  | G.ConcatString _, _
  | G.Spread, _
  | G.Op _, _
  | G.IncrDecr _, _
  | G.EncodedString _, _
  | G.HashSplat, _
  | G.Defined, _
  | G.ForOf, _
  | G.NextArrayIndex, _
  | InterpolatedElement, _ ->
      fail ()

and m_concat_string_kind a b =
  match (a, b) with
  (* fstring pattern should match only fstring *)
  | G.FString s1, B.FString s2 -> m_string s1 s2
  | G.FString _, _ -> fail ()
  (* same for tagged template literals *)
  | G.TaggedTemplateLiteral, B.TaggedTemplateLiteral -> return ()
  | G.TaggedTemplateLiteral, _
  | _, B.TaggedTemplateLiteral ->
      fail ()
  (* less-is-more: *)
  | _ -> return ()

and m_container_set_or_dict_unordered_elements (a1, a2) (b1, b2) =
  match ((a1, a2), (b1, b2)) with
  (* those rules should be applied only for python? *)
  | ((G.Dict | G.Set), []), ((G.Dict | G.Set), []) -> return ()
  | ((G.Dict | G.Set), [ { e = G.Ellipsis _; _ } ]), ((G.Dict | G.Set), _) ->
      return ()
  | (G.Set, a2), (B.Set, b2) ->
      let has_ellipsis, a2 = has_ellipsis_and_filter_ellipsis a2 in
      m_list_in_any_order ~less_is_ok:has_ellipsis m_expr a2 b2
  | (G.Dict, a2), (B.Dict, b2) ->
      let has_ellipsis, a2 = has_ellipsis_and_filter_ellipsis a2 in
      m_list_in_any_order ~less_is_ok:has_ellipsis m_expr a2 b2
  | _, _ ->
      (* less: could return fail () *)
      m_container_operator a1 b1 >>= fun () -> m_list m_expr a2 b2

(* coupling: if you add a constructor in AST_generic.container,
 * you probrably need to update m_container_set_or_dict_unordered_elements
 * and m_expr to handle this new kind of container.
 *)
and m_container_operator a b =
  match (a, b) with
  (* boilerplate *)
  | G.Array, B.Array -> return ()
  | G.List, B.List -> return ()
  | G.Set, B.Set -> return ()
  | G.Dict, B.Dict -> return ()
  | G.Tuple, B.Tuple -> return ()
  | G.Array, _
  | G.List, _
  | G.Set, _
  | G.Dict, _
  | G.Tuple, _ ->
      fail ()

and m_container_ordered_elements a b =
  m_list_with_dots m_expr
    (function
      | { e = G.Ellipsis _; _ } -> true
      | _ -> false)
    ~less_is_ok:false (* empty list can not match non-empty list *) a b

(* Poor's man typechecker on literals (for now).
 * old: was partly in typing/Typechecking_generic.ml before.
 *
 * todo:
 *  - local type inference on AST generic? good coverage?
 *  - we could allow metavars on the type itself, as in
 *    foo($X: $T) ... $T x; ...
 *    which would require to transform the code in the generic_vs_generic
 *    style as typechecking could also bind metavariables in the process
 *)
and m_compatible_type lang typed_mvar t e =
  match (Type_generic.builtin_type_of_type lang t, e.G.e) with
  | Some builtin, B.L lit -> (
      match (builtin, lit) with
      | T.TInt, B.Int _
      | T.TFloat, B.Float _
      | T.TString, B.String _ ->
          envf typed_mvar (MV.E e)
      | _ -> fail ())
  | _ -> (
      match (t.G.t, e.G.e) with
      (* for C specific literals *)
      | ( G.TyPointer (_, { t = TyN (G.Id (("char", _), _)); _ }),
          B.L (B.String _) ) ->
          envf typed_mvar (MV.E e)
      | G.TyPointer (_, _), B.L (B.Null _) -> envf typed_mvar (MV.E e)
      (* for C strings to match metavariable pointer types *)
      | ( G.TyPointer (t1, { t = G.TyN (G.Id ((_, tok), id_info)); _ }),
          B.L (B.String _) ) ->
          m_type_ t
            (G.TyPointer (t1, G.TyN (G.Id (("char", tok), id_info)) |> G.t)
            |> G.t)
          >>= fun () -> envf typed_mvar (MV.E e)
      (* for matching ids *)
      (* this is covered by the basic type propagation done in Naming_AST.ml *)
      | _ta, B.N (B.Id (idb, ({ B.id_type = tb; _ } as id_infob))) ->
          (* NOTE: Name values must be represented with MV.Id! *)
          m_type_option_with_hook idb (Some t) !tb >>= fun () ->
          envf typed_mvar (MV.Id (idb, Some id_infob))
      | _ta, _eb -> (
          match type_of_expr e with
          | Some (idb, tb) ->
              m_type_option_with_hook idb (Some t) tb >>= fun () ->
              envf typed_mvar (MV.E e)
          | _ -> fail ()))

(* returns a type option and an ident that can be used to query LSP *)
and type_of_expr e : (G.ident * G.type_ option) option =
  match e.B.e with
  | B.New (tk, t, _) -> Some (("new", tk), Some t)
  (* this is covered by the basic type propagation done in Naming_AST.ml *)
  | B.N
      (B.IdQualified
        { name_last = idb, None; name_info = { B.id_type = tb; _ }; _ })
  | B.DotAccess
      ({ e = IdSpecial (This, _); _ }, _, FN (Id (idb, { B.id_type = tb; _ })))
    ->
      Some (idb, !tb)
  (* deep: those are usually resolved only in deep mode *)
  | B.DotAccess (_, _, FN (Id (idb, { B.id_type = tb; _ }))) -> Some (idb, !tb)
  (* deep: same *)
  | B.Call
      ( { e = B.DotAccess (_, _, FN (Id (idb, { B.id_type = tb; _ }))); _ },
        _args ) -> (
      match !tb with
      (* less: in OCaml functions can be curried, so we need to match
       * _params and _args to calculate the resulting type.
       *)
      | Some { t = TyFun (_params, tret); _ } -> Some (idb, Some tret)
      | Some _ -> None
      | None -> None)
  | B.ParenExpr (_, e, _) -> type_of_expr e
  | _ -> None

(*---------------------------------------------------------------------------*)
(* XML *)
(*---------------------------------------------------------------------------*)
and m_xml a b =
  match (a, b) with
  | ( { G.xml_kind = a1; xml_attrs = a2; xml_body = a3 },
      { B.xml_kind = b1; xml_attrs = b2; xml_body = b3 } ) ->
      m_xml_kind a1 b1 >>= fun () ->
      m_attrs a2 b2 >>= fun () -> m_xml_bodies a3 b3

and m_xml_kind a b =
  match (a, b) with
  (* iso: allow a Classic to match a Singleton, and vice versa *)
  | G.XmlClassic (a0, a1, a2, _), B.XmlSingleton (b0, b1, b2)
  | G.XmlSingleton (a0, a1, a2), B.XmlClassic (b0, b1, b2, _) ->
      if_config
        (fun x -> x.Config.xml_singleton_loose_matching)
        ~then_:
          (let* () = m_tok a0 b0 in
           let* () = m_ident a1 b1 in
           let* () = m_tok a2 b2 in
           return ())
        ~else_:(fail ())
  | G.XmlClassic (a0, a1, a2, a3), B.XmlClassic (b0, b1, b2, b3) ->
      let* () = m_tok a0 b0 in
      let* () = m_ident a1 b1 in
      let* () = m_tok a2 b2 in
      let* () = m_tok a3 b3 in
      return ()
  | G.XmlSingleton (a0, a1, a2), B.XmlSingleton (b0, b1, b2) ->
      let* () = m_tok a0 b0 in
      let* () = m_ident a1 b1 in
      let* () = m_tok a2 b2 in
      return ()
  | G.XmlFragment (a1, a2), B.XmlFragment (b1, b2) ->
      let* () = m_tok a1 b1 in
      let* () = m_tok a2 b2 in
      return ()
  | G.XmlClassic _, _
  | G.XmlSingleton _, _
  | G.XmlFragment _, _ ->
      fail ()

and m_attrs a b =
  let has_ellipsis, a = has_xml_ellipsis_and_filter_ellipsis a in
  if_config
    (fun x -> x.xml_attrs_implicit_ellipsis)
    ~then_:(m_list_in_any_order ~less_is_ok:true m_xml_attr a b)
    ~else_:(m_list_in_any_order ~less_is_ok:has_ellipsis m_xml_attr a b)

and m_xml_bodies a b =
  match (a, b) with
  (* dots: *)
  | [ XmlText ("...", _) ], _ -> return ()
  (* dots: metavars:
   * less: we should be more general and use
   * m_list_with_dots_and_metavar_ellipsis() at some point
   *)
  | [ XmlText (s, tok) ], _ when MV.is_metavar_ellipsis s ->
      envf (s, tok) (MV.Xmls b)
  | [ (XmlText _ as a1) ], [ (XmlText _ as b1) ] -> m_xml_body a1 b1
  (* TODO: handle metavar matching a complex Xml elt or even list of elts *)
  | [ XmlText (s, _) ], [ _b ] when MV.is_metavar_name s -> fail ()
  (* TODO: should we impose $...X here to match a list of children? *)
  | [ XmlText (s, _) ], _b when MV.is_metavar_name s -> fail ()
  | _ -> m_list__m_body a b

and m_list__m_body a b =
  match a with
  (* less-is-ok: it's ok to have an empty body in the pattern *)
  | [] -> return ()
  | _ -> m_list m_xml_body a b

and m_xml_attr a b =
  match (a, b) with
  | G.XmlAttr (a1, at, a2), B.XmlAttr (b1, bt, b2) ->
      let* () = m_ident a1 b1 in
      let* () = m_tok at bt in
      m_xml_attr_value a2 b2
  | G.XmlAttrExpr a1, B.XmlAttrExpr b1 -> m_bracket m_expr a1 b1
  | G.XmlEllipsis a1, B.XmlEllipsis b1 -> m_tok a1 b1
  | G.XmlAttr _, _
  | G.XmlAttrExpr _, _
  | G.XmlEllipsis _, _ ->
      fail ()

and m_xml_attr_value a b =
  (* less: deep? *)
  m_expr a b

and m_xml_body a b =
  match (a, b) with
  (* dots: the "..." is actually intercepted now in m_bodies *)
  | G.XmlText a1, B.XmlText b1 ->
      m_string_ellipsis_or_metavar_or_default
        ~m_string_for_default:m_string_xhp_text a1 b1
  (* boilerplate *)
  | G.XmlExpr a1, B.XmlExpr b1 ->
      (* less: could allow ... to match also a None *)
      m_bracket (m_option m_expr) a1 b1
  | G.XmlXml a1, B.XmlXml b1 -> m_xml a1 b1
  | G.XmlText _, _
  | G.XmlExpr _, _
  | G.XmlXml _, _ ->
      fail ()

(*---------------------------------------------------------------------------*)
(* Arguments list iso *)
(*---------------------------------------------------------------------------*)
and m_arguments a b =
  match (a, b) with
  | a, b -> m_bracket m_list__m_argument a b

(* less: factorize in m_list_with_dots? but also has unordered for kwd args *)
and m_list__m_argument (xsa : G.argument list) (xsb : G.argument list) =
  match (xsa, xsb) with
  | [], [] -> return ()
  (* dots: ..., can also match no argument *)
  | [ G.Arg { e = G.Ellipsis _i; _ } ], [] -> return ()
  (* dots: metavars: $...ARGS *)
  | G.Arg { e = G.N (G.Id ((s, tok), _idinfo)); _ } :: xsa, xsb
    when MV.is_metavar_ellipsis s ->
      (* can match 0 or more arguments (just like ...) *)
      let candidates = inits_and_rest_of_list_empty_ok xsb in
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | (inits, rest) :: xs ->
            envf (s, tok) (MV.Args inits)
            >>= (fun () -> m_list__m_argument xsa rest)
            >||> aux xs
      in
      aux candidates
  | G.Arg { e = G.Ellipsis i; _ } :: xsa, xb :: xsb ->
      (* can match nothing *)
      m_list__m_argument xsa (xb :: xsb)
      >||> (* can match more *)
      m_list__m_argument (G.Arg (G.Ellipsis i |> G.e) :: xsa) xsb
  (* unordered kwd argument matching *)
  | (G.ArgKwd (((s, _tok) as ida), ea) as a) :: xsa, xsb
  | (G.ArgKwdOptional (((s, _tok) as ida), ea) as a) :: xsa, xsb -> (
      if MV.is_metavar_name s then
        let candidates = all_elem_and_rest_of_list xsb in
        (* less: could use a fold *)
        let rec aux xs =
          match xs with
          | [] -> fail ()
          | (b, xsb) :: xs ->
              m_argument a b
              >>= (fun () -> m_list__m_argument xsa (lazy_rest_of_list xsb))
              >||> aux xs
        in
        aux candidates
      else
        try
          let before, there, after =
            xsb
            |> Common2.split_when (function
                 | G.ArgKwd ((s2, _), _)
                 | G.ArgKwdOptional ((s2, _), _)
                   when s =$= s2 ->
                     true
                 | _ -> false)
          in
          match there with
          | G.ArgKwd (idb, eb)
          | G.ArgKwdOptional (idb, eb) ->
              m_ident ida idb >>= fun () ->
              m_expr ea eb >>= fun () -> m_list__m_argument xsa (before @ after)
          | _ -> raise Impossible
        with
        | Not_found -> fail ())
  (* the general case *)
  | xa :: aas, xb :: bbs ->
      m_argument xa xb >>= fun () -> m_list__m_argument aas bbs
  | [], xsb ->
      (* If the remaining arguments in the target code are all optional, it's
         a match. *)
      if
        List.for_all
          (function
            | G.ArgKwdOptional _ -> true
            | _ -> false)
          xsb
      then return ()
      else fail ()
  | _ :: _, _ -> fail ()

(* special case m_arguments when inside a Call(Special(Concat,_), ...)
 * less: factorize with m_list_with_dots? hard because of the special
 * call to Normalize_generic below.
 *)
and m_arguments_concat a b =
  match (a, b) with
  | [], [] -> return ()
  (* dots '...' for string literal, can match any number of arguments *)
  | [ G.Arg { e = G.L (G.String ("...", _)); _ } ], _xsb -> return ()
  (* specific case: f"...{$X}..." will properly extract $X from f"foo {bar} baz" *)
  | G.Arg { e = G.L (G.String ("...", a)); _ } :: xsa, B.Arg bexpr :: xsb ->
      (* can match nothing *)
      m_arguments_concat xsa (B.Arg bexpr :: xsb)
      >||> (* can match more *)
      m_arguments_concat (G.Arg (G.L (G.String ("...", a)) |> G.e) :: xsa) xsb
  (* the general case *)
  | xa :: aas, xb :: bbs -> (
      (* exception: for concat strings, don't have ellipsis/metavars match   *)
      (* string literals since string literals are implicitly not   *)
      (* interpolated, and ellipsis/metavars implicitly are                  *)
      match (xa, xb) with
      | G.Arg { e = G.Ellipsis _; _ }, G.Arg { e = G.L (G.String _); _ } ->
          fail ()
      | ( G.Arg { e = G.N (G.Id ((s, _tok), _idinfo)); _ },
          G.Arg { e = G.L (G.String _); _ } )
        when MV.is_metavar_name s ->
          fail ()
      | _ -> m_argument xa xb >>= fun () -> m_arguments_concat aas bbs)
  | [], _
  | _ :: _, _ ->
      fail ()

and m_argument a b =
  match (a, b) with
  (* TODO: iso on keyword argument, keyword is optional in pattern.
   * TODO: maybe Arg (N (Id "$S")) should be allowed to match
   * an ArgType or ArgOther (especially for C/C++ where typedef
   * inference is sometimes wrong when we get an ArgType instead of Arg.
   *)

  (* boilerplate *)
  | G.Arg a1, B.Arg b1 -> m_expr a1 b1
  | G.ArgType a1, B.ArgType b1 -> m_type_ a1 b1
  | G.ArgKwd (a1, a2), B.ArgKwd (b1, b2)
  | G.ArgKwdOptional (a1, a2), B.ArgKwdOptional (b1, b2) ->
      m_ident a1 b1 >>= fun () -> m_expr a2 b2
  | G.OtherArg (a1, a2), B.OtherArg (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.Arg _, _
  | G.ArgKwd _, _
  | G.ArgKwdOptional _, _
  | G.ArgType _, _
  | G.OtherArg _, _ ->
      fail ()

(*---------------------------------------------------------------------------*)
(* Associative-commutative iso *)
(*---------------------------------------------------------------------------*)
and m_call_op aop toka aargs bop tokb bargs tin =
  let is_commutative_operator = function
    | G.BitOr
    | G.BitAnd
    | G.BitXor ->
        true
    (* TODO: Plus, Mult, ... ? *)
    | G.And
    | G.Or ->
        tin.config.commutative_boolop
    | __else__ -> false
  in
  let m_op_default =
    m_arithmetic_operator aop bop >>= fun () -> m_arguments aargs bargs
  in
  (* If this an AC operation we try to perform AC matching, otherwise we perform
   * regular non-AC matching. *)
  if tin.config.ac_matching && aop =*= bop && H.is_associative_operator aop then (
    match
      ( H.ac_matching_nf aop (G.unbracket aargs),
        H.ac_matching_nf bop (B.unbracket bargs) )
    with
    | Some aargs_ac, Some bargs_ac ->
        if is_commutative_operator aop then
          m_ac_op tokb aop aargs_ac bargs_ac tin
        else m_assoc_op tokb aop aargs_ac bargs_ac tin
    | ___else___ ->
        logger#warning
          "Will not perform AC-matching, something went wrong when trying to \
           convert operands to AC normal form: %s ~ %s"
          (G.show_expr
             (G.Call (G.IdSpecial (G.Op aop, toka) |> G.e, aargs) |> G.e))
          (B.show_expr
             (B.Call (B.IdSpecial (B.Op bop, tokb) |> G.e, bargs) |> G.e));
        m_op_default tin)
  else m_op_default tin

(* Associative-matching of operators.
 *
 * This is very similar to m_list__m_argument where $MVAR acts like $...$MVAR
 * (but cannot match an empty list of arguments).
 *
 * NOTE: There is not need for supporting $...MVAR here, and strictly speaking
 *   it doesn't apply either since we still see the operator as binary.
 *)
and m_assoc_op tok op aargs_ac bargs_ac =
  match (aargs_ac, bargs_ac) with
  | [], [] -> return ()
  (* dots: ..., can also match no argument *)
  | [ { e = G.Ellipsis _i; _ } ], [] -> return ()
  (* $MVAR, acting similar to $...MVAR *)
  | ({ e = G.N (G.Id ((s, _tok), _idinfo)); _ } as xa) :: xsa, xsb
    when MV.is_metavar_name s ->
      let candidates = inits_and_rest_of_list_empty_ok xsb in
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | (inits, rest) :: xs -> (
            match H.undo_ac_matching_nf tok op inits with
            | Some op_bs' ->
                m_expr xa op_bs'
                >>= (fun () -> m_assoc_op tok op xsa rest)
                >||> aux xs
            | None -> aux xs)
      in
      aux candidates
  | { e = G.Ellipsis i; _ } :: xsa, xb :: xsb ->
      (* can match nothing *)
      m_assoc_op tok op xsa (xb :: xsb)
      >||> (* can match more *)
      m_assoc_op tok op ((G.Ellipsis i |> G.e) :: xsa) xsb
  | xa :: xsa, xb :: xsb ->
      let* () = m_expr xa xb in
      m_assoc_op tok op xsa xsb
  | _ :: _, []
  | [], _ :: _ ->
      fail ()

(* Associative-Commutative (AC) matching of operators.
 *
 * This for example, will successfully match `a && b && c` against `b && a && c`!
 * It will also match `if (<... b && c ...>) ...` against `if (a && b && c) S`
 * which was not matching before as `a && b && c` is parsed as `(a && b) && c`.
 *
 * NOTE: There is not need for supporting $...MVAR here, and strictly speaking
 *   it doesn't apply either since we still see the operator as binary.
 *
 * BEHAVIOR ISSUES:
 *
 * Even without a deep-expr pattern, `if (b && c) ...` will also match
 * `if (a && b && c) S`. That is, there is an implicit `op ...` added to AC
 * operators. Why? Let's say that we want to match pattern `<... a && b ...>`
 * against `a && (b && c)`, the sub-expressions of `a && (b && c)` are itself,
 * `a`, `b && c`, `b`, and `c`. The only chance to match `a && b` is to do it
 * on `a && (b && c)`, and for that to work we cannot fail when there are
 * operands left to match. TODO: We could try to detect when the AC op-pattern
 * occurs inside a deep-expr and only then assume an implicit `&& ...`.
 *
 * AC-matching of metavariables could lead to some strange behaviors given that
 * we work with ranges. E.g. we can match `a && $X` against `b && a && c` by
 * binding $X to `b && c`, but the range of $X will be that of the whole
 * `b && a && c` expression. Eventually, if we switch to work with the sub-ASTs
 * matched by patterns rather than with their ranges, this will stop being a
 * problem. In the meantime, one can disable AC-matching per rule.
 *
 * Autofix will probably not work well with AC-matching either.
 *
 * PERFORMANCE ISSUES:
 *
 * Note that AC-matching is an NP-complete problem. This is a naive
 * implementation with lots of dumb combinatorial search. We only use
 * AC-matching when we expect it to be fast, otherwise we fall-back to
 * regular non-AC matching.
 *
 * For a more efficient AC matching algorithm, see paper by Steven M. Eker:
 *
 *     "Associative-Commutative Matching Via Bipartite Graph Matching"
 *)
and m_ac_op tok op aargs_ac bargs_ac =
  (* Partitition aargs_ac to separate metavariables and ellipsis (avars) from
   * non-mvar-ish expressions (aapps). *)
  let avars, aapps =
    aargs_ac
    |> List.partition (fun e ->
           match e.G.e with
           | G.Ellipsis _ -> true
           | G.N (G.Id ((str, _tok), _id_info)) -> MV.is_metavar_name str
           | ___else___ -> false)
  in
  (* Try to match each aapp with a different barg, this is a 1-to-1 matching.
   * Here we don't expect perf issues on real code, because each aapp will
   * typically only match one bargs_ac, so there should be no combinatorial
   * explosion. Of course one can construct a synthetic example that explodes!
   * E.g. matching a long pattern `A && B && ...` against a very long decision
   * `A && ... && A && B && ... && B && ...` could explode.
   *)
  let bs_left =
    match aapps with
    (* if there are no aapps we don't want to fail *)
    | [] -> m_comb_unit bargs_ac
    | _ -> m_comb_unit bargs_ac |> m_comb_fold (m_comb_1to1 m_expr) aapps
  in
  (* Try to match each variable with a unique disjoint subset of the remaining
   * bs_left, ellipsis (`...`) can match the empty set. This can easily
   * explode so we only perform full AC matching for variables when the
   * number of bs left to match (num_bs_left) is small. Note that an mvar will
   * typically match all subsets of the bs left!!! *)
  let num_bs_left = List.length bargs_ac - List.length aapps in
  let avars_no_end_dots =
    (* An ending ellipsis (...) can be removed without affecting the result
     * but reducing duplicates and improving perf. *)
    match List.rev avars with
    | { e = G.Ellipsis _; _ } :: rev_avars -> List.rev rev_avars
    | ____else____ -> avars
  in
  match avars_no_end_dots with
  (* Nothing to do here, just return. *)
  | [] -> m_comb_flatten bs_left
  | ___many___ when num_bs_left <= 3 ->
      (* AC matching, it explodes easily so use with care! *)
      let m_var x bs' =
        (* `...` can match the empty set, whereas `$MVAR` must much something. *)
        match (x, H.undo_ac_matching_nf tok op bs') with
        | { G.e = G.Ellipsis _; _ }, None -> return ()
        | ___mvar___, None -> fail ()
        | ___mvar___, Some op_bs' -> m_expr x op_bs'
      in
      bs_left
      |> m_comb_fold (m_comb_1toN m_var) avars_no_end_dots
      |> m_comb_flatten
  | ___many___ ->
      (* FALLBACK: We add an ellipsis (`...`) at the end to make sure we match even if
       * there are more bs left than avars, and then we do regular non-AC matching.
       *
       * TODO: Could we first fallback to associative-only matching? It could still
       *       explode but not as easily
       *)
      (* TODO: Issue a proper warning to the user. *)
      logger#warning
        "Restricted AC-matching due to potential blow-up: op=%s avars#=%d \
         bs_left#=%d\n"
        (G.show_operator op) (List.length avars) num_bs_left;
      m_comb_bind bs_left (fun bs' tin ->
          let avars_dots =
            avars_no_end_dots @ [ G.Ellipsis (G.fake "...") |> G.e ]
          in
          let tout =
            m_list__m_argument
              (Common.map G.arg avars_dots)
              (Common.map B.arg bs') tin
          in
          [ ([], tout) ])
      |> m_comb_flatten

(*****************************************************************************)
(* Type *)
(*****************************************************************************)
and m_type_ a b =
  Trace_matching.(if on then print_type_pair a b);
  let* () = m_attributes a.t_attrs b.t_attrs in
  match (a.t, b.t) with
  (* this must be before the next case, to prefer to bind metavars to
   * MV.Id (or MV.N) when we can, instead of the more general MV.T below *)
  | G.TyN a1, B.TyN b1 -> m_name a1 b1
  | G.TyN (G.Id ((str, tok), _id_info)), _t2 when MV.is_metavar_name str ->
      envf (str, tok) (MV.T b)
  (* dots: *)
  | G.TyEllipsis _, _ -> return ()
  (* boilerplate *)
  | G.TyFun (a1, a2), B.TyFun (b1, b2) ->
      m_parameters a1 b1 >>= fun () -> m_type_ a2 b2
  | G.TyArray (a1, a2), B.TyArray (b1, b2) ->
      m_bracket (m_option m_expr) a1 b1 >>= fun () -> m_type_ a2 b2
  | G.TyTuple a1, B.TyTuple b1 ->
      let partial_m_list_with_dots =
        m_list_with_dots m_type_ (function
          | { t = G.TyEllipsis _; _ } -> true
          | _ -> false)
      in
      (m_bracket (partial_m_list_with_dots ~less_is_ok:false)) a1 b1
  | G.TyAny a1, B.TyAny b1 -> m_tok a1 b1
  | G.TyApply (a1, a2), B.TyApply (b1, b2) ->
      m_type_ a1 b1 >>= fun () -> m_type_arguments a2 b2
  | G.TyVar a1, B.TyVar b1 -> m_ident a1 b1
  | G.TyPointer (a0, a1), B.TyPointer (b0, b1) ->
      m_tok a0 b0 >>= fun () -> m_type_ a1 b1
  | G.TyRef (a0, a1), B.TyRef (b0, b1) ->
      m_tok a0 b0 >>= fun () -> m_type_ a1 b1
  | G.TyQuestion (a1, a2), B.TyQuestion (b1, b2) ->
      m_type_ a1 b1 >>= fun () -> m_tok a2 b2
  | G.TyRest (a1, a2), B.TyRest (b1, b2) ->
      m_tok a1 b1 >>= fun () -> m_type_ a2 b2
  | G.TyRecordAnon (a0, a1), B.TyRecordAnon (b0, b1) ->
      let* () = m_class_kind a0 b0 in
      m_bracket m_fields a1 b1
  | G.TyOr (a1, a2, a3), B.TyOr (b1, b2, b3) ->
      m_type_ a1 b1 >>= fun () ->
      m_tok a2 b2 >>= fun () -> m_type_ a3 b3
  | G.TyAnd (a1, a2, a3), B.TyAnd (b1, b2, b3) ->
      m_type_ a1 b1 >>= fun () ->
      m_tok a2 b2 >>= fun () -> m_type_ a3 b3
  | G.TyExpr a1, B.TyExpr b1 -> m_expr a1 b1
  | G.OtherType (a1, a2), B.OtherType (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.TyFun _, _
  | G.TyApply _, _
  | G.TyVar _, _
  | G.TyArray _, _
  | G.TyPointer _, _
  | G.TyTuple _, _
  | G.TyQuestion _, _
  | G.TyRest _, _
  | G.TyN _, _
  | G.TyAny _, _
  | G.TyOr _, _
  | G.TyAnd _, _
  | G.TyRecordAnon _, _
  | G.TyRef _, _
  | G.TyExpr _, _
  | G.OtherType _, _ ->
      fail ()

and m_type_arguments a b =
  match (a, b) with
  | a, b -> m_bracket (m_list m_type_argument) a b

and m_type_argument a b =
  match (a, b) with
  | G.TA a1, B.TA b1 -> m_type_ a1 b1
  | G.TAWildcard (a1, a2), B.TAWildcard (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_option m_wildcard a2 b2
  | G.TAExpr a1, B.TAExpr b1 -> m_expr a1 b1
  | G.OtherTypeArg (a1, a2), B.OtherTypeArg (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.TA _, _
  | G.TAWildcard _, _
  | G.TAExpr _, _
  | G.OtherTypeArg _, _ ->
      fail ()

and m_todo_kind a b = m_ident a b

and m_wildcard (a1, a2) (b1, b2) =
  let* () = m_wrap m_bool a1 b1 in
  m_type_ a2 b2

(*****************************************************************************)
(* Attribute *)
(*****************************************************************************)
and m_keyword_attribute a b =
  match (a, b) with
  | G.Var, B.Var -> return ()
  (* equivalent: quite JS-specific *)
  | G.Var, (B.Let | B.Const) ->
      if_config (fun x -> x.let_is_var) ~then_:(return ()) ~else_:(fail ())
  | _ -> m_other_xxx a b

and m_attribute a b =
  match (a, b) with
  (* boilerplate *)
  | G.KeywordAttr a1, B.KeywordAttr b1 -> m_wrap m_keyword_attribute a1 b1
  | G.NamedAttr (a0, a1, a2), B.NamedAttr (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      (* 'm_name' handles aliasing for attributes! *)
      m_name a1 b1 >>= fun () -> m_bracket m_list__m_argument a2 b2
  | G.OtherAttribute (a1, a2), B.OtherAttribute (b1, b2) ->
      m_other_attribute_operator a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.KeywordAttr _, _
  | G.NamedAttr _, _
  | G.OtherAttribute _, _ ->
      fail ()

and m_attributes a b = m_list_in_any_order ~less_is_ok:true m_attribute a b
and m_other_attribute_operator = m_other_xxx

(*****************************************************************************)
(* Statement list *)
(*****************************************************************************)
(* possibly go deeper when someone wants that a pattern like
 *   ...
 *   bar();
 * to match also calls to bar() deeply as in
 *   foo();
 *   if(true)
 *      bar();
 *
 * When combined with the deep expr, this even allows to match code like
 *  if(true)
 *     x = bar();
 *
 * This is currently very hacky. We just flatten the list of all substmts.
 *
 * alternatives:
 *   - do it the right way by having '...' work on control-flow paths as in
 *     coccinelle
 *
 * todo? we could restrict ourselves to only a few forms?
 *)
(* experimental! *)
and m_stmts_deep ~inside ~less_is_ok (xsa : G.stmt list) (xsb : G.stmt list) tin
    =
  (* shares the cache with m_list__m_stmt *)
  match (tin.cache, xsa, xsb) with
  | Some cache, a :: _, _ :: _ when a.s_use_cache ->
      let tin = { tin with mv = Env.update_min_env tin.mv a } in
      Caching.Cache.match_stmt_list ~access:cache_access ~cache
        ~function_id:CK.Match_deep ~list_kind:CK.Original ~less_is_ok
        ~compute:(m_stmts_deep_uncached ~inside ~less_is_ok)
        ~pattern:xsa ~target:xsb tin
  | _ -> m_stmts_deep_uncached ~inside ~less_is_ok xsa xsb tin

and m_stmts_deep_uncached ~inside ~less_is_ok (xsa : G.stmt list)
    (xsb : G.stmt list) =
  (* opti: this was the old code:
   *   if !Flag.go_deeper_stmt && (has_ellipsis_stmts xsa)
   *   then
   *   m_list__m_stmt xsa xsb >!> (fun () ->
   *     let xsb' = SubAST_generic.flatten_substmts_of_stmts xsb in
   *     m_list__m_stmt xsa xsb'
   *   )
   *   else m_list__m_stmt xsa xsb
   *
   * but this was really slow on huge files because with a pattern like
   * 'foo(); ...; bar();' we would call flatten_substmts_of_stmts
   * on each sequences in the program, even though foo(); was not
   * matched first.
   * Better to first match the first element, and if it matches and
   * we have a '...' that was not matched on the current sequence,
   * then we try with flatten_substmts_of_stmts.
   *
   * The code below is mostly a copy paste of m_list__m_stmt. We could
   * factorize, but I prefer to control and limit the number of places
   * where we call m_stmts_deep. Once we call m_list__m_stmt, we
   * are in a simpler world where the list of stmts will not grow.
   *)
  match (xsa, xsb) with
  | [], [] -> return ()
  (* less-is-ok:
   * it's ok to have statements after in the concrete code as long as we
   * matched all the statements in the pattern (there is an implicit
   * '...' at the end, in addition to implicit '...' at the beginning
   * handled by kstmts calling the pattern for each subsequences).
   * TODO: sgrep_generic though then display the whole sequence as a match
   * instead of just the relevant part.
   *)
  | [], _ :: _ -> if less_is_ok then return () else fail ()
  (* dots: '...', can also match no statement *)
  | [ { s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } ], [] -> return ()
  (* inside:
   * When a pattern-inside (or pattern-not-inside) ends in ... we do not
   * need to compute all possible endings, it's enough to return the largest
   * one. If some other pattern P matches inside the largest match here, then
   * that is enough to either keep P (pattern-inside) or filter it out
   * (pattern-not-inside).
   *)
  | [ { s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } ], xb :: bbs
    when inside ->
      env_add_matched_stmt xb >>= fun () ->
      m_stmts_deep_uncached ~inside ~less_is_ok xsa bbs
  | ( ({ s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } :: _ as xsa),
      (_ :: _ as xsb) ) ->
      (* let's first try without going deep *)
      m_list__m_stmt ~list_kind:CK.Original xsa xsb >!> fun () ->
      if_config
        (fun x -> x.go_deeper_stmt)
        ~then_:
          (if not (stmts_may_match xsa xsb) then fail ()
          else
            match SubAST_generic.flatten_substmts_of_stmts xsb with
            | None -> fail () (* was already flat *)
            | Some (xsb, last_stmt) ->
                m_list__m_stmt ~list_kind:(CK.Flattened_until last_stmt.s_id)
                  xsa xsb)
        ~else_:(fail ())
  (* dots: metavars: $...BODY *)
  | ( ({ s = G.ExprStmt ({ e = G.N (G.Id ((s, _), _idinfo)); _ }, _); _ } :: _
      as xsa),
      xsb )
    when MV.is_metavar_ellipsis s ->
      (* less: for metavariable ellipsis, does it make sense to go deep? *)
      m_list__m_stmt ~list_kind:CK.Original xsa xsb
  (* the general case *)
  | xa :: aas, xb :: bbs ->
      m_stmt xa xb >>= fun () ->
      env_add_matched_stmt xb >>= fun () ->
      m_stmts_deep ~inside ~less_is_ok aas bbs
  | _ :: _, _ -> fail ()

and m_list__m_stmt ?less_is_ok ~list_kind xsa xsb tin =
  (* shares the cache with m_stmts_deep *)
  match (tin.cache, xsa, xsb) with
  | Some cache, a :: _, _ :: _ when a.s_use_cache ->
      let tin = { tin with mv = Env.update_min_env tin.mv a } in
      Caching.Cache.match_stmt_list ~access:cache_access ~cache
        ~function_id:CK.Match_list ~list_kind ~less_is_ok:true
        ~compute:(m_list__m_stmt_uncached ?less_is_ok ~list_kind)
        ~pattern:xsa ~target:xsb tin
  | _ -> m_list__m_stmt_uncached ?less_is_ok ~list_kind xsa xsb tin

(* TODO: factorize with m_list_and_dots less_is_ok = true *)
(* coupling: many of the cases below are similar to the one in
 * m_stmts_deep_uncached.
 * TODO? can we remove the duplication
 *)
and m_list__m_stmt_uncached ?(less_is_ok = true) ~list_kind (xsa : G.stmt list)
    (xsb : G.stmt list) =
  logger#ldebug
    (lazy
      (spf "m_list__m_stmt_uncached: %d vs %d" (List.length xsa)
         (List.length xsb)));
  match (xsa, xsb) with
  | [], [] -> return ()
  (* less-is-ok:
   * it's ok to have statements after in the concrete code as long as we
   * matched all the statements in the pattern (there is an implicit
   * '...' at the end, in addition to implicit '...' at the beginning
   * handled by kstmts calling the pattern for each subsequences).
   * TODO: sgrep_generic though then display the whole sequence as a match
   * instead of just the relevant part.
   *)
  | [], _ :: _ -> if less_is_ok then return () else fail ()
  (* dots: '...', can also match no statement *)
  | [ { s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } ], [] -> return ()
  | ( { s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } :: xsa_tail,
      (xb :: xsb_tail as xsb) ) ->
      (* can match nothing *)
      m_list__m_stmt ~list_kind xsa_tail xsb
      >||> (* can match more *)
      ( env_add_matched_stmt xb >>= fun () ->
        m_list__m_stmt ~list_kind xsa xsb_tail )
  (* dots: metavars: $...BODY *)
  | ( { s = G.ExprStmt ({ e = G.N (G.Id ((s, tok), _idinfo)); _ }, _); _ } :: xsa,
      xsb )
    when MV.is_metavar_ellipsis s ->
      (* can match 0 or more arguments *)
      let candidates = inits_and_rest_of_list_empty_ok xsb in
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | (inits, rest) :: xs ->
            envf (s, tok) (MV.Ss inits)
            >>= (fun () ->
                  (* less: env_add_matched_stmt ?? *)
                  (* when we use { $...BODY }, we don't have an implicit
                   * ... after, so we use less_is_ok:false here
                   *)
                  m_list__m_stmt ~less_is_ok:false ~list_kind xsa rest)
            >||> aux xs
      in
      aux candidates
  (* the general case *)
  | xa :: aas, xb :: bbs ->
      m_stmt xa xb >>= fun () ->
      env_add_matched_stmt xb >>= fun () -> m_list__m_stmt ~list_kind aas bbs
  | _ :: _, _ -> fail ()

(*****************************************************************************)
(* Statement *)
(*****************************************************************************)
and m_stmt a b =
  Trace_matching.(if on then print_stmt_pair a b);
  match (a.s, b.s) with
  (* the order of the matches matters! take care! *)
  (* equivalence: user-defined equivalence! *)
  | G.DisjStmt (a1, a2), _b -> m_stmt a1 b >||> m_stmt a2 b
  (* metavar: *)
  (* Note that we can't consider $S a statement metavariable only if the
   * semicolon is a fake one. Indeed in many places we have patterns
   * like 'if(...) $S;' because 'if(...) $S' would not parse.
   * alt: parse if(...) $S without the ending semicolon?
   * But at least we can try to match $S as a statement metavar
   * _or_ an expression metavar with >||>. below
   *)
  | G.ExprStmt (({ e = G.N (G.Id ((str, tok), _id_info)); _ } as suba), sc), _b
    when MV.is_metavar_name str -> (
      envf (str, tok) (MV.S b)
      >||>
      match b.s with
      | B.ExprStmt (subb, _) when not (Parse_info.is_fake sc) ->
          m_expr suba subb
      | _ -> fail ())
  (* dots: '...' can to match any statememt *)
  | G.ExprStmt ({ e = G.Ellipsis _i; _ }, _), _b -> return ()
  (* deep ellipsis as a statement should match any exprs in stmt *)
  | G.ExprStmt ({ e = G.DeepEllipsis (_, a, _); _ }, _), b ->
      let no_match _ _ = fail () in
      m_deep m_expr_deep no_match SubAST_generic.subexprs_of_stmt_kind a b
  | G.Return (a0, a1, asc), B.Return (b0, b1, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_option_ellipsis_ok m_expr a1 b1 in
      m_tok asc bsc
  (* deeper: go deep by default implicitly (no need for explicit <... ...>) *)
  | G.ExprStmt (a1, a2), B.ExprStmt (b1, b2) ->
      m_expr_deep a1 b1 >>= fun () -> m_tok a2 b2
  (* opti: specialization to avoid going in the deep stmt matching!
   * TODO: we should not need this; '...' should not enumerate all
   * possible subset of stmt list and take forever.
   * Note that as a side effect it returns also less equivalent
   * matches (which again, should not happen), which used to introduce
   * some regressions (see tests/OTHER/rules/regression_uniq...) but this
   * has been fixed now.
   *)
  | ( G.Block (_, [ { s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } ], _),
      B.Block _b1 ) ->
      return ()
  (* opti: another specialization; again we should not need it *)
  | ( G.Block
        ( _,
          [
            { s = G.ExprStmt ({ e = G.Ellipsis _; _ }, _); _ };
            a;
            { s = G.ExprStmt ({ e = G.Ellipsis _; _ }, _); _ };
          ],
          _ ),
      B.Block (_, bs, _) ) ->
      let bs =
        match SubAST_generic.flatten_substmts_of_stmts bs with
        (* already flat  *)
        | None -> bs
        | Some (xs, _) -> xs
      in
      or_list m_stmt a bs
  (* the general case *)
  (* ... will now allow a subset of stmts (less_is_ok = false here) *)
  | G.Block a1, B.Block b1 ->
      m_bracket (m_stmts_deep ~inside:false ~less_is_ok:false) a1 b1
  (* equivalence: vardef ==> assign, and go deep.
   * coupling: with Visitor_AST.v_vardef_as_assign_expr which also deals with
   * vardef-assign equivalence. But the code there is useful when the pattern
   * is an expression and we want to visit also certain DefStmt as expressions.
   * Here instead, the pattern is a statement, so we need to duplicate the
   * logic.
   *)
  | ( G.ExprStmt (a1, _),
      B.DefStmt (ent, B.VarDef ({ B.vinit = Some _; _ } as def)) ) ->
      if_config
        (fun x -> x.vardef_assign)
        ~then_:
          (let b1 = H.vardef_to_assign (ent, def) in
           m_expr_deep a1 b1)
        ~else_:(fail ())
  (* coupling: with Visitor_AST.v_flddef_as_assign_expr *)
  | ( G.ExprStmt (({ G.e = Assign _; _ } as a1), _sc),
      B.DefStmt (ent, B.FuncDef fdef) ) ->
      if_config
        (fun x -> x.flddef_assign)
        ~then_:
          (let resolved = Some (G.LocalVar, G.sid_TODO) in
           let b1 = H.funcdef_to_lambda (ent, fdef) resolved in
           m_expr a1 b1)
        ~else_:(fail ())
  (* equivalence: *)
  | G.ExprStmt (a1, _), B.Return (_, Some b1, _) -> m_expr_deep a1 b1
  (* boilerplate *)
  | G.If (a0, a1, a2, a3), B.If (b0, b1, b2, b3) ->
      m_tok a0 b0 >>= fun () ->
      (* too many regressions doing m_expr_deep by default; Use DeepEllipsis *)
      m_condition a1 b1 >>= fun () ->
      m_block a2 b2 >>= fun () ->
      (* less-is-more: *)
      m_option_none_can_match_some m_block a3 b3
  | G.While (a0, a1, a2), B.While (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_condition a1 b1 >>= fun () -> m_stmt a2 b2
  | G.DefStmt a1, B.DefStmt b1 -> m_definition a1 b1
  | G.DirectiveStmt a1, B.DirectiveStmt b1 -> m_directive a1 b1
  | G.DoWhile (a0, a1, a2), B.DoWhile (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_stmt a1 b1 >>= fun () -> m_expr a2 b2
  | G.For (a0, a1, a2), B.For (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_for_header a1 b1 >>= fun () -> m_stmt a2 b2
  | G.Switch (at, a1, a2), B.Switch (bt, b1, b2) ->
      m_tok at bt >>= fun () ->
      m_option m_condition a1 b1 >>= fun () -> m_case_clauses a2 b2
  | G.Continue (a0, a1, asc), B.Continue (b0, b1, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_label_ident a1 b1 in
      m_tok asc bsc
  | G.Break (a0, a1, asc), B.Break (b0, b1, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_label_ident a1 b1 in
      m_tok asc bsc
  | G.Label (a1, a2), B.Label (b1, b2) ->
      m_label a1 b1 >>= fun () -> m_stmt a2 b2
  | G.Goto (a0, a1, asc), B.Goto (b0, b1, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_label a1 b1 in
      m_tok asc bsc
  | G.Throw (a0, a1, asc), B.Throw (b0, b1, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_expr a1 b1 in
      m_tok asc bsc
  | G.Try (a0, a1, a2, a3), B.Try (b0, b1, b2, b3) ->
      let* () = m_tok a0 b0 in
      let* () = m_stmt a1 b1 in
      let* () = (m_list m_catch) a2 b2 in
      (m_option m_finally) a3 b3
  | G.Assert (a0, aargs, asc), B.Assert (b0, bargs, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_arguments aargs bargs in
      m_tok asc bsc
  | G.OtherStmt (a1, a2), B.OtherStmt (b1, b2) ->
      m_other_stmt_operator a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.OtherStmtWithStmt (a1, a2, a3), B.OtherStmtWithStmt (b1, b2, b3) ->
      m_other_stmt_with_stmt_operator a1 b1 >>= fun () ->
      m_list m_any a2 b2 >>= fun () -> m_stmt a3 b3
  | G.WithUsingResource (a1, a2, a3), B.WithUsingResource (b1, b2, b3) ->
      m_tok a1 b1 >>= fun () ->
      m_stmt a2 b2 >>= fun () -> m_stmt a3 b3
  | G.ExprStmt _, _
  | G.DefStmt _, _
  | G.DirectiveStmt _, _
  | G.Block _, _
  | G.If _, _
  | G.While _, _
  | G.DoWhile _, _
  | G.For _, _
  | G.Switch _, _
  | G.Return _, _
  | G.Continue _, _
  | G.Break _, _
  | G.Label _, _
  | G.Goto _, _
  | G.Throw _, _
  | G.Try _, _
  | G.Assert _, _
  | G.OtherStmt _, _
  | G.OtherStmtWithStmt _, _
  | G.WithUsingResource _, _ ->
      fail ()

and m_condition a b =
  match (a, b) with
  | G.Cond a1, B.Cond b1 -> m_expr a1 b1
  | G.OtherCond (a1, a2), B.OtherCond (b1, b2) ->
      let* () = m_todo_kind a1 b1 in
      let* () = m_list m_any a2 b2 in
      return ()
  | G.Cond _, _
  | G.OtherCond _, _ ->
      fail ()

and m_case_clauses a b =
  let _has_ellipsis, a = has_case_ellipsis_and_filter_ellipsis a in
  (* todo? always implicit ...?
   * todo? do in any order? In theory the order of the cases matter, but
   * in a semgrep context, people probably don't want to find
   * specific cases in a specific order.
   *)
  m_list_in_any_order ~less_is_ok:true m_case_and_body a b

and m_for_header a b =
  match (a, b) with
  (* dots: *)
  | G.ForEllipsis _, _ -> return ()
  | G.ForClassic (a1, a2, a3), B.ForClassic (b1, b2, b3) ->
      (m_list m_for_var_or_expr) a1 b1 >>= fun () ->
      m_option m_expr a2 b2 >>= fun () -> m_option m_expr a3 b3
  | G.ForEach (a1, at, a2), B.ForEach (b1, bt, b2) ->
      m_pattern a1 b1 >>= fun () ->
      m_tok at bt >>= fun () -> m_expr a2 b2
  | G.ForIn (a1, a2), B.ForIn (b1, b2) ->
      (m_list m_for_var_or_expr) a1 b1 >>= fun () ->
      m_list_with_dots m_expr
        (function
          | { e = G.Ellipsis _; _ } -> true
          | _ -> false)
        ~less_is_ok:false a2 b2
  | G.ForClassic _, _
  | G.ForEach _, _
  | G.ForIn _, _ ->
      fail ()

and m_block a b =
  match (a.s, b.s) with
  | G.Block _, B.Block _ -> m_stmt a b
  | G.Block (_, [ a_stmt ], _), _ -> m_stmt a_stmt b
  | _, B.Block (_, [ b_stmt ], _) -> m_stmt a b_stmt
  | _, _ -> m_stmt a b

and m_for_var_or_expr a b =
  match (a, b) with
  | G.ForInitVar (a1, a2), B.ForInitVar (b1, b2) ->
      m_entity a1 b1 >>= fun () -> m_variable_definition a2 b2
  | G.ForInitExpr a1, B.ForInitExpr b1 -> m_expr a1 b1
  | G.ForInitVar _, _
  | G.ForInitExpr _, _ ->
      fail ()

and m_label a b =
  match (a, b) with
  | a, b -> m_ident a b

and m_catch a b =
  match (a, b) with
  | (at, a1, a2), (bt, b1, b2) ->
      m_tok at bt >>= fun () ->
      m_catch_exn a1 b1 >>= fun () -> m_stmt a2 b2

and m_catch_exn a b =
  match (a, b) with
  (* dots: *)
  | G.CatchPattern (G.PatEllipsis _), _ -> return ()
  (* boilerplate *)
  | G.CatchPattern a, CatchPattern b -> m_pattern a b
  | G.CatchParam a, B.CatchParam b -> m_parameter_classic a b
  | G.OtherCatch (a0, a1), B.OtherCatch (b0, b1) ->
      let* () = m_todo_kind a0 b0 in
      m_list m_any a1 b1
  | G.CatchPattern _, _
  | G.OtherCatch _, _
  | G.CatchParam _, _ ->
      fail ()

and m_finally a b =
  match (a, b) with
  | (at, a), (bt, b) -> m_tok at bt >>= fun () -> m_stmt a b

and m_case_and_body a b =
  match (a, b) with
  | CasesAndBody (a1, a2), CasesAndBody (b1, b2) ->
      (m_list m_case) a1 b1 >>= fun () -> m_stmt a2 b2
  | CaseEllipsis _, CasesAndBody _ -> return ()
  | CasesAndBody _, _
  | CaseEllipsis _, _ ->
      fail ()

and m_case a b =
  match (a, b) with
  | G.Case (a0, a1), B.Case (b0, b1) ->
      m_tok a0 b0 >>= fun () -> m_pattern a1 b1
  | G.CaseEqualExpr (a0, a1), B.CaseEqualExpr (b0, b1) ->
      m_tok a0 b0 >>= fun () -> m_expr a1 b1
  | G.Default a0, B.Default b0 -> m_tok a0 b0
  | G.OtherCase (a0, a1), B.OtherCase (b0, b1) ->
      let* () = m_todo_kind a0 b0 in
      m_list m_any a1 b1
  | G.Case _, _
  | G.Default _, _
  | G.CaseEqualExpr _, _
  | G.OtherCase _, _ ->
      fail ()

and m_other_stmt_operator = m_other_xxx
and m_other_stmt_with_stmt_operator = m_other_xxx

(*****************************************************************************)
(* Pattern *)
(*****************************************************************************)
and m_pattern a b =
  match (a, b) with
  (* equivalence: user-defined equivalence! *)
  | G.DisjPat (a1, a2), b -> m_pattern a1 b >||> m_pattern a2 b
  (* metavar: *)
  (* less: G.PatId vs B.PatId? Use MV.Id then ? *)
  | G.PatId ((str, tok), _id_info), b2 when MV.is_metavar_name str -> (
      try
        let e2 = H.pattern_to_expr b2 in
        envf (str, tok) (MV.E e2)
        (* this can happen with PatAs in exception handler in Python *)
      with
      | H.NotAnExpr -> envf (str, tok) (MV.P b2))
  (* dots: *)
  | G.PatEllipsis _, _ -> return ()
  (* boilerplate *)
  | G.PatId (a1, a2), B.PatId (b1, b2) ->
      m_ident a1 b1 >>= fun () -> m_id_info a2 b2
  | G.PatLiteral a1, B.PatLiteral b1 -> m_literal a1 b1
  | G.PatType a1, B.PatType b1 -> m_type_ a1 b1
  | G.PatConstructor (a1, a2), B.PatConstructor (b1, b2) ->
      m_name a1 b1 >>= fun () ->
      (m_list_with_dots ~less_is_ok:false m_pattern (function
        | G.PatEllipsis _ -> true
        | _ -> false))
        a2 b2
  | G.PatTuple a1, B.PatTuple b1 -> m_bracket (m_list m_pattern) a1 b1
  | G.PatList a1, B.PatList b1 -> m_bracket (m_list m_pattern) a1 b1
  | G.PatRecord a1, B.PatRecord b1 -> m_bracket (m_list m_field_pattern) a1 b1
  | G.PatKeyVal (a1, a2), B.PatKeyVal (b1, b2) ->
      m_pattern a1 b1 >>= fun () -> m_pattern a2 b2
  | G.PatUnderscore a1, B.PatUnderscore b1 -> m_tok a1 b1
  | G.PatDisj (a1, a2), B.PatDisj (b1, b2) ->
      m_pattern a1 b1 >>= fun () -> m_pattern a2 b2
  | G.PatAs (a1, (a2, a3)), B.PatAs (b1, (b2, b3)) ->
      m_pattern a1 b1 >>= fun () -> m_ident_and_id_info (a2, a3) (b2, b3)
  | G.PatTyped (a1, a2), B.PatTyped (b1, b2) ->
      m_pattern a1 b1 >>= fun () -> m_type_ a2 b2
  | G.PatWhen (a1, a2), B.PatWhen (b1, b2) ->
      m_pattern a1 b1 >>= fun () -> m_expr a2 b2
  | G.OtherPat (a1, a2), B.OtherPat (b1, b2) ->
      m_other_pattern_operator a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.PatId _, _
  | G.PatLiteral _, _
  | G.PatConstructor _, _
  | G.PatTuple _, _
  | G.PatList _, _
  | G.PatRecord _, _
  | G.PatKeyVal _, _
  | G.PatUnderscore _, _
  | G.PatDisj _, _
  | G.PatWhen _, _
  | G.PatAs _, _
  | G.PatTyped _, _
  | G.OtherPat _, _
  | G.PatType _, _ ->
      fail ()

and m_field_pattern a b =
  match (a, b) with
  | (a1, a2), (b1, b2) -> m_dotted_name a1 b1 >>= fun () -> m_pattern a2 b2

and m_other_pattern_operator = m_other_xxx

(*****************************************************************************)
(* Definitions *)
(*****************************************************************************)
and m_definition a b =
  Trace_matching.(if on then print_definition_pair a b);
  match (a, b) with
  | (a1, a2), (b1, b2) ->
      (* subtle: if you change the order here, so that we execute m_entity
       * only when the definition_kind matches, this helps to avoid
       * calls to ocamllsp when you put a type constraint on a function.
       * Indeed, we will call ocamllsp only for FuncDef.
       * This also avoids to call ocamllsp on type definition entities,
       * which can leads to errors in type_of_string.
       *)
      let* () = m_entity a1 b1 in
      let* () = m_definition_kind a2 b2 in
      return ()

and m_entity a b =
  match (a, b) with
  (* bugfix: when we use a metavar to match an entity, as in $X(...): ...
   * and later we use $X again to match a name, the $X is first an ident and
   * later an expression, which would prevent a match. Instead we need to
   * make $X an expression early on.
   * update: actually better to use a special MV.Id for that.
   *)
  | ( { G.name = a1; attrs = a2; tparams = a4 },
      { B.name = b1; attrs = b2; tparams = b4 } ) ->
      m_entity_name a1 b1 >>= fun () ->
      m_attributes a2 b2 >>= fun () -> m_list__m_type_parameter a4 b4

and m_list__m_type_parameter a b =
  match a with
  (* less-is-ok: it's ok to not have generics at all in the pattern.
   * TODO? or should we impose that the entity name above is a metavariable?
   * and then bind it to an IdQualifier with a type_argument?
   *)
  | [] -> return ()
  | _ ->
      m_list_with_dots m_type_parameter
        (function
          | G.TParamEllipsis _ -> true
          | _ -> false)
        ~less_is_ok:false (* empty list can not match non-empty list *) a b

and m_definition_kind a b =
  match (a, b) with
  (* boilerplate *)
  | G.EnumEntryDef a1, B.EnumEntryDef b1 -> m_enum_entry_definition a1 b1
  | G.FuncDef a1, B.FuncDef b1 -> m_function_definition a1 b1
  | G.VarDef a1, B.VarDef b1 -> m_variable_definition a1 b1
  | G.FieldDefColon a1, B.FieldDefColon b1 -> m_variable_definition a1 b1
  | G.ClassDef a1, B.ClassDef b1 -> m_class_definition a1 b1
  | G.TypeDef a1, B.TypeDef b1 -> m_type_definition a1 b1
  | G.ModuleDef a1, B.ModuleDef b1 -> m_module_definition a1 b1
  | G.MacroDef a1, B.MacroDef b1 -> m_macro_definition a1 b1
  | G.Signature a1, B.Signature b1 -> m_type_ a1 b1
  | G.UseOuterDecl a1, B.UseOuterDecl b1 -> m_tok a1 b1
  | G.OtherDef (a1, a2), B.OtherDef (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.FuncDef _, _
  | G.VarDef _, _
  | G.ClassDef _, _
  | G.TypeDef _, _
  | G.ModuleDef _, _
  | G.MacroDef _, _
  | G.Signature _, _
  | G.UseOuterDecl _, _
  | G.FieldDefColon _, _
  | G.EnumEntryDef _, _
  | G.OtherDef _, _ ->
      fail ()

and m_enum_entry_definition a b =
  match (a, b) with
  | { G.ee_args = a1; ee_body = a2 }, { B.ee_args = b1; ee_body = b2 } ->
      let* () = m_option m_arguments a1 b1 in
      let* () = m_option (m_bracket m_fields) a2 b2 in
      return ()

and m_type_parameter a b =
  match (a, b) with
  | G.TP a1, B.TP b1 -> m_type_parameter_classic a1 b1
  | G.OtherTypeParam (a1, a2), B.OtherTypeParam (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  (* those constructs should be handled in the caller *)
  | G.TParamEllipsis a1, B.TParamEllipsis b1 -> m_tok a1 b1
  | G.TP _, _
  | G.TParamEllipsis _, _
  | G.OtherTypeParam _, _ ->
      fail ()

and m_type_parameter_classic a b =
  match (a, b) with
  | ( {
        G.tp_id = a1;
        tp_attrs = a2;
        tp_bounds = a3;
        tp_default = a4;
        tp_variance = a5;
      },
      {
        B.tp_id = b1;
        tp_attrs = b2;
        tp_bounds = b3;
        tp_default = b4;
        tp_variance = b5;
      } ) ->
      let* () = m_ident a1 b1 in
      let* () = m_attributes a2 b2 in
      m_list__m_type_any_order a3 b3 >>= fun () ->
      (m_option m_type_) a4 b4 >>= fun () ->
      (* less-is-more: *)
      let* () = m_option_none_can_match_some (m_wrap m_variance) a5 b5 in
      return ()

and m_variance a b =
  match (a, b) with
  | Covariant, Covariant -> return ()
  | Contravariant, Contravariant -> return ()
  | Covariant, _
  | Contravariant, _ ->
      fail ()

(* ------------------------------------------------------------------------- *)
(* Function (or method) definition *)
(* ------------------------------------------------------------------------- *)
and m_function_kind a b =
  if a =*= b then return ()
  else
    (* iso: we don't care if it's a Function or Arrow *)
    if_config (fun x -> x.arrow_is_function) ~then_:(return ()) ~else_:(fail ())

and m_function_definition a b =
  Trace_matching.(if on then print_function_definition_pair a b);
  match (a, b) with
  | ( { G.fparams = a1; frettype = a2; fbody = a3; fkind = a4 },
      { B.fparams = b1; frettype = b2; fbody = b3; fkind = b4 } ) ->
      m_parameters a1 b1 >>= fun () ->
      (m_option_none_can_match_some m_type_) a2 b2 >>= fun () ->
      m_function_body a3 b3 >>= fun () -> m_wrap m_function_kind a4 b4

and m_function_body a b =
  match (a, b) with
  | G.FBStmt a1, B.FBStmt b1 -> m_stmt a1 b1
  (* TODO: equivalence: do magic conversion to FStmt? *)
  | G.FBExpr a1, B.FBExpr b1 -> m_expr a1 b1
  | G.FBDecl a1, B.FBDecl b1 -> m_tok a1 b1
  | G.FBNothing, B.FBNothing -> return ()
  (* DEBT: right now we still use FBStmt [] to encode an FBNothing
   * in ast_js.ml, and other languages, so we temporary allow
   * those empty body to match an FBNothing that was generated
   * in Visitor_AST.v_def_as_partial of the target.
   *)
  | G.FBStmt { s = G.Block (_, [], _); _ }, B.FBNothing -> return ()
  | G.FBStmt _, _
  | G.FBExpr _, _
  | G.FBDecl _, _
  | G.FBNothing, _ ->
      fail ()

and m_parameters a b =
  m_list_with_dots_and_metavar_ellipsis ~f:m_parameter
    ~is_dots:(function
      | G.ParamEllipsis _ -> true
      | _ -> false)
    ~less_is_ok:false (* empty list can not match non-empty list *)
    ~is_metavar_ellipsis:(function
      | Param { pname = Some (s, tok); _ } when MV.is_metavar_ellipsis s ->
          Some ((s, tok), fun xs -> MV.Params xs)
      | _ -> None)
    a b

and m_parameter a b =
  match (a, b) with
  (* boilerplate *)
  | G.Param a1, B.Param b1 -> m_parameter_classic a1 b1
  | G.ParamRest (a1, a2), B.ParamRest (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_parameter_classic a2 b2
  | G.ParamHashSplat (a1, a2), B.ParamHashSplat (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_parameter_classic a2 b2
  | G.ParamPattern a1, B.ParamPattern b1 -> m_pattern a1 b1
  | G.OtherParam (a1, a2), B.OtherParam (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.ParamEllipsis a1, B.ParamEllipsis b1 -> m_tok a1 b1
  | G.Param _, _
  | G.ParamPattern _, _
  | G.ParamRest _, _
  | G.ParamHashSplat _, _
  | G.ParamEllipsis _, _
  | G.OtherParam _, _ ->
      fail ()

and m_parameter_classic a b =
  match (a, b) with
  (* bugfix: when we use a metavar to match a parameter, as in foo($X): ...
   * and later we use $X again to match a name, the $X is first an ident and
   * later an expression, which would prevent a match. Instead we need to
   * make $X an expression early on
   *)
  | ( { G.pname = Some a1; pdefault = a2; ptype = a3; pattrs = a4; pinfo = a5 },
      { B.pname = Some b1; pdefault = b2; ptype = b3; pattrs = b4; pinfo = b5 }
    ) ->
      m_ident_and_id_info (a1, a5) (b1, b5) >>= fun () ->
      (m_option m_expr) a2 b2 >>= fun () ->
      (m_type_option_with_hook b1) a3 b3 >>= fun () ->
      m_list_in_any_order ~less_is_ok:true m_attribute a4 b4
  (* boilerplate *)
  | ( { G.pname = a1; pdefault = a2; ptype = a3; pattrs = a4; pinfo = a5 },
      { B.pname = b1; pdefault = b2; ptype = b3; pattrs = b4; pinfo = b5 } ) ->
      (m_option m_ident) a1 b1 >>= fun () ->
      (m_option m_expr) a2 b2 >>= fun () ->
      (m_option_none_can_match_some m_type_) a3 b3 >>= fun () ->
      m_list_in_any_order ~less_is_ok:true m_attribute a4 b4 >>= fun () ->
      m_id_info a5 b5

(* ------------------------------------------------------------------------- *)
(* Variable definition *)
(* ------------------------------------------------------------------------- *)
and m_variable_definition a b =
  match (a, b) with
  (* boilerplate *)
  | { G.vinit = a1; vtype = a2 }, { B.vinit = b1; vtype = b2 } ->
      (m_option m_expr) a1 b1 >>= fun () ->
      (m_option_none_can_match_some m_type_) a2 b2

(* ------------------------------------------------------------------------- *)
(* Field definition and use *)
(* ------------------------------------------------------------------------- *)

(* As opposed to statements, the order of fields should not matter.
 *
 * We actually filter the '...' and use a less-is-ok approach.
 * Indeed '...' are not really useful, and in some patological cases they
 * were actually leading to the use a tons of memory. Indeed, in certain
 * files containing a long list of fields (like 3000 static fields),
 * the classic use of >||> to handle Ellipsis variations were stressing
 * a lot the engine. Simpler to just filter them.
 *)
and m_fields (xsa : G.field list) (xsb : G.field list) =
  let has_ellipsis = ref false in
  (* let's filter the '...' *)
  let xsa =
    (* TODO: Similar to has_ellipsis_and_filter_ellipsis, refactor? *)
    xsa
    |> Common.exclude (function
         | G.F { s = G.ExprStmt ({ e = G.Ellipsis _; _ }, _); _ } ->
             has_ellipsis := true;
             true
         | _ -> false)
  in
  if_config
    (fun x -> x.implicit_ellipsis)
    ~then_:(m_list__m_field ~less_is_ok:true xsa xsb)
    ~else_:(m_list__m_field ~less_is_ok:!has_ellipsis xsa xsb)

(* less: mix of m_list_and_dots and m_list_unordered_keys, hard to factorize *)
and m_list__m_field ~less_is_ok (xsa : G.field list) (xsb : G.field list) =
  logger#ldebug
    (lazy (spf "m_list__m_field:%d vs %d" (List.length xsa) (List.length xsb)));
  match (xsa, xsb) with
  | [], [] -> return ()
  (* less-is-ok:
   * it's ok to have fields after in the concrete code as long as we
   * matched all the fields in the pattern.
   *)
  | [], _ :: _ -> if less_is_ok then return () else fail ()
  | G.F { s = G.ExprStmt ({ e = G.Ellipsis _; _ }, _); _ } :: _, _ ->
      raise Impossible
  (* Note that we restrict the match-a-field-at-any-position only for
   * definitions, which allows us to optimize things a little bit
   * by using split_when below.
   * However, if the field use a metavariable, we need to use
   * the more expensive all_elem_and_rest_of_list (see "general case" below).
   *
   * bugfix: In python we used to not do this match-a-field-at-any-pos
   * for code like 'class $FOO: $VAR = 1' because those were originally
   * not parsed as DefStmt but as Assign.
   * alt: keep them as Assign, but always do the all_elem_and_rest_of_list
   *)
  | ( G.F
        {
          s = G.DefStmt (({ G.name = G.EN (G.Id ((s1, _), _)); _ }, _) as adef);
          _;
        }
      :: xsa,
      xsb )
    when (not (MV.is_metavar_name s1)) && not (Pattern.is_regexp_string s1) -> (
      try
        let before, there, after =
          xsb
          |> Common2.split_when (function
               | G.F
                   {
                     s =
                       G.DefStmt ({ B.name = B.EN (B.Id ((s2, _tok), _)); _ }, _);
                     _;
                   }
                 when s2 = s1 ->
                   true
               | _ -> false)
        in
        match there with
        | G.F { s = G.DefStmt bdef; _ } ->
            m_definition adef bdef >>= fun () ->
            m_list__m_field ~less_is_ok xsa (before @ after)
        | _ -> raise Impossible
      with
      | Not_found -> fail ())
  (* the general case *)
  (* This applies to definitions where the field name is a metavariable,
   * and to any other non-def kind of field (e.g., FieldSpread for `...x` in JS).
   *)
  | a :: xsa, xsb ->
      let candidates = all_elem_and_rest_of_list xsb in
      (* less: could use a fold *)
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | (b, xsb) :: xs ->
            m_field a b
            >>= (fun () ->
                  m_list__m_field ~less_is_ok xsa (lazy_rest_of_list xsb))
            >||> aux xs
      in
      aux candidates

and m_field a b =
  match (a, b) with
  (* boilerplate *)
  | G.F a1, B.F b1 -> m_stmt a1 b1

(* ------------------------------------------------------------------------- *)
(* Type definition *)
(* ------------------------------------------------------------------------- *)
and m_type_definition a b =
  match (a, b) with
  | { G.tbody = a1 }, { B.tbody = b1 } -> m_type_definition_kind a1 b1

and m_type_definition_kind a b =
  match (a, b) with
  | G.OrType a1, B.OrType b1 -> (m_list m_or_type) a1 b1
  | G.AndType a1, B.AndType b1 -> m_bracket m_fields a1 b1
  | G.AliasType a1, B.AliasType b1 -> m_type_ a1 b1
  | G.NewType a1, B.NewType b1 -> m_type_ a1 b1
  | G.Exception (a1, a2), B.Exception (b1, b2) ->
      m_ident a1 b1 >>= fun () ->
      (* TODO: m_list__m_type_ ? *)
      (m_list m_type_) a2 b2
  | G.OtherTypeKind (a1, a2), B.OtherTypeKind (b1, b2) ->
      m_other_type_kind_operator a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.AbstractType a1, B.AbstractType b1 -> m_tok a1 b1
  | G.OrType _, _
  | G.AndType _, _
  | G.AliasType _, _
  | G.Exception _, _
  | G.NewType _, _
  | G.AbstractType _, _
  | G.OtherTypeKind _, _ ->
      fail ()

and m_or_type a b =
  match (a, b) with
  | G.OrConstructor (a1, a2), B.OrConstructor (b1, b2) ->
      m_ident a1 b1 >>= fun () ->
      (* TODO: m_list__m_type_ ? *)
      (m_list m_type_) a2 b2
  | G.OrEnum (a1, a2), B.OrEnum (b1, b2) ->
      m_ident a1 b1 >>= fun () -> m_option m_expr a2 b2
  | G.OrUnion (a1, a2), B.OrUnion (b1, b2) ->
      m_ident a1 b1 >>= fun () -> m_type_ a2 b2
  | G.OrConstructor _, _
  | G.OrEnum _, _
  | G.OrUnion _, _ ->
      fail ()

and m_other_type_kind_operator = m_other_xxx

and _m_list__m_type_ (xsa : G.type_ list) (xsb : G.type_ list) =
  m_list_with_dots m_type_
    (* dots: '...', this is very Python Specific I think *)
      (function
      | { t = G.TyExpr { G.e = G.Ellipsis _i; _ }; _ } -> true
      | _ -> false)
      (* less-is-ok: it's ok to not specify all the parents I think *)
    ~less_is_ok:true xsa xsb

and m_list__m_type_any_order (xsa : G.type_ list) (xsb : G.type_ list) =
  (* TODO? filter existing ellipsis?
   * let _has_ellipsis, xsb = has_ellipsis_and_filter_ellipsis xsb in *)
  (* always implicit ... *)
  m_list_in_any_order ~less_is_ok:true m_type_ xsa xsb

and m_list__m_class_parent (xsa : G.class_parent list)
    (xsb : G.class_parent list) =
  (* TODO: m_list_in_any_order ~less_is_ok:true m_class_parent xsa xsb
   * but regressions for python?
   *)
  m_list_with_dots m_class_parent
    (* dots: '...', this is very Python Specific I think *)
      (function
      | { G.t = G.TyExpr { e = G.Ellipsis _i; _ }; _ }, None -> true
      | _ -> false)
      (* less-is-ok: it's ok to not specify all the parents I think *)
    ~less_is_ok:true xsa xsb

and m_class_parent_basic (a1, a2) (b1, b2) =
  let* () = m_type_ a1 b1 in
  (* less: m_option_none_can_match_some? *)
  let* () = m_option m_arguments a2 b2 in
  return ()

and m_class_parent a b =
  m_class_parent_basic a b >!> (* less: could be >||> *)
                           fun () ->
  match (a, b) with
  (* less: this could be generalized, but let's go simple first *)
  | (a1, None), ({ t = B.TyN (B.Id (id, { id_resolved; _ })); _ }, None) ->
      let xs =
        match !id_resolved with
        | Some (B.ImportedEntity xs, _sid) -> xs
        | _ -> [ id ]
      in
      (* deep: *)
      let candidates =
        match !hook_find_possible_parents with
        | None -> []
        | Some f -> f xs
      in
      (* less: use a fold *)
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | x :: xs ->
            let t = B.TyN x |> B.t in
            m_type_ a1 t >||> aux xs
      in
      aux candidates
  | _ -> fail ()

(* ------------------------------------------------------------------------- *)
(* Class definition *)
(* ------------------------------------------------------------------------- *)
(* TODO: there are a few remaining m_list m_type_ we could transform
 * to use instead m_list__m_type_, for Exception, TyTuple and OrConstructor
 * but maybe quite different from list of types in inheritance
 *)
and m_class_definition a b =
  Trace_matching.(if on then print_class_definition_pair a b);
  match (a, b) with
  | ( {
        G.ckind = a1;
        cextends = a2;
        cimplements = a3;
        cmixins = a5;
        cbody = a4;
        cparams = a6;
      },
      {
        B.ckind = b1;
        cextends = b2;
        cimplements = b3;
        cmixins = b5;
        cbody = b4;
        cparams = b6;
      } ) ->
      m_class_kind a1 b1 >>= fun () ->
      m_list__m_class_parent a2 b2 >>= fun () ->
      m_list__m_type_any_order a3 b3 >>= fun () ->
      m_list__m_type_any_order a5 b5 >>= fun () ->
      m_parameters a6 b6 >>= fun () -> m_bracket m_fields a4 b4

and m_class_kind a b = m_wrap m_class_kind_bis a b

and m_class_kind_bis a b =
  match (a, b) with
  | G.Class, B.Class
  | G.Interface, B.Interface
  | G.Trait, B.Trait
  | G.Object, B.Object ->
      return ()
  | G.Class, _
  | G.Interface, _
  | G.Trait, _
  | G.Object, _ ->
      fail ()

(* ------------------------------------------------------------------------- *)
(* Module definition *)
(* ------------------------------------------------------------------------- *)
and m_module_definition a b =
  match (a, b) with
  | { G.mbody = a1 }, { B.mbody = b1 } -> m_module_definition_kind a1 b1

and m_module_definition_kind a b =
  match (a, b) with
  | G.ModuleAlias a1, B.ModuleAlias b1 -> m_dotted_name a1 b1
  | G.ModuleStruct (a1, a2), B.ModuleStruct (b1, b2) ->
      (m_option m_dotted_name) a1 b1 >>= fun () -> (m_list m_item) a2 b2
  | G.OtherModule (a1, a2), B.OtherModule (b1, b2) ->
      m_other_module_operator a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.ModuleAlias _, _
  | G.ModuleStruct _, _
  | G.OtherModule _, _ ->
      fail ()

and m_other_module_operator = m_other_xxx

(* ------------------------------------------------------------------------- *)
(* Macro definition *)
(* ------------------------------------------------------------------------- *)
and m_macro_definition a b =
  match (a, b) with
  | ( { G.macroparams = a1; macrobody = a2 },
      { B.macroparams = b1; macrobody = b2 } ) ->
      (m_list m_ident) a1 b1 >>= fun () -> (m_list m_any) a2 b2

(*****************************************************************************)
(* Directives (Module import/export, macros) *)
(*****************************************************************************)
and m_directive a b =
  Trace_matching.(if on then print_directive_pair a b);
  let* () =
    m_list_in_any_order ~less_is_ok:true m_attribute a.d_attrs b.d_attrs
  in

  m_directive_basic a.d b.d >!> fun () ->
  match a.d with
  (* normalize only if very simple import pattern (no alias) *)
  | G.ImportFrom (_, _, _, None)
  | G.ImportAs (_, _, None) -> (
      (* equivalence: *)
      let normal_a = Normalize_generic.normalize_import_opt true a.d in
      let normal_b = Normalize_generic.normalize_import_opt false b.d in
      match (normal_a, normal_b) with
      | Some (a0, a1), Some (b0, b1) ->
          m_tok a0 b0 >>= fun () -> m_module_name_prefix a1 b1
      | _ -> fail ())
  (* more complex pattern should not be normalized *)
  | G.ImportFrom _
  | G.ImportAs _
  (* definitely do not normalize the pattern for ImportAll *)
  | G.ImportAll _
  | G.Package _
  | G.PackageEnd _
  | G.Pragma _
  | G.OtherDirective _ ->
      fail ()

(* less-is-ok: a few of these below with the use of m_module_name_prefix and
 * m_option_none_can_match_some.
 * todo? not sure it makes sense to always allow m_module_name_prefix below
 *)
and m_directive_basic a b =
  match (a, b) with
  (* metavar: import $LIB should bind $LIB to the full qualified name *)
  | ( G.ImportFrom (a0, DottedName [], (str, tok), a3),
      B.ImportFrom (b0, DottedName xs, x, b3) )
    when MV.is_metavar_name str ->
      let name = H.name_of_ids (xs @ [ x ]) in
      let* () = m_tok a0 b0 in
      let* () = envf (str, tok) (MV.N name) in
      (m_option_none_can_match_some m_ident_and_id_info) a3 b3
  | G.ImportFrom (a0, a1, a2, a3), B.ImportFrom (b0, b1, b2, b3) ->
      m_tok a0 b0 >>= fun () ->
      m_module_name_prefix a1 b1 >>= fun () ->
      m_ident_and_empty_id_info a2 b2 >>= fun () ->
      (m_option_none_can_match_some m_ident_and_id_info) a3 b3
  | G.ImportAs (a0, a1, a2), B.ImportAs (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_module_name_prefix a1 b1 >>= fun () ->
      (m_option_none_can_match_some m_ident_and_id_info) a2 b2
  | G.ImportAll (a0, a1, a2), B.ImportAll (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_module_name_prefix a1 b1 >>= fun () -> m_tok a2 b2
  (* boilerplate *)
  | G.Package (a0, a1), B.Package (b0, b1) ->
      m_tok a0 b0 >>= fun () -> m_dotted_name a1 b1
  | G.PackageEnd a1, B.PackageEnd b1 -> m_tok a1 b1
  | G.Pragma (a1, a2), B.Pragma (b1, b2) ->
      m_ident a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.OtherDirective (a1, a2), B.OtherDirective (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.ImportFrom _, _
  | G.ImportAs _, _
  | G.OtherDirective _, _
  | G.Pragma _, _
  | G.ImportAll _, _
  | G.Package _, _
  | G.PackageEnd _, _ ->
      fail ()

(*****************************************************************************)
(* Toplevel *)
(*****************************************************************************)
and m_item a b = m_stmt a b

and m_program a b =
  match (a, b) with
  | a, b -> (m_list m_item) a b

(*****************************************************************************)
(* Any *)
(*****************************************************************************)
and m_partial a b =
  match (a, b) with
  | G.PartialDef a1, B.PartialDef b1 -> m_definition a1 b1
  | G.PartialIf (a1, a2), B.PartialIf (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_expr a2 b2
  | G.PartialMatch (a1, a2), B.PartialMatch (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_expr a2 b2
  | G.PartialTry (a1, a2), B.PartialTry (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_stmt a2 b2
  | G.PartialFinally (a1, a2), B.PartialFinally (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_stmt a2 b2
  | G.PartialCatch a1, B.PartialCatch b1 -> m_catch a1 b1
  | G.PartialSingleField (a1, a2, a3), B.PartialSingleField (b1, b2, b3) ->
      let* () = m_ident a1 b1 in
      let* () = m_tok a2 b2 in
      m_expr a3 b3
  | G.PartialLambdaOrFuncDef a1, B.PartialLambdaOrFuncDef b1 ->
      m_function_definition a1 b1
  | G.PartialDef _, _
  | G.PartialIf _, _
  | G.PartialMatch _, _
  | G.PartialTry _, _
  | G.PartialCatch _, _
  | G.PartialFinally _, _
  | G.PartialSingleField _, _
  | G.PartialLambdaOrFuncDef _, _ ->
      fail ()

and m_any a b =
  match (a, b) with
  | G.Str a1, B.Str b1 -> m_string_ellipsis_or_metavar_or_default a1 b1
  | G.Ss a1, B.Ss b1 -> m_stmts_deep ~inside:false ~less_is_ok:true a1 b1
  | G.Flds a1, B.Flds b1 -> m_fields a1 b1
  | G.E a1, B.E b1 -> m_expr a1 b1
  | G.S a1, B.S b1 -> m_stmt a1 b1
  | G.Partial a1, B.Partial b1 -> m_partial a1 b1
  | G.Args a1, B.Args b1 -> m_list m_argument a1 b1
  | G.Params a1, B.Params b1 -> m_list m_parameter a1 b1
  | G.Xmls a1, B.Xmls b1 -> m_list m_xml_body a1 b1
  | G.Anys a1, B.Anys b1 -> m_list m_any a1 b1
  (* boilerplate *)
  | G.Modn a1, B.Modn b1 -> m_module_name a1 b1
  | G.ModDk a1, B.ModDk b1 -> m_module_definition_kind a1 b1
  | G.Tk a1, B.Tk b1 -> m_tok a1 b1
  | G.TodoK a1, B.TodoK b1 -> m_todo_kind a1 b1
  | G.Di a1, B.Di b1 -> m_dotted_name a1 b1
  | G.En a1, B.En b1 -> m_entity a1 b1
  | G.T a1, B.T b1 -> m_type_ a1 b1
  | G.P a1, B.P b1 -> m_pattern a1 b1
  | G.Def a1, B.Def b1 -> m_definition a1 b1
  | G.Dir a1, B.Dir b1 -> m_directive a1 b1
  | G.Fld a1, B.Fld b1 -> m_field a1 b1
  | G.Pa a1, B.Pa b1 -> m_parameter a1 b1
  | G.Ce a1, B.Ce b1 -> m_catch_exn a1 b1
  | G.Cs a1, B.Cs b1 -> m_case a1 b1
  | G.Ar a1, B.Ar b1 -> m_argument a1 b1
  | G.Tp a1, B.Tp b1 -> m_type_parameter a1 b1
  | G.Ta a1, B.Ta b1 -> m_type_argument a1 b1
  | G.At a1, B.At b1 -> m_attribute a1 b1
  | G.Dk a1, B.Dk b1 -> m_definition_kind a1 b1
  | G.Pr a1, B.Pr b1 -> m_program a1 b1
  | G.I a1, B.I b1 -> m_ident a1 b1
  | G.Lbli a1, B.Lbli b1 -> m_label_ident a1 b1
  | G.ForOrIfComp a1, B.ForOrIfComp b1 -> m_for_or_if_comp a1 b1
  | G.I _, _
  | G.Modn _, _
  | G.Di _, _
  | G.En _, _
  | G.E _, _
  | G.S _, _
  | G.T _, _
  | G.P _, _
  | G.Def _, _
  | G.Dir _, _
  | G.Pa _, _
  | G.Ce _, _
  | G.Cs _, _
  | G.Ar _, _
  | G.Tp _, _
  | G.Ta _, _
  | G.At _, _
  | G.Dk _, _
  | G.Pr _, _
  | G.Fld _, _
  | G.Ss _, _
  | G.Flds _, _
  | G.Tk _, _
  | G.Lbli _, _
  | G.ModDk _, _
  | G.TodoK _, _
  | G.Partial _, _
  | G.Args _, _
  | G.Params _, _
  | G.Xmls _, _
  | G.ForOrIfComp _, _
  | G.Anys _, _
  | G.Str _, _ ->
      fail ()