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

(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(*
 * This module provides a big functor, GENERIC_VS_GENERIC, which can be used
 * to match some AST elements against other AST elements in
 * a flexible way.
 *
 * 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.
 *
 * I then hardcoded a few isomorphisms by abusing some existing constructs,
 * for instance constants starting with a big $X are considered metavars
 * for expression.
 *
 * C-s  "iso" or any comment
 *
 *)

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

(*****************************************************************************)
(* Globals *)
(*****************************************************************************)

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

(*****************************************************************************)
(* Functor parameter combinators *)
(*****************************************************************************)

(* This is the interface of the structure that will be passed to the
 * functor below.
 *)
module type PARAM =
  sig
    (* tin is for 'type in' and tout for 'type out' *)
    type tin
    type 'x tout

    (* A matcher is something taking an element A and an element B
     * (for GENERIC_VS_GENERIC below, 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
     * encapsulate the possible matched element A and B.
     *
     * If you just want to do a simple matcher that just returns
     * a boolean, then instantiate the PARAM struct with
     *   type tin = unit  (* no environment information *)
     *   type ('a * 'b) tout = ('a * 'b) option
     * and if the toplevel matching returns a None, then you know
     * A didn't match B.
     *)
    type ('a, 'b) matcher = 'a -> 'b  -> tin -> ('a * 'b) 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 (a,b) ->
     *        m2 (a, b) tin
     *)
    val (>>=):
      (tin -> ('a * 'b) tout)  ->
      ('a * 'b -> (tin -> ('c * 'd) tout)) ->
      (tin -> ('c * 'd) tout)


    (* the disjunctive combinator *)
    val (>||>) :
      (tin -> 'x tout) ->
      (tin -> 'x tout) ->
      (tin -> 'x tout)


    (* The classical monad combinators *)
    val return : ('a * 'b) -> tin -> ('a *'b) tout
    val fail : tin -> ('a * 'b) tout

    val tokenf : (A.tok, B.tok) matcher

    val envf : (MV.mvar A.wrap, A.any) matcher
    (* ugly hack for the "A" string metavariables *)
    val envf2 : (MV.mvar A.wrap, A.any * A.any) matcher
  end

(*****************************************************************************)
(* Functor code, "JS vs JS" *)
(*****************************************************************************)

module GENERIC_VS_GENERIC =
  functor (X : PARAM) ->
struct

type ('a, 'b) matcher = 'a -> 'b  -> X.tin -> ('a * 'b) X.tout

let (>>=) = X.(>>=)
let (>||>) = X.(>||>)

let return =
  X.return
let fail () =
  X.fail

let fail2 s =
  pr2 (spf "JS_VS_JS: TODO for %s" s); X.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 (None, None)
  | Some xa, Some xb ->
      f xa xb >>= (fun (xa, xb) ->
        return (
          Some xa,
          Some xb
        )
      )
  | 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 (xa, xb) ->
      return (
        {contents = xa},
        {contents = xb}
      )
    )

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

let m_either f g a b =
  match a, b with
  | Left a, Left b ->
      f a b >>= (fun (a, b) ->
        return (
          Left a, Left b
        ))
  | Right a, Right b ->
      g a b >>= (fun (a, b) ->
        return (
          Right a, Right b
        ))
  | Left _, Right _
  | Right _, Left _ ->
      fail ()

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

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

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

(* we dont care about position, space/indent/comment isomorphism
 * so we could just do  'return (a, b)'
 * but we need to propagate transformation at least.
 *)
let m_info a b =
  X.tokenf a b

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 (xaa, xbb) ->
    m_info ainfo binfo >>= (fun (ainfo, binfo) ->
      return (
        (xaa, ainfo),
        (xbb, binfo)
      )
  ))

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

let m_name a b = 
  (* iso on name *)
  match a, b with
  | (str, tok), b when MV.is_metavar_name str ->
      X.envf (str, tok) (B.N b) >>= (function
      | ((str, tok), B.N (b))  ->
        return (
          (str, tok),
          b
        )
      | _ -> raise Impossible
      )
  (* 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_name) 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 (a1, b1) -> 
    return (
       A.FileName(a1),
       B.FileName(b1)
    )
    )
  | A.DottedName(a1), B.DottedName(b1) ->
    m_dotted_name a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.DottedName(a1),
       B.DottedName(b1)
    )
    )
  | A.FileName _, _
  | A.DottedName _, _
   -> fail ()

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

(* start of recursive need *)

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

let rec m_expr a b = 
  match a, b with

  (* special case, metavars !! *)
  | A.Id ((str,tok), id_info),          e2 when MV.is_metavar_name str ->
      X.envf (str, tok) (B.E (e2)) >>= (function
      | ((str, tok), B.E (e2))  ->
        return (
          (A.Id ((str,tok), id_info)),
          e2
        )
      | _ -> raise Impossible
      )

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

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

  (* iso allowing regexp *)
  | 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 (info_name, info_sb) ->
        return (
          A.String(name, info_name),
          B.String(sb, info_sb)
        ))
      else fail ()

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


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

  | A.Regexp(a1), B.Regexp(b1) ->
    (m_wrap m_string) a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Regexp(a1),
       B.Regexp(b1)
    )
    )
  | A.Null(a1), B.Null(b1) ->
    m_tok a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Null(a1),
       B.Null(b1)
    )
    )
  | A.Undefined(a1), B.Undefined(b1) ->
    m_tok a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Undefined(a1),
       B.Undefined(b1)
    )
    )
  | 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 (a1, b1) -> 
    m_expr a2 b2 >>= (fun (a2, b2) -> 
    return (
       (a1, a2),
       (b1, b2)
    )
    ))


and m_arithmetic_operator a b = 
  match a, b with
  | A.Plus, B.Plus ->
    return (
       A.Plus,
       B.Plus
    )
  | A.Minus, B.Minus ->
    return (
       A.Minus,
       B.Minus
    )
  | A.Mult, B.Mult ->
    return (
       A.Mult,
       B.Mult
    )
  | A.Div, B.Div ->
    return (
       A.Div,
       B.Div
    )
  | A.Mod, B.Mod ->
    return (
       A.Mod,
       B.Mod
    )
  | A.Pow, B.Pow ->
    return (
       A.Pow,
       B.Pow
    )
  | A.FloorDiv, B.FloorDiv ->
    return (
       A.FloorDiv,
       B.FloorDiv
    )
  | A.LSL, B.LSL ->
    return (
       A.LSL,
       B.LSL
    )
  | A.LSR, B.LSR ->
    return (
       A.LSR,
       B.LSR
    )
  | A.ASR, B.ASR ->
    return (
       A.ASR,
       B.ASR
    )
  | A.BitOr, B.BitOr ->
    return (
       A.BitOr,
       B.BitOr
    )
  | A.BitXor, B.BitXor ->
    return (
       A.BitXor,
       B.BitXor
    )
  | A.BitAnd, B.BitAnd ->
    return (
       A.BitAnd,
       B.BitAnd
    )
  | A.BitNot, B.BitNot ->
    return (
       A.BitNot,
       B.BitNot
    )
  | A.And, B.And ->
    return (
       A.And,
       B.And
    )
  | A.Or, B.Or ->
    return (
       A.Or,
       B.Or
    )
  | A.Not, B.Not ->
    return (
       A.Not,
       B.Not
    )
  | A.Eq, B.Eq ->
    return (
       A.Eq,
       B.Eq
    )
  | A.NotEq, B.NotEq ->
    return (
       A.NotEq,
       B.NotEq
    )
  | A.PhysEq, B.PhysEq ->
    return (
       A.PhysEq,
       B.PhysEq
    )
  | A.NotPhysEq, B.NotPhysEq ->
    return (
       A.NotPhysEq,
       B.NotPhysEq
    )
  | A.Lt, B.Lt ->
    return (
       A.Lt,
       B.Lt
    )
  | A.LtE, B.LtE ->
    return (
       A.LtE,
       B.LtE
    )
  | A.Gt, B.Gt ->
    return (
       A.Gt,
       B.Gt
    )
  | A.GtE, B.GtE ->
    return (
       A.GtE,
       B.GtE
    )
  | A.Plus, _
  | A.Minus, _
  | A.Mult, _
  | A.Div, _
  | A.Mod, _
  | A.Pow, _
  | A.FloorDiv, _
  | A.LSL, _
  | A.LSR, _
  | A.ASR, _
  | A.BitOr, _
  | A.BitXor, _
  | A.BitAnd, _
  | A.BitNot, _
  | A.And, _
  | A.Or, _
  | A.Not, _
  | A.Eq, _
  | A.NotEq, _
  | A.PhysEq, _
  | A.NotPhysEq, _
  | A.Lt, _
  | A.LtE, _
  | A.Gt, _
  | A.GtE, _
   -> fail ()

and m_special a b = 
  match a, b with
  | A.This, B.This ->
    return (
       A.This,
       B.This
    )
  | A.Super, B.Super ->
    return (
       A.Super,
       B.Super
    )
  | A.Self, B.Self ->
    return (
       A.Self,
       B.Self
    )
  | A.Parent, B.Parent ->
    return (
       A.Parent,
       B.Parent
    )
  | A.Eval, B.Eval ->
    return (
       A.Eval,
       B.Eval
    )
  | A.Typeof, B.Typeof ->
    return (
       A.Typeof,
       B.Typeof
    )
  | A.Instanceof, B.Instanceof ->
    return (
       A.Instanceof,
       B.Instanceof
    )
  | A.Sizeof, B.Sizeof ->
    return (
       A.Sizeof,
       B.Sizeof
    )
  | A.New, B.New ->
    return (
       A.New,
       B.New
    )
  | A.Concat, B.Concat ->
    return (
       A.Concat,
       B.Concat
    )
  | A.Spread, B.Spread ->
    return (
       A.Spread,
       B.Spread
    )
  | A.ArithOp(a1), B.ArithOp(b1) ->
    m_arithmetic_operator a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.ArithOp(a1),
       B.ArithOp(b1)
    )
    )
  | A.IncrDecr(a1, a2), B.IncrDecr(b1, b2) ->
    m_bool a1 b1 >>= (fun (a1, b1) -> 
    m_bool a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.IncrDecr(a1, a2),
       B.IncrDecr(b1, b2)
    )
    ))
  | 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 (a1, b1) -> 
    (m_option m_type_arguments) a2 b2 >>= (fun (a2, b2) -> 
    (m_ref m_resolved_name) a3 b3 >>= (fun (a3, b3) -> 
    (m_ref (m_option m_type_)) a4 b4 >>= (fun (a4, b4) -> 
    return (
      { 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;
      } 
    )
  ))))

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


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

(*---------------------------------------------------------------------------*)
(* 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 ([], [])

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

  (* iso on ... *)
  | [A.Arg (A.Ellipses _i)], _bbs ->
      return (
        xsa,
        xsb
      )

(* TODO
  (* spread metavariable to match any arity *)
  | [A.Apply(A.IdSpecial (A.Spread, info_spread_TODO), 
        [A.Id((name, info_name), aref)])], 
    bbs 
    when MV.is_metavar_name name ->
      X.envf (name, info_name) (B.Expr (B.Apply (B.Nop, bbs))) >>= (function
      | ((name, info_name), (B.Expr (B.Apply (B.Nop, bbs))))  ->
        return (
          [A.Apply(A.IdSpecial (A.Spread, info_spread_TODO), 
              [A.Id((name, info_name), aref)])], 
          bbs 
        )
      | _ -> raise Impossible
      )
    *)

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


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

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

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

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

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

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

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

and m_other_type_argument_operator a b = 
  match a, b with
  | A.OTA_Question, B.OTA_Question ->
    return (
       A.OTA_Question,
       B.OTA_Question
    )

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

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

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

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

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

and m_stmt a b = 
  match a, b with

  (* special case metavar! *)
  | A.ExprStmt(A.Id ((str,tok), id_info)), b when MV.is_metavar_name str ->
      X.envf (str, tok) (B.S b) >>= (function
      | ((str, tok), B.S (b))  ->
        return (
          A.ExprStmt((A.Id ((str,tok), id_info))),
          b
        )
      | _ -> raise Impossible
      )

  (* iso on ..., allow to match any statememt *)
  | A.ExprStmt(A.Ellipses _i), b ->
      return (a, b)

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

  (* TODO: ... should also allow a subset of stmts *)
  | A.Block(a1), B.Block(b1) ->
    (m_list m_stmt) a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Block(a1),
       B.Block(b1)
    )
    )
  | A.If(a1, a2, a3), B.If(b1, b2, b3) ->
    m_expr a1 b1 >>= (fun (a1, b1) -> 
    m_stmt a2 b2 >>= (fun (a2, b2) -> 
    m_stmt a3 b3 >>= (fun (a3, b3) -> 
    return (
       A.If(a1, a2, a3),
       B.If(b1, b2, b3)
    )
    )))
  | A.While(a1, a2), B.While(b1, b2) ->
    m_expr a1 b1 >>= (fun (a1, b1) -> 
    m_stmt a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.While(a1, a2),
       B.While(b1, b2)
    )
    ))
  | A.DoWhile(a1, a2), B.DoWhile(b1, b2) ->
    m_stmt a1 b1 >>= (fun (a1, b1) -> 
    m_expr a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.DoWhile(a1, a2),
       B.DoWhile(b1, b2)
    )
    ))
  | A.For(a1, a2), B.For(b1, b2) ->
    m_for_header a1 b1 >>= (fun (a1, b1) -> 
    m_stmt a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.For(a1, a2),
       B.For(b1, b2)
    )
    ))
  | A.Switch(a1, a2), B.Switch(b1, b2) ->
    m_expr a1 b1 >>= (fun (a1, b1) -> 
    (m_list m_case_and_body) a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.Switch(a1, a2),
       B.Switch(b1, b2)
    )
    ))
  | A.Return(a1), B.Return(b1) ->
    m_expr a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Return(a1),
       B.Return(b1)
    )
    )
  | A.Continue(a1), B.Continue(b1) ->
    (m_option m_expr) a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Continue(a1),
       B.Continue(b1)
    )
    )
  | A.Break(a1), B.Break(b1) ->
    (m_option m_expr) a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Break(a1),
       B.Break(b1)
    )
    )
  | A.Label(a1, a2), B.Label(b1, b2) ->
    m_label a1 b1 >>= (fun (a1, b1) -> 
    m_stmt a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.Label(a1, a2),
       B.Label(b1, b2)
    )
    ))
  | A.Goto(a1), B.Goto(b1) ->
    m_label a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Goto(a1),
       B.Goto(b1)
    )
    )
  | A.Throw(a1), B.Throw(b1) ->
    m_expr a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Throw(a1),
       B.Throw(b1)
    )
    )
  | A.Try(a1, a2, a3), B.Try(b1, b2, b3) ->
    m_stmt a1 b1 >>= (fun (a1, b1) -> 
    (m_list m_catch) a2 b2 >>= (fun (a2, b2) -> 
    (m_option m_finally) a3 b3 >>= (fun (a3, b3) -> 
    return (
       A.Try(a1, a2, a3),
       B.Try(b1, b2, b3)
    )
    )))
  | A.Assert(a1, a2), B.Assert(b1, b2) ->
    m_expr a1 b1 >>= (fun (a1, b1) -> 
    (m_option m_expr) a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.Assert(a1, a2),
       B.Assert(b1, b2)
    )
    ))
  | A.OtherStmt(a1, a2), B.OtherStmt(b1, b2) ->
    m_other_stmt_operator a1 b1 >>= (fun (a1, b1) -> 
    (m_list m_any) a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.OtherStmt(a1, a2),
       B.OtherStmt(b1, b2)
    )
    ))
  | A.ExprStmt _, _
  | A.LocalDef _, _
  | A.LocalDirective _, _
  | 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 (a1, b1) -> 
    m_expr a2 b2 >>= (fun (a2, b2) -> 
    m_expr a3 b3 >>= (fun (a3, b3) -> 
    return (
       A.ForClassic(a1, a2, a3),
       B.ForClassic(b1, b2, b3)
    )
    )))
  | A.ForEach(a1, a2), B.ForEach(b1, b2) ->
    m_pattern a1 b1 >>= (fun (a1, b1) -> 
    m_expr a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.ForEach(a1, a2),
       B.ForEach(b1, b2)
    )
    ))
  | 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 (a1, b1) -> 
    m_variable_definition a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.ForInitVar(a1, a2),
       B.ForInitVar(b1, b2)
    )
    ))
  | A.ForInitExpr(a1), B.ForInitExpr(b1) ->
    m_expr a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.ForInitExpr(a1),
       B.ForInitExpr(b1)
    )
    )
  | A.ForInitVar _, _
  | A.ForInitExpr _, _
   -> fail ()


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

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

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 (a1, b1) -> 
    m_stmt a2 b2 >>= (fun (a2, b2) -> 
    return (
       (a1, a2),
       (b1, b2)
    )
    ))


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


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

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

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

and m_other_pattern_operator a b = 
  match a, b with
  | A.OP_Expr, B.OP_Expr ->
    return (
       A.OP_Expr,
       B.OP_Expr
    )
  | A.OP_Var, B.OP_Var ->
    return (
       A.OP_Var,
       B.OP_Var
    )
  | A.OP_Expr, _
  | A.OP_Var, _
   -> fail ()

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

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

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_name a1 b1 >>= (fun (a1, b1) -> 
    (m_list m_attribute) a2 b2 >>= (fun (a2, b2) -> 
    (m_option m_type_) a3 b3 >>= (fun (a3, b3) -> 
    (m_list m_type_parameter) a4 b4 >>= (fun (a4, b4) -> 
    return (
      { A. 
      name = a1;
      attrs = a2;
      type_ = a3;
      tparams = a4;
      },
      { B.
      name = b1;
      attrs = b2;
      type_ = b3;
      tparams = b4;
      } 
    )
  ))))

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


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

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_name a1 b1 >>= (fun (a1, b1) -> 
    m_type_parameter_constraints a2 b2 >>= (fun (a2, b2) -> 
    return (
       (a1, a2),
       (b1, b2)
    )
    ))

(* ------------------------------------------------------------------------- *)
(* 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 (a1, b1) -> 
    (m_option m_type_) a2 b2 >>= (fun (a2, b2) -> 
    m_stmt a3 b3 >>= (fun (a3, b3) -> 
    return (
      { A. 
      fparams = a1;
      frettype = a2;
      fbody = a3;
      },
      { B.
      fparams = b1;
      frettype = b2;
      fbody = b3;
      } 
    )
  )))

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 (a1, b1) -> 
    return (
       A.ParamClassic(a1),
       B.ParamClassic(b1)
    )
    )
  | A.ParamPattern(a1), B.ParamPattern(b1) ->
    m_pattern a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.ParamPattern(a1),
       B.ParamPattern(b1)
    )
    )
  | A.OtherParam(a1, a2), B.OtherParam(b1, b2) ->
    m_other_parameter_operator a1 b1 >>= (fun (a1, b1) -> 
    (m_list m_any) a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.OtherParam(a1, a2),
       B.OtherParam(b1, b2)
    )
    ))
  | 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_name a1 b1 >>= (fun (a1, b1) -> 
    (m_option m_expr) a2 b2 >>= (fun (a2, b2) -> 
    (m_option m_type_) a3 b3 >>= (fun (a3, b3) -> 
    (m_list m_attribute) a4 b4 >>= (fun (a4, b4) -> 
    return (
      { A. 
      pname = a1;
      pdefault = a2;
      ptype = a3;
      pattrs = a4;
      },
      { B.
      pname = b1;
      pdefault = b2;
      ptype = b3;
      pattrs = b4;
      } 
    )
  ))))


and m_other_parameter_operator a b = 
  match a, b with
  | A.OPO_KwdParam, B.OPO_KwdParam ->
    return (
       A.OPO_KwdParam,
       B.OPO_KwdParam
    )
  | A.OPO_Ref, B.OPO_Ref ->
    return (
       A.OPO_Ref,
       B.OPO_Ref
    )
  | A.OPO_KwdParam, _
  | A.OPO_Ref, _
   -> fail ()


(* ------------------------------------------------------------------------- *)
(* 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 (a1, b1) -> 
    (m_option m_type_) a2 b2 >>= (fun (a2, b2) -> 
    return (
      { A. 
      vinit = a1;
      vtype = a2;
      },
      { B.
      vinit = b1;
      vtype = b2;
      } 
    )
  ))

(* ------------------------------------------------------------------------- *)
(* 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 (a1, b1) -> 
    m_variable_definition a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.FieldVar(a1, a2),
       B.FieldVar(b1, b2)
    )
    ))
  | A.FieldMethod(a1, a2), B.FieldMethod(b1, b2) ->
    m_entity a1 b1 >>= (fun (a1, b1) -> 
    m_function_definition a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.FieldMethod(a1, a2),
       B.FieldMethod(b1, b2)
    )
    ))
  | A.FieldDynamic(a1, a2, a3), B.FieldDynamic(b1, b2, b3) ->
    m_expr a1 b1 >>= (fun (a1, b1) -> 
    (m_list m_attribute) a2 b2 >>= (fun (a2, b2) -> 
    m_expr a3 b3 >>= (fun (a3, b3) -> 
    return (
       A.FieldDynamic(a1, a2, a3),
       B.FieldDynamic(b1, b2, b3)
    )
    )))
  | A.FieldSpread(a1), B.FieldSpread(b1) ->
    m_expr a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.FieldSpread(a1),
       B.FieldSpread(b1)
    )
    )
  | A.FieldStmt(a1), B.FieldStmt(b1) ->
    m_stmt a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.FieldStmt(a1),
       B.FieldStmt(b1)
    )
    )
  | A.FieldVar _, _
  | A.FieldMethod _, _
  | A.FieldDynamic _, _
  | A.FieldSpread _, _
  | A.FieldStmt _, _
   -> fail ()

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

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

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



and m_other_type_kind_operator a b = 
  match a, b with
  | A.OTKO_EnumWithValue, B.OTKO_EnumWithValue ->
    return (
       A.OTKO_EnumWithValue,
       B.OTKO_EnumWithValue
    )



(* ------------------------------------------------------------------------- *)
(* 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 (a1, b1) -> 
    (m_list m_type_) a2 b2 >>= (fun (a2, b2) -> 
    (m_list m_type_) a3 b3 >>= (fun (a3, b3) -> 
    (m_list m_field) a4 b4 >>= (fun (a4, b4) -> 
    return (
      { A. 
      ckind = a1;
      cextends = a2;
      cimplements = a3;
      cbody = a4;
      },
      { B.
      ckind = b1;
      cextends = b2;
      cimplements = b3;
      cbody = b4;
      } 
    )
  ))))

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

(* ------------------------------------------------------------------------- *)
(* 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 (a1, b1) -> 
    (m_list m_alias) a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.Import(a1, a2),
       B.Import(b1, b2)
    )
    ))
  | A.ImportAll(a1, a2), B.ImportAll(b1, b2) ->
    m_module_name a1 b1 >>= (fun (a1, b1) -> 
    (m_option m_name) a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.ImportAll(a1, a2),
       B.ImportAll(b1, b2)
    )
    ))
  | A.OtherDirective(a1, a2), B.OtherDirective(b1, b2) ->
    m_other_directive_operator a1 b1 >>= (fun (a1, b1) -> 
    (m_list m_any) a2 b2 >>= (fun (a2, b2) -> 
    return (
       A.OtherDirective(a1, a2),
       B.OtherDirective(b1, b2)
    )
    ))
  | A.Import _, _
  | A.ImportAll _, _
  | A.OtherDirective _, _
   -> fail ()

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

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

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

and m_item a b = 
  match a, b with
  | A.IStmt(a1), B.IStmt(b1) ->
    m_stmt a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.IStmt(a1),
       B.IStmt(b1)
    )
    )
  | A.IDef(a1), B.IDef(b1) ->
    m_definition a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.IDef(a1),
       B.IDef(b1)
    )
    )
  | A.IDir(a1), B.IDir(b1) ->
    m_directive a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.IDir(a1),
       B.IDir(b1)
    )
    )
  | 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 (a1, b1) -> 
    return (
       A.N(a1),
       B.N(b1)
    )
    )
  | A.Dn(a1), B.Dn(b1) ->
    m_dotted_name a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Dn(a1),
       B.Dn(b1)
    )
    )
  | A.En(a1), B.En(b1) ->
    m_entity a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.En(a1),
       B.En(b1)
    )
    )
  | A.E(a1), B.E(b1) ->
    m_expr a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.E(a1),
       B.E(b1)
    )
    )
  | A.S(a1), B.S(b1) ->
    m_stmt a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.S(a1),
       B.S(b1)
    )
    )
  | A.T(a1), B.T(b1) ->
    m_type_ a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.T(a1),
       B.T(b1)
    )
    )
  | A.P(a1), B.P(b1) ->
    m_pattern a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.P(a1),
       B.P(b1)
    )
    )
  | A.D(a1), B.D(b1) ->
    m_definition a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.D(a1),
       B.D(b1)
    )
    )
  | A.Di(a1), B.Di(b1) ->
    m_directive a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Di(a1),
       B.Di(b1)
    )
    )
  | A.I(a1), B.I(b1) ->
    m_item a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.I(a1),
       B.I(b1)
    )
    )
  | A.Pa(a1), B.Pa(b1) ->
    m_parameter a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Pa(a1),
       B.Pa(b1)
    )
    )
  | A.Ar(a1), B.Ar(b1) ->
    m_argument a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Ar(a1),
       B.Ar(b1)
    )
    )
  | A.At(a1), B.At(b1) ->
    m_attribute a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.At(a1),
       B.At(b1)
    )
    )
  | A.Dk(a1), B.Dk(b1) ->
    m_definition_kind a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Dk(a1),
       B.Dk(b1)
    )
    )
  | A.Pr(a1), B.Pr(b1) ->
    m_program a1 b1 >>= (fun (a1, b1) -> 
    return (
       A.Pr(a1),
       B.Pr(b1)
    )
    )
  | A.N _, _
  | A.Dn _, _
  | A.En _, _
  | A.E _, _
  | A.S _, _
  | A.T _, _
  | A.P _, _
  | A.D _, _
  | A.Di _, _
  | A.I _, _
  | A.Pa _, _
  | A.Ar _, _
  | A.At _, _
  | A.Dk _, _
  | A.Pr _, _
   -> fail ()

end