Source file generic_vs_generic.ml

(* Yoann Padioleau
 *
 * Copyright (C) 2019 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

(* A 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.
 *
 * subtle: use 'b' for to report errors, 'a' is the sgrep pattern and it
 * has no file information usually.
 *)
module A = Ast_generic
module B = Ast_generic

module MV = Metavars_generic
module Ast = Ast_generic
module Lib = Lib_ast

(*****************************************************************************)
(* 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
 *  - '...' can match any sequence
 *  - simple constructs match complex constructs having more details
 *    (e.g., the absence of attribute in a pattern will still match functions
 *     having many attributes), "less-is-more"
 *  - we do not care about differences in spaces/indentations/comments.
 *    we work at the AST-level.
 *)

(*****************************************************************************)
(* Globals *)
(*****************************************************************************)
let verbose = ref false

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)
let pr2, _pr2_once = Common2.mk_pr2_wrappers verbose

(*****************************************************************************)
(* Types *)
(*****************************************************************************)

  (* ------------------------------------------------------------------------*)
  (* Combinators history *) 
  (* ------------------------------------------------------------------------*)
  (*
   * version0: 
   *   type ('a, 'b) matcher = 'a -> 'b -> bool
   * 
   *   This just lets you know if you matched something.
   * 
   * version1:
   *   type ('a, 'b) matcher = 'a -> 'b -> unit -> ('a, 'b) option
   * 
   *   The Maybe monad.
   * 
   * version2:
   *   type ('a, 'b) matcher = 'a -> 'b -> binding -> binding list
   * 
   *   Why not returning a binding option ? because we need sometimes
   *   to return multiple possible bindings for one matching code.
   *   For instance with the pattern do 'f(..., X, ...)', X could be binded
   *   to different parts of the code.
   * 
   *   Note that the empty list means a match failure.
   *
   * version3:
   *   type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a,'b) tout
   * 
   * version4: back to simpler
   *   type ('a, 'b) matcher = 'a -> 'b -> tin -> tout
   *)

    (* tin is for 'type in' and tout for 'type out' *)
    type tin = MV.metavars_binding
    type tout = MV.metavars_binding list

    (* A matcher is something taking an element A and an element B
     * (for this module A will be the AST of the pattern and B
     * the AST of the program we want to match over), then some environment
     * information tin, and it will return something (tout) that will
     * represent a match between element A and B.
     *)
    type ('a, 'b) matcher = 'a -> 'b  -> tin -> tout

    (* The >>= combinator below allow you to configure the matching process
     * anyway you want. Essentially this combinator takes a matcher,
     * another matcher, and returns a matcher that combine the 2
     * matcher arguments.
     *
     * In the case of a simple boolean matcher, you just need to write:
     *
     *   let (>>=) m1 m2 = fun tin ->
     *    match m1 tin with
     *    | None -> None
     *    | Some x ->
     *        m2 x tin
     *)
    let ((>>=):
      (tin -> tout) ->
      (unit -> (tin -> tout)) ->
      (tin -> tout)) = 
    fun m1 m2 ->
      fun tin ->
        (* let's get a list of possible environment match (could be 
         * the empty list when it didn't match, playing the role None
         * had before)
         *)
        let xs = m1 tin in
        (* try m2 on each possible returned bindings *)
        let xxs = xs |> List.map (fun binding -> 
          m2 () binding
        ) in
        List.flatten xxs

    (* the disjunctive combinator *)
    let ((>||>) :
      (tin -> tout) ->
      (tin -> tout) ->
      (tin -> tout)) = fun m1 m2 -> fun tin ->
(* CHOICE
      let xs = m1 tin in
      if null xs
      then m2 tin
      else xs
*)
    (* opti? use set instead of list *)
    m1 tin @ m2 tin

    (* The classical monad combinators *)
    let (return : tin -> tout) = fun tin ->
    [tin]
      
    let (fail : tin -> tout) = fun _tin ->
    []

  (* ------------------------------------------------------------------------*)
  (* Environment *) 
  (* ------------------------------------------------------------------------*)

  (* pre: both 'a' and 'b' contains only regular code; there are no
   * metavariables inside them.
   *)
  let equal_ast_binded_code a b =
    match a, b with
    | Ast.E _, Ast.E _ 
    | Ast.N _, Ast.N _
    | Ast.S _, Ast.S _
      ->
        (* Note that because we want to retain the position information
         * of the matched code in the environment (e.g. for the -pvar
         * sgrep command line argument), we can not just use the
         * generic '=' OCaml operator as 'a' and 'b' may represent
         * the same code but they will contain leaves in their AST
         * with different position information. So before doing
         * the comparison we just need to remove/abstract-away 
         * the line number information in each ASTs.
         *)
        let a = Lib.abstract_position_info_any a in
        let b = Lib.abstract_position_info_any b in
        a =*= b

    | _, _ -> 
        false

  let check_and_add_metavar_binding((mvar:MV.mvar), valu) = fun tin ->
    match Common2.assoc_opt mvar tin with
    | Some valu' ->
        (* Should we use generic_vs_generic itself for comparing the code?
         * Hmmm, we can't because it leads to a circular dependencies.
         * Moreover here we know both valu and valu' are regular code,
         * not patterns, so we can just use the generic '=' of OCaml.
         *)
        if equal_ast_binded_code valu valu'
        then Some tin
        else None
    | None ->
        (* first time the metavar is binded, just add it to the environment *)
        Some (Common2.insert_assoc (mvar, valu) tin)

  let (envf: (MV.mvar Ast.wrap, Ast.any) matcher) =
   fun (mvar, _imvar) any  -> fun tin ->
    match check_and_add_metavar_binding (mvar, any) tin with
    | None ->
        pr2 (spf "envf: fail, %s" mvar);
        fail tin
    | Some new_binding ->
        pr2 (spf "envf: success, %s" mvar);
        return new_binding

  let empty_environment () = []

(*****************************************************************************)
(* Boilerplate code, "AST Generic vs AST Generic" *)
(*****************************************************************************)

let return () = return
let fail () = fail

(* ---------------------------------------------------------------------- *)
(* stdlib: option, list, ref, either, bool *)
(* ---------------------------------------------------------------------- *)
let (m_option: ('a,'b) matcher -> ('a option,'b option) matcher) = fun f a b ->
  match a, b with
  | None, None -> return ()
  | Some xa, Some xb ->
      f xa xb >>= (fun () ->
        return ()
      )
  | None, _
  | Some _, _
      -> fail ()

let (m_ref: ('a,'b) matcher -> ('a ref,'b ref) matcher) = fun f a b ->
  match a, b with
  { contents = xa}, { contents = xb} ->
    f xa xb >>= (fun () ->
      return ()
    )

let rec m_list f a b =
  match a, b with
  | [], [] ->
      return ()
  | xa::aas, xb::bbs ->
      f xa xb >>= (fun () ->
      m_list f aas bbs >>= (fun () ->
        return ()
      )
      )
  | [], _
  | _::_, _ ->
      fail ()


let m_bool a b = 
  if a = b then return () else fail ()

let m_string a b =
  if a =$= b then return () else fail ()

let m_other_xxx a b = 
  match a, b with
  | a, b when a =*= b -> return ()
  | _ -> fail ()

(* ---------------------------------------------------------------------- *)
(* Token *)
(* ---------------------------------------------------------------------- *)

(* we do not care about position! or differences in space/indent/comment!
 * so we can just  'return ()'
 *)
let m_info _a _b = return ()

let m_tok a b = m_info a b

let m_wrap f a b =
  match a, b with
  ((xaa, ainfo), (xbb, binfo)) ->
    f xaa xbb >>= (fun () ->
    m_info ainfo binfo >>= (fun () ->
      return ()
  ))

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

let m_ident a b = 
  (* metavariable! *)
  match a, b with
  | (str, tok), b when MV.is_metavar_name str ->
      envf (str, tok) (B.Id b)

  (* 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

let m_qualified_name a b = 
  match a, b with
  (a, b) -> m_dotted_name a b

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

let m_resolved_name a b = 
  match a, b with
  | A.Local, B.Local ->
    return ()
  | A.Param, B.Param ->
    return ()
  | A.Global(a1), B.Global(b1) ->
    m_qualified_name a1 b1 >>= (fun () -> 
    return ()
    )
  | A.ImportedModule(a1), B.ImportedModule(b1) ->
    m_qualified_name a1 b1 >>= (fun () -> 
    return ()
    )
  | A.NotResolved, B.NotResolved ->
    return ()
  | A.Macro, B.Macro ->
    return ()
  | A.EnumConstant, B.EnumConstant ->
    return ()

  | A.Local, _
  | A.Param, _
  | A.Global _, _
  | A.NotResolved, _
  | A.Macro, _
  | A.EnumConstant, _
  | A.ImportedModule _, _
   -> fail ()


(* start of recursive need *)
let rec m_name a b =
  match a,b with
  | (a1, a2), (b1, b2) ->
    m_ident a1 b1 >>= (fun () ->
    m_id_info a2 b2 >>= (fun () ->
      return ()
   ))
       
(* ------------------------------------------------------------------------- *)
(* Expression *)
(* ------------------------------------------------------------------------- *)

and m_expr a b = 
  match a, b with


  (* $X should not match an IdSpecial otherwise $X(...) could match
   * a+b because this is transformed in a Call(IdSpecial Plus, ...) 
   *)
  | A.Name ((str,_tok), _id_info), B.IdSpecial _ when MV.is_metavar_name str ->
      fail ()

  (* metavariable! *)
  | A.Name ((str,tok), _id_info), e2 when MV.is_metavar_name str ->
      envf (str, tok) (B.E (e2))

  | A.L(a1), B.L(b1) ->
    m_literal a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Container(a1, a2), B.Container(b1, b2) ->
    m_container_operator a1 b1 >>= (fun () -> 
    (m_list m_expr) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Tuple(a1), B.Tuple(b1) ->
    (m_list m_expr) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Record(a1), B.Record(b1) ->
    (m_list m_field) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Constructor(a1, a2), B.Constructor(b1, b2) ->
    m_name a1 b1 >>= (fun () -> 
    (m_list m_expr) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Lambda(a1), B.Lambda(b1) ->
    m_function_definition a1 b1 >>= (fun () -> 
    return ())
  | A.AnonClass(a1), B.AnonClass(b1) ->
    m_class_definition a1 b1 >>= (fun () -> 
    return ())
  | A.Nop, B.Nop ->
    return ()
  | A.Name(a1), B.Name(b1) ->
    m_name a1 b1 >>= (fun () -> 
    return ())
  | A.IdSpecial(a1), B.IdSpecial(b1) ->
    m_wrap m_special a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Call(a1, a2), B.Call(b1, b2) ->
    m_expr a1 b1 >>= (fun () -> 
    m_arguments a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Xml(a1), B.Xml(b1) ->
    m_xml a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Assign(a1, a2), B.Assign(b1, b2) ->
    m_expr a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.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 >>= (fun () -> 
    return ()
    )))
  | A.LetPattern(a1, a2), B.LetPattern(b1, b2) ->
    m_pattern a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.ObjAccess(a1, a2), B.ObjAccess(b1, b2) ->
    m_expr a1 b1 >>= (fun () -> 
    m_ident a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.ArrayAccess(a1, a2), B.ArrayAccess(b1, b2) ->
    m_expr a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Conditional(a1, a2, a3), B.Conditional(b1, b2, b3) ->
    m_expr a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    m_expr a3 b3 >>= (fun () -> 
    return ()
    )))
  | A.MatchPattern(a1, a2), B.MatchPattern(b1, b2) ->
    m_expr a1 b1 >>= (fun () -> 
    (m_list m_action) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Yield(a1), B.Yield(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Await(a1), B.Await(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Cast(a1, a2), B.Cast(b1, b2) ->
    m_type_ a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Seq(a1), B.Seq(b1) ->
    (m_list m_expr) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Ref(a1), B.Ref(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.DeRef(a1), B.DeRef(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Ellipses(a1), B.Ellipses(b1) ->
    m_tok a1 b1 >>= (fun () -> 
    return ()
    )
  | A.OtherExpr(a1, a2), B.OtherExpr(b1, b2) ->
    m_other_expr_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.L _, _  | A.Container _, _  | A.Tuple _, _  | A.Record _, _
  | A.Constructor _, _  | A.Lambda _, _  | A.AnonClass _, _  | A.Nop, _
  | A.Name _, _  | A.IdSpecial _, _  | A.Call _, _  | A.Xml _, _
  | A.Assign _, _  | A.AssignOp _, _  | A.LetPattern _, _  | A.ObjAccess _, _
  | A.ArrayAccess _, _  | A.Conditional _, _  | A.MatchPattern _, _
  | A.Yield _, _  | A.Await _, _  | A.Cast _, _  | A.Seq _, _  | A.Ref _, _
  | A.DeRef _, _  | A.Ellipses _, _  | A.OtherExpr _, _
   -> fail ()


and m_literal a b = 
  match a, b with

  (* '...' on string *)
  | A.String("...", a), B.String(_s, b) ->
      m_info a b >>= (fun () ->
        return ())

  (* regexp matching *)
  | A.String(name, info_name), B.String(sb, info_sb)
      when name =~ "^=~/\\(.*\\)/$" ->
      let s = Common.matched1 name in
(* TODO
      let rex = Pcre.regexp s in
      if Pcre.pmatch ~rex sb
*)
      if sb =~ s
      then
        m_info info_name info_sb >>= (fun () ->
        return ())
      else fail ()

  | A.String(a1), B.String(b1) ->
    (m_wrap m_string) a1 b1 >>= (fun () -> 
    return ()
    )

  | A.Unit(a1), B.Unit(b1) ->
    m_tok a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Bool(a1), B.Bool(b1) ->
    (m_wrap m_bool) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Int(a1), B.Int(b1) ->
    (m_wrap m_string) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Float(a1), B.Float(b1) ->
    (m_wrap m_string) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Char(a1), B.Char(b1) ->
    (m_wrap m_string) a1 b1 >>= (fun () -> 
    return ()
    )

  | A.Regexp(a1), B.Regexp(b1) ->
    (m_wrap m_string) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Null(a1), B.Null(b1) ->
    m_tok a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Undefined(a1), B.Undefined(b1) ->
    m_tok a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Unit _, _  | A.Bool _, _  | A.Int _, _  | A.Float _, _  | A.Char _, _
  | A.String _, _  | A.Regexp _, _  | A.Null _, _  | A.Undefined _, _
   -> fail ()


and m_action a b = 
  match a, b with
  | (a1, a2), (b1, b2) ->
    m_pattern a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    return ()
    ))


and m_arithmetic_operator a b = 
  match a, b with
  | _ when a =*= b -> return ()
  | _ -> fail ()

and m_special a b = 
  match a, b with
  | A.This, B.This ->
    return ()
  | A.Super, B.Super ->
    return ()
  | A.Self, B.Self ->
    return ()
  | A.Parent, B.Parent ->
    return ()
  | A.Eval, B.Eval ->
    return ()
  | A.Typeof, B.Typeof ->
    return ()
  | A.Instanceof, B.Instanceof ->
    return ()
  | A.Sizeof, B.Sizeof ->
    return ()
  | A.New, B.New ->
    return ()
  | A.Concat, B.Concat ->
    return ()
  | A.Spread, B.Spread ->
    return ()
  | A.ArithOp(a1), B.ArithOp(b1) ->
    m_arithmetic_operator a1 b1 >>= (fun () -> 
    return ()
    )
  | A.IncrDecr(a1, a2), B.IncrDecr(b1, b2) ->
    m_bool a1 b1 >>= (fun () -> 
    m_bool a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.This, _  | A.Super, _  | A.Self, _  | A.Parent, _  | A.Eval, _
  | A.Typeof, _  | A.Instanceof, _  | A.Sizeof, _  | A.New, _
  | A.Concat, _  | A.Spread, _  | A.ArithOp _, _  | A.IncrDecr _, _
   -> fail ()

and m_id_info a b = 
  match a, b with
  { A. id_qualifier = a1; id_typeargs = a2; id_resolved = _a3; id_type = a4; },
  { B. id_qualifier = b1; id_typeargs = b2; id_resolved = _b3; id_type = b4; }
   -> 
    (m_option m_dotted_name) a1 b1 >>= (fun () -> 
    (m_option m_type_arguments) a2 b2 >>= (fun () -> 
     (* TODO:
      * right now doing import flask in a file means every reference
      * to flask.xxx will be tagged with a ImportedEntity, but
      * sgrep pattern might use flask.xxx without this tag, which prevents
      * matching, hence the comment for now. 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)
      *)
      (* (m_ref m_resolved_name) a3 b3  >>= (fun () ->  *)
    (m_ref (m_option m_type_)) a4 b4 >>= (fun () -> 
    return ()
  )))

and m_container_operator a b = 
  match a, b with
  | A.Array, B.Array ->
    return ()
  | A.List, B.List ->
    return ()
  | A.Set, B.Set ->
    return ()
  | A.Dict, B.Dict ->
    return ()
  | A.Array, _  | A.List, _  | A.Set, _  | A.Dict, _
   -> fail ()

and m_other_expr_operator = m_other_xxx

and m_xml a b = 
  match a, b with
  (a, b) -> (m_list m_any) a b

(*---------------------------------------------------------------------------*)
(* Arguments list iso *)
(*---------------------------------------------------------------------------*)

and m_arguments a b = 
  match a, b with
  (a, b) -> (m_list__m_argument) a b

and m_list__m_argument (xsa: A.argument list) (xsb: A.argument list) =
  match xsa, xsb with
  | [], [] ->
      return ()

  (* '...', can also match no argument *)
  | [A.Arg (A.Ellipses _i)], [] ->
      return ()

  | A.Arg (A.Ellipses i)::xsa, xb::xsb ->
      (* can match nothing *)
      (m_list__m_argument xsa (xb::xsb)) >||>
      (* can match one *)
      (m_list__m_argument xsa xsb) >||>
      (* can match more *)
      (m_list__m_argument ((A.Arg (A.Ellipses i))::xsa) xsb)

  | A.ArgKwd ((s, _tok) as ida, ea)::xsa, xsb ->
      (try 
        let (before, there, after) = xsb |> Common2.split_when (function
            | A.ArgKwd ((s2,_), _) when s =$= s2 -> true
            | _ -> false) in
        (match there with
        | A.ArgKwd (idb, eb) ->
           m_ident ida idb >>= (fun () ->
           m_expr ea eb >>= (fun () ->
           m_list__m_argument xsa (before @ after) >>= (fun () ->
              return ()
           )))
        | _ -> raise Impossible
        )
      with Not_found -> fail ()
      )

  (* the general case *)
  | xa::aas, xb::bbs ->
      m_argument xa xb >>= (fun () ->
      m_list__m_argument aas bbs >>= (fun () ->
        return ()
      )
      )
  | [], _
  | _::_, _ ->
      fail ()


and m_argument a b = 
  match a, b with
  | A.Arg(a1), B.Arg(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )

  | A.ArgType(a1), B.ArgType(b1) ->
    m_type_ a1 b1 >>= (fun () -> 
    return ()
    )

  (* TODO: iso on keyword argument, keyword is optional in pattern *)

  | A.ArgKwd(a1, a2), B.ArgKwd(b1, b2) ->
    m_ident a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.ArgOther(a1, a2), B.ArgOther(b1, b2) ->
    m_other_argument_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Arg _, _  | A.ArgKwd _, _  | A.ArgType _, _  | A.ArgOther _, _
   -> fail ()

and m_other_argument_operator = m_other_xxx

(* ------------------------------------------------------------------------- *)
(* Type *)
(* ------------------------------------------------------------------------- *)

and m_type_ a b = 
  match a, b with
  | A.TyBuiltin(a1), B.TyBuiltin(b1) ->
    (m_wrap m_string) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.TyFun(a1, a2), B.TyFun(b1, b2) ->
    (m_list m_type_) a1 b1 >>= (fun () -> 
    m_type_ a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.TyApply(a1, a2), B.TyApply(b1, b2) ->
    m_name a1 b1 >>= (fun () -> 
    m_type_arguments a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.TyVar(a1), B.TyVar(b1) ->
    m_ident a1 b1 >>= (fun () -> 
    return ()
    )
  | A.TyArray(a1, a2), B.TyArray(b1, b2) ->
    (m_option m_expr) a1 b1 >>= (fun () -> 
    m_type_ a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.TyPointer(a1), B.TyPointer(b1) ->
    m_type_ a1 b1 >>= (fun () -> 
    return ()
    )
  | A.TyTuple(a1), B.TyTuple(b1) ->
    (m_list m_type_) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.TyQuestion(a1), B.TyQuestion(b1) ->
    m_type_ a1 b1 >>= (fun () -> 
    return ()
    )
  | A.OtherType(a1, a2), B.OtherType(b1, b2) ->
    m_other_type_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.TyBuiltin _, _  | A.TyFun _, _  | A.TyApply _, _  | A.TyVar _, _
  | A.TyArray _, _  | A.TyPointer _, _ | A.TyTuple _, _  | A.TyQuestion _, _
  | A.OtherType _, _
   -> fail ()


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


and m_type_argument a b = 
  match a, b with
  | A.TypeArg(a1), B.TypeArg(b1) ->
    m_type_ a1 b1 >>= (fun () -> 
    return ()
    )
  | A.OtherTypeArg(a1, a2), B.OtherTypeArg(b1, b2) ->
    m_other_type_argument_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.TypeArg _, _  | A.OtherTypeArg _, _
   -> fail ()

and m_other_type_operator = m_other_xxx

and m_other_type_argument_operator = m_other_xxx

(* ------------------------------------------------------------------------- *)
(* Attribute *)
(* ------------------------------------------------------------------------- *)

(* TODO: should sort attributes and allow subset *)

and m_attribute a b = 
  match a, b with
  | A.Recursive, B.Recursive ->
    return ()
  | A.MutuallyRecursive, B.MutuallyRecursive ->
    return ()
  | A.Static, B.Static ->
    return ()
  | A.Volatile, B.Volatile ->
    return ()
  | A.Extern, B.Extern ->
    return ()
  | A.Public, B.Public ->
    return ()
  | A.Private, B.Private ->
    return ()
  | A.Protected, B.Protected ->
    return ()
  | A.Abstract, B.Abstract ->
    return ()
  | A.Final, B.Final ->
    return ()
  | A.Var, B.Var ->
    return ()
  | A.Let, B.Let ->
    return ()
  | A.Const, B.Const ->
    return ()
  | A.Mutable, B.Mutable ->
    return ()
  | A.Generator, B.Generator ->
    return ()
  | A.Async, B.Async ->
    return ()
  | A.Ctor, B.Ctor ->
    return ()
  | A.Dtor, B.Dtor ->
    return ()
  | A.Getter, B.Getter ->
    return ()
  | A.Setter, B.Setter ->
    return ()
  | A.Variadic, B.Variadic ->
    return ()
  | A.NamedAttr(a1, a2), B.NamedAttr(b1, b2) ->
    m_ident a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.OtherAttribute(a1, a2), B.OtherAttribute(b1, b2) ->
    m_other_attribute_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Recursive, _  | A.MutuallyRecursive, _  
  | A.Static, _  | A.Volatile, _  | A.Extern, _  
  | A.Public, _  | A.Private, _ | A.Protected, _
  | A.Abstract, _  | A.Final, _  | A.Var, _  | A.Let, _
  | A.Const, _  | A.Mutable, _  | A.Generator, _  | A.Async, _
  | A.Ctor, _  | A.Dtor, _  | A.Getter, _  | A.Setter, _
  | A.Variadic, _  | A.NamedAttr _, _  | A.OtherAttribute _, _
   -> fail ()

and m_other_attribute_operator = m_other_xxx

(* ------------------------------------------------------------------------- *)
(* Statement *)
(* ------------------------------------------------------------------------- *)

and m_stmt a b = 
  match a, b with

  (* metavariable! *)
  | A.ExprStmt(A.Name ((str,tok), _id_info)), b when MV.is_metavar_name str ->
      envf (str, tok) (B.S b)

  (* '...' can to match any statememt *)
  | A.ExprStmt(A.Ellipses _i), _b ->
      return ()

  | A.ExprStmt(a1), B.ExprStmt(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.DefStmt(a1), B.DefStmt(b1) ->
    m_definition a1 b1 >>= (fun () -> 
    return ()
    )
  | A.DirectiveStmt(a1), B.DirectiveStmt(b1) ->
    m_directive a1 b1 >>= (fun () -> 
    return ()
    )

  (* TODO: ... should also allow a subset of stmts *)
  | A.Block(a1), B.Block(b1) ->
    (m_list m_stmt) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.If(a1, a2, a3), B.If(b1, b2, b3) ->
    m_expr a1 b1 >>= (fun () -> 
    m_stmt a2 b2 >>= (fun () -> 
    m_stmt a3 b3 >>= (fun () -> 
    return ()
    )))
  | A.While(a1, a2), B.While(b1, b2) ->
    m_expr a1 b1 >>= (fun () -> 
    m_stmt a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.DoWhile(a1, a2), B.DoWhile(b1, b2) ->
    m_stmt a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.For(a1, a2), B.For(b1, b2) ->
    m_for_header a1 b1 >>= (fun () -> 
    m_stmt a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Switch(a1, a2), B.Switch(b1, b2) ->
    m_expr a1 b1 >>= (fun () -> 
    (m_list m_case_and_body) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Return(a1), B.Return(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Continue(a1), B.Continue(b1) ->
    (m_option m_expr) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Break(a1), B.Break(b1) ->
    (m_option m_expr) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Label(a1, a2), B.Label(b1, b2) ->
    m_label a1 b1 >>= (fun () -> 
    m_stmt a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Goto(a1), B.Goto(b1) ->
    m_label a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Throw(a1), B.Throw(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Try(a1, a2, a3), B.Try(b1, b2, b3) ->
    m_stmt a1 b1 >>= (fun () -> 
    (m_list m_catch) a2 b2 >>= (fun () -> 
    (m_option m_finally) a3 b3 >>= (fun () -> 
    return ()
    )))
  | A.Assert(a1, a2), B.Assert(b1, b2) ->
    m_expr a1 b1 >>= (fun () -> 
    (m_option m_expr) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.OtherStmt(a1, a2), B.OtherStmt(b1, b2) ->
    m_other_stmt_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.ExprStmt _, _  | A.DefStmt _, _  | A.DirectiveStmt _, _
  | A.Block _, _  | A.If _, _  | A.While _, _  | A.DoWhile _, _  | A.For _, _
  | A.Switch _, _  | A.Return _, _  | A.Continue _, _  | A.Break _, _
  | A.Label _, _  | A.Goto _, _  | A.Throw _, _  | A.Try _, _  | A.Assert _, _
  | A.OtherStmt _, _
   -> fail ()


and m_for_header a b = 
  match a, b with
  | A.ForClassic(a1, a2, a3), B.ForClassic(b1, b2, b3) ->
    (m_list m_for_var_or_expr) a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    m_expr a3 b3 >>= (fun () -> 
    return ()
    )))
  | A.ForEach(a1, a2), B.ForEach(b1, b2) ->
    m_pattern a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.ForClassic _, _  | A.ForEach _, _
   -> fail ()


and m_for_var_or_expr a b = 
  match a, b with
  | A.ForInitVar(a1, a2), B.ForInitVar(b1, b2) ->
    m_entity a1 b1 >>= (fun () -> 
    m_variable_definition a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.ForInitExpr(a1), B.ForInitExpr(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.ForInitVar _, _  | A.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
  | (a1, a2), (b1, b2) ->
    m_pattern a1 b1 >>= (fun () -> 
    m_stmt a2 b2 >>= (fun () -> 
    return ()
    ))

and m_finally a b = 
  match a, b with
  (a, b) -> m_stmt a b

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


and m_case a b = 
  match a, b with
  | A.Case(a1), B.Case(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Default, B.Default ->
    return ()
  | A.Case _, _  | A.Default, _
   -> fail ()


and m_other_stmt_operator = m_other_xxx

(* ------------------------------------------------------------------------- *)
(* Pattern *)
(* ------------------------------------------------------------------------- *)

and m_pattern a b = 
  match a, b with
  | A.PatVar(a1), B.PatVar(b1) ->
    m_ident a1 b1 >>= (fun () -> 
    return ()
    )
  | A.PatLiteral(a1), B.PatLiteral(b1) ->
    m_literal a1 b1 >>= (fun () -> 
    return ()
    )
  | A.PatConstructor(a1, a2), B.PatConstructor(b1, b2) ->
    m_name a1 b1 >>= (fun () -> 
    (m_list m_pattern) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.PatTuple(a1), B.PatTuple(b1) ->
    (m_list m_pattern) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.PatList(a1), B.PatList(b1) ->
    (m_list m_pattern) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.PatRecord(a1), B.PatRecord(b1) ->
    (m_list m_field_pattern) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.PatKeyVal(a1, a2), B.PatKeyVal(b1, b2) ->
    m_pattern a1 b1 >>= (fun () -> 
    m_pattern a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.PatUnderscore(a1), B.PatUnderscore(b1) ->
    m_tok a1 b1 >>= (fun () -> 
    return ()
    )
  | A.PatDisj(a1, a2), B.PatDisj(b1, b2) ->
    m_pattern a1 b1 >>= (fun () -> 
    m_pattern a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.PatAs(a1, a2), B.PatAs(b1, b2) ->
    m_pattern a1 b1 >>= (fun () -> 
    m_ident a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.PatTyped(a1, a2), B.PatTyped(b1, b2) ->
    m_pattern a1 b1 >>= (fun () -> 
    m_type_ a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.PatWhen(a1, a2), B.PatWhen(b1, b2) ->
    m_pattern a1 b1 >>= (fun () -> 
    m_expr a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.OtherPat(a1, a2), B.OtherPat(b1, b2) ->
    m_other_pattern_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.PatVar _, _  | A.PatLiteral _, _  | A.PatConstructor _, _
  | A.PatTuple _, _  | A.PatList _, _  | A.PatRecord _, _  | A.PatKeyVal _, _
  | A.PatUnderscore _, _  | A.PatDisj _, _  | A.PatWhen _, _  | A.PatAs _, _
  | A.PatTyped _, _  | A.OtherPat _, _
   -> fail ()

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

and m_other_pattern_operator = m_other_xxx

(* ------------------------------------------------------------------------- *)
(* Definitions *)
(* ------------------------------------------------------------------------- *)

and m_definition a b = 
  match a, b with
  | (a1, a2), (b1, b2) ->
    m_entity a1 b1 >>= (fun () -> 
    m_definition_kind a2 b2 >>= (fun () -> 
    return ()
    ))

and m_entity a b = 
  match a, b with
  { A. name = a1; attrs = a2; type_ = a3; tparams = a4; },
  { B. name = b1; attrs = b2; type_ = b3; tparams = b4; } -> 
    m_ident a1 b1 >>= (fun () -> 
    (m_list m_attribute) a2 b2 >>= (fun () -> 
    (m_option m_type_) a3 b3 >>= (fun () -> 
    (m_list m_type_parameter) a4 b4 >>= (fun () -> 
    return ()
  ))))

and m_definition_kind a b = 
  match a, b with
  | A.FuncDef(a1), B.FuncDef(b1) ->
    m_function_definition a1 b1 >>= (fun () -> 
    return ()
    )
  | A.VarDef(a1), B.VarDef(b1) ->
    m_variable_definition a1 b1 >>= (fun () -> 
    return ()
    )
  | A.ClassDef(a1), B.ClassDef(b1) ->
    m_class_definition a1 b1 >>= (fun () -> 
    return ()
    )
  | A.TypeDef(a1), B.TypeDef(b1) ->
    m_type_definition a1 b1 >>= (fun () -> 
    return ()
    )
  | A.ModuleDef(a1), B.ModuleDef(b1) ->
    m_module_definition a1 b1 >>= (fun () -> 
    return ()
    )
  | A.MacroDef(a1), B.MacroDef(b1) ->
    m_macro_definition a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Signature(a1), B.Signature(b1) ->
    m_type_ a1 b1 >>= (fun () -> 
    return ()
    )
  | A.FuncDef _, _ | A.VarDef _, _  | A.ClassDef _, _  | A.TypeDef _, _
  | A.ModuleDef _, _  | A.MacroDef _, _  | A.Signature _, _
   -> fail ()


and m_type_parameter_constraint a b = 
  match a, b with
  | A.Extends(a1), B.Extends(b1) ->
    m_type_ a1 b1 >>= (fun () -> 
    return ()
    )

and m_type_parameter_constraints a b = 
  match a, b with
  (a, b) -> (m_list m_type_parameter_constraint) a b

and m_type_parameter a b = 
  match a, b with
  | (a1, a2), (b1, b2) ->
    m_ident a1 b1 >>= (fun () -> 
    m_type_parameter_constraints a2 b2 >>= (fun () -> 
    return ()
    ))

(* ------------------------------------------------------------------------- *)
(* Function (or method) definition *)
(* ------------------------------------------------------------------------- *)

and m_function_definition a b = 
  match a, b with
  { A. fparams = a1; frettype = a2; fbody = a3; },
  { B. fparams = b1; frettype = b2; fbody = b3; } -> 
    m_parameters a1 b1 >>= (fun () -> 
    (m_option m_type_) a2 b2 >>= (fun () -> 
    m_stmt a3 b3 >>= (fun () -> 
    return ()
  )))

and m_parameters a b = 
  match a, b with
  (a, b) -> (m_list m_parameter) a b

and m_parameter a b = 
  match a, b with
  | A.ParamClassic(a1), B.ParamClassic(b1) ->
    m_parameter_classic a1 b1 >>= (fun () -> 
    return ()
    )
  | A.ParamPattern(a1), B.ParamPattern(b1) ->
    m_pattern a1 b1 >>= (fun () -> 
    return ()
    )
  | A.OtherParam(a1, a2), B.OtherParam(b1, b2) ->
    m_other_parameter_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.ParamClassic _, _  | A.ParamPattern _, _  | A.OtherParam _, _
   -> fail ()


and m_parameter_classic a b = 
  match a, b with
  { A. pname = a1; pdefault = a2; ptype = a3; pattrs = a4; },
  { B. pname = b1; pdefault = b2; ptype = b3; pattrs = b4; } -> 
    m_ident a1 b1 >>= (fun () -> 
    (m_option m_expr) a2 b2 >>= (fun () -> 
    (m_option m_type_) a3 b3 >>= (fun () -> 
    (m_list m_attribute) a4 b4 >>= (fun () -> 
    return ()
  ))))


and m_other_parameter_operator = m_other_xxx

(* ------------------------------------------------------------------------- *)
(* Variable definition *)
(* ------------------------------------------------------------------------- *)

and m_variable_definition a b = 
  match a, b with
  { A. vinit = a1; vtype = a2; },
  { B. vinit = b1; vtype = b2; } -> 
    (m_option m_expr) a1 b1 >>= (fun () -> 
    (m_option m_type_) a2 b2 >>= (fun () -> 
    return ()
  ))

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

and m_field a b = 
  match a, b with
  | A.FieldVar(a1, a2), B.FieldVar(b1, b2) ->
    m_entity a1 b1 >>= (fun () -> 
    m_variable_definition a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.FieldMethod(a1, a2), B.FieldMethod(b1, b2) ->
    m_entity a1 b1 >>= (fun () -> 
    m_function_definition a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.FieldDynamic(a1, a2, a3), B.FieldDynamic(b1, b2, b3) ->
    m_expr a1 b1 >>= (fun () -> 
    (m_list m_attribute) a2 b2 >>= (fun () -> 
    m_expr a3 b3 >>= (fun () -> 
    return ()
    )))
  | A.FieldSpread(a1), B.FieldSpread(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.FieldStmt(a1), B.FieldStmt(b1) ->
    m_stmt a1 b1 >>= (fun () -> 
    return ()
    )
  | A.FieldVar _, _ | A.FieldMethod _, _ | A.FieldDynamic _, _
  | A.FieldSpread _, _ | A.FieldStmt _, _
   -> fail ()

(* ------------------------------------------------------------------------- *)
(* Type definition *)
(* ------------------------------------------------------------------------- *)
and m_type_definition a b = 
  match a, b with
  { A. tbody = a1;},
  { B. tbody = b1; } -> 
    m_type_definition_kind a1 b1 >>= (fun () -> 
    return ()
  )

and m_type_definition_kind a b = 
  match a, b with
  | A.OrType(a1), B.OrType(b1) ->
    (m_list m_or_type) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.AndType(a1), B.AndType(b1) ->
    (m_list m_field) a1 b1 >>= (fun () -> 
    return ()
    )
  | A.AliasType(a1), B.AliasType(b1) ->
    m_type_ a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Exception(a1, a2), B.Exception(b1, b2) ->
    m_ident a1 b1 >>= (fun () -> 
    (m_list m_type_) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.OtherTypeKind(a1, a2), B.OtherTypeKind(b1, b2) ->
    m_other_type_kind_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.OrType _, _ | A.AndType _, _ | A.AliasType _, _ | A.Exception _, _
  | A.OtherTypeKind _, _
   -> fail ()

and m_or_type a b = 
  match a, b with
  | A.OrConstructor(a1, a2), B.OrConstructor(b1, b2) ->
    (m_ident) a1 b1 >>= (fun () -> 
    (m_list m_type_) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.OrEnum(a1, a2), B.OrEnum(b1, b2) ->
    m_ident a1 b1 >>= (fun () -> 
    (m_expr) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.OrUnion(a1, a2), B.OrUnion(b1, b2) ->
    m_ident a1 b1 >>= (fun () -> 
    (m_type_) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.OtherOr(a1, a2), B.OtherOr(b1, b2) ->
    m_other_or_type_element_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.OrConstructor _, _ | A.OrEnum _, _ | A.OrUnion _, _ | A.OtherOr _, _
   -> fail ()

and m_other_type_kind_operator = m_other_xxx

and m_other_or_type_element_operator = m_other_xxx

(* ------------------------------------------------------------------------- *)
(* Class definition *)
(* ------------------------------------------------------------------------- *)

and m_class_definition a b = 
  match a, b with
  { A. ckind = a1; cextends = a2; cimplements = a3; cbody = a4; },
  { B. ckind = b1; cextends = b2; cimplements = b3; cbody = b4; } -> 
    m_class_kind a1 b1 >>= (fun () -> 
    (m_list m_type_) a2 b2 >>= (fun () -> 
    (m_list m_type_) a3 b3 >>= (fun () -> 
    (m_list m_field) a4 b4 >>= (fun () -> 
    return ()
  ))))

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

(* ------------------------------------------------------------------------- *)
(* Module definition *)
(* ------------------------------------------------------------------------- *)

and m_module_definition a b = 
  match a, b with
  { A. mbody = a1; },
  { B. mbody = b1; } -> 
    m_module_definition_kind a1 b1 >>= (fun () -> 
    return ()
  )

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

and m_other_module_operator = m_other_xxx

(* ------------------------------------------------------------------------- *)
(* Macro definition *)
(* ------------------------------------------------------------------------- *)

and m_macro_definition a b = 
  match a, b with
  { A. macroparams = a1; macrobody = a2; },
  { B. macroparams = b1; macrobody = b2; } -> 
    (m_list m_ident) a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
  ))

(* ------------------------------------------------------------------------- *)
(* Directives (Module import/export, macros) *)
(* ------------------------------------------------------------------------- *)

and m_directive a b = 
  match a, b with
  | A.Import(a1, a2), B.Import(b1, b2) ->
    m_module_name a1 b1 >>= (fun () -> 
    (m_list m_alias) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.ImportAll(a1, a2), B.ImportAll(b1, b2) ->
    m_module_name a1 b1 >>= (fun () -> 
    (m_option m_ident) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.OtherDirective(a1, a2), B.OtherDirective(b1, b2) ->
    m_other_directive_operator a1 b1 >>= (fun () -> 
    (m_list m_any) a2 b2 >>= (fun () -> 
    return ()
    ))
  | A.Import _, _ | A.ImportAll _, _ | A.OtherDirective _, _
   -> fail ()

and m_alias a b = 
  match a, b with
  | (a1, a2), (b1, b2) ->
    m_ident a1 b1 >>= (fun () -> 
    (m_option m_ident) a2 b2 >>= (fun () -> 
    return ()
    ))

and m_other_directive_operator = m_other_xxx

(* ------------------------------------------------------------------------- *)
(* Toplevel *)
(* ------------------------------------------------------------------------- *)

and m_item a b = 
  match a, b with
  | A.IStmt(a1), B.IStmt(b1) ->
    m_stmt a1 b1 >>= (fun () -> 
    return ()
    )
  | A.IDef(a1), B.IDef(b1) ->
    m_definition a1 b1 >>= (fun () -> 
    return ()
    )
  | A.IDir(a1), B.IDir(b1) ->
    m_directive a1 b1 >>= (fun () -> 
    return ()
    )
  | A.IStmt _, _ | A.IDef _, _ | A.IDir _, _
   -> fail ()

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

(* ------------------------------------------------------------------------- *)
(* Any *)
(* ------------------------------------------------------------------------- *)

and m_any a b = 
  match a, b with
  | A.N(a1), B.N(b1) ->
    m_name a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Di(a1), B.Di(b1) ->
    m_dotted_name a1 b1 >>= (fun () -> 
    return ()
    )
  | A.En(a1), B.En(b1) ->
    m_entity a1 b1 >>= (fun () -> 
    return ()
    )
  | A.E(a1), B.E(b1) ->
    m_expr a1 b1 >>= (fun () -> 
    return ()
    )
  | A.S(a1), B.S(b1) ->
    m_stmt a1 b1 >>= (fun () -> 
    return ()
    )
  | A.T(a1), B.T(b1) ->
    m_type_ a1 b1 >>= (fun () -> 
    return ()
    )
  | A.P(a1), B.P(b1) ->
    m_pattern a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Def(a1), B.Def(b1) ->
    m_definition a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Dir(a1), B.Dir(b1) ->
    m_directive a1 b1 >>= (fun () -> 
    return ()
    )
  | A.I(a1), B.I(b1) ->
    m_item a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Pa(a1), B.Pa(b1) ->
    m_parameter a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Ar(a1), B.Ar(b1) ->
    m_argument a1 b1 >>= (fun () -> 
    return ()
    )
  | A.At(a1), B.At(b1) ->
    m_attribute a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Dk(a1), B.Dk(b1) ->
    m_definition_kind a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Pr(a1), B.Pr(b1) ->
    m_program a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Id(a1), B.Id(b1) ->
    m_ident a1 b1 >>= (fun () -> 
    return ()
    )
  | A.Id _, _  | A.N _, _  | A.Di _, _  | A.En _, _  | A.E _, _
  | A.S _, _  | A.T _, _  | A.P _, _  | A.Def _, _  | A.Dir _, _
  | A.I _, _  | A.Pa _, _  | A.Ar _, _  | A.At _, _  | A.Dk _, _ | A.Pr _, _
   -> fail ()