Release coccinelle-0.2.0rc1

[bpt/coccinelle.git] / engine / cocci_vs_c.ml

(* Yoann Padioleau, Julia Lawall
 *
 * Copyright (C) 2006, 2007, 2008 Ecole des Mines de Nantes
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License (GPL)
 * version 2 as published by the Free Software Foundation.
 *
 * This program 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.
 *
 * This file was part of Coccinelle.
 *)

open Common

module A = Ast_cocci
module B = Ast_c

module F = Control_flow_c

module Flag = Flag_matcher

(*****************************************************************************)
(* Wrappers *)
(*****************************************************************************)
let pr2, pr2_once = Common.mk_pr2_wrappers Flag_matcher.verbose_matcher

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

type sequence = Ordered | Unordered

let seqstyle eas =
   match A.unwrap eas with
   | A.DOTS _ -> Ordered
   | A.CIRCLES _ -> Unordered
   | A.STARS _ -> failwith "not handling stars"

let (redots : 'a A.dots -> 'a list -> 'a A.dots)=fun eas easundots ->
  A.rewrap eas ( 
    match A.unwrap eas with 
    | A.DOTS _ -> A.DOTS easundots
    | A.CIRCLES _ -> A.CIRCLES easundots
    | A.STARS _ -> A.STARS easundots
  )


let (need_unordered_initialisers : B.initialiser B.wrap2 list -> bool) = 
 fun ibs -> 
   ibs +> List.exists (fun (ib, icomma) -> 
     match B.unwrap ib with
     | B.InitDesignators _ 
     | B.InitFieldOld _ 
     | B.InitIndexOld _
         -> true
     | B.InitExpr _ 
     | B.InitList _ 
         -> false
   )

(* For the #include <linux/...> in the .cocci, need to find where is
 * the '+' attached to this element, to later find the first concrete
 * #include <linux/xxx.h> or last one in the serie of #includes in the
 * .c.
 *)
type include_requirement = 
  | IncludeMcodeBefore
  | IncludeMcodeAfter 
  | IncludeNothing


        
(* todo? put in semantic_c.ml *)
type info_ident = 
  | Function 
  | LocalFunction (* entails Function *)
  | DontKnow


let term      mc = A.unwrap_mcode mc
let mcodekind mc = A.get_mcodekind mc


let mcode_contain_plus = function
  | A.CONTEXT (_,A.NOTHING) -> false
  | A.CONTEXT _ -> true
  | A.MINUS (_,_,_,[]) -> false
  | A.MINUS (_,_,_,x::xs) -> true
  | A.PLUS _ -> raise Impossible

let mcode_simple_minus = function
  | A.MINUS (_,_,_,[]) -> true
  | _ -> false


(* In transformation.ml sometime I build some mcodekind myself and
 * julia has put None for the pos. But there is no possible raise
 * NoMatch in those cases because it is for the minusall trick or for
 * the distribute, so either have to build those pos, in fact a range,
 * because for the distribute have to erase a fullType with one
 * mcodekind, or add an argument to tag_with_mck such as "safe" that
 * don't do the check_pos. Hence this DontCarePos constructor. *)

let minusizer = 
  ("fake","fake"), 
  {A.line = 0; A.column =0; A.strbef=[]; A.straft=[];},
  (A.MINUS(A.DontCarePos,[],-1,[])),
  A.NoMetaPos

let generalize_mcode ia = 
  let (s1, i, mck, pos) = ia in
  let new_mck =
    match mck with
    | A.PLUS _ -> raise Impossible
    | A.CONTEXT (A.NoPos,x) -> 
        A.CONTEXT (A.DontCarePos,x)
    | A.MINUS   (A.NoPos,inst,adj,x) -> 
        A.MINUS   (A.DontCarePos,inst,adj,x)

    | A.CONTEXT ((A.FixPos _|A.DontCarePos), _) 
    | A.MINUS ((A.FixPos _|A.DontCarePos), _, _, _)
        ->
        raise Impossible
  in
  (s1, i, new_mck, pos)



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

(* 0x0 is equivalent to 0,  value format isomorphism *)
let equal_c_int s1 s2 = 
  try 
    int_of_string s1 =|= int_of_string s2
  with Failure("int_of_string") -> 
    s1 =$= s2



(*---------------------------------------------------------------------------*)
(* Normally A should reuse some types of Ast_c, so those
 * functions should not exist.
 * 
 * update: but now Ast_c depends on A, so can't make too
 * A depends on Ast_c, so have to stay with those equal_xxx
 * functions. 
 *)

let equal_unaryOp a b = 
  match a, b with
  | A.GetRef   , B.GetRef  -> true
  | A.DeRef    , B.DeRef   -> true
  | A.UnPlus   , B.UnPlus  -> true
  | A.UnMinus  , B.UnMinus -> true
  | A.Tilde    , B.Tilde   -> true
  | A.Not      , B.Not     -> true
  | _, B.GetRefLabel -> false (* todo cocci? *)
  | _, (B.Not|B.Tilde|B.UnMinus|B.UnPlus|B.DeRef|B.GetRef) -> false
      


let equal_arithOp a b = 
  match a, b with
  | A.Plus     , B.Plus     -> true
  | A.Minus    , B.Minus    -> true
  | A.Mul      , B.Mul      -> true
  | A.Div      , B.Div      -> true
  | A.Mod      , B.Mod      -> true
  | A.DecLeft  , B.DecLeft  -> true
  | A.DecRight , B.DecRight -> true
  | A.And      , B.And      -> true
  | A.Or       , B.Or       -> true
  | A.Xor      , B.Xor      -> true
  | _, (B.Xor|B.Or|B.And|B.DecRight|B.DecLeft|B.Mod|B.Div|B.Mul|B.Minus|B.Plus)
      -> false

let equal_logicalOp a b = 
  match a, b with
  | A.Inf    , B.Inf    -> true
  | A.Sup    , B.Sup    -> true
  | A.InfEq  , B.InfEq  -> true
  | A.SupEq  , B.SupEq  -> true
  | A.Eq     , B.Eq     -> true
  | A.NotEq  , B.NotEq  -> true
  | A.AndLog , B.AndLog -> true
  | A.OrLog  , B.OrLog  -> true
  | _, (B.OrLog|B.AndLog|B.NotEq|B.Eq|B.SupEq|B.InfEq|B.Sup|B.Inf)
      -> false

let equal_assignOp a b = 
  match a, b with
  | A.SimpleAssign, B.SimpleAssign -> true
  | A.OpAssign a,   B.OpAssign b -> equal_arithOp a b
  | _, (B.OpAssign _|B.SimpleAssign) -> false

let equal_fixOp a b = 
  match a, b with
  | A.Dec, B.Dec -> true
  | A.Inc, B.Inc -> true
  | _, (B.Inc|B.Dec) -> false

let equal_binaryOp a b = 
  match a, b with
  | A.Arith a,    B.Arith b ->   equal_arithOp a b
  | A.Logical a,  B.Logical b -> equal_logicalOp a b
  | _, (B.Logical _ | B.Arith _) -> false

let equal_structUnion a b = 
  match a, b with
  | A.Struct, B.Struct -> true
  | A.Union,  B.Union -> true
  | _, (B.Struct|B.Union) -> false

let equal_sign a b = 
  match a, b with
  | A.Signed,    B.Signed   -> true
  | A.Unsigned,  B.UnSigned -> true
  | _, (B.UnSigned|B.Signed) -> false

let equal_storage a b = 
  match a, b with
  | A.Static   , B.Sto B.Static
  | A.Auto     , B.Sto B.Auto
  | A.Register , B.Sto B.Register
  | A.Extern   , B.Sto B.Extern 
      -> true
  | _, (B.NoSto | B.StoTypedef) -> false
  | _, (B.Sto (B.Register|B.Static|B.Auto|B.Extern)) -> false


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

let equal_metavarval valu valu' =
  match valu, valu' with
  | Ast_c.MetaIdVal a, Ast_c.MetaIdVal b -> a =$= b
  | Ast_c.MetaFuncVal a, Ast_c.MetaFuncVal b -> a =$= b
  | Ast_c.MetaLocalFuncVal a, Ast_c.MetaLocalFuncVal b -> 
      (* do something more ? *)
      a =$= b

  (* al_expr before comparing !!! and accept when they match.
   * Note that here we have Astc._expression, so it is a match
   * modulo isomorphism (there is no metavariable involved here,
   * just isomorphisms). => TODO call isomorphism_c_c instead of
   * =*=. Maybe would be easier to transform ast_c in ast_cocci
   * and call the iso engine of julia. *)
  | Ast_c.MetaExprVal a, Ast_c.MetaExprVal b -> 
      Lib_parsing_c.al_expr a =*= Lib_parsing_c.al_expr b
  | Ast_c.MetaExprListVal a, Ast_c.MetaExprListVal b -> 
      Lib_parsing_c.al_arguments a =*= Lib_parsing_c.al_arguments b

  | Ast_c.MetaStmtVal a, Ast_c.MetaStmtVal b -> 
      Lib_parsing_c.al_statement a =*= Lib_parsing_c.al_statement b
  | Ast_c.MetaInitVal a, Ast_c.MetaInitVal b -> 
      Lib_parsing_c.al_init a =*= Lib_parsing_c.al_init b
  | Ast_c.MetaTypeVal a, Ast_c.MetaTypeVal b -> 
      (* old: Lib_parsing_c.al_type a =*= Lib_parsing_c.al_type b *)
      C_vs_c.eq_type a b
        
  | Ast_c.MetaListlenVal a, Ast_c.MetaListlenVal b -> a =|= b

  | Ast_c.MetaParamVal a, Ast_c.MetaParamVal b -> 
      Lib_parsing_c.al_param a =*= Lib_parsing_c.al_param b
  | Ast_c.MetaParamListVal a, Ast_c.MetaParamListVal b -> 
      Lib_parsing_c.al_params a =*= Lib_parsing_c.al_params b

  | Ast_c.MetaPosVal (posa1,posa2), Ast_c.MetaPosVal (posb1,posb2) -> 
      Ast_cocci.equal_pos posa1 posb1 && Ast_cocci.equal_pos posa2 posb2

  | Ast_c.MetaPosValList l1, Ast_c.MetaPosValList l2 ->
      List.exists
        (function (fla,cea,posa1,posa2) ->
          List.exists
            (function (flb,ceb,posb1,posb2) ->
              fla =$= flb && cea =$= ceb &&
              Ast_c.equal_posl posa1 posb1 && Ast_c.equal_posl posa2 posb2)
            l2)
        l1

  | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _
      |B.MetaTypeVal _ |B.MetaInitVal _
      |B.MetaParamListVal _|B.MetaParamVal _|B.MetaExprListVal _
      |B.MetaExprVal _|B.MetaLocalFuncVal _|B.MetaFuncVal _|B.MetaIdVal _
    ), _
      -> raise Impossible

(* probably only one argument needs to be stripped, because inherited
metavariables containing expressions are stripped in advance. But don't
know which one is which... *)
let equal_inh_metavarval valu valu'=
  match valu, valu' with
  | Ast_c.MetaIdVal a, Ast_c.MetaIdVal b -> a =$= b
  | Ast_c.MetaFuncVal a, Ast_c.MetaFuncVal b -> a =$= b
  | Ast_c.MetaLocalFuncVal a, Ast_c.MetaLocalFuncVal b -> 
      (* do something more ? *)
      a =$= b

  (* al_expr before comparing !!! and accept when they match.
   * Note that here we have Astc._expression, so it is a match
   * modulo isomorphism (there is no metavariable involved here,
   * just isomorphisms). => TODO call isomorphism_c_c instead of
   * =*=. Maybe would be easier to transform ast_c in ast_cocci
   * and call the iso engine of julia. *)
  | Ast_c.MetaExprVal a, Ast_c.MetaExprVal b -> 
      Lib_parsing_c.al_inh_expr a =*= Lib_parsing_c.al_inh_expr b
  | Ast_c.MetaExprListVal a, Ast_c.MetaExprListVal b -> 
      Lib_parsing_c.al_inh_arguments a =*= Lib_parsing_c.al_inh_arguments b

  | Ast_c.MetaStmtVal a, Ast_c.MetaStmtVal b -> 
      Lib_parsing_c.al_inh_statement a =*= Lib_parsing_c.al_inh_statement b
  | Ast_c.MetaInitVal a, Ast_c.MetaInitVal b -> 
      Lib_parsing_c.al_inh_init a =*= Lib_parsing_c.al_inh_init b
  | Ast_c.MetaTypeVal a, Ast_c.MetaTypeVal b -> 
      (* old: Lib_parsing_c.al_inh_type a =*= Lib_parsing_c.al_inh_type b *)
      C_vs_c.eq_type a b
        
  | Ast_c.MetaListlenVal a, Ast_c.MetaListlenVal b -> a =|= b

  | Ast_c.MetaParamVal a, Ast_c.MetaParamVal b -> 
      Lib_parsing_c.al_param a =*= Lib_parsing_c.al_param b
  | Ast_c.MetaParamListVal a, Ast_c.MetaParamListVal b -> 
      Lib_parsing_c.al_params a =*= Lib_parsing_c.al_params b

  | Ast_c.MetaPosVal (posa1,posa2), Ast_c.MetaPosVal (posb1,posb2) -> 
      Ast_cocci.equal_pos posa1 posb1 && Ast_cocci.equal_pos posa2 posb2
        
  | Ast_c.MetaPosValList l1, Ast_c.MetaPosValList l2 ->
      List.exists
        (function (fla,cea,posa1,posa2) ->
          List.exists
            (function (flb,ceb,posb1,posb2) ->
              fla =$= flb && cea =$= ceb &&
              Ast_c.equal_posl posa1 posb1 && Ast_c.equal_posl posa2 posb2)
            l2)
        l1

  | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _
      |B.MetaTypeVal _ |B.MetaInitVal _
      |B.MetaParamListVal _|B.MetaParamVal _|B.MetaExprListVal _
      |B.MetaExprVal _|B.MetaLocalFuncVal _|B.MetaFuncVal _|B.MetaIdVal _
    ), _
      -> raise Impossible


(*---------------------------------------------------------------------------*)
(* could put in ast_c.ml, next to the split/unsplit_comma *)
let split_signb_baseb_ii (baseb, ii) = 
  let iis = ii +> List.map (fun info -> (B.str_of_info info), info) in
  match baseb, iis with
  
  | B.Void, ["void",i1] -> None, [i1]
      
  | B.FloatType (B.CFloat),["float",i1] -> None, [i1]
  | B.FloatType (B.CDouble),["double",i1] -> None, [i1]
  | B.FloatType (B.CLongDouble),["long",i1;"double",i2] -> None,[i1;i2]
      
  | B.IntType (B.CChar), ["char",i1] -> None, [i1]


  | B.IntType (B.Si (sign, base)), xs ->
      let (signed,rest) =
        match (sign,xs) with
          (_,[]) -> None,[]
        | (B.Signed,(("signed",i1)::rest)) -> (Some (B.Signed,i1),rest)
        | (B.Signed,rest) -> (None,rest)
        | (B.UnSigned,(("unsigned",i1)::rest)) -> (Some (B.UnSigned,i1),rest)
        | (B.UnSigned,rest) -> (* is this case possible? *) (None,rest) in
      (* The original code only allowed explicit signed and unsigned for char,
         while this code allows char by itself.  Not sure that needs to be
         checked for here.  If it does, then add a special case. *)
      let base_res =
        match (base,rest) with
          B.CInt, ["int",i1] -> [i1]
        | B.CInt, [] -> []

        | B.CInt, ["",i1] -> (* no type is specified at all *)
            (match i1.B.pinfo with
              B.FakeTok(_,_) -> []
            | _ -> failwith ("unrecognized signed int: "^
                             (String.concat " "(List.map fst iis))))

        | B.CChar2, ["char",i2] -> [i2]

        | B.CShort, ["short",i1] -> [i1]
        | B.CShort, ["short",i1;"int",i2] -> [i1;i2]

        | B.CLong, ["long",i1] -> [i1]
        | B.CLong, ["long",i1;"int",i2] -> [i1;i2]

        | B.CLongLong, ["long",i1;"long",i2] -> [i1;i2]
        | B.CLongLong, ["long",i1;"long",i2;"int",i3] -> [i1;i2;i3]

        | _ ->
          failwith ("strange type1, maybe because of weird order: "^
                    (String.concat " " (List.map fst iis))) in
      (signed,base_res)
  | _ -> failwith ("strange type2, maybe because of weird order: "^
                   (String.concat " " (List.map fst iis)))

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

let rec unsplit_icomma xs = 
  match xs with
  | [] -> []
  | x::y::xs -> 
      (match A.unwrap y with
      | A.IComma mcode -> 
          (x, y)::unsplit_icomma xs
      | _ -> failwith "wrong ast_cocci in initializer"
      )
  | _ -> 
      failwith ("wrong ast_cocci in initializer, should have pair " ^
                "number of Icomma")



let resplit_initialiser ibs iicomma = 
  match iicomma, ibs with
  | [], [] -> []
  | [], _ -> 
      failwith "should have a iicomma, do you generate fakeInfo in parser?"
  | _, [] -> 
      failwith "shouldn't have a iicomma"
  | [iicomma], x::xs -> 
      let elems = List.map fst (x::xs) in
      let commas = List.map snd (x::xs) +> List.flatten in
      let commas = commas @ [iicomma] in
      zip elems commas 
  | _ -> raise Impossible



let rec split_icomma xs = 
  match xs with
  | [] -> []
  | (x,y)::xs -> x::y::split_icomma xs

let rec unsplit_initialiser ibs_unsplit = 
  match ibs_unsplit with
  | [] -> [],  [] (* empty iicomma *)
  | (x, commax)::xs -> 
      let (xs, lastcomma) = unsplit_initialiser_bis commax xs in
      (x, [])::xs,  lastcomma

and unsplit_initialiser_bis comma_before = function
  | [] -> [], [comma_before]
  | (x, commax)::xs -> 
      let (xs, lastcomma) = unsplit_initialiser_bis commax xs in
      (x, [comma_before])::xs,  lastcomma




(*---------------------------------------------------------------------------*)
(* coupling: same in type_annotater_c.ml *)
let structdef_to_struct_name ty = 
  match ty with 
  | qu, (B.StructUnion (su, sopt, fields), iis) -> 
      (match sopt,iis with
      | Some s , [i1;i2;i3;i4] -> 
          qu, (B.StructUnionName (su, s), [i1;i2])
      | None, _ -> 
          ty
          
      | x -> raise Impossible
      )
  | _ -> raise Impossible

(*---------------------------------------------------------------------------*)
let initialisation_to_affectation decl = 
  match decl with
  | B.MacroDecl _ -> F.Decl decl
  | B.DeclList (xs, iis) -> 
      
      (* todo?: should not do that if the variable is an array cos
       *  will have x[] = , mais de toute facon ca sera pas un InitExp
       *)
      (match xs with
      | [] -> raise Impossible
      | [x] -> 
          let ({B.v_namei = var;
                B.v_type = returnType;
                B.v_type_bis = tybis;
                B.v_storage = storage;
                B.v_local = local},
              iisep) = x in



          (match var with
          | Some (name, iniopt) -> 
              (match iniopt with
              | Some (iini, (B.InitExpr e, ii_empty2)) -> 

                  let local =
                    match local with
                      Ast_c.NotLocalDecl -> Ast_c.NotLocalVar
                    | Ast_c.LocalDecl ->
                        Ast_c.LocalVar (Ast_c.info_of_type returnType) in

                  let typexp = 
                    (* old: Lib_parsing_c.al_type returnType
                     * but this type has not the typename completed so
                     * instead try to use tybis
                     *)
                    match !tybis with
                    | Some ty_with_typename_completed -> 
                        ty_with_typename_completed
                    | None -> raise Impossible
                  in
                        
                  let typ =
                    ref (Some (typexp,local),
                               Ast_c.NotTest) in
                  let ident = name in
                  let idexpr = 
                    Ast_c.mk_e_bis (B.Ident (ident)) typ Ast_c.noii
                  in
                  let assign = 
                    Ast_c.mk_e 
                      (B.Assignment (idexpr,B.SimpleAssign, e)) [iini] in
                  F.DefineExpr assign
                    
              | _ -> F.Decl decl
              )
          | _ -> F.Decl decl
          )
      | x::xs -> 
          pr2_once "TODO: initialisation_to_affectation for multi vars";
          (* todo? do a fold_left and generate 'x = a, y = b' etc, use
           * the Sequence expression operator of C and make an 
           * ExprStatement from that.
           *)
          F.Decl decl
      )





(*****************************************************************************)
(* Functor parameter combinators *)
(*****************************************************************************)
(* monad like stuff
 * src: papers on parser combinators in haskell (cf a pearl by meijer in ICFP)
 * 
 * version0: was not tagging the SP, so just tag the C
 *  val (>>=): 
 *   (tin -> 'c tout)  -> ('c -> (tin -> 'b tout)) -> (tin -> 'b tout)
 *   val return : 'b -> tin -> 'b tout
 *   val fail : tin -> 'b tout
 * 
 * version1: now also tag the SP so return a ('a * 'b)
 *)

type mode = PatternMode | TransformMode

module type PARAM = 
  sig 
    type tin
    type 'x tout


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

    val mode : mode

    val (>>=): 
      (tin -> ('a * 'b) tout)  -> 
      ('a -> 'b -> (tin -> ('c * 'd) tout)) -> 
      (tin -> ('c * 'd) tout)

    val return : ('a * 'b) -> tin -> ('a *'b) tout
    val fail : tin -> ('a * 'b) tout

    val (>||>) : 
      (tin -> 'x tout) ->
      (tin -> 'x tout) -> 
      (tin -> 'x tout)

    val (>|+|>) : 
      (tin -> 'x tout) ->
      (tin -> 'x tout) -> 
      (tin -> 'x tout)

    val (>&&>) : (tin -> bool) -> (tin -> 'x tout) -> (tin -> 'x tout)

    val tokenf : ('a A.mcode, B.info) matcher
    val tokenf_mck : (A.mcodekind, B.info) matcher

    val distrf_e : 
      (A.meta_name A.mcode, B.expression) matcher
    val distrf_args : 
      (A.meta_name A.mcode, (Ast_c.argument, Ast_c.il) either list) matcher
    val distrf_type : 
      (A.meta_name A.mcode, Ast_c.fullType) matcher
    val distrf_params : 
      (A.meta_name A.mcode,
       (Ast_c.parameterType, Ast_c.il) either list) matcher
    val distrf_param : 
      (A.meta_name A.mcode, Ast_c.parameterType) matcher
    val distrf_ini : 
      (A.meta_name A.mcode, Ast_c.initialiser) matcher
    val distrf_node : 
      (A.meta_name A.mcode, Control_flow_c.node) matcher

    val distrf_define_params : 
      (A.meta_name A.mcode, (string Ast_c.wrap, Ast_c.il) either list)
      matcher

    val distrf_struct_fields : 
      (A.meta_name A.mcode, B.field list) matcher

    val distrf_cst : 
      (A.meta_name A.mcode, (B.constant, string) either B.wrap) matcher

    val cocciExp : 
      (A.expression, B.expression) matcher -> (A.expression, F.node) matcher

    val cocciExpExp : 
      (A.expression, B.expression) matcher ->
        (A.expression, B.expression) matcher

    val cocciTy : 
      (A.fullType, B.fullType) matcher -> (A.fullType, F.node) matcher

    val cocciInit : 
      (A.initialiser, B.initialiser) matcher -> (A.initialiser, F.node) matcher

    val envf :
      A.keep_binding -> A.inherited -> 
      A.meta_name A.mcode * Ast_c.metavar_binding_kind *
          (unit -> Common.filename * string * Ast_c.posl * Ast_c.posl) ->
      (unit -> tin -> 'x tout) -> (tin -> 'x tout)

    val check_idconstraint :
      ('a -> 'b -> bool) -> 'a -> 'b ->
        (unit -> tin -> 'x tout) -> (tin -> 'x tout)

    val check_constraints_ne :
      ('a, 'b) matcher -> 'a list -> 'b ->
        (unit -> tin -> 'x tout) -> (tin -> 'x tout)

    val all_bound : A.meta_name list -> (tin -> bool)

    val optional_storage_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout)
    val optional_qualifier_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout)
    val value_format_flag: (bool -> tin -> 'x tout) -> (tin -> 'x tout)


  end

(*****************************************************************************)
(* Functor code, "Cocci vs C" *)
(*****************************************************************************)

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

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

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

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

let tokenf = X.tokenf

(* should be raise Impossible when called from transformation.ml *)
let fail2 () = 
  match X.mode with
  | PatternMode -> fail
  | TransformMode -> raise Impossible


let (option: ('a,'b) matcher -> ('a option,'b option) matcher)= fun f t1 t2 ->
  match (t1,t2) with
  | (Some t1, Some t2) -> 
      f t1 t2 >>= (fun t1 t2 -> 
        return (Some t1, Some t2)
      )
  | (None, None) -> return (None, None)
  | _ -> fail

(* Dots are sometimes used as metavariables, since like metavariables they
can match other things.  But they no longer have the same type.  Perhaps these
functions could be avoided by introducing an appropriate level of polymorphism,
but I don't know how to declare polymorphism across functors *)
let dots2metavar (_,info,mcodekind,pos) = (("","..."),info,mcodekind,pos)
let metavar2dots (_,info,mcodekind,pos) = ("...",info,mcodekind,pos)

let satisfies_iconstraint c id : bool =
  match c with
      A.IdNoConstraint -> true
    | A.IdNegIdSet l -> not (List.mem id l)
    | A.IdRegExp (_,recompiled) ->
        if Str.string_match recompiled id 0 then
          true
        else
          false
    | A.IdNotRegExp (_,recompiled) ->
        if Str.string_match recompiled id 0 then
          false
        else
          true

let satisfies_econstraint c exp : bool =
    match Ast_c.unwrap_expr exp with
        Ast_c.Ident (name) ->
          (
            match name with
                Ast_c.RegularName     rname -> satisfies_iconstraint c (Ast_c.unwrap_st rname)
              | Ast_c.CppConcatenatedName _ ->
                  pr2_once ("WARNING: Unable to apply a constraint on a CppConcatenatedName identifier !"); true
              | Ast_c.CppVariadicName     _ ->
                  pr2_once ("WARNING: Unable to apply a constraint on a CppVariadicName identifier !"); true
              | Ast_c.CppIdentBuilder     _ ->
                  pr2_once ("WARNING: Unable to apply a constraint on a CppIdentBuilder identifier !"); true
          )
      | Ast_c.Constant cst ->
          (match cst with
             | Ast_c.String (str, _) -> satisfies_iconstraint c str
             | Ast_c.MultiString strlist ->
                 pr2_once ("WARNING: Unable to apply a constraint on an multistring constant !"); true
             | Ast_c.Char  (char , _) -> satisfies_iconstraint c char
             | Ast_c.Int   (int  , _) -> satisfies_iconstraint c int
             | Ast_c.Float (float, _) -> satisfies_iconstraint c float
          )
      | _ -> pr2_once ("WARNING: Unable to apply a constraint on an expression !"); true

(*---------------------------------------------------------------------------*)
(* toc: 
 *  - expression
 *  - ident
 *  - arguments
 *  - parameters
 *  - declaration
 *  - initialisers
 *  - type       
 *  - node
 *)

(*---------------------------------------------------------------------------*)
let rec (expression: (A.expression, Ast_c.expression) matcher) =
 fun ea eb -> 
  X.all_bound (A.get_inherited ea) >&&>
  let wa x = A.rewrap ea x  in
  match A.unwrap ea, eb with
  
  (* general case: a MetaExpr can match everything *)
  | A.MetaExpr (ida,constraints,keep,opttypa,form,inherited),
    (((expr, opttypb), ii) as expb) ->

      (* old: before have a MetaConst. Now we factorize and use 'form' to 
       * differentiate between different cases *)
      let rec matches_id = function
          B.Ident(name) -> true
        | B.Cast(ty,e) -> matches_id (B.unwrap_expr e)
        | _ -> false in
      let form_ok =
        match (form,expr) with
          (A.ANY,_) -> true
        | (A.CONST,e) ->
            let rec matches = function
                B.Constant(c) -> true
              | B.Ident (nameidb) -> 
                  let s = Ast_c.str_of_name nameidb in 
                  if s =~ "^[A-Z_][A-Z_0-9]*$" 
                  then begin
                    pr2_once ("warning: " ^ s ^ " treated as a constant");
                    true
                  end
                  else false
              | B.Cast(ty,e) -> matches (B.unwrap_expr e)
              | B.Unary(e,B.UnMinus) -> matches (B.unwrap_expr e)
              | B.SizeOfExpr(exp) -> true
              | B.SizeOfType(ty) -> true
              | _ -> false in
            matches e
        | (A.LocalID,e) ->
            (matches_id e) &&
            (match !opttypb with
              (Some (_,Ast_c.LocalVar _),_) -> true
            | _ -> false)
        | (A.ID,e) -> matches_id e in

      if form_ok
      then
        (let (opttypb,_testb) = !opttypb in
        match opttypa, opttypb with
        | None, _ -> return ((),())
        | Some _, None -> 
            pr2_once ("Missing type information. Certainly a pb in " ^
                      "annotate_typer.ml");
            fail

        | Some tas, Some tb ->
            tas +> List.fold_left (fun acc ta ->
              acc >|+|> compatible_type ta tb) fail
        ) >>=
        (fun () () ->
           match constraints with
               Ast_cocci.NoConstraint ->
                 let max_min _ =
                   Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_expr expb) in
                   X.envf keep inherited (ida, Ast_c.MetaExprVal expb, max_min)
                     (fun () ->
                        X.distrf_e ida expb >>=
                          (fun ida expb ->
                             return (
                               A.MetaExpr (ida,constraints,keep,opttypa,form,inherited)+>
                                 A.rewrap ea,
                               expb
                             ))
                     )

             | Ast_cocci.NotIdCstrt cstrt ->
                 X.check_idconstraint satisfies_econstraint cstrt eb
                   (fun () ->
                      let max_min _ =
                        Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_expr expb) in
                        X.envf keep inherited (ida, Ast_c.MetaExprVal expb, max_min)
                          (fun () ->
                             X.distrf_e ida expb >>=
                               (fun ida expb ->
                                  return (
                                    A.MetaExpr (ida,constraints,keep,opttypa,form,inherited)+>
                                      A.rewrap ea,
                                    expb
                                  ))
                          ))

             | Ast_cocci.NotExpCstrt cstrts ->
                 X.check_constraints_ne expression cstrts eb
                   (fun () ->
                      let max_min _ =
                        Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_expr expb) in
                        X.envf keep inherited (ida, Ast_c.MetaExprVal expb, max_min)
                          (fun () ->
                             X.distrf_e ida expb >>=
                               (fun ida expb ->
                                  return (
                                    A.MetaExpr (ida,constraints,keep,opttypa,form,inherited)+>
                                      A.rewrap ea,
                                    expb
                                  ))
                          )))
      else fail

  (* old: 
   * | A.MetaExpr(ida,false,opttypa,_inherited), expb ->
   *   D.distribute_mck (mcodekind ida) D.distribute_mck_e expb binding
   * 
   * but bug! because if have not tagged SP, then transform without doing
   * any checks. Hopefully now have tagged SP technique.
   *)
          
          
  (* old: 
   * | A.Edots _, _ -> raise Impossible. 
   * 
   * In fact now can also have the Edots inside normal expression, not 
   * just in arg lists. in 'x[...];' less: in if(<... x ... y ...>) 
   *)
  | A.Edots (mcode, None), expb    -> 
      X.distrf_e (dots2metavar mcode) expb >>= (fun mcode expb -> 
        return (
        A.Edots (metavar2dots mcode, None) +> A.rewrap ea , 
        expb
          ))
        
        
  | A.Edots (_, Some expr), _    -> failwith "not handling when on Edots"
        
        
  | A.Ident ida,   ((B.Ident (nameidb), typ),noii) ->
      assert (null noii);
      ident_cpp DontKnow ida nameidb >>= (fun ida nameidb -> 
        return (
        ((A.Ident ida)) +> wa, 
        ((B.Ident (nameidb), typ),Ast_c.noii)
          ))
        
        
        

  | A.MetaErr _,     _ -> failwith "not handling MetaErr"

  (* todo?: handle some isomorphisms in int/float ? can have different
   * format : 1l can match a 1.
   * 
   * todo: normally string can contain some metavar too, so should
   * recurse on the string 
   *)
  | A.Constant (ia1), ((B.Constant (ib) , typ),ii) -> 
      (* for everything except the String case where can have multi elems *)
      let do1 () = 
        let ib1 = tuple_of_list1 ii in 
        tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
          return ( 
            ((A.Constant ia1)) +> wa, 
            ((B.Constant (ib), typ),[ib1])
          ))
      in
      (match term ia1, ib with 
      | A.Int x, B.Int (y,_) -> 
          X.value_format_flag (fun use_value_equivalence -> 
            if use_value_equivalence 
            then 
              if equal_c_int x y
              then do1()
              else fail
            else 
              if x =$= y
              then do1()
            else fail
          )
      | A.Char x, B.Char (y,_) when x =$= y  (* todo: use kind ? *)
          -> do1()
      | A.Float x, B.Float (y,_) when x =$= y (* todo: use floatType ? *)
          -> do1()

      | A.String sa, B.String (sb,_kind) when sa =$= sb ->
          (match ii with
          | [ib1] -> 
            tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
              return ( 
                ((A.Constant ia1)) +> wa, 
                ((B.Constant (ib), typ),[ib1])
              ))
          | _ -> fail (* multi string, not handled *)
          )

      | _, B.MultiString _ -> (* todo cocci? *) fail
      | _, (B.String _ | B.Float _ | B.Char _ | B.Int _) -> fail
      )


  | A.FunCall (ea, ia1, eas, ia2),  ((B.FunCall (eb, ebs), typ),ii) -> 
      (* todo: do special case to allow IdMetaFunc, cos doing the
       * recursive call will be too late, match_ident will not have the
       * info whether it was a function. todo: but how detect when do
       * x.field = f; how know that f is a Func ? By having computed
       * some information before the matching!
       * 
       * Allow match with FunCall containing types. Now ast_cocci allow
       * type in parameter, and morover ast_cocci allow f(...) and those
       * ... could match type. 
       *)
      let (ib1, ib2) = tuple_of_list2 ii in
      expression ea eb >>= (fun ea eb ->
      tokenf ia1 ib1 >>= (fun ia1 ib1 ->
      tokenf ia2 ib2 >>= (fun ia2 ib2 ->
      arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs ->
        let eas = redots eas easundots in
        return (
          ((A.FunCall (ea, ia1, eas, ia2)) +> wa,
          ((B.FunCall (eb, ebs),typ), [ib1;ib2])
        ))))))




  | A.Assignment (ea1, opa, ea2, simple),
      ((B.Assignment (eb1, opb, eb2), typ),ii) -> 
      let (opbi) = tuple_of_list1 ii in
      if equal_assignOp (term opa) opb 
      then
        expression ea1 eb1 >>= (fun ea1 eb1 -> 
        expression ea2 eb2 >>= (fun ea2 eb2 -> 
        tokenf opa opbi >>= (fun opa opbi -> 
          return (
            ((A.Assignment (ea1, opa, ea2, simple))) +> wa,
            ((B.Assignment (eb1, opb, eb2), typ), [opbi])
        ))))
      else fail

  | A.CondExpr(ea1,ia1,ea2opt,ia2,ea3),((B.CondExpr(eb1,eb2opt,eb3),typ),ii) ->
      let (ib1, ib2) = tuple_of_list2 ii in
      expression ea1 eb1 >>= (fun ea1 eb1 -> 
      option expression ea2opt eb2opt >>= (fun  ea2opt eb2opt -> 
      expression ea3 eb3 >>= (fun ea3 eb3 -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
        return (
          ((A.CondExpr(ea1,ia1,ea2opt,ia2,ea3))) +> wa,
          ((B.CondExpr (eb1, eb2opt, eb3),typ), [ib1;ib2])
        ))))))

  (* todo?: handle some isomorphisms here ? *)
  | A.Postfix (ea, opa), ((B.Postfix (eb, opb), typ),ii) -> 
      let opbi = tuple_of_list1 ii in
      if equal_fixOp (term opa) opb
      then
        expression ea eb >>= (fun ea eb -> 
        tokenf opa opbi >>= (fun opa opbi -> 
          return (
            ((A.Postfix (ea, opa))) +> wa,
            ((B.Postfix (eb, opb), typ),[opbi])
        )))
      else fail
        
        
  | A.Infix (ea, opa), ((B.Infix (eb, opb), typ),ii) -> 
      let opbi = tuple_of_list1 ii in
      if equal_fixOp (term opa) opb
      then
        expression ea eb >>= (fun ea eb -> 
        tokenf opa opbi >>= (fun opa opbi -> 
          return (
            ((A.Infix (ea, opa))) +> wa,
            ((B.Infix (eb, opb), typ),[opbi])
        )))
      else fail

  | A.Unary (ea, opa), ((B.Unary (eb, opb), typ),ii) -> 
      let opbi = tuple_of_list1 ii in
      if equal_unaryOp (term opa) opb
      then
        expression ea eb >>= (fun ea eb -> 
        tokenf opa opbi >>= (fun opa opbi -> 
          return (
            ((A.Unary (ea, opa))) +> wa,
            ((B.Unary (eb, opb), typ),[opbi])
        )))
      else fail

  | A.Binary (ea1, opa, ea2), ((B.Binary (eb1, opb, eb2), typ),ii) -> 
      let opbi = tuple_of_list1 ii in
      if equal_binaryOp (term opa) opb
      then 
        expression ea1 eb1 >>= (fun ea1 eb1 -> 
        expression ea2 eb2 >>= (fun ea2 eb2 -> 
        tokenf opa opbi >>= (fun opa opbi -> 
          return (
            ((A.Binary (ea1, opa, ea2))) +> wa,
            ((B.Binary (eb1, opb, eb2), typ),[opbi]
          )))))
      else fail

  | A.Nested (ea1, opa, ea2), eb -> 
      let rec loop eb =
        (if A.get_test_exp ea1 && not (Ast_c.is_test eb) then fail
        else expression ea1 eb) >|+|>
        (match eb with
          ((B.Binary (eb1, opb, eb2), typ),ii)
          when equal_binaryOp (term opa) opb ->
            let opbi = tuple_of_list1 ii in
            let left_to_right =
              (expression ea1 eb1 >>= (fun ea1 eb1 -> 
                expression ea2 eb2 >>= (fun ea2 eb2 -> 
                  tokenf opa opbi >>= (fun opa opbi -> 
                    return (
                    ((A.Nested (ea1, opa, ea2))) +> wa,
                    ((B.Binary (eb1, opb, eb2), typ),[opbi]
                       )))))) in
            let right_to_left =
              (expression ea2 eb1 >>= (fun ea2 eb1 -> 
                expression ea1 eb2 >>= (fun ea1 eb2 -> 
                  tokenf opa opbi >>= (fun opa opbi -> 
                    return (
                    ((A.Nested (ea1, opa, ea2))) +> wa,
                    ((B.Binary (eb1, opb, eb2), typ),[opbi]
                       )))))) in
            let in_left =
              (loop eb1 >>= (fun ea1 eb1 -> 
                expression ea2 eb2 >>= (fun ea2 eb2 -> 
                  tokenf opa opbi >>= (fun opa opbi -> 
                    return (
                    ((A.Nested (ea1, opa, ea2))) +> wa,
                    ((B.Binary (eb1, opb, eb2), typ),[opbi]
                       )))))) in
            let in_right =
              (expression ea2 eb1 >>= (fun ea2 eb1 -> 
                loop eb2 >>= (fun ea1 eb2 -> 
                  tokenf opa opbi >>= (fun opa opbi -> 
                    return (
                    ((A.Nested (ea1, opa, ea2))) +> wa,
                    ((B.Binary (eb1, opb, eb2), typ),[opbi]
                       )))))) in
            left_to_right >|+|> right_to_left >|+|> in_left >|+|> in_right
        | _ -> fail) in
      loop eb

  (* todo?: handle some isomorphisms here ?  (with pointers = Unary Deref) *)
  | A.ArrayAccess (ea1, ia1, ea2, ia2),((B.ArrayAccess (eb1, eb2), typ),ii) -> 
      let (ib1, ib2) = tuple_of_list2 ii in
      expression ea1 eb1 >>= (fun ea1 eb1 -> 
      expression ea2 eb2 >>= (fun ea2 eb2 -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
        return (
          ((A.ArrayAccess (ea1, ia1, ea2, ia2))) +> wa,
          ((B.ArrayAccess (eb1, eb2),typ), [ib1;ib2])
        )))))

  (* todo?: handle some isomorphisms here ? *)
  | A.RecordAccess (ea, ia1, ida), ((B.RecordAccess (eb, idb), typ),ii) ->
      let (ib1) = tuple_of_list1 ii in
      ident_cpp DontKnow ida idb >>= (fun ida idb -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      expression ea eb >>= (fun ea eb -> 
        return (
          ((A.RecordAccess (ea, ia1, ida))) +> wa,
          ((B.RecordAccess (eb, idb), typ), [ib1])
        ))))



  | A.RecordPtAccess (ea,ia1,ida),((B.RecordPtAccess (eb, idb), typ), ii) ->
      let (ib1) = tuple_of_list1 ii in
      ident_cpp DontKnow ida idb >>= (fun ida idb -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      expression ea eb >>= (fun ea eb -> 
        return (
          ((A.RecordPtAccess (ea, ia1, ida))) +> wa,
          ((B.RecordPtAccess (eb, idb), typ), [ib1])
        ))))


  (* todo?: handle some isomorphisms here ? 
   * todo?: do some iso-by-absence on cast ? 
   *    by trying | ea, B.Case (typb, eb) -> match_e_e ea eb ?
   *)

  | A.Cast (ia1, typa, ia2, ea), ((B.Cast (typb, eb), typ),ii) -> 
      let (ib1, ib2) = tuple_of_list2 ii in
      fullType typa typb >>= (fun typa typb -> 
      expression ea eb >>= (fun ea eb -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
        return (
          ((A.Cast (ia1, typa, ia2, ea))) +> wa,
          ((B.Cast (typb, eb),typ),[ib1;ib2])
        )))))

  | A.SizeOfExpr (ia1, ea), ((B.SizeOfExpr (eb), typ),ii) -> 
      let ib1 = tuple_of_list1 ii in
      expression ea eb >>= (fun ea eb -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
        return (
          ((A.SizeOfExpr (ia1, ea))) +> wa,
          ((B.SizeOfExpr (eb), typ),[ib1])
      )))

  | A.SizeOfType (ia1, ia2, typa, ia3), ((B.SizeOfType typb, typ),ii) -> 
      let (ib1,ib2,ib3) = tuple_of_list3 ii in
      fullType typa typb >>= (fun typa typb -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
      tokenf ia3 ib3 >>= (fun ia3 ib3 -> 
        return (
          ((A.SizeOfType (ia1, ia2, typa, ia3))) +> wa,
          ((B.SizeOfType (typb),typ),[ib1;ib2;ib3])
      )))))


  (* todo? iso ? allow all the combinations ? *)
  | A.Paren (ia1, ea, ia2), ((B.ParenExpr (eb), typ),ii) -> 
      let (ib1, ib2) = tuple_of_list2 ii in
      expression ea eb >>= (fun ea eb -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
        return (
          ((A.Paren (ia1, ea, ia2))) +> wa,
          ((B.ParenExpr (eb), typ), [ib1;ib2])
      ))))

  | A.NestExpr(exps,None,true), eb ->
      (match A.unwrap exps with
        A.DOTS [exp] ->
          X.cocciExpExp expression exp eb >>= (fun exp eb -> 
            return (
            (A.NestExpr(A.rewrap exps (A.DOTS [exp]),None,true)) +> wa,
            eb
            )
          )
      | _ ->
          failwith
            "for nestexpr, only handling the case with dots and only one exp")

  | A.NestExpr _,     _ ->
      failwith "only handling multi and no when code in a nest expr"

  (* only in arg lists or in define body *)  
  | A.TypeExp _,    _ -> fail

  (* only in arg lists *)
  | A.MetaExprList _,    _   
  | A.EComma _,    _  
  | A.Ecircles _,    _ 
  | A.Estars _,    _   
      ->
        raise Impossible

  | A.DisjExpr eas, eb -> 
      eas +> List.fold_left (fun acc ea -> acc >|+|> (expression ea eb)) fail

  | A.UniqueExp _,_ | A.OptExp _,_ -> 
      failwith "not handling Opt/Unique/Multi on expr"

 (* Because of Exp cant put a raise Impossible; have to put a fail *)

 (* have not a counter part in coccinelle, for the moment *) 
  | _, ((B.Sequence _,_),_) 
  | _, ((B.StatementExpr _,_),_) 
  | _, ((B.Constructor _,_),_) 
    -> fail


  | _, 
     (((B.Cast (_, _)|B.ParenExpr _|B.SizeOfType _|B.SizeOfExpr _|
     B.RecordPtAccess (_, _)|
     B.RecordAccess (_, _)|B.ArrayAccess (_, _)|
     B.Binary (_, _, _)|B.Unary (_, _)|
     B.Infix (_, _)|B.Postfix (_, _)|
     B.Assignment (_, _, _)|B.CondExpr (_, _, _)|
     B.FunCall (_, _)|B.Constant _|B.Ident _),
     _),_)
       -> fail





(* ------------------------------------------------------------------------- *)
and (ident_cpp: info_ident -> (A.ident, B.name) matcher) = 
 fun infoidb ida idb ->
   match idb with
   | B.RegularName (s, iis) -> 
       let iis = tuple_of_list1 iis in
       ident infoidb ida (s, iis) >>= (fun ida (s,iis) -> 
         return (
           ida, 
           (B.RegularName (s, [iis]))
         ))
   | B.CppConcatenatedName _ | B.CppVariadicName _ |B.CppIdentBuilder _
       ->
         (* This should be moved to the Id case of ident.  Metavariables
         should be allowed to be bound to such variables.  But doing so
         would require implementing an appropriate distr function *)
         fail

and (ident: info_ident -> (A.ident, string * Ast_c.info) matcher) = 
 fun infoidb ida ((idb, iib)) -> (* (idb, iib) as ib *)
  X.all_bound (A.get_inherited ida) >&&>
  match A.unwrap ida with
  | A.Id sa -> 
      if (term sa) =$= idb then
      tokenf sa iib >>= (fun sa iib -> 
        return (
          ((A.Id sa)) +> A.rewrap ida,
          (idb, iib)
        ))
      else fail

  | A.MetaId(mida,constraints,keep,inherited) -> 
      X.check_idconstraint satisfies_iconstraint constraints idb
        (fun () ->
      let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in
      (* use drop_pos for ids so that the pos is not added a second time in
         the call to tokenf *)
      X.envf keep inherited (A.drop_pos mida, Ast_c.MetaIdVal (idb), max_min)
        (fun () -> 
        tokenf mida iib >>= (fun mida iib -> 
          return (
            ((A.MetaId (mida, constraints, keep, inherited)) +> A.rewrap ida,
            (idb, iib)
            )))
      ))

  | A.MetaFunc(mida,constraints,keep,inherited) -> 
      let is_function _ =
        X.check_idconstraint satisfies_iconstraint constraints idb
            (fun () ->
          let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in
          X.envf keep inherited (A.drop_pos mida,Ast_c.MetaFuncVal idb,max_min)
            (fun () ->
            tokenf mida iib >>= (fun mida iib -> 
              return (
                ((A.MetaFunc(mida,constraints,keep,inherited)))+>A.rewrap ida,
                (idb, iib)
              ))
          )) in
      (match infoidb with 
      | LocalFunction | Function -> is_function()
      | DontKnow ->
          failwith "MetaFunc, need more semantic info about id"
          (* the following implementation could possibly be useful, if one
             follows the convention that a macro is always in capital letters
             and that a macro is not a function.
          (if idb =~ "^[A-Z_][A-Z_0-9]*$" then fail else is_function())*)
      )

  | A.MetaLocalFunc(mida,constraints,keep,inherited) -> 
      (match infoidb with 
      | LocalFunction -> 
          X.check_idconstraint satisfies_iconstraint constraints idb
            (fun () ->
          let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in
          X.envf keep inherited
            (A.drop_pos mida,Ast_c.MetaLocalFuncVal idb, max_min)
            (fun () ->
            tokenf mida iib >>= (fun mida iib -> 
              return (
                ((A.MetaLocalFunc(mida,constraints,keep,inherited)))
                   +> A.rewrap ida,
                (idb, iib)
              ))
          ))
      | Function -> fail
      | DontKnow -> failwith "MetaLocalFunc, need more semantic info about id"
      )

  | A.OptIdent _ | A.UniqueIdent _ -> 
      failwith "not handling Opt/Unique for ident"



(* ------------------------------------------------------------------------- *)
and (arguments: sequence -> 
      (A.expression list, Ast_c.argument Ast_c.wrap2 list) matcher) = 
 fun seqstyle eas ebs ->
  match seqstyle with
  | Unordered -> failwith "not handling ooo"
  | Ordered -> 
      arguments_bis eas (Ast_c.split_comma ebs) >>= (fun eas ebs_splitted -> 
        return (eas, (Ast_c.unsplit_comma ebs_splitted))
      )
(* because '...' can match nothing, need to take care when have 
 * ', ...'   or '...,'  as in  f(..., X, Y, ...). It must match
 * f(1,2) for instance.
 * So I have added special cases such as (if startxs = []) and code
 * in the Ecomma matching rule.
 * 
 * old: Must do some try, for instance when f(...,X,Y,...) have to
 * test the transfo for all the combinaitions    and if multiple transfo
 * possible ? pb ? => the type is to return a expression option ? use
 * some combinators to help ?
 * update: with the tag-SP approach, no more a problem.
 *)

and arguments_bis = fun eas ebs -> 
  match eas, ebs with
  | [], [] -> return ([], [])
  | [], eb::ebs -> fail
  | ea::eas, ebs -> 
      X.all_bound (A.get_inherited ea) >&&>
      (match A.unwrap ea, ebs with
      | A.Edots (mcode, optexpr), ys -> 
          (* todo: if optexpr, then a WHEN and so may have to filter yys *)
          if optexpr <> None then failwith "not handling when in argument";

          (* '...' can take more or less the beginnings of the arguments *)
          let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
          startendxs +> List.fold_left (fun acc (startxs, endxs) -> 
            acc >||> (

              (* allow '...', and maybe its associated ',' to match nothing.
               * for the associated ',' see below how we handle the EComma
               * to match nothing.
               *)
              (if null startxs
              then
                if mcode_contain_plus (mcodekind mcode)
                then fail 
                  (* failwith "I have no token that I could accroche myself on" *)
                else return (dots2metavar mcode, [])
              else 
                (* subtil: we dont want the '...' to match until the
                 * comma. cf -test pb_params_iso. We would get at
                 * "already tagged" error.
                 * this is because both f (... x, ...) and f (..., x, ...)
                 * would match a  f(x,3)  with our "optional-comma" strategy.
                 *)
                  (match Common.last startxs with
                  | Right _ -> fail
                  | Left _ -> 
                      X.distrf_args (dots2metavar mcode) startxs
                  )
              )
              >>= (fun mcode startxs ->
                let mcode = metavar2dots mcode in
                arguments_bis eas endxs >>= (fun eas endxs -> 
                  return (
                    (A.Edots (mcode, optexpr) +> A.rewrap ea) ::eas,
                    startxs ++ endxs
                  )))
            )
          ) fail 

      | A.EComma ia1, Right ii::ebs -> 
          let ib1 = tuple_of_list1 ii in
          tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
            arguments_bis eas ebs >>= (fun eas ebs -> 
              return (
                (A.EComma ia1 +> A.rewrap ea)::eas,
                (Right [ib1])::ebs
              )
            ))
      | A.EComma ia1, ebs -> 
          (* allow ',' to maching nothing. optional comma trick *)
          if mcode_contain_plus (mcodekind ia1)
          then fail
          else arguments_bis eas ebs

      | A.MetaExprList(ida,leninfo,keep,inherited),ys ->
          let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
          startendxs +> List.fold_left (fun acc (startxs, endxs) -> 
            acc >||> (
              let ok =
                if null startxs
                then
                  if mcode_contain_plus (mcodekind ida)
                  then false 
                    (* failwith "no token that I could accroche myself on" *)
                  else true
                else 
                  (match Common.last startxs with
                  | Right _ -> false
                  | Left _ -> true
                  )
              in
              if not ok
              then fail
              else 
                let startxs' = Ast_c.unsplit_comma startxs in
                let len = List.length  startxs' in

                (match leninfo with
                | Some (lenname,lenkeep,leninherited) ->
                    let max_min _ = failwith "no pos" in
                    X.envf lenkeep leninherited
                      (lenname, Ast_c.MetaListlenVal (len), max_min)
                | None -> function f -> f()
                )
                (fun () -> 
                  let max_min _ =
                    Lib_parsing_c.lin_col_by_pos
                      (Lib_parsing_c.ii_of_args startxs) in
                  X.envf keep inherited
                    (ida, Ast_c.MetaExprListVal startxs', max_min)
                (fun () -> 
                  if null startxs
                  then return (ida, [])
                  else X.distrf_args ida (Ast_c.split_comma startxs')
                )
                >>= (fun ida startxs -> 
                  arguments_bis eas endxs >>= (fun eas endxs -> 
                    return (
                      (A.MetaExprList(ida,leninfo,keep,inherited))
                      +> A.rewrap ea::eas,
                      startxs ++ endxs
                    ))
                  )
                )
            )) fail 


      | _unwrapx, (Left eb)::ebs -> 
          argument ea eb >>= (fun ea eb -> 
          arguments_bis eas ebs >>= (fun eas ebs -> 
            return (ea::eas, Left eb::ebs)
          ))
      | _unwrapx, (Right y)::ys -> raise Impossible
      | _unwrapx, [] -> fail
      )
            
      
and argument arga argb =
  X.all_bound (A.get_inherited arga) >&&>
   match A.unwrap arga, argb with
  | A.TypeExp tya,  
    Right (B.ArgType {B.p_register=b,iib; p_namei=sopt;p_type=tyb}) ->

      if b || sopt <> None
      then 
        (* failwith "the argument have a storage and ast_cocci does not have"*)
        fail
      else 
        (* b = false and sopt = None *)
        fullType tya tyb >>= (fun tya tyb -> 
          return (
            (A.TypeExp tya) +> A.rewrap arga,
            (Right (B.ArgType {B.p_register=(b,iib);
                               p_namei=sopt;
                               p_type=tyb;}))
        ))

  | A.TypeExp tya,  _                                  -> fail
  | _,              Right (B.ArgType _) -> fail
  | _, Left argb ->
      expression arga argb >>= (fun arga argb ->
        return (arga, Left argb)
      )
  | _, Right (B.ArgAction y) -> fail


(* ------------------------------------------------------------------------- *)
(* todo? facto code with argument ? *)
and (parameters: sequence -> 
      (A.parameterTypeDef list, Ast_c.parameterType Ast_c.wrap2 list)
        matcher) = 
 fun seqstyle eas ebs ->
  match seqstyle with
  | Unordered -> failwith "not handling ooo"
  | Ordered -> 
      parameters_bis eas (Ast_c.split_comma ebs) >>= (fun eas ebs_splitted -> 
        return (eas, (Ast_c.unsplit_comma ebs_splitted))
      )


and parameters_bis eas ebs = 
  match eas, ebs with
  | [], [] -> return ([], [])
  | [], eb::ebs -> fail
  | ea::eas, ebs ->
      (* the management of positions is inlined into each case, because
         sometimes there is a Param and sometimes a ParamList *)
      X.all_bound (A.get_inherited ea) >&&>
      (match A.unwrap ea, ebs with
      | A.Pdots (mcode), ys -> 

          (* '...' can take more or less the beginnings of the arguments *)
          let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
          startendxs +> List.fold_left (fun acc (startxs, endxs) -> 
            acc >||> (

              (if null startxs
              then
                if mcode_contain_plus (mcodekind mcode)
                then fail 
                (* failwith "I have no token that I could accroche myself on"*)
                else return (dots2metavar mcode, [])
              else 
                (match Common.last startxs with
                | Right _ -> fail
                | Left _ -> 
                    X.distrf_params (dots2metavar mcode) startxs
                )
              ) >>= (fun mcode startxs ->
                let mcode = metavar2dots mcode in
                parameters_bis eas endxs >>= (fun eas endxs -> 
                  return (
                    (A.Pdots (mcode) +> A.rewrap ea) ::eas,
                    startxs ++ endxs
                  )))
            )
          ) fail 

      | A.PComma ia1, Right ii::ebs -> 
          let ib1 = tuple_of_list1 ii in
          tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
          parameters_bis eas ebs >>= (fun eas ebs -> 
            return (
              (A.PComma ia1 +> A.rewrap ea)::eas,
              (Right [ib1])::ebs
            )
          ))

      | A.PComma ia1, ebs -> 
          (* try optional comma trick *)
          if mcode_contain_plus (mcodekind ia1)
          then fail
          else parameters_bis eas ebs


      | A.MetaParamList(ida,leninfo,keep,inherited),ys->
          let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
          startendxs +> List.fold_left (fun acc (startxs, endxs) -> 
            acc >||> (
              let ok =
                if null startxs
                then
                  if mcode_contain_plus (mcodekind ida)
                  then false 
               (* failwith "I have no token that I could accroche myself on" *)
                  else true
                else 
                  (match Common.last startxs with
                  | Right _ -> false
                  | Left _ -> true
                  )
              in
              if not ok
              then fail
              else 
                let startxs' = Ast_c.unsplit_comma startxs in
                let len = List.length  startxs' in

                (match leninfo with
                  Some (lenname,lenkeep,leninherited) ->
                    let max_min _ = failwith "no pos" in
                    X.envf lenkeep leninherited
                      (lenname, Ast_c.MetaListlenVal (len), max_min)
                | None -> function f -> f()
                )
                (fun () ->
                  let max_min _ =
                    Lib_parsing_c.lin_col_by_pos
                      (Lib_parsing_c.ii_of_params startxs) in
                  X.envf keep inherited 
                    (ida, Ast_c.MetaParamListVal startxs', max_min)
                (fun () -> 
                  if null startxs
                  then return (ida, [])
                  else X.distrf_params ida (Ast_c.split_comma startxs')
                ) >>= (fun ida startxs -> 
                  parameters_bis eas endxs >>= (fun eas endxs -> 
                    return (
                      (A.MetaParamList(ida,leninfo,keep,inherited))
                        +> A.rewrap ea::eas,
                      startxs ++ endxs
                    ))
                )
                ))
          ) fail 


      | A.VoidParam ta, ys -> 
          (match eas, ebs with
          | [], [Left eb] -> 
              let {B.p_register=(hasreg,iihasreg);
                   p_namei = idbopt;
                   p_type=tb; } = eb in
              
              if idbopt =*= None && not hasreg
              then 
                match tb with 
                | (qub, (B.BaseType B.Void,_)) -> 
                    fullType ta tb >>= (fun ta tb -> 
                      return (
                        [(A.VoidParam ta) +> A.rewrap ea],
                        [Left {B.p_register=(hasreg, iihasreg);
                               p_namei = idbopt;
                               p_type = tb;}]
                      ))
                | _ -> fail
              else fail
          | _ -> fail
          )

      | (A.OptParam _ | A.UniqueParam _), _ -> 
              failwith "handling Opt/Unique for Param"

      | A.Pcircles (_), ys -> raise Impossible (* in Ordered mode *)


      | A.MetaParam (ida,keep,inherited), (Left eb)::ebs -> 
          (* todo: use quaopt, hasreg ? *)
          let max_min _ =
            Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_param eb) in
          X.envf keep inherited (ida,Ast_c.MetaParamVal eb,max_min) (fun () -> 
            X.distrf_param ida eb
          ) >>= (fun ida eb -> 
              parameters_bis eas ebs >>= (fun eas ebs -> 
                return (
                  (A.MetaParam(ida,keep,inherited))+> A.rewrap ea::eas,
                  (Left eb)::ebs
                )))


      | A.Param (typa, idaopt), (Left eb)::ebs -> 
          (*this should succeed if the C code has a name, and fail otherwise*)
          parameter (idaopt, typa) eb >>= (fun (idaopt, typa) eb -> 
          parameters_bis eas ebs >>= (fun eas ebs -> 
            return (
              (A.Param (typa, idaopt))+> A.rewrap ea :: eas,
              (Left eb)::ebs
            )))
          
      | _unwrapx, (Right y)::ys -> raise Impossible
      | _unwrapx, [] -> fail
      )
  


(*
let split_register_param = fun (hasreg, idb, ii_b_s) -> 
  match hasreg, idb,  ii_b_s with
  | false, Some s, [i1] -> Left (s, [], i1)
  | true, Some s, [i1;i2] -> Left (s, [i1], i2)
  | _, None, ii -> Right ii
  | _ -> raise Impossible
*)


and parameter = fun (idaopt, typa) paramb ->

  let {B.p_register = (hasreg,iihasreg);
       p_namei = nameidbopt;
       p_type = typb;} = paramb in

  fullType typa typb >>= (fun typa typb -> 
  match idaopt, nameidbopt with
  | Some ida, Some nameidb -> 
      (* todo: if minus on ida, should also minus the iihasreg ? *)
      ident_cpp DontKnow ida nameidb >>= (fun ida nameidb -> 
        return (
          (Some ida, typa),
          {B.p_register = (hasreg, iihasreg);
           p_namei = Some (nameidb);
           p_type = typb}
        ))
        
  | None, None -> 
      return (
        (None, typa),
        {B.p_register=(hasreg,iihasreg);
         p_namei = None;
         p_type = typb;}
      )
      

  (* why handle this case ? because of transform_proto ? we may not
   * have an ident in the proto.
   * If have some plus on ida ? do nothing about ida ? 
   *)
 (* not anymore !!! now that julia is handling the proto.
  | _, Right iihasreg -> 
      return (
        (idaopt, typa),
        ((hasreg, None, typb), iihasreg)
      )
 *)

  | Some _, None -> fail
  | None, Some _ -> fail
  )




(* ------------------------------------------------------------------------- *)
and (declaration: (A.mcodekind * bool * A.declaration,B.declaration) matcher) =
 fun (mckstart, allminus, decla) declb -> 
  X.all_bound (A.get_inherited decla) >&&>
  match A.unwrap decla, declb with

  (* Un MetaDecl est introduit dans l'asttoctl pour sauter au dessus
   * de toutes les declarations qui sont au debut d'un fonction et
   * commencer le reste du match au premier statement. Alors, ca matche
   * n'importe quelle declaration. On n'a pas besoin d'ajouter
   * quoi que ce soit dans l'environnement. C'est une sorte de DDots.
   * 
   * When the SP want to remove the whole function, the minus is not
   * on the MetaDecl but on the MetaRuleElem. So there should
   * be no transform of MetaDecl, just matching are allowed.
   *)

  | A.MetaDecl(ida,_keep,_inherited), _ -> (* keep ? inherited ? *)
      (* todo: should not happen in transform mode *)
      return ((mckstart, allminus, decla), declb)



  | _, (B.DeclList ([var], iiptvirgb::iifakestart::iisto)) -> 
      onedecl allminus decla (var,iiptvirgb,iisto) >>=
      (fun decla (var,iiptvirgb,iisto)->
        X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> 
          return (
            (mckstart, allminus, decla),
            (B.DeclList ([var], iiptvirgb::iifakestart::iisto))
          )))
        
  | _, (B.DeclList (xs, iiptvirgb::iifakestart::iisto)) -> 
      if X.mode =*= PatternMode
      then
        xs +> List.fold_left (fun acc var -> 
          acc >||> (
            X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart ->
              onedecl allminus decla (var, iiptvirgb, iisto) >>= 
                (fun decla (var, iiptvirgb, iisto) -> 
                  return (
                    (mckstart, allminus, decla),
                    (B.DeclList ([var], iiptvirgb::iifakestart::iisto))
                  )))))
          fail
      else 
        failwith "More that one variable in decl. Have to split to transform."

  | A.MacroDecl (sa,lpa,eas,rpa,enda), B.MacroDecl ((sb,ebs),ii) ->
      let (iisb, lpb, rpb, iiendb, iifakestart, iistob) = 
        (match ii with
        | iisb::lpb::rpb::iiendb::iifakestart::iisto -> 
            (iisb,lpb,rpb,iiendb, iifakestart,iisto)
        | _ -> raise Impossible
        ) in
      (if allminus 
      then minusize_list iistob
      else return ((), iistob)
      ) >>= (fun () iistob ->

        X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> 
        ident DontKnow sa (sb, iisb) >>= (fun sa (sb, iisb) ->
        tokenf lpa lpb >>= (fun lpa lpb -> 
        tokenf rpa rpb >>= (fun rpa rpb -> 
        tokenf enda iiendb >>= (fun enda iiendb -> 
        arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs -> 
        let eas = redots eas easundots in

          return (
            (mckstart, allminus, 
            (A.MacroDecl (sa,lpa,eas,rpa,enda)) +> A.rewrap decla), 
            (B.MacroDecl ((sb,ebs),
                         [iisb;lpb;rpb;iiendb;iifakestart] ++ iistob))
          ))))))))

  | _, (B.MacroDecl _ |B.DeclList _) ->       fail



and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> 
 X.all_bound (A.get_inherited decla) >&&>
 match A.unwrap decla, declb with

 (* kind of typedef iso, we must unfold, it's for the case 
  * T { }; that we want to match against typedef struct { } xx_t;
  *)
 | A.TyDecl (tya0, ptvirga), 
   ({B.v_namei = Some (nameidb, None);
     B.v_type = typb0;
     B.v_storage = (B.StoTypedef, inl);
     B.v_local = local; 
     B.v_attr = attrs;
     B.v_type_bis = typb0bis;
   }, iivirg) ->

   (match A.unwrap tya0, typb0 with
   | A.Type(cv1,tya1), ((qu,il),typb1) ->

     (match A.unwrap tya1, typb1 with
     | A.StructUnionDef(tya2, lba, declsa, rba), 
      (B.StructUnion (sub, sbopt, declsb), ii) -> 

       let (iisub, iisbopt, lbb, rbb) = 
         match sbopt with
         | None -> 
             let (iisub, lbb, rbb) = tuple_of_list3 ii in
             (iisub, [], lbb, rbb)
         | Some s -> 
             pr2 (sprintf 
              "warning: both a typedef (%s) and struct name introduction (%s)"
              (Ast_c.str_of_name nameidb) s
             );
             pr2 "warning: I will consider only the typedef";
             let (iisub, iisb, lbb, rbb) = tuple_of_list4 ii in
             (iisub, [iisb], lbb, rbb)
       in
       let structnameb = 
         structdef_to_struct_name
           (Ast_c.nQ, (B.StructUnion (sub, sbopt, declsb), ii))
       in
       let fake_typeb = 
         Ast_c.nQ,((B.TypeName (nameidb, Some 
           (Lib_parsing_c.al_type structnameb))), []) 
       in

       tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb -> 
       tokenf lba lbb >>= (fun lba lbb -> 
       tokenf rba rbb >>= (fun rba rbb -> 
       struct_fields (A.undots declsa) declsb >>=(fun undeclsa declsb ->
         let declsa = redots declsa undeclsa in

         (match A.unwrap tya2 with
         | A.Type(cv3, tya3) -> 
           (match A.unwrap tya3 with
           | A.MetaType(ida,keep, inherited) -> 

               fullType tya2 fake_typeb >>= (fun tya2 fake_typeb -> 
                 let tya1 =
                   A.StructUnionDef(tya2,lba,declsa,rba)+> A.rewrap tya1 in
                 let tya0 = A.Type(cv1, tya1) +> A.rewrap tya0 in
               
                   
                 let typb1 = B.StructUnion (sub,sbopt, declsb),
                   [iisub] @ iisbopt @ [lbb;rbb] in
                 let typb0 = ((qu, il), typb1) in
               
                 match fake_typeb with 
                 | _nQ, ((B.TypeName (nameidb, _typ)),[]) -> 

                     return (
                     (A.TyDecl (tya0, ptvirga)) +> A.rewrap decla,
                     (({B.v_namei = Some (nameidb, None);
                        B.v_type = typb0;
                        B.v_storage = (B.StoTypedef, inl);
                        B.v_local = local;
                        B.v_attr = attrs;
                        B.v_type_bis = typb0bis;
                     },
                       iivirg),iiptvirgb,iistob)
                     )
                 | _ -> raise Impossible    
             )

           | A.StructUnionName(sua, sa) -> 

             fullType tya2 structnameb >>= (fun tya2 structnameb -> 

               let tya1 = A.StructUnionDef(tya2,lba,declsa,rba)+> A.rewrap tya1
               in
               let tya0 = A.Type(cv1, tya1) +> A.rewrap tya0 in

               match structnameb with 
               | _nQ, (B.StructUnionName (sub, s), [iisub;iisbopt]) ->

                   let typb1 = B.StructUnion (sub,sbopt, declsb),
                     [iisub;iisbopt;lbb;rbb] in
                   let typb0 = ((qu, il), typb1) in
               
                   return (
                     (A.TyDecl (tya0, ptvirga)) +> A.rewrap decla,
                     (({B.v_namei = Some (nameidb, None);
                        B.v_type = typb0;
                        B.v_storage = (B.StoTypedef, inl);
                        B.v_local = local;
                        B.v_attr = attrs;
                        B.v_type_bis = typb0bis;
                     },
                      iivirg),iiptvirgb,iistob)
                   )
               | _ -> raise Impossible    
             )
           | _ -> raise Impossible
           )
         | _ -> fail
       )))))
     | _ -> fail
     )
   | _ -> fail
   )
         
   | A.UnInit (stoa, typa, ida, ptvirga), 
     ({B.v_namei= Some (nameidb, _);B.v_storage= (B.StoTypedef,_);}, iivirg) 
     -> fail

   | A.Init (stoa, typa, ida, eqa, inia, ptvirga), 
     ({B.v_namei=Some(nameidb, _);B.v_storage=(B.StoTypedef,_);}, iivirg)
       -> fail



    (* could handle iso here but handled in standard.iso *)
   | A.UnInit (stoa, typa, ida, ptvirga), 
     ({B.v_namei = Some (nameidb, None);
       B.v_type = typb;
       B.v_storage = stob;
       B.v_local = local;
       B.v_attr = attrs;
       B.v_type_bis = typbbis;
     }, iivirg) -> 

       tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb -> 
       fullType typa typb >>= (fun typa typb -> 
       ident_cpp DontKnow ida nameidb >>= (fun ida nameidb -> 
       storage_optional_allminus allminus stoa (stob, iistob) >>= 
        (fun stoa (stob, iistob) -> 
         return (
           (A.UnInit (stoa, typa, ida, ptvirga)) +>  A.rewrap decla,
           (({B.v_namei = Some (nameidb, None);
              B.v_type = typb;
              B.v_storage = stob;
              B.v_local = local;
              B.v_attr = attrs;
              B.v_type_bis = typbbis;
           },iivirg),
            iiptvirgb,iistob)
         )))))

   | A.Init (stoa, typa, ida, eqa, inia, ptvirga), 
     ({B.v_namei = Some(nameidb, Some (iieqb, inib));
       B.v_type = typb;
       B.v_storage = stob;
       B.v_local = local;
       B.v_attr = attrs;
       B.v_type_bis = typbbis;
     },iivirg)
       ->
       tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb -> 
       tokenf eqa iieqb >>= (fun eqa iieqb -> 
       fullType typa typb >>= (fun typa typb -> 
       ident_cpp DontKnow ida nameidb >>= (fun ida nameidb -> 
       storage_optional_allminus allminus stoa (stob, iistob) >>= 
       (fun stoa (stob, iistob) -> 
       initialiser inia inib >>= (fun inia inib -> 
         return (
           (A.Init (stoa, typa, ida, eqa, inia, ptvirga)) +> A.rewrap decla,
           (({B.v_namei = Some(nameidb, Some (iieqb, inib));
              B.v_type = typb;
              B.v_storage = stob;
              B.v_local = local;
              B.v_attr = attrs;
              B.v_type_bis = typbbis;
           },iivirg),
           iiptvirgb,iistob)
         )))))))
           
   (* do iso-by-absence here ? allow typedecl and var ? *)
   | A.TyDecl (typa, ptvirga), 
     ({B.v_namei = None; B.v_type = typb; 
       B.v_storage = stob; 
       B.v_local = local;
       B.v_attr = attrs;
       B.v_type_bis = typbbis;
     }, iivirg)  ->

       if stob =*= (B.NoSto, false)
       then
         tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb -> 
         fullType typa typb >>= (fun typa typb -> 
           return (
             (A.TyDecl (typa, ptvirga)) +> A.rewrap decla,
             (({B.v_namei = None;
                B.v_type = typb;
                B.v_storage = stob;
                B.v_local = local;
                B.v_attr = attrs;
                B.v_type_bis = typbbis;
             }, iivirg), iiptvirgb, iistob)
           )))
       else fail


   | A.Typedef (stoa, typa, ida, ptvirga), 
     ({B.v_namei = Some (nameidb, None);
       B.v_type = typb;
       B.v_storage = (B.StoTypedef,inline);
       B.v_local = local;
       B.v_attr = attrs;
       B.v_type_bis = typbbis;
     },iivirg) ->

       tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb -> 
       fullType typa typb >>= (fun typa typb -> 
       (match iistob with
       | [iitypedef] -> 
           tokenf stoa iitypedef >>= (fun stoa iitypedef -> 
             return (stoa, [iitypedef])
           )
       | _ -> failwith "weird, have both typedef and inline or nothing";
       ) >>= (fun stoa iistob -> 
       (match A.unwrap ida with
       | A.MetaType(_,_,_) -> 

           let fake_typeb = 
             Ast_c.nQ, ((B.TypeName (nameidb, Ast_c.noTypedefDef())), []) 
           in
           fullTypebis ida fake_typeb >>= (fun ida fake_typeb -> 
             match fake_typeb with
             | _nQ, ((B.TypeName (nameidb, _typ)), []) ->
                 return (ida, nameidb)
             | _ -> raise Impossible
           )

       | A.TypeName sa -> 
           (match nameidb with
           | B.RegularName (sb, iidb) -> 
               let iidb1 = tuple_of_list1 iidb in
               
               if (term sa) =$= sb
               then 
                 tokenf sa iidb1 >>= (fun sa iidb1 -> 
                   return (
                     (A.TypeName sa) +> A.rewrap ida,
                     B.RegularName (sb, [iidb1])
                   ))
               else fail

           | B.CppConcatenatedName _ | B.CppVariadicName _ |B.CppIdentBuilder _
               -> raise Todo
           )

       | _ -> raise Impossible

       ) >>= (fun ida nameidb ->
         return (
           (A.Typedef (stoa, typa, ida, ptvirga)) +> A.rewrap decla,
           (({B.v_namei = Some (nameidb, None);
              B.v_type = typb;
              B.v_storage = (B.StoTypedef,inline);
              B.v_local = local;
              B.v_attr = attrs;
              B.v_type_bis = typbbis;
           },
             iivirg),
            iiptvirgb, iistob)
         )
       ))))
             
       
   | _, ({B.v_namei = None;}, _) -> 
       (* old:   failwith "no variable in this declaration, weird" *)
       fail



  | A.DisjDecl declas, declb -> 
      declas +> List.fold_left (fun acc decla -> 
        acc >|+|> 
            (* (declaration (mckstart, allminus, decla) declb) *)
            (onedecl allminus decla (declb,iiptvirgb, iistob))
      ) fail


     
   (* only in struct type decls *)
   | A.Ddots(dots,whencode), _ ->
       raise Impossible
            
   | A.OptDecl _,    _ | A.UniqueDecl _,     _ -> 
       failwith "not handling Opt/Unique Decl"

   | _, ({B.v_namei=Some _}, _) -> 
       fail




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

and (initialiser: (A.initialiser, Ast_c.initialiser) matcher) =  fun ia ib -> 
    X.all_bound (A.get_inherited ia) >&&>
    match (A.unwrap ia,ib) with

    | (A.MetaInit(ida,keep,inherited), ib) -> 
        let max_min _ =
          Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_ini ib) in
        X.envf keep inherited (ida, Ast_c.MetaInitVal ib, max_min)
          (fun () -> 
            X.distrf_ini ida ib >>= (fun ida ib -> 
              return (
                A.MetaInit (ida,keep,inherited) +> A.rewrap ia,
                ib
             ))
          )

    | (A.InitExpr expa, ib) -> 
        (match A.unwrap expa, ib with
        | A.Edots (mcode, None), ib    -> 
            X.distrf_ini (dots2metavar mcode) ib >>= (fun mcode ib -> 
              return (
                A.InitExpr 
                  (A.Edots (metavar2dots mcode, None) +> A.rewrap expa) 
                    +>  A.rewrap ia,
                ib
               ))

        | A.Edots (_, Some expr), _    -> failwith "not handling when on Edots"

        | _, (B.InitExpr expb, ii) -> 
            assert (null ii);
            expression expa expb >>= (fun expa expb -> 
              return (
                (A.InitExpr expa) +> A.rewrap ia,
                (B.InitExpr expb, ii)
              ))
        | _ -> fail
        )

    | (A.InitList (ia1, ias, ia2, []), (B.InitList ibs, ii)) -> 
        (match ii with 
        | ib1::ib2::iicommaopt -> 
            tokenf ia1 ib1 >>= (fun ia1 ib1 ->
            tokenf ia2 ib2 >>= (fun ia2 ib2 ->
            initialisers ias (ibs, iicommaopt) >>= (fun ias (ibs,iicommaopt) ->
              return (
                (A.InitList (ia1, ias, ia2, [])) +> A.rewrap ia,
                (B.InitList ibs, ib1::ib2::iicommaopt)
              ))))
              
        | _ -> raise Impossible
        )

    | (A.InitList (i1, ias, i2, whencode),(B.InitList ibs, _ii)) ->
        failwith "TODO: not handling whencode in initialisers"


    | (A.InitGccExt (designatorsa, ia2, inia), 
      (B.InitDesignators (designatorsb, inib), ii2))->

        let iieq = tuple_of_list1 ii2 in

        tokenf ia2 iieq >>= (fun ia2 iieq -> 
        designators designatorsa designatorsb >>=
          (fun designatorsa designatorsb ->
        initialiser inia inib >>= (fun inia inib -> 
          return (
            (A.InitGccExt (designatorsa, ia2, inia)) +> A.rewrap ia,
            (B.InitDesignators (designatorsb, inib), [iieq])
          ))))




    | (A.InitGccName (ida, ia1, inia), (B.InitFieldOld (idb, inib), ii)) -> 
        (match ii with 
        | [iidb;iicolon] -> 
            ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) -> 
            initialiser inia inib >>= (fun inia inib -> 
            tokenf ia1 iicolon >>= (fun ia1 iicolon -> 
              return (
                (A.InitGccName (ida, ia1, inia)) +> A.rewrap ia,
                (B.InitFieldOld (idb, inib), [iidb;iicolon])
              ))))
        | _ -> fail
        )



    | A.IComma(comma), _ ->
        raise Impossible

    | A.UniqueIni _,_ | A.OptIni _,_ -> 
      failwith "not handling Opt/Unique on initialisers"

    | _, (B.InitIndexOld (_, _), _) -> fail 
    | _, (B.InitFieldOld (_, _), _) -> fail 

    | _, ((B.InitDesignators (_, _)|B.InitList _|B.InitExpr _), _)
        -> fail

and designators dla dlb =
  match (dla,dlb) with
    ([],[]) -> return ([], [])
  | ([],_) | (_,[]) -> fail
  | (da::dla,db::dlb) ->
      designator da db >>= (fun da db ->
      designators dla dlb >>= (fun dla dlb ->
      return (da::dla, db::dlb)))

and designator da db =
  match (da,db) with
    (A.DesignatorField (ia1, ida), (B.DesignatorField idb,ii1)) ->

        let (iidot, iidb) = tuple_of_list2 ii1 in
        tokenf ia1 iidot >>= (fun ia1 iidot -> 
        ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) ->
          return (
            A.DesignatorField (ia1, ida),
            (B.DesignatorField idb, [iidot;iidb])
          )))

  | (A.DesignatorIndex (ia1,ea,ia2), (B.DesignatorIndex eb, ii1)) ->
        
        let (ib1, ib2) = tuple_of_list2 ii1 in
        tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
        tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
        expression ea eb >>= (fun ea eb -> 
          return (
            A.DesignatorIndex (ia1,ea,ia2),
            (B.DesignatorIndex eb, [ib1;ib2])
          ))))

  | (A.DesignatorRange (ia1,e1a,ia2,e2a,ia3),
     (B.DesignatorRange (e1b, e2b), ii1)) ->

        let (ib1, ib2, ib3) = tuple_of_list3 ii1 in
        tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
        tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
        tokenf ia3 ib3 >>= (fun ia3 ib3 -> 
        expression e1a e1b >>= (fun e1a e1b -> 
        expression e2a e2b >>= (fun e2a e2b -> 
          return (
            A.DesignatorRange (ia1,e1a,ia2,e2a,ia3),
            (B.DesignatorRange (e1b, e2b), [ib1;ib2;ib3])
          ))))))
  | (_, ((B.DesignatorField _|B.DesignatorIndex _|B.DesignatorRange _), _)) ->
      fail


and initialisers = fun ias (ibs, iicomma) ->
  let ias_unsplit = unsplit_icomma      ias in
  let ibs_split   = resplit_initialiser ibs iicomma in

  let f = 
    if need_unordered_initialisers ibs 
    then initialisers_unordered2
    else initialisers_ordered2
  in
  f ias_unsplit ibs_split >>= 
      (fun ias_unsplit ibs_split -> 
        return (
          split_icomma ias_unsplit,
          unsplit_initialiser ibs_split
        )
      )

(* todo: one day julia will reput a IDots *)
and initialisers_ordered2 = fun ias ibs -> 
  match ias, ibs with
  | [], [] -> return ([], [])
  | (x, xcomma)::xs, (y, commay)::ys -> 
      (match A.unwrap xcomma with
      | A.IComma commax -> 
          tokenf commax commay >>= (fun commax commay -> 
          initialiser x y >>= (fun x y -> 
          initialisers_ordered2 xs ys >>= (fun xs ys -> 
            return (
                    (x, (A.IComma commax) +> A.rewrap xcomma)::xs, 
                    (y, commay)::ys
            )
          )))
      | _ -> raise Impossible (* unsplit_iicomma wrong *)
      )
  | _ -> fail

          

and initialisers_unordered2 = fun ias ibs -> 

  match ias, ibs with
  | [], ys -> return ([], ys)
  | (x,xcomma)::xs, ys -> 

      let permut = Common.uncons_permut_lazy ys in
      permut +> List.fold_left (fun acc ((e, pos), rest) -> 
        acc >||> 
          (
            (match A.unwrap xcomma, e with 
            | A.IComma commax, (y, commay) -> 
                tokenf commax commay >>= (fun commax commay -> 
                initialiser x y >>= (fun x y -> 
                  return (
                    (x, (A.IComma commax) +> A.rewrap xcomma), 
                    (y, commay))
                )
                )
            | _ -> raise Impossible (* unsplit_iicomma wrong *)
            ) 
            >>= (fun x e -> 
              let rest = Lazy.force rest in
              initialisers_unordered2 xs rest >>= (fun xs rest -> 
                return (
                  x::xs,
                  Common.insert_elem_pos (e, pos) rest
                ))))
      ) fail
       

(* ------------------------------------------------------------------------- *)
and (struct_fields: (A.declaration list, B.field list) matcher) =
 fun eas ebs -> 
  match eas, ebs with
  | [], [] -> return ([], [])
  | [], eb::ebs -> fail
  | ea::eas, ebs -> 
      X.all_bound (A.get_inherited ea) >&&>
      (match A.unwrap ea, ebs with
      | A.Ddots (mcode, optwhen), ys -> 
          if optwhen <> None then failwith "not handling when in argument";

          (* '...' can take more or less the beginnings of the arguments *)
          let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
          startendxs +> List.fold_left (fun acc (startxs, endxs) -> 
            acc >||> (
              
              (if null startxs 
              then
                if mcode_contain_plus (mcodekind mcode)
                then fail 
                  (* failwith "I have no token that I could accroche myself on" *)
                else return (dots2metavar mcode, [])
              else 

                  X.distrf_struct_fields (dots2metavar mcode) startxs
              ) >>= (fun mcode startxs ->
                let mcode = metavar2dots mcode in
                struct_fields eas endxs >>= (fun eas endxs -> 
                  return (
                    (A.Ddots (mcode, optwhen) +> A.rewrap ea) ::eas,
                    startxs ++ endxs
                  )))
            )
          ) fail 
      | _unwrapx, eb::ebs -> 
          struct_field ea eb >>= (fun ea eb -> 
          struct_fields eas ebs >>= (fun eas ebs -> 
            return (ea::eas, eb::ebs)
          ))

      | _unwrapx, [] -> fail
      )

and (struct_field: (A.declaration, B.field) matcher) = fun fa fb -> 

  match fb with 
  | B.DeclarationField (B.FieldDeclList (onefield_multivars,iiptvirg)) -> 

    let iiptvirgb = tuple_of_list1 iiptvirg in

    (match onefield_multivars with
    | [] -> raise Impossible
    | [onevar,iivirg] -> 
      assert (null iivirg);
      (match onevar with
      | B.BitField (sopt, typb, _, expr) -> 
          pr2_once "warning: bitfield not handled by ast_cocci";
          fail
      | B.Simple (None, typb) -> 
          pr2_once "warning: unamed struct field not handled by ast_cocci";
          fail
      | B.Simple (Some nameidb, typb) -> 

          (* build a declaration from a struct field *)
          let allminus = false in
          let iisto = [] in
          let stob = B.NoSto, false in
          let fake_var = 
            ({B.v_namei = Some (nameidb, None);
              B.v_type = typb;
              B.v_storage = stob;
              B.v_local = Ast_c.NotLocalDecl;
              B.v_attr = Ast_c.noattr;
              B.v_type_bis = ref None; 
              (* the struct field should also get expanded ? no it's not
               * important here, we will rematch very soon *)
            },
             iivirg)            
          in
          onedecl allminus fa (fake_var,iiptvirgb,iisto) >>= 
            (fun fa (var,iiptvirgb,iisto) -> 

              match fake_var with
              | ({B.v_namei = Some (nameidb, None);
                  B.v_type = typb;
                  B.v_storage = stob;
                }, iivirg) -> 

                  let onevar = B.Simple (Some nameidb, typb) in
                  
                  return (
                    (fa),
                    ((B.DeclarationField 
                        (B.FieldDeclList ([onevar, iivirg], [iiptvirgb])))
                    )
                  )
              | _ -> raise Impossible
            )
      )

    | x::y::xs -> 
      pr2_once "PB: More that one variable in decl. Have to split";
      fail
    )
  | B.EmptyField _iifield -> 
      fail

  | B.MacroDeclField _ -> 
      raise Todo

  | B.CppDirectiveStruct directive -> fail
  | B.IfdefStruct directive -> fail



(* ------------------------------------------------------------------------- *)
and (fullType: (A.fullType, Ast_c.fullType) matcher) = 
 fun typa typb -> 
   X.optional_qualifier_flag (fun optional_qualifier -> 
   X.all_bound (A.get_inherited typa) >&&>
   match A.unwrap typa, typb with
   | A.Type(cv,ty1), ((qu,il),ty2) ->

       if qu.B.const && qu.B.volatile 
       then
         pr2_once
           ("warning: the type is both const & volatile but cocci " ^ 
            "does not handle that");

        (* Drop out the const/volatile part that has been matched.
         * This is because a SP can contain  const T v; in which case
         * later in match_t_t when we encounter a T, we must not add in
         * the environment the whole type.
         *)
       

       (match cv with
       (* "iso-by-absence" *)
       | None -> 
           let do_stuff () = 
             fullTypebis ty1 ((qu,il), ty2) >>= (fun ty1 fullty2 -> 
               return (
                 (A.Type(None, ty1)) +> A.rewrap typa,
                 fullty2
               ))
           in
           (match optional_qualifier, qu.B.const || qu.B.volatile with
           | false, false -> do_stuff ()
           | false, true -> fail
           | true, false -> do_stuff ()
           | true, true -> 
               if !Flag.show_misc 
               then pr2_once "USING optional_qualifier builtin isomorphism";
               do_stuff()
           )
             
           
       | Some x -> 
          (* todo: can be __const__ ? can be const & volatile so 
           * should filter instead ? 
           *)
           (match term x, il with 
           | A.Const, [i1] when qu.B.const -> 
               
               tokenf x i1 >>= (fun x i1 -> 
               fullTypebis ty1 (Ast_c.nQ,ty2) >>= (fun ty1 (_, ty2) -> 
                 return (
                   (A.Type(Some x, ty1)) +> A.rewrap typa,
                   ((qu, [i1]), ty2)
                 )))
               
           | A.Volatile, [i1] when qu.B.volatile -> 
               tokenf x i1 >>= (fun x i1 -> 
               fullTypebis ty1 (Ast_c.nQ,ty2) >>= (fun ty1 (_, ty2) -> 
                 return (
                   (A.Type(Some x, ty1)) +> A.rewrap typa,
                   ((qu, [i1]), ty2)
                 )))
               
           | _ -> fail
           )
       )

  | A.DisjType typas, typb -> 
      typas +>
      List.fold_left (fun acc typa -> acc >|+|> (fullType typa typb)) fail

   | A.OptType(_), _  | A.UniqueType(_), _
       -> failwith "not handling Opt/Unique on type"
   )
 

(*
 * Why not (A.typeC, Ast_c.typeC) matcher ?
 * because when there is MetaType, we want that T record the whole type, 
 * including the qualifier, and so this type (and the new_il function in
 * preceding function).
*)

and (fullTypebis: (A.typeC, Ast_c.fullType) matcher) = 
  fun ta tb -> 
  X.all_bound (A.get_inherited ta) >&&> 
  match A.unwrap ta, tb with

  (* cas general *)
  | A.MetaType(ida,keep, inherited),  typb -> 
      let max_min _ =
        Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_type typb) in
      X.envf keep inherited (ida, B.MetaTypeVal typb, max_min) (fun () -> 
        X.distrf_type ida typb >>= (fun ida typb -> 
          return (
            A.MetaType(ida,keep, inherited) +> A.rewrap ta,
            typb
          ))
      )
  | unwrap, (qub, typb) -> 
      typeC ta typb >>= (fun ta typb -> 
        return (ta, (qub, typb))
      )

and simulate_signed ta basea stringsa signaopt tb baseb ii rebuilda =
      (* In ii there is a list, sometimes of length 1 or 2 or 3.
       * And even if in baseb we have a Signed Int, that does not mean
       * that ii is of length 2, cos Signed is the default, so if in signa
       * we have Signed explicitely ? we cant "accrocher" this mcode to 
       * something :( So for the moment when there is signed in cocci,
       * we force that there is a signed in c too (done in pattern.ml).
       *)
      let signbopt, iibaseb = split_signb_baseb_ii (baseb, ii) in

        
      (* handle some iso on type ? (cf complex C rule for possible implicit
         casting) *)
      match basea, baseb with
      | A.VoidType,  B.Void 
      | A.FloatType, B.FloatType (B.CFloat)
      | A.DoubleType, B.FloatType (B.CDouble) -> 
           assert (signaopt =*= None); 
           let stringa = tuple_of_list1 stringsa in
           let (ibaseb) = tuple_of_list1 ii in 
           tokenf stringa ibaseb >>= (fun stringa ibaseb -> 
             return (
               (rebuilda ([stringa], signaopt)) +> A.rewrap ta,
               (B.BaseType baseb, [ibaseb])
             ))
            
      | A.CharType,  B.IntType B.CChar when signaopt =*= None -> 
          let stringa = tuple_of_list1 stringsa in
          let ibaseb = tuple_of_list1 ii in
           tokenf stringa ibaseb >>= (fun stringa ibaseb -> 
             return (
               (rebuilda ([stringa], signaopt)) +> A.rewrap ta,
               (B.BaseType (B.IntType B.CChar), [ibaseb])
             ))
            
      | A.CharType,B.IntType (B.Si (_sign, B.CChar2)) when signaopt <> None -> 
          let stringa = tuple_of_list1 stringsa in
          let ibaseb = tuple_of_list1 iibaseb in
          sign signaopt signbopt >>= (fun signaopt iisignbopt -> 
          tokenf stringa ibaseb >>= (fun stringa ibaseb -> 
            return (
               (rebuilda ([stringa], signaopt)) +> A.rewrap ta,
               (B.BaseType (baseb), iisignbopt ++ [ibaseb])
               )))
          
      | A.ShortType, B.IntType (B.Si (_, B.CShort)) 
      | A.IntType,   B.IntType (B.Si (_, B.CInt))   
      | A.LongType,  B.IntType (B.Si (_, B.CLong))  ->
          let stringa = tuple_of_list1 stringsa in
          (match iibaseb with 
          | [] -> 
              (* iso-by-presence ? *)
              (* when unsigned int in SP,  allow have just unsigned in C ? *)
              if mcode_contain_plus (mcodekind stringa)
              then fail
              else 
                
                sign signaopt signbopt >>= (fun signaopt iisignbopt -> 
                    return (
                      (rebuilda ([stringa], signaopt)) +> A.rewrap ta,
                      (B.BaseType (baseb), iisignbopt ++ [])
                    ))
              

          | [x;y] -> 
              pr2_once 
                "warning: long int or short int not handled by ast_cocci";
              fail

          | [ibaseb] -> 
          sign signaopt signbopt >>= (fun signaopt iisignbopt -> 
          tokenf stringa ibaseb >>= (fun stringa ibaseb -> 
            return (
               (rebuilda ([stringa], signaopt)) +> A.rewrap ta,
               (B.BaseType (baseb), iisignbopt ++ [ibaseb])
               )))
          | _ -> raise Impossible

          )

            
      | A.LongLongType, B.IntType (B.Si (_, B.CLongLong)) ->
          let (string1a,string2a) = tuple_of_list2 stringsa in
          (match iibaseb with 
            [ibase1b;ibase2b] -> 
              sign signaopt signbopt >>= (fun signaopt iisignbopt -> 
              tokenf string1a ibase1b >>= (fun base1a ibase1b -> 
              tokenf string2a ibase2b >>= (fun base2a ibase2b -> 
              return (
                (rebuilda ([base1a;base2a], signaopt)) +> A.rewrap ta,
                (B.BaseType (baseb), iisignbopt ++ [ibase1b;ibase2b])
              ))))
          | [] -> fail (* should something be done in this case? *)
          | _ -> raise Impossible)


      | _, B.FloatType B.CLongDouble 
          -> 
          pr2_once 
            "warning: long double not handled by ast_cocci";
          fail

      | _, (B.Void|B.FloatType _|B.IntType _) -> fail

and simulate_signed_meta ta basea signaopt tb baseb ii rebuilda =
      (* In ii there is a list, sometimes of length 1 or 2 or 3.
       * And even if in baseb we have a Signed Int, that does not mean
       * that ii is of length 2, cos Signed is the default, so if in signa
       * we have Signed explicitely ? we cant "accrocher" this mcode to 
       * something :( So for the moment when there is signed in cocci,
       * we force that there is a signed in c too (done in pattern.ml).
       *)
      let signbopt, iibaseb = split_signb_baseb_ii (baseb, ii) in

      let match_to_type rebaseb = 
        sign signaopt signbopt >>= (fun signaopt iisignbopt -> 
        let fta = A.rewrap basea (A.Type(None,basea)) in
        let ftb = Ast_c.nQ,(B.BaseType (rebaseb), iibaseb) in
        fullType fta ftb >>= (fun fta (_,tb) ->
          (match A.unwrap fta,tb with
            A.Type(_,basea), (B.BaseType baseb, ii) ->
              return (
              (rebuilda (basea, signaopt)) +> A.rewrap ta,
              (B.BaseType (baseb), iisignbopt ++ ii)
                )
          | _ -> failwith "not possible"))) in
        
      (* handle some iso on type ? (cf complex C rule for possible implicit
         casting) *)
      match baseb with
      | B.IntType (B.Si (_sign, B.CChar2)) ->
          match_to_type (B.IntType B.CChar)
          
      | B.IntType (B.Si (_, ty)) ->
          (match iibaseb with 
          | [] -> fail (* metavariable has to match something *)

          | _ -> match_to_type (B.IntType (B.Si (B.Signed, ty)))

          )

      | (B.Void|B.FloatType _|B.IntType _) -> fail

and (typeC: (A.typeC, Ast_c.typeC) matcher) = 
  fun ta tb -> 
  match A.unwrap ta, tb with
    | A.BaseType (basea,stringsa), (B.BaseType baseb, ii) -> 
        simulate_signed ta basea stringsa None tb baseb ii
          (function (stringsa, signaopt) -> A.BaseType (basea,stringsa))
    | A.SignedT (signaopt, Some basea), (B.BaseType baseb, ii) -> 
        (match A.unwrap basea with
          A.BaseType (basea1,strings1) ->
            simulate_signed ta basea1 strings1 (Some signaopt) tb baseb ii
              (function (strings1, Some signaopt) ->
                A.SignedT
                  (signaopt,
                   Some (A.rewrap basea (A.BaseType (basea1,strings1))))
                | _ -> failwith "not possible")
        | A.MetaType(ida,keep,inherited) ->
            simulate_signed_meta ta basea (Some signaopt) tb baseb ii
              (function (basea, Some signaopt) ->
                A.SignedT(signaopt,Some basea)
                | _ -> failwith "not possible")
        | _ -> failwith "not possible")
    | A.SignedT (signa,None),   (B.BaseType baseb, ii) -> 
        let signbopt, iibaseb = split_signb_baseb_ii (baseb, ii) in
        (match iibaseb, baseb with
        | [], B.IntType (B.Si (_sign, B.CInt)) -> 
            sign (Some signa) signbopt >>= (fun signaopt iisignbopt -> 
              match signaopt with
              | None -> raise Impossible
              | Some signa -> 
                  return (
                    (A.SignedT (signa,None)) +> A.rewrap ta,
                    (B.BaseType baseb, iisignbopt)
                  )
            )
        | _ -> fail
        )



    (* todo? iso with array *)
    | A.Pointer (typa, iamult),            (B.Pointer typb, ii) -> 
        let (ibmult) = tuple_of_list1 ii in 
        fullType typa typb >>= (fun typa typb -> 
        tokenf iamult ibmult >>= (fun iamult ibmult -> 
          return (
            (A.Pointer (typa, iamult)) +> A.rewrap ta,
            (B.Pointer typb, [ibmult])
          )))

    | A.FunctionType(allminus,tyaopt,lpa,paramsa,rpa), 
      (B.FunctionType(tyb, (paramsb, (isvaargs, iidotsb))), ii) -> 

        let (lpb, rpb) = tuple_of_list2 ii in
        if isvaargs 
        then
          pr2_once
            ("Not handling well variable length arguments func. "^
             "You have been warned");
        tokenf lpa lpb >>= (fun lpa lpb -> 
        tokenf rpa rpb >>= (fun rpa rpb -> 
        fullType_optional_allminus allminus tyaopt tyb >>= (fun tyaopt tyb -> 
        parameters (seqstyle paramsa) (A.undots paramsa) paramsb >>=
          (fun paramsaundots paramsb -> 
            let paramsa = redots paramsa paramsaundots in
            return (
              (A.FunctionType(allminus,tyaopt,lpa,paramsa,rpa) +> A.rewrap ta,
              (B.FunctionType(tyb, (paramsb, (isvaargs, iidotsb))), [lpb;rpb])
              )
            )))))
            
        

          

    | A.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a), 
        (B.ParenType t1, ii) ->
        let (lp1b, rp1b) = tuple_of_list2 ii in
        let (qu1b, t1b) = t1 in
        (match t1b with
        | B.Pointer t2, ii -> 
            let (starb) = tuple_of_list1 ii in
            let (qu2b, t2b) = t2 in
            (match t2b with
            | B.FunctionType (tyb, (paramsb, (isvaargs, iidotsb))), ii -> 
                let (lp2b, rp2b) = tuple_of_list2 ii in

                if isvaargs
                then
                  pr2_once
                    ("Not handling well variable length arguments func. "^
                     "You have been warned");

                fullType tya tyb >>= (fun tya tyb -> 
                tokenf lp1a lp1b >>= (fun lp1a lp1b -> 
                tokenf rp1a rp1b >>= (fun rp1a rp1b -> 
                tokenf lp2a lp2b >>= (fun lp2a lp2b -> 
                tokenf rp2a rp2b >>= (fun rp2a rp2b -> 
                tokenf stara starb >>= (fun stara starb -> 
                parameters (seqstyle paramsa) (A.undots paramsa) paramsb >>=
                (fun paramsaundots paramsb -> 
                  let paramsa = redots paramsa paramsaundots in

                  let t2 = 
                    (qu2b, 
                    (B.FunctionType (tyb, (paramsb, (isvaargs, iidotsb))),
                    [lp2b;rp2b])) 
                  in
                  let t1 = 
                    (qu1b,
                    (B.Pointer t2, [starb]))
                  in
                  
                  return (
                    (A.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a))
                    +> A.rewrap ta,
                    (B.ParenType t1, [lp1b;rp1b])
                  )
                )))))))



            | _ -> fail
            )
        | _ -> fail
        )
        
        

    (* todo: handle the iso on optionnal size specifification ? *)
    | A.Array (typa, ia1, eaopt, ia2), (B.Array (ebopt, typb), ii) -> 
        let (ib1, ib2) = tuple_of_list2 ii in
        fullType typa typb >>= (fun typa typb -> 
        option expression eaopt ebopt >>= (fun eaopt ebopt -> 
        tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
        tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
          return (
            (A.Array (typa, ia1, eaopt, ia2)) +> A.rewrap ta,
            (B.Array (ebopt, typb), [ib1;ib2])
          )))))


     (* todo: could also match a Struct that has provided a name *)
     (* This is for the case where the SmPL code contains "struct x", without
        a definition.  In this case, the name field is always present.
        This case is also called from the case for A.StructUnionDef when
        a name is present in the C code. *)
    | A.StructUnionName(sua, Some sa), (B.StructUnionName (sub, sb), ii) -> 
        (* sa is now an ident, not an mcode, old: ... && (term sa) =$= sb *)
        let (ib1, ib2) = tuple_of_list2 ii in
        if equal_structUnion  (term sua) sub 
        then
          ident DontKnow sa (sb, ib2) >>= (fun sa (sb, ib2) -> 
          tokenf sua ib1 >>= (fun sua ib1 -> 
            return (
              (A.StructUnionName (sua, Some sa)) +> A.rewrap ta,
              (B.StructUnionName (sub, sb), [ib1;ib2])
              )))
        else fail
        

    | A.StructUnionDef(ty, lba, declsa, rba), 
     (B.StructUnion (sub, sbopt, declsb), ii) -> 

       let (ii_sub_sb, lbb, rbb) =
         match ii with
           [iisub; lbb; rbb] -> (Common.Left iisub,lbb,rbb)
         | [iisub; iisb; lbb; rbb] -> (Common.Right (iisub,iisb),lbb,rbb)
         | _ -> failwith "list of length 3 or 4 expected" in

       let process_type =
         match (sbopt,ii_sub_sb) with
           (None,Common.Left iisub) ->
             (* the following doesn't reconstruct the complete SP code, just
                the part that matched *)
             let rec loop s =
               match A.unwrap s with
                 A.Type(None,ty) ->
                   (match A.unwrap ty with
                     A.StructUnionName(sua, None) ->
                       tokenf sua iisub >>= (fun sua iisub ->
                         let ty =
                           A.Type(None,
                                  A.StructUnionName(sua, None) +> A.rewrap ty)
                             +> A.rewrap s in
                         return (ty,[iisub]))
                   | _ -> fail)
               | A.DisjType(disjs) ->
                   disjs +>
                   List.fold_left (fun acc disj -> acc >|+|> (loop disj)) fail
               | _ -> fail in
             loop ty
               
         | (Some sb,Common.Right (iisub,iisb)) ->

             (* build a StructUnionName from a StructUnion *)
             let fake_su = B.nQ, (B.StructUnionName (sub, sb), [iisub;iisb]) in
            
             fullType ty fake_su >>= (fun ty fake_su -> 
               match fake_su with
               | _nQ, (B.StructUnionName (sub, sb), [iisub;iisb]) -> 
                   return (ty,  [iisub; iisb])
               | _ -> raise Impossible)
         | _ -> fail in

       process_type
         >>= (fun ty ii_sub_sb -> 

            tokenf lba lbb >>= (fun lba lbb -> 
            tokenf rba rbb >>= (fun rba rbb -> 
            struct_fields (A.undots declsa) declsb >>=(fun undeclsa declsb ->
              let declsa = redots declsa undeclsa in

              return (
                (A.StructUnionDef(ty, lba, declsa, rba)) +> A.rewrap ta,
                (B.StructUnion (sub, sbopt, declsb),ii_sub_sb@[lbb;rbb])
              )))))


   (* todo? handle isomorphisms ? because Unsigned Int can be match on a 
    * uint in the C code. But some CEs consists in renaming some types,
    * so we don't want apply isomorphisms every time. 
    *) 
    | A.TypeName sa,  (B.TypeName (nameb, typb), noii) ->
        assert (null noii);

        (match nameb with
        | B.RegularName (sb, iidb) -> 
            let iidb1 = tuple_of_list1 iidb in
               
            if (term sa) =$= sb
            then 
              tokenf sa iidb1 >>= (fun sa iidb1 -> 
                return (
                  (A.TypeName sa) +> A.rewrap ta,
                  (B.TypeName (B.RegularName (sb, [iidb1]), typb), noii)
                   ))
               else fail

           | B.CppConcatenatedName _ | B.CppVariadicName _ |B.CppIdentBuilder _
               -> raise Todo
        )


    | _, (B.TypeOfExpr e, ii) -> fail
    | _, (B.TypeOfType e, ii) -> fail

    | _, (B.ParenType e, ii) -> fail (* todo ?*)
    | A.EnumName(en,namea), (B.EnumName nameb, ii) ->
        let (ib1,ib2) = tuple_of_list2 ii in
        ident DontKnow namea (nameb, ib2) >>= (fun namea (nameb, ib2) -> 
          tokenf en ib1 >>= (fun en ib1 -> 
          return (
          (A.EnumName (en, namea)) +> A.rewrap ta,
          (B.EnumName nameb, [ib1;ib2])
          )))

    | _, (B.Enum _, _) -> fail (* todo cocci ?*)

    | _,
     ((B.TypeName _ | B.StructUnionName (_, _) | B.EnumName _ |
      B.StructUnion (_, _, _) |
      B.FunctionType _ | B.Array (_, _) | B.Pointer _ |
      B.BaseType _),
     _)
     -> fail


(* todo: iso on sign, if not mentioned then free.  tochange? 
 * but that require to know if signed int because explicit
 * signed int,  or because implicit signed int.
 *)

and sign signa signb = 
  match signa, signb with
  | None, None -> return (None, [])
  | Some signa,  Some (signb, ib) -> 
      if equal_sign (term signa) signb
      then tokenf signa ib >>= (fun signa ib -> 
        return (Some signa, [ib])
      )
      else fail
  | _, _ -> fail


and minusize_list iixs = 
  iixs +> List.fold_left (fun acc ii -> 
    acc >>= (fun xs ys -> 
    tokenf minusizer ii >>= (fun minus ii -> 
      return (minus::xs, ii::ys)
    ))) (return ([],[]))
   >>= (fun _xsminys ys -> 
     return ((), List.rev ys)
   )

and storage_optional_allminus allminus stoa (stob, iistob) = 
  (* "iso-by-absence" for storage, and return type. *)
  X.optional_storage_flag (fun optional_storage -> 
  match stoa, stob with
  | None, (stobis, inline) -> 
      let do_minus () = 
        if allminus 
        then 
          minusize_list iistob >>= (fun () iistob -> 
            return (None, (stob, iistob))
          )
        else return (None, (stob, iistob))
      in

      (match optional_storage, stobis with
      | false, B.NoSto -> do_minus ()
      | false, _ -> fail
      | true, B.NoSto -> do_minus ()
      | true, _ -> 
          if !Flag.show_misc 
          then pr2_once "USING optional_storage builtin isomorphism";
          do_minus()
      )

  | Some x, ((stobis, inline)) -> 
      if equal_storage (term x) stobis
      then 
        match iistob with
        | [i1] ->
           tokenf x i1 >>= (fun x i1 -> 
             return (Some x,  ((stobis, inline), [i1]))
           )
       (* or if have inline ? have to do a split_storage_inline a la 
        * split_signb_baseb_ii *)
        | _ -> raise Impossible 
      else fail
  )
 




and fullType_optional_allminus allminus tya retb = 
  match tya with 
  | None -> 
      if allminus
      then 
        X.distrf_type minusizer retb >>= (fun _x retb -> 
          return (None, retb)
        )

      else return (None, retb)
  | Some tya -> 
      fullType tya retb >>= (fun tya retb -> 
        return (Some tya, retb)
      )



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

and compatible_base_type a signa b =
  let ok  = return ((),()) in

  match a, b with
  | Type_cocci.VoidType, B.Void -> 
      assert (signa =*= None);
      ok
  | Type_cocci.CharType, B.IntType B.CChar when signa =*= None -> 
      ok
  | Type_cocci.CharType, B.IntType (B.Si (signb, B.CChar2)) -> 
      compatible_sign signa signb 
  | Type_cocci.ShortType, B.IntType (B.Si (signb, B.CShort)) -> 
      compatible_sign signa signb
  | Type_cocci.IntType, B.IntType (B.Si (signb, B.CInt)) -> 
      compatible_sign signa signb
  | Type_cocci.LongType, B.IntType (B.Si (signb, B.CLong)) -> 
      compatible_sign signa signb
  | _, B.IntType (B.Si (signb, B.CLongLong)) -> 
      pr2_once "no longlong in cocci";
      fail
  | Type_cocci.FloatType, B.FloatType B.CFloat ->
      assert (signa =*= None); 
      ok
  | Type_cocci.DoubleType, B.FloatType B.CDouble ->
      assert (signa =*= None); 
      ok
  | _, B.FloatType B.CLongDouble -> 
      pr2_once "no longdouble in cocci";
      fail
  | Type_cocci.BoolType, _ -> failwith "no booltype in C"
        
  | _, (B.Void|B.FloatType _|B.IntType _) -> fail

and compatible_base_type_meta a signa qua b ii local =
  match a, b with
  | Type_cocci.MetaType(ida,keep,inherited),
    B.IntType (B.Si (signb, B.CChar2)) -> 
      compatible_sign signa signb >>= fun _ _ ->
        let newb = ((qua, (B.BaseType (B.IntType B.CChar),ii)),local) in
        compatible_type a newb
  | Type_cocci.MetaType(ida,keep,inherited), B.IntType (B.Si (signb, ty)) -> 
      compatible_sign signa signb >>= fun _ _ ->
        let newb =
          ((qua, (B.BaseType (B.IntType (B.Si (B.Signed, ty))),ii)),local) in
        compatible_type a newb
  | _, B.FloatType B.CLongDouble -> 
      pr2_once "no longdouble in cocci";
      fail
        
  | _, (B.Void|B.FloatType _|B.IntType _) -> fail


and compatible_type a (b,local) = 
  let ok  = return ((),()) in

  let rec loop = function
    | Type_cocci.BaseType a, (qua, (B.BaseType b,ii)) -> 
        compatible_base_type a None b

    | Type_cocci.SignedT (signa,None), (qua, (B.BaseType b,ii)) -> 
        compatible_base_type Type_cocci.IntType (Some signa) b

    | Type_cocci.SignedT (signa,Some ty), (qua, (B.BaseType b,ii)) -> 
        (match ty with
          Type_cocci.BaseType ty ->
            compatible_base_type ty (Some signa) b
        | Type_cocci.MetaType(ida,keep,inherited) ->
            compatible_base_type_meta ty (Some signa) qua b ii local
        | _ -> failwith "not possible")

    | Type_cocci.Pointer  a, (qub, (B.Pointer b, ii)) -> 
        loop (a,b)
    | Type_cocci.FunctionPointer a, _ ->
        failwith
          "TODO: function pointer type doesn't store enough information to determine compatability"
    | Type_cocci.Array   a, (qub, (B.Array (eopt, b),ii)) ->
      (* no size info for cocci *)
        loop (a,b)
    | Type_cocci.StructUnionName (sua, _, sa),
        (qub, (B.StructUnionName (sub, sb),ii)) -> 
          if equal_structUnion_type_cocci sua sub && sa =$= sb
          then ok
          else fail
    | Type_cocci.EnumName (_, sa),
        (qub, (B.EnumName (sb),ii)) -> 
          if sa =$= sb
          then ok
          else fail
    | Type_cocci.TypeName sa, (qub, (B.TypeName (namesb, _typb),noii)) -> 
        let sb = Ast_c.str_of_name namesb in
        if sa =$= sb 
        then ok
        else fail

    | Type_cocci.ConstVol (qua, a),      (qub, b) -> 
        if (fst qub).B.const && (fst qub).B.volatile 
        then
          begin
            pr2_once ("warning: the type is both const & volatile but cocci " ^
                      "does not handle that");
            fail
          end
        else 
          if 
            (match qua with 
            | Type_cocci.Const -> (fst qub).B.const
            | Type_cocci.Volatile -> (fst qub).B.volatile
            )
          then loop (a,(Ast_c.nQ, b))
          else fail

    | Type_cocci.MetaType (ida,keep,inherited),     typb -> 
        let max_min _ =
          Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_type typb) in
        X.envf keep inherited (A.make_mcode ida, B.MetaTypeVal typb, max_min)
          (fun () -> ok
        )

  (* subtil: must be after the MetaType case *)
    | a, (qub, (B.TypeName (_namesb, Some b), noii)) -> 
      (* kind of typedef iso *)
        loop (a,b)





  (* for metavariables of type expression *^* *)
    | Type_cocci.Unknown , _ -> ok

    | (_,
      (_,
      ((
       B.TypeOfType _|B.TypeOfExpr _|B.ParenType _|
       B.EnumName _|B.StructUnion (_, _, _)|B.Enum (_, _)
      ),
      _))) -> fail

    | (_,
      (_,
      ((
       B.StructUnionName (_, _)|
       B.FunctionType _|
       B.Array (_, _)|B.Pointer _|B.TypeName _|
       B.BaseType _
      ),
      _))) -> fail


  in
  loop (a,b)

and compatible_sign signa signb = 
  let ok  = return ((),()) in
  match signa, signb with
  | None, B.Signed 
  | Some Type_cocci.Signed, B.Signed
  | Some Type_cocci.Unsigned, B.UnSigned
      -> ok
  | _ -> fail


and equal_structUnion_type_cocci a b = 
  match a, b with
  | Type_cocci.Struct, B.Struct -> true
  | Type_cocci.Union,  B.Union -> true
  | _, (B.Struct | B.Union) -> false



(*---------------------------------------------------------------------------*)
and inc_file (a, before_after) (b, h_rel_pos) = 

  let rec aux_inc (ass, bss) passed = 
    match ass, bss with
    | [], [] -> true
    | [A.IncDots], _ -> 
        let passed = List.rev passed in

        (match before_after, !h_rel_pos with
        | IncludeNothing, _ -> true
        | IncludeMcodeBefore, Some x -> 
            List.mem passed (x.Ast_c.first_of)

        | IncludeMcodeAfter, Some x -> 
            List.mem passed (x.Ast_c.last_of)

        (* no info, maybe cos of a #include <xx.h> that was already in a .h *)
        | _, None -> false 
        )

    | (A.IncPath x)::xs, y::ys -> x =$= y && aux_inc (xs, ys) (x::passed)
    | _ -> failwith "IncDots not in last place or other pb"
        
  in

  match a, b with
  | A.Local ass, B.Local bss -> 
      aux_inc (ass, bss) []
  | A.NonLocal ass, B.NonLocal bss -> 
      aux_inc (ass, bss) []
  | _ -> false
       


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

and (define_params: sequence -> 
  (A.define_param list, (string B.wrap) B.wrap2 list) matcher) = 
 fun seqstyle eas ebs -> 
  match seqstyle with
  | Unordered -> failwith "not handling ooo"
  | Ordered -> 
      define_paramsbis eas (Ast_c.split_comma ebs) >>= (fun eas ebs_splitted ->
        return (eas, (Ast_c.unsplit_comma ebs_splitted))
      )

(* todo? facto code with argument and parameters ? *)
and define_paramsbis = fun eas ebs -> 
  match eas, ebs with
  | [], [] -> return ([], [])
  | [], eb::ebs -> fail
  | ea::eas, ebs -> 
      X.all_bound (A.get_inherited ea) >&&>
      (match A.unwrap ea, ebs with
      | A.DPdots (mcode), ys -> 

          (* '...' can take more or less the beginnings of the arguments *)
          let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
          startendxs +> List.fold_left (fun acc (startxs, endxs) -> 
            acc >||> (

              (if null startxs
              then
                if mcode_contain_plus (mcodekind mcode)
                then fail 
                  (* failwith "I have no token that I could accroche myself on" *)
                else return (dots2metavar mcode, [])
              else 
                (match Common.last startxs with
                | Right _ -> fail
                | Left _ -> 
                    X.distrf_define_params (dots2metavar mcode) startxs
                )
              ) >>= (fun mcode startxs ->
                let mcode = metavar2dots mcode in
                define_paramsbis eas endxs >>= (fun eas endxs -> 
                  return (
                    (A.DPdots (mcode) +> A.rewrap ea) ::eas,
                    startxs ++ endxs
                  )))
              )
            ) fail 

      | A.DPComma ia1, Right ii::ebs -> 
          let ib1 = tuple_of_list1 ii in
          tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
          define_paramsbis eas ebs >>= (fun eas ebs -> 
            return (
              (A.DPComma ia1 +> A.rewrap ea)::eas,
              (Right [ib1])::ebs
            )
          ))

      | A.DPComma ia1, ebs -> 
          if mcode_contain_plus (mcodekind ia1)
          then fail
          else 
            (define_paramsbis eas ebs) (* try optional comma trick *)

      | (A.OptDParam _ | A.UniqueDParam _), _ -> 
              failwith "handling Opt/Unique for define parameters"

      | A.DPcircles (_), ys -> raise Impossible (* in Ordered mode *)

      | A.DParam ida, (Left (idb, ii))::ebs -> 
          let ib1 = tuple_of_list1 ii in
          ident DontKnow ida (idb, ib1) >>= (fun ida (idb, ib1) -> 
          define_paramsbis eas ebs >>= (fun eas ebs -> 
            return (
              (A.DParam ida)+> A.rewrap ea :: eas,
              (Left (idb, [ib1]))::ebs
            )))
          
      | _unwrapx, (Right y)::ys -> raise Impossible
      | _unwrapx, [] -> fail
      )
  


(*****************************************************************************)
(* Entry points *)
(*****************************************************************************)

(* no global solution for positions here, because for a statement metavariable
we want a MetaStmtVal, and for the others, it's not clear what we want *)

let rec (rule_elem_node: (A.rule_elem, Control_flow_c.node) matcher) = 
 fun re node -> 
  let rewrap x = 
    x >>= (fun a b -> return (A.rewrap re a, F.rewrap node b))
  in
  X.all_bound (A.get_inherited re) >&&>

  rewrap (
  match A.unwrap re, F.unwrap node with

  (* note: the order of the clauses is important. *)

  | _, F.Enter | _, F.Exit | _, F.ErrorExit -> fail2()

  (* the metaRuleElem contains just '-' information. We dont need to add
   * stuff in the environment. If we need stuff in environment, because
   * there is a + S somewhere, then this will be done via MetaStmt, not
   * via MetaRuleElem. 
   * Can match TrueNode/FalseNode/... so must be placed before those cases.
   *)

  | A.MetaRuleElem(mcode,keep,inherited), unwrap_node -> 
      let default = A.MetaRuleElem(mcode,keep,inherited), unwrap_node in
      (match unwrap_node with
      | F.CaseNode _
      | F.TrueNode | F.FalseNode | F.AfterNode
      | F.LoopFallThroughNode  | F.FallThroughNode 
      | F.InLoopNode -> 
          if X.mode =*= PatternMode 
          then return default 
          else
            if mcode_contain_plus (mcodekind mcode)
            then failwith "try add stuff on fake node"
              (* minusize or contextize a fake node is ok *)
            else return default

      | F.EndStatement None -> 
          if X.mode =*= PatternMode then return default 
          else 
              (* DEAD CODE NOW ? only useful in -no_cocci_vs_c_3 ?
                 if mcode_contain_plus (mcodekind mcode)
                 then
                 let fake_info = Ast_c.fakeInfo() in
                 distrf distrf_node (mcodekind mcode) 
                 (F.EndStatement (Some fake_info)) 
                 else return unwrap_node
              *)
            raise Todo
              
      | F.EndStatement (Some i1) -> 
          tokenf mcode i1 >>= (fun mcode i1 -> 
            return (
              A.MetaRuleElem (mcode,keep, inherited),
              F.EndStatement (Some i1)
            ))

      | F.FunHeader _ -> 
          if X.mode =*= PatternMode then return default
          else failwith "a MetaRuleElem can't transform a headfunc"
      | _n -> 
          if X.mode =*= PatternMode then return default 
          else 
          X.distrf_node (generalize_mcode mcode) node >>= (fun mcode node -> 
            return (
              A.MetaRuleElem(mcode,keep, inherited),
              F.unwrap node
            ))
      )


  (* rene cant have found that a state containing a fake/exit/... should be 
   * transformed 
   * TODO: and F.Fake ?
   *)
  | _, F.EndStatement _ | _, F.CaseNode _
  | _, F.TrueNode | _, F.FalseNode | _, F.AfterNode
  | _, F.FallThroughNode | _, F.LoopFallThroughNode
  | _, F.InLoopNode
    -> fail2()

  (* really ? diff between pattern.ml and transformation.ml *)
  | _, F.Fake -> fail2()


  (* cas general: a Meta can match everything. It matches only
   * "header"-statement. We transform only MetaRuleElem, not MetaStmt.
   * So can't have been called in transform. 
   *)
  | A.MetaStmt (ida,keep,metainfoMaybeTodo,inherited),  F.Decl(_) -> fail

  | A.MetaStmt (ida,keep,metainfoMaybeTodo,inherited),  unwrap_node -> 
      (* todo: should not happen in transform mode *)

      (match Control_flow_c.extract_fullstatement node with
      | Some stb -> 
            let max_min _ =
              Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_stmt stb) in
            X.envf keep inherited (ida, Ast_c.MetaStmtVal stb, max_min)
              (fun () -> 
              (* no need tag ida, we can't be called in transform-mode *)
                return (
                A.MetaStmt (ida, keep, metainfoMaybeTodo, inherited),
                unwrap_node
              )
            )
      | None -> fail
      )

  (* not me?: *)
  | A.MetaStmtList _, _ -> 
      failwith "not handling MetaStmtList"

  | A.TopExp ea, F.DefineExpr eb  ->
      expression ea eb >>= (fun ea eb -> 
        return (
          A.TopExp ea,
          F.DefineExpr eb
        ))
         
  | A.TopExp ea, F.DefineType eb  ->
      (match A.unwrap ea with
        A.TypeExp(ft) ->
          fullType ft eb >>= (fun ft eb -> 
            return (
              A.TopExp (A.rewrap ea (A.TypeExp(ft))),
              F.DefineType eb
            ))
      | _ -> fail)
         


  (* It is important to put this case before the one that fails because
   * of the lack of the counter part of a C construct in SmPL (for instance
   * there is not yet a CaseRange in SmPL). Even if SmPL don't handle
   * yet certain constructs, those constructs may contain expression
   * that we still want and can transform.
   *)

  | A.Exp exp, nodeb -> 

      (* kind of iso, initialisation vs affectation *)
      let node = 
        match A.unwrap exp, nodeb with
        | A.Assignment (ea, op, eb, true), F.Decl decl -> 
            initialisation_to_affectation decl +> F.rewrap node
        | _ -> node
      in


     (* Now keep fullstatement inside the control flow node, 
      * so that can then get in a MetaStmtVar the fullstatement to later
      * pp back when the S is in a +. But that means that 
      * Exp will match an Ifnode even if there is no such exp
      * inside the condition of the Ifnode (because the exp may
      * be deeper, in the then branch). So have to not visit
      * all inside a node anymore.
      * 
      * update: j'ai choisi d'accrocher au noeud du CFG à la
      * fois le fullstatement et le partialstatement et appeler le 
      * visiteur que sur le partialstatement.
      *)
      let expfn = 
        match Ast_cocci.get_pos re with
        | None -> expression
        | Some pos -> 
            (fun ea eb -> 
              let (max,min) = 
                Lib_parsing_c.max_min_by_pos (Lib_parsing_c.ii_of_expr eb) in
              let keep = Type_cocci.Unitary in
              let inherited = false in
              let max_min _ = failwith "no pos" in
              X.envf keep inherited (pos, B.MetaPosVal (min,max), max_min)
                (fun () -> 
                  expression ea eb
              )
            )
      in
      X.cocciExp expfn exp node >>= (fun exp node -> 
        return (
          A.Exp exp,
          F.unwrap node
        )
      )

  | A.Ty ty, nodeb -> 
      X.cocciTy fullType ty node >>= (fun ty node -> 
        return (
          A.Ty ty,
          F.unwrap node
        )
      )

  | A.TopInit init, nodeb -> 
      X.cocciInit initialiser init node >>= (fun init node -> 
        return (
          A.TopInit init,
          F.unwrap node
        )
      )


  | A.FunHeader (mckstart, allminus, fninfoa, ida, oparen, paramsa, cparen),
    F.FunHeader ({B.f_name = nameidb;
                  f_type = (retb, (paramsb, (isvaargs, iidotsb)));
                  f_storage = stob;
                  f_attr = attrs;
                  f_body = body;
                  f_old_c_style = oldstyle;
                  }, ii) -> 
      assert (null body);

      if oldstyle <> None
      then pr2 "OLD STYLE DECL NOT WELL SUPPORTED";


      (* fninfoa records the order in which the SP specified the various
         information, but this isn't taken into account in the matching.
         Could this be a problem for transformation? *)
      let stoa =
        match
          List.filter (function A.FStorage(s) -> true | _ -> false) fninfoa
        with [A.FStorage(s)] -> Some s | _ -> None in
      let tya = 
        match List.filter (function A.FType(s) -> true | _ -> false) fninfoa
        with [A.FType(t)] -> Some t | _ -> None in

      (match List.filter (function A.FInline(i) -> true | _ -> false) fninfoa
      with [A.FInline(i)] -> failwith "not checking inline" | _ -> ());

      (match List.filter (function A.FAttr(a) -> true | _ -> false) fninfoa
      with [A.FAttr(a)] -> failwith "not checking attributes" | _ -> ());

      (match ii with
      | ioparenb::icparenb::iifakestart::iistob -> 

          (* maybe important to put ident as the first tokens to transform.
           * It's related to transform_proto. So don't change order
           * between the >>=.
           *)
          ident_cpp LocalFunction ida nameidb >>= (fun ida nameidb -> 
          X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> 
          tokenf oparen ioparenb >>= (fun oparen ioparenb ->
          tokenf cparen icparenb >>= (fun cparen icparenb ->
          parameters (seqstyle paramsa) 
            (A.undots paramsa) paramsb >>=
            (fun paramsaundots paramsb -> 
              let paramsa = redots paramsa paramsaundots in
          storage_optional_allminus allminus 
            stoa (stob, iistob) >>= (fun stoa (stob, iistob) -> 
              (
                if isvaargs 
                then 
                  pr2_once
                    ("Not handling well variable length arguments func. "^
                     "You have been warned");
                if allminus
                then minusize_list iidotsb
                else return ((),iidotsb)
              ) >>= (fun () iidotsb -> 
            
           fullType_optional_allminus allminus tya retb >>= (fun tya retb -> 

             let fninfoa = 
               (match stoa with Some st -> [A.FStorage st] | None -> []) ++
               (match tya  with Some t -> [A.FType t] | None -> [])

             in

             return (
               A.FunHeader(mckstart,allminus,fninfoa,ida,oparen,
                          paramsa,cparen),
               F.FunHeader ({B.f_name = nameidb;
                             f_type = (retb, (paramsb, (isvaargs, iidotsb)));
                             f_storage = stob;
                             f_attr = attrs;
                             f_body = body;
                             f_old_c_style = oldstyle; (* TODO *)
                           },
                           ioparenb::icparenb::iifakestart::iistob)
                )
              ))))))))
      | _ -> raise Impossible
      )






  | A.Decl (mckstart,allminus,decla), F.Decl declb -> 
      declaration (mckstart,allminus,decla) declb >>= 
       (fun (mckstart,allminus,decla) declb -> 
        return (
          A.Decl (mckstart,allminus,decla),
          F.Decl declb
        ))


  | A.SeqStart mcode, F.SeqStart (st, level, i1) -> 
      tokenf mcode i1 >>= (fun mcode i1 -> 
        return (
          A.SeqStart mcode, 
          F.SeqStart (st, level, i1)
        ))

  | A.SeqEnd mcode, F.SeqEnd (level, i1) -> 
      tokenf mcode i1 >>= (fun mcode i1 -> 
        return (
          A.SeqEnd mcode,
          F.SeqEnd (level, i1)
          ))

  | A.ExprStatement (ea, ia1), F.ExprStatement (st, (Some eb, ii)) -> 
      let ib1 = tuple_of_list1 ii in 
      expression ea eb >>= (fun ea eb -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
        return (
          A.ExprStatement (ea, ia1),
          F.ExprStatement (st, (Some eb, [ib1]))
        )
      ))


  | A.IfHeader (ia1,ia2, ea, ia3), F.IfHeader (st, (eb,ii)) -> 
      let (ib1, ib2, ib3) = tuple_of_list3 ii in
      expression ea eb >>= (fun ea eb -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
      tokenf ia3 ib3 >>= (fun ia3 ib3 -> 
        return (
          A.IfHeader (ia1, ia2, ea, ia3),
          F.IfHeader (st, (eb,[ib1;ib2;ib3]))
        )))))

  | A.Else ia, F.Else ib -> 
      tokenf ia ib >>= (fun ia ib -> 
        return (A.Else ia, F.Else ib)
      )

  | A.WhileHeader (ia1, ia2, ea, ia3), F.WhileHeader (st, (eb, ii)) -> 
      let (ib1, ib2, ib3) = tuple_of_list3 ii in
      expression ea eb >>= (fun ea eb -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
      tokenf ia3 ib3 >>= (fun ia3 ib3 -> 
        return (
          A.WhileHeader (ia1, ia2, ea, ia3), 
          F.WhileHeader (st, (eb, [ib1;ib2;ib3]))
        )))))

  | A.DoHeader ia, F.DoHeader (st, ib) -> 
      tokenf ia ib >>= (fun ia ib -> 
        return (
          A.DoHeader ia, 
          F.DoHeader (st, ib)
        ))
  | A.WhileTail (ia1,ia2,ea,ia3,ia4), F.DoWhileTail (eb, ii) -> 
      let (ib1, ib2, ib3, ib4) = tuple_of_list4 ii in
      expression ea eb >>= (fun ea eb -> 
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
      tokenf ia3 ib3 >>= (fun ia3 ib3 -> 
      tokenf ia4 ib4 >>= (fun ia4 ib4 -> 
        return (
          A.WhileTail (ia1,ia2,ea,ia3,ia4), 
          F.DoWhileTail (eb, [ib1;ib2;ib3;ib4])
        ))))))
  | A.IteratorHeader (ia1, ia2, eas, ia3), F.MacroIterHeader (st, ((s,ebs),ii))
      -> 
      let (ib1, ib2, ib3) = tuple_of_list3 ii in

      ident DontKnow ia1 (s, ib1) >>= (fun ia1 (s, ib1) -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
      tokenf ia3 ib3 >>= (fun ia3 ib3 -> 
      arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs -> 
       let eas = redots eas easundots in
       return (
         A.IteratorHeader (ia1, ia2, eas, ia3), 
         F.MacroIterHeader (st, ((s,ebs), [ib1;ib2;ib3]))
       )))))

     

  | A.ForHeader (ia1, ia2, ea1opt, ia3, ea2opt, ia4, ea3opt, ia5), 
    F.ForHeader (st, (((eb1opt,ib3s), (eb2opt,ib4s), (eb3opt,ib4vide)), ii))
    -> 
      assert (null ib4vide);
      let (ib1, ib2, ib5) = tuple_of_list3 ii in
      let ib3 = tuple_of_list1 ib3s in
      let ib4 = tuple_of_list1 ib4s in
      
      tokenf ia1 ib1 >>= (fun ia1 ib1 ->
      tokenf ia2 ib2 >>= (fun ia2 ib2 ->
      tokenf ia3 ib3 >>= (fun ia3 ib3 ->
      tokenf ia4 ib4 >>= (fun ia4 ib4 ->
      tokenf ia5 ib5 >>= (fun ia5 ib5 ->
      option expression ea1opt eb1opt >>= (fun ea1opt eb1opt ->
      option expression ea2opt eb2opt >>= (fun ea2opt eb2opt ->
      option expression ea3opt eb3opt >>= (fun ea3opt eb3opt ->
        return (
          A.ForHeader (ia1, ia2, ea1opt, ia3, ea2opt, ia4, ea3opt, ia5),
          F.ForHeader (st, (((eb1opt,[ib3]), (eb2opt,[ib4]), (eb3opt,[])),
                           [ib1;ib2;ib5]))

        )))))))))


  | A.SwitchHeader(ia1,ia2,ea,ia3), F.SwitchHeader (st, (eb,ii)) ->
      let (ib1, ib2, ib3) = tuple_of_list3 ii in
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
      tokenf ia3 ib3 >>= (fun ia3 ib3 -> 
      expression ea eb >>= (fun ea eb -> 
        return (
          A.SwitchHeader(ia1,ia2,ea,ia3), 
          F.SwitchHeader (st, (eb,[ib1;ib2;ib3]))
        )))))
      
  | A.Break (ia1, ia2), F.Break (st, ((),ii)) -> 
      let (ib1, ib2) = tuple_of_list2 ii in
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
        return (
          A.Break (ia1, ia2), 
          F.Break (st, ((),[ib1;ib2]))
        )))

  | A.Continue (ia1, ia2), F.Continue (st, ((),ii)) -> 
      let (ib1, ib2) = tuple_of_list2 ii in
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
        return (
          A.Continue (ia1, ia2), 
          F.Continue (st, ((),[ib1;ib2]))
        )))

  | A.Return (ia1, ia2), F.Return (st, ((),ii)) -> 
      let (ib1, ib2) = tuple_of_list2 ii in
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
        return (
          A.Return (ia1, ia2), 
          F.Return (st, ((),[ib1;ib2]))
        )))

  | A.ReturnExpr (ia1, ea, ia2), F.ReturnExpr (st, (eb, ii)) -> 
      let (ib1, ib2) = tuple_of_list2 ii in
      tokenf ia1 ib1 >>= (fun ia1 ib1 -> 
      tokenf ia2 ib2 >>= (fun ia2 ib2 -> 
      expression ea eb >>= (fun ea eb -> 
        return (
          A.ReturnExpr (ia1, ea, ia2), 
          F.ReturnExpr (st, (eb, [ib1;ib2]))
        ))))



  | A.Include(incla,filea), 
    F.Include {B.i_include = (fileb, ii);
               B.i_rel_pos = h_rel_pos;
               B.i_is_in_ifdef = inifdef;
               B.i_content = copt;
              } ->
      assert (copt =*= None);
      
      let include_requirment = 
        match mcodekind incla, mcodekind filea with
        | A.CONTEXT (_, A.BEFORE _), _ -> 
            IncludeMcodeBefore
        | _, A.CONTEXT (_, A.AFTER _) -> 
            IncludeMcodeAfter
        | _ -> 
            IncludeNothing
      in

      let (inclb, iifileb) = tuple_of_list2 ii in 
      if inc_file (term filea, include_requirment) (fileb, h_rel_pos)
      then 
        tokenf incla inclb >>= (fun incla inclb -> 
        tokenf filea iifileb >>= (fun filea iifileb -> 
          return (
            A.Include(incla, filea),
            F.Include {B.i_include = (fileb, [inclb;iifileb]);
                       B.i_rel_pos = h_rel_pos;
                       B.i_is_in_ifdef = inifdef;
                       B.i_content = copt;
            }
          )))
      else fail



  | A.DefineHeader(definea,ida,params), F.DefineHeader ((idb, ii), defkind) ->
      let (defineb, iidb, ieol) = tuple_of_list3 ii in
      ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) -> 
      tokenf definea defineb >>= (fun definea defineb -> 
      (match A.unwrap params, defkind with
      | A.NoParams, B.DefineVar -> 
          return (
            A.NoParams +> A.rewrap params, 
            B.DefineVar
          )
      | A.DParams(lpa,eas,rpa), (B.DefineFunc (ebs, ii)) -> 
          let (lpb, rpb) = tuple_of_list2 ii in
          tokenf lpa lpb >>= (fun lpa lpb -> 
          tokenf rpa rpb >>= (fun rpa rpb -> 

          define_params (seqstyle eas) (A.undots eas) ebs >>= 
            (fun easundots ebs -> 
              let eas = redots eas easundots in
              return (
                A.DParams (lpa,eas,rpa) +> A.rewrap params,
                B.DefineFunc (ebs,[lpb;rpb])
                )
            )))
      | _ -> fail
      ) >>= (fun params defkind -> 
        return (
          A.DefineHeader (definea, ida, params),
          F.DefineHeader ((idb,[defineb;iidb;ieol]),defkind)
        ))
      ))


  | A.Default(def,colon), F.Default (st, ((),ii)) -> 
      let (ib1, ib2) = tuple_of_list2 ii in
      tokenf def ib1 >>= (fun def ib1 -> 
      tokenf colon ib2 >>= (fun colon ib2 -> 
        return (
          A.Default(def,colon), 
          F.Default (st, ((),[ib1;ib2]))
        )))

      
      
  | A.Case(case,ea,colon), F.Case (st, (eb,ii)) -> 
      let (ib1, ib2) = tuple_of_list2 ii in
      tokenf case ib1 >>= (fun case ib1 -> 
      expression ea eb >>= (fun ea eb -> 
      tokenf colon ib2 >>= (fun colon ib2 -> 
        return (
          A.Case(case,ea,colon), 
          F.Case (st, (eb,[ib1;ib2]))
        ))))

  (* only occurs in the predicates generated by asttomember *)
  | A.DisjRuleElem eas, _ -> 
      (eas +>
      List.fold_left (fun acc ea -> acc >|+|> (rule_elem_node ea node)) fail)
        >>= (fun ea eb -> return (A.unwrap ea,F.unwrap eb))

  | _, F.ExprStatement (_, (None, ii)) -> fail (* happen ? *)

  | A.Label(id,dd), F.Label (st, nameb, ((),ii)) ->
      let (ib2) = tuple_of_list1 ii in
      ident_cpp DontKnow id nameb >>= (fun ida nameb ->
      tokenf dd ib2 >>= (fun dd ib2 ->
        return (
        A.Label (ida,dd),
        F.Label (st,nameb, ((),[ib2]))
      )))

  | A.Goto(goto,id,sem),          F.Goto (st,nameb, ((),ii))       ->
      let (ib1,ib3) = tuple_of_list2 ii in
      tokenf goto ib1 >>= (fun goto ib1 ->
      ident_cpp DontKnow id nameb >>= (fun id nameb ->
      tokenf sem ib3 >>= (fun sem ib3 ->
        return(
            A.Goto(goto,id,sem),
            F.Goto (st,nameb, ((),[ib1;ib3]))
          ))))

  (* have not a counter part in coccinelle, for the moment *)
  (* todo?: print a warning at least ? *)
  | _, F.CaseRange _  
  | _, F.Asm _
  | _, F.MacroTop _
    -> fail2()

  | _, (F.IfdefEndif _|F.IfdefElse _|F.IfdefHeader _)
    -> fail2 ()

  | _, 
    (F.MacroStmt (_, _)| F.DefineDoWhileZeroHeader _| F.EndNode|F.TopNode)
      -> fail
  | _, 
    (F.Label (_, _, _)|F.Break (_, _)|F.Continue (_, _)|F.Default (_, _)|
    F.Case (_, _)|F.Include _|F.Goto _|F.ExprStatement _|
    F.DefineType _|F.DefineExpr _|F.DefineTodo|
    F.DefineHeader (_, _)|F.ReturnExpr (_, _)|F.Return (_, _)|F.MacroIterHeader (_, _)|
    F.SwitchHeader (_, _)|F.ForHeader (_, _)|F.DoWhileTail _|F.DoHeader (_, _)|
    F.WhileHeader (_, _)|F.Else _|F.IfHeader (_, _)|
    F.SeqEnd (_, _)|F.SeqStart (_, _, _)|
    F.Decl _|F.FunHeader _)
      -> fail


  )
end