(*
 * This file is part of Coccinelle, licensed under the terms of the GPL v2.
 * See copyright.txt in the Coccinelle source code for more information.
 * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr
 *)

open Common

module F = Control_flow_c
module V = Visitor_ast

(*****************************************************************************)
(* The functor argument  *)
(*****************************************************************************)

(* info passed recursively in monad in addition to binding *)
type xinfo = {
  optional_storage_iso : bool;
  optional_qualifier_iso : bool;
  value_format_iso : bool;
  optional_declarer_semicolon_iso : bool;
  optional_attributes_iso : bool;
  current_rule_name : string; (* used for errors *)
  index : int list (* witness tree indices *)
}

module XTRANS = struct

  (* ------------------------------------------------------------------------*)
  (* Combinators history *)
  (* ------------------------------------------------------------------------*)
  (*
   * version0:
   *  type ('a, 'b) transformer =
   *    'a -> 'b -> Lib_engine.metavars_binding -> 'b
   *  exception NoMatch
   *
   * version1:
   *   type ('a, 'b) transformer =
   *    'a -> 'b -> Lib_engine.metavars_binding -> 'b option
   * use an exception monad
   *
   * version2:
   *    type tin = Lib_engine.metavars_binding
   *)

  (* ------------------------------------------------------------------------*)
  (* Standard type and operators  *)
  (* ------------------------------------------------------------------------*)

  type tin = {
    extra: xinfo;
    binding: Lib_engine.metavars_binding;
    binding0: Lib_engine.metavars_binding; (* inherited variable *)
  }
  type 'x tout = 'x option

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

  let constraint_checker =
    ref ((fun _ -> failwith "unbound constraint_checker") :
	   (Ast_cocci.meta_name ->
            Ast_c.metavar_binding_kind ->
            (Ast_cocci.meta_name -> Ast_c.metavar_binding_kind) ->
            Ast_cocci.constraints -> tin -> (unit * unit) tout))

  let (>>=) m f = fun tin ->
     match m tin with
     | None -> None
     | Some (a,b) -> f a b tin

  let return = fun x -> fun tin ->
    Some x

  (* can have fail in transform now that the process is deterministic ? *)
  let fail = fun tin ->
    None

  let (>||>) m1 m2 = fun tin ->
    match m1 tin with
    | None -> m2 tin
    | Some x -> Some x (* stop as soon as have found something *)

  let (>|+|>) m1 m2 = m1 >||> m2

  let (>&&>) f m = fun tin ->
    if f tin then m tin else fail tin

  let mnot f res = fun tin ->
    match f tin with
      None -> return res tin
    | _ -> fail tin

  let optional_storage_flag f = fun tin ->
    f (tin.extra.optional_storage_iso) tin

  let optional_qualifier_flag f = fun tin ->
    f (tin.extra.optional_qualifier_iso) tin

  let value_format_flag f = fun tin ->
    f (tin.extra.value_format_iso) tin

  let optional_declarer_semicolon_flag f = fun tin ->
    f (tin.extra.optional_declarer_semicolon_iso) tin

  let optional_attributes_flag f = fun tin ->
    f (tin.extra.optional_attributes_iso) tin

  let mode = Cocci_vs_c.TransformMode

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

  (* When env is used in + code, have to strip it more to avoid circular
  references due to local variable information *)

  let drop_exp_types = (* keep position information *)
    { Visitor_c.default_visitor_c_s with
      Visitor_c.kinfo_s = (fun (k,_) i ->
	{ i with Ast_c.cocci_tag = ref Ast_c.emptyAnnot; }
      );
      Visitor_c.kexpr_s = (fun (k,_) e ->
	let (e', ty),ii' = k e in
	(e', Ast_c.noType()), ii'
      );
    }

  let clean_env env =
    List.map
      (function (v,vl) ->
	match vl with
	| Ast_c.MetaExprVal(e,original,ml,ty) ->
	    (v,Ast_c.MetaExprVal(Visitor_c.vk_expr_s drop_exp_types e,
				 Visitor_c.vk_expr_s drop_exp_types original,ml,ty))
	| Ast_c.MetaExprListVal(es,original) ->
	    (v,Ast_c.MetaExprListVal(Visitor_c.vk_arguments_s drop_exp_types es,
				     Visitor_c.vk_arguments_s drop_exp_types original))
	| Ast_c.MetaTypeVal(ty,original) ->
	    (v,Ast_c.MetaTypeVal(Visitor_c.vk_type_s drop_exp_types ty,
				 Visitor_c.vk_type_s drop_exp_types original))
	| Ast_c.MetaInitVal(i,original) ->
	    (v,Ast_c.MetaInitVal(Visitor_c.vk_ini_s drop_exp_types i,
				 Visitor_c.vk_ini_s drop_exp_types original))
	| Ast_c.MetaInitListVal(newlines,is,original) ->
	    (v,Ast_c.MetaInitListVal(newlines,Visitor_c.vk_inis_s drop_exp_types is,
				     Visitor_c.vk_inis_s drop_exp_types original))
	| Ast_c.MetaDeclVal(d,original) ->
	    (v,
	     Ast_c.MetaDeclVal
	       (Visitor_c.vk_decl_s drop_exp_types d,
		Visitor_c.vk_decl_s drop_exp_types original))
	| Ast_c.MetaStmtVal(s,original,ty) ->
	    (v,
	     Ast_c.MetaStmtVal
	       (Visitor_c.vk_statement_s drop_exp_types s,
		Visitor_c.vk_statement_s drop_exp_types original,ty))
	| Ast_c.MetaStmtListVal(ss,original,ty) ->
	    (v,Ast_c.MetaStmtListVal(Visitor_c.vk_statement_sequencable_list_s drop_exp_types ss,
				     Visitor_c.vk_statement_sequencable_list_s drop_exp_types original,
				     ty))

	| Ast_c.MetaParamVal(p,original) ->
	    (v,Ast_c.MetaParamVal(Visitor_c.vk_param_s drop_exp_types p,
				  Visitor_c.vk_param_s drop_exp_types original))
	| Ast_c.MetaParamListVal(p,original) ->
	    (v,Ast_c.MetaParamListVal(Visitor_c.vk_params_s drop_exp_types p,
				      Visitor_c.vk_params_s drop_exp_types original))
	| Ast_c.MetaFieldVal(fld,original) ->
	    (v,Ast_c.MetaFieldVal(Visitor_c.vk_struct_field_s drop_exp_types fld,
				  Visitor_c.vk_struct_field_s drop_exp_types original))
	| Ast_c.MetaFieldListVal(fld,original) ->
	    (v,Ast_c.MetaFieldListVal(Visitor_c.vk_struct_fields_s drop_exp_types fld,
				      Visitor_c.vk_struct_fields_s drop_exp_types original))
	| Ast_c.MetaAttrArgVal(a,original) ->
	    (v,Ast_c.MetaAttrArgVal(Visitor_c.vk_attr_arg_s drop_exp_types a,
				    Visitor_c.vk_attr_arg_s drop_exp_types original))

	(* These don't contain local variables, but the cocci_tag field
	   causes problems too.  Why is this not needd for other metavars? *)
	| Ast_c.MetaAssignOpVal(b) ->
	    (v,Ast_c.MetaAssignOpVal(Visitor_c.vk_assignOp_s drop_exp_types b))
	| Ast_c.MetaBinaryOpVal(b) ->
	    (v,Ast_c.MetaBinaryOpVal(Visitor_c.vk_binaryOp_s drop_exp_types b))

	| _ -> (v,vl))
      env


  (* ------------------------------------------------------------------------*)
  (* Exp  *)
  (* ------------------------------------------------------------------------*)
  let cocciExp = fun expf expa node -> fun tin ->

    let bigf = {
      Visitor_c.default_visitor_c_s with
      Visitor_c.kexpr_s = (fun (k, bigf) expb ->
	match expf expa expb tin with
	| None -> (* failed *) k expb
	| Some (x, expb) -> expb);
    }
    in
    Some (expa, Visitor_c.vk_node_s bigf node)


  (* same as cocciExp, but for expressions in an expression, not expressions
     in a node *)
  let cocciExpExp = fun mc expf expa expb -> fun tin ->
    match mc with
      Ast_cocci.MINUS _ -> Some (expa,expb) (* do nothing *)
    | _ ->

    let bigf = {
      Visitor_c.default_visitor_c_s with
      Visitor_c.kexpr_s = (fun (k, bigf) expb ->
	match expf expa expb tin with
	| None -> (* failed *) k expb
	| Some (x, expb) -> expb);
    }
    in
    Some (expa, Visitor_c.vk_expr_s bigf expb)


  let cocciTy = fun expf expa node -> fun tin ->

    let bigf = {
      Visitor_c.default_visitor_c_s with
      Visitor_c.ktype_s = (fun (k, bigf) expb ->
	match expf expa expb tin with
	| None -> (* failed *) k expb
	| Some (x, expb) -> expb);
      Visitor_c.kdecl_s = (fun (k, bigf) expb ->
	let iif ii = List.map (Visitor_c.vk_info_s bigf) ii in
	match expb with
	  Ast_c.DeclList(xs,iis) ->
	    (match xs with
	      (x,ii)::xs ->
		Ast_c.DeclList
		  ((Visitor_c.vk_onedecl_s bigf x,iif ii) ::
		   (List.map
		      (fun (x,ii) ->
			(Visitor_c.vk_onedecl_opt_s false bigf x,iif ii))
		      xs),
		   iif iis)
	    | _ -> failwith "no decls")
	| _ -> k expb);
    }
    in
    Some (expa, Visitor_c.vk_node_s bigf node)

  let cocciId = fun expf expa node -> fun tin ->

    let bigf = {
      Visitor_c.default_visitor_c_s with
      Visitor_c.kname_s = (fun (k, bigf) expb ->
	match expf expa expb tin with
	| None -> (* failed *) k expb
	| Some (x, expb) -> expb);
    }
    in
    Some (expa, Visitor_c.vk_node_s bigf node)

  let cocciInit = fun expf expa node -> fun tin ->

    let bigf = {
      Visitor_c.default_visitor_c_s with
      Visitor_c.kini_s = (fun (k, bigf) expb ->
	match expf expa expb tin with
	| None -> (* failed *) k expb
	| Some (x, expb) -> expb);
    }
    in
    Some (expa, Visitor_c.vk_node_s bigf node)


  (* ------------------------------------------------------------------------*)
  (* Tokens *)
  (* ------------------------------------------------------------------------*)
   let check_pos info mck pos =
     match mck with
     | Ast_cocci.PLUS _ -> raise (Impossible 51)
     | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
     | Ast_cocci.MINUS   (Ast_cocci.FixPos (i1,i2),_,_,_) ->
         pos <= i2 && pos >= i1
     | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
     | Ast_cocci.MINUS   (Ast_cocci.DontCarePos,_,_,_) ->
         true
     | _ ->
	 match info with
	   Some info ->
	     failwith
	       (Printf.sprintf
		  "weird: don't have position info for the mcodekind in line %d column %d"
		  info.Ast_cocci.line info.Ast_cocci.column)
	 | None ->
	     failwith "weird: don't have position info for the mcodekind"

    (* these remove constraints, at least those that contain pcre regexps,
       which cannot be compared (problem in the unparser) *)
  let strip_anything anything =
    let donothing r k e = k e in
    let mcode mc = mc in
    let ident r k e =
      let e = k e in
      match Ast_cocci.unwrap e with
	Ast_cocci.MetaId(name,constraints,u,i) ->
          Ast_cocci.rewrap e
	    (Ast_cocci.MetaId(name,Ast_cocci.CstrTrue,u,i))
      | Ast_cocci.MetaFunc(name,constraints,u,i) ->
          Ast_cocci.rewrap e
	    (Ast_cocci.MetaFunc(name,Ast_cocci.CstrTrue,u,i))
      | Ast_cocci.MetaLocalFunc(name,constraints,u,i) ->
          Ast_cocci.rewrap e
	    (Ast_cocci.MetaLocalFunc(name,Ast_cocci.CstrTrue,u,i))
      |  _ -> e in
    let expression r k e =
      let e = k e in
      match Ast_cocci.unwrap e with
	Ast_cocci.MetaErr(name,constraints,u,i) ->
	  Ast_cocci.rewrap e
	    (Ast_cocci.MetaErr(name,Ast_cocci.CstrTrue,u,i))
      | Ast_cocci.MetaExpr(name,constraints,u,ty,form,i,bitfield) ->
          Ast_cocci.rewrap e
	    (Ast_cocci.MetaExpr(name,Ast_cocci.CstrTrue,u,ty,form,i,bitfield))
      | _ -> e in
    let fn =
      V.rebuilder {V.rmcode=mcode} {V.rdonothing=donothing}
	~ident:ident ~expr:expression donothing in

  fn.V.rebuilder_anything anything

  let strip_minus_code = function
      Ast_cocci.REPLACEMENT(l,c) ->
	Ast_cocci.REPLACEMENT(List.map (List.map strip_anything) l,c)
    | Ast_cocci.NOREPLACEMENT -> Ast_cocci.NOREPLACEMENT
  let strip_context_code = function
      Ast_cocci.BEFORE(l,c) ->
	Ast_cocci.BEFORE(List.map (List.map strip_anything) l,c)
    | Ast_cocci.AFTER(l,c) ->
	Ast_cocci.AFTER(List.map (List.map strip_anything) l,c)
    | Ast_cocci.BEFOREAFTER(l1,l2,c) ->
	Ast_cocci.BEFOREAFTER(List.map (List.map strip_anything) l1,
			      List.map (List.map strip_anything) l2,c)
    | Ast_cocci.NOTHING -> Ast_cocci.NOTHING
  let strip_mck_code = function
      Ast_cocci.MINUS(p,l,a,repl) ->
	Ast_cocci.MINUS(p,l,a,strip_minus_code repl)
    | Ast_cocci.CONTEXT(p,ba) -> Ast_cocci.CONTEXT(p,strip_context_code ba)
    | Ast_cocci.PLUS(c) -> Ast_cocci.PLUS(c)

  let tag_with_mck mck ib = fun tin ->

    let cocciinforef = ib.Ast_c.cocci_tag in
    let (oldmcode, oldenvs) = Ast_c.mcode_and_env_of_cocciref cocciinforef in

    let mck =
      (* coccionly:
      if !Flag_parsing_cocci.sgrep_mode
      then Sgrep.process_sgrep ib mck
      else
      *)
        mck
    in
    (match mck, Ast_c.pinfo_of_info ib with
    | _,                  Ast_c.AbstractLineTok _ -> raise (Impossible 52)
    | Ast_cocci.MINUS(_), Ast_c.ExpandedTok _ ->
        failwith
	  (Printf.sprintf
	     "%s: %d: try to delete an expanded token: %s"
	     (Ast_c.file_of_info ib)
	     (Ast_c.line_of_info ib) (Ast_c.str_of_info ib))
    | _ -> ()
    );

    let many_context_count = function
	Ast_cocci.BEFORE(_,Ast_cocci.MANY) | Ast_cocci.AFTER(_,Ast_cocci.MANY)
      |	 Ast_cocci.BEFOREAFTER(_,_,Ast_cocci.MANY) -> true
      |	_ -> false in

    let many_minus_count = function
	Ast_cocci.REPLACEMENT(_,Ast_cocci.MANY) -> true
      |	_ -> false in

    (match (oldmcode,mck) with
    | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING),      _) ->
	(* nothing there, so take the new stuff *)
	let update_inst inst = function
	    Ast_cocci.MINUS (pos,_,adj,any_xxs) ->
	      Ast_cocci.MINUS (pos,inst,adj,any_xxs)
	  | mck -> mck in
	let mck = strip_mck_code (update_inst tin.extra.index mck) in
	(* clean_env actually only needed if there is an addition
	   not sure the extra efficiency would be worth duplicating the code *)
        cocciinforef :=
	  Some (mck, [clean_env tin.binding])
    | (_,   Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING)) ->
	(* can this case occur? stay with the old stuff *)
	()
    | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,Ast_cocci.NOREPLACEMENT),
       Ast_cocci.MINUS(new_pos,new_inst,new_adj,Ast_cocci.NOREPLACEMENT))
	(* Now put no constraints on double remove.  This is needed for
	   tests/multidecl2: - T i; with int *i, i[12], k; (for symbol i)
	   The positions of the two matches are different because the types
	   end in different places (on * and then on ]) *)
      (*when old_pos = new_pos*)
	    (* not sure why the following condition is useful.
	       should be ok to double remove even if the environments are
	       different *)
          (* &&
	  (List.mem tin.binding oldenvs or !Flag.sgrep_mode2) *)
	    (* no way to combine adjacency information, just drop one *)
      ->
        cocciinforef := Some
	  (Ast_cocci.MINUS
	     (old_pos,Common.union_set old_inst new_inst,old_adj,
	      Ast_cocci.NOREPLACEMENT),
	   [clean_env tin.binding]);
        (if !Flag_matcher.show_misc
        then pr2_once "already tagged but only removed, so safe")

    (* ++ cases *)
    | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,old_modif),
       Ast_cocci.MINUS(new_pos,new_inst,new_adj,new_modif))
	when old_pos = new_pos &&
	  old_modif = strip_minus_code new_modif &&
	  many_minus_count old_modif ->

          cocciinforef :=
	    Some(Ast_cocci.MINUS(old_pos,Common.union_set old_inst new_inst,
				 old_adj,old_modif),
		 (clean_env tin.binding)::oldenvs)

    | (Ast_cocci.CONTEXT(old_pos,old_modif),
       Ast_cocci.CONTEXT(new_pos,new_modif))
	when old_pos = new_pos &&
	  old_modif = strip_context_code new_modif &&
	  many_context_count old_modif ->
	    (* iteration only allowed on context; no way to replace something
	       more than once; now no need for iterable; just check a flag *)

          cocciinforef :=
	    Some(Ast_cocci.CONTEXT(old_pos,old_modif),
		 (clean_env tin.binding)::oldenvs)

    (* non ++ but same modif for two reasons *)
    | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,old_modif),
       Ast_cocci.MINUS(new_pos,new_inst,new_adj,new_modif))
	when old_pos = new_pos &&
	  old_modif = strip_minus_code new_modif &&
	  List.mem (clean_env tin.binding) oldenvs ->

          cocciinforef :=
	    Some(Ast_cocci.MINUS(old_pos,Common.union_set old_inst new_inst,
				 old_adj,old_modif),
		 oldenvs)

    | (Ast_cocci.CONTEXT(old_pos,old_modif),
       Ast_cocci.CONTEXT(new_pos,new_modif))
	when old_pos = new_pos &&
	  old_modif = strip_context_code new_modif &&
	  List.mem (clean_env tin.binding) oldenvs ->
	    (* iteration only allowed on context; no way to replace something
	       more than once; now no need for iterable; just check a flag *)

          cocciinforef := Some(Ast_cocci.CONTEXT(old_pos,old_modif),oldenvs)

    | _ ->

(*
	(match (oldmcode,mck) with
	| (Ast_cocci.CONTEXT(old_pos,old_modif),
	   Ast_cocci.CONTEXT(new_pos,new_modif)) ->
	     Printf.printf "failed because of %b %b %b\n"
	       (old_pos = new_pos)
	       (old_modif = strip_context_code new_modif)
	       (many_context_count old_modif);
	     Printf.printf "failed because of %s %s\n"
	       (Dumper.dump old_modif)
	       (Dumper.dump (strip_context_code new_modif))
	| _ -> Printf.printf "other failure\n");
*)

          (* coccionly:
          if !Flag.sgrep_mode2
          then ib (* safe *)
          else
          *)
             begin
            (* coccionly:
               pad: if don't want cocci write:
                failwith
	        (match Ast_c.pinfo_of_info ib with
		  Ast_c.FakeTok _ -> "already tagged fake token"
             *)
	       let pm str mcode env =
		 Printf.sprintf
		   "%s modification:\n%s\nAccording to environment %d:\n%s\n"
		   str
		   (Common.format_to_string
		      (function _ ->
			Pretty_print_cocci.print_mcodekind mcode))
		   (List.length env)
		   (String.concat "\n"
		      (List.map
			 (function ((r,vr),vl) ->
			   Printf.sprintf "   %s.%s -> %s" r vr
			     (Common.format_to_string
				(function _ ->
				  Pretty_print_engine.pp_binding_kind vl)))
			 env)) in
	       flush stdout; flush stderr;
	       Common.pr2
		 ("\n"^ (String.concat "\n"
			   (List.map (pm "previous" oldmcode) oldenvs)) ^ "\n"
		  ^ (pm "current" mck tin.binding));
               failwith
	         (match Ast_c.pinfo_of_info ib with
		   Ast_c.FakeTok _ ->
		     Printf.sprintf "%s: already tagged fake token\n"
		       tin.extra.current_rule_name
		| _ ->
		    Printf.sprintf
		      "%s: already tagged token:\nC code context\n%s"
		      tin.extra.current_rule_name
	              (Common.error_message (Ast_c.file_of_info ib)
			 (Ast_c.str_of_info ib, Ast_c.opos_of_info ib)))
            end);
    ib

  let tokenf ia ib = fun tin ->
    let (_,i,mck,_) = ia in
    let pos = Ast_c.info_to_fixpos ib in
    if check_pos (Some i) mck pos
    then return (ia, tag_with_mck mck ib tin) tin
    else fail tin

  let tokenf_mck mck ib = fun tin ->
    let pos = Ast_c.info_to_fixpos ib in
    if check_pos None mck pos
    then return (mck, tag_with_mck mck ib tin) tin
    else fail tin


  (* ------------------------------------------------------------------------*)
  (* Distribute mcode *)
  (* ------------------------------------------------------------------------*)

  (* When in the SP we attach something to a metavariable, or delete it, as in
   * - S
   * + foo();
   * we have to minusize all the token that compose S in the C code, and
   * attach the 'foo();'  to the right token, the one at the very right.
   *)

  type 'a distributer =
      (Ast_c.info -> Ast_c.info) *  (* what to do on left *)
      (Ast_c.info -> Ast_c.info) *  (* what to do on middle *)
      (Ast_c.info -> Ast_c.info) *  (* what to do on right *)
      (Ast_c.info -> Ast_c.info) -> (* what to do on both *)
      'a -> 'a

  let distribute_mck mcodekind distributef expr tin =
    match mcodekind with
    | Ast_cocci.MINUS (pos,_,adj,any_xxs) ->
	let inst = tin.extra.index in
        distributef (
          (fun ib ->
	    tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin),
          (fun ib ->
	    tag_with_mck
	      (Ast_cocci.MINUS (pos,inst,adj,Ast_cocci.NOREPLACEMENT)) ib tin),
          (fun ib ->
	    tag_with_mck
	      (Ast_cocci.MINUS (pos,inst,adj,Ast_cocci.NOREPLACEMENT)) ib tin),
          (fun ib ->
	    tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin)
        ) expr
    | Ast_cocci.CONTEXT (pos,any_befaft) ->
        (match any_befaft with
        | Ast_cocci.NOTHING -> expr

        | Ast_cocci.BEFORE (xxs,c) ->
            distributef (
              (fun ib -> tag_with_mck
                (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin),
              (fun x -> x),
              (fun x -> x),
              (fun ib -> tag_with_mck
                (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin)
            ) expr
        | Ast_cocci.AFTER (xxs,c) ->
            distributef (
              (fun x -> x),
              (fun x -> x),
              (fun ib -> tag_with_mck
                (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin),
              (fun ib -> tag_with_mck
                (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin)
            ) expr

        | Ast_cocci.BEFOREAFTER (xxs, yys, c) ->
            distributef (
              (fun ib -> tag_with_mck
                (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin),
              (fun x -> x),
              (fun ib -> tag_with_mck
                (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (yys,c))) ib tin),
              (fun ib -> tag_with_mck
                (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFOREAFTER (xxs,yys,c)))
                ib tin)
            ) expr

        )
    | Ast_cocci.PLUS _ -> raise (Impossible 53)


  (* use new strategy, collect ii, sort, recollect and tag *)

  let mk_bigf (maxpos, minpos) (lop,mop,rop,bop) =
    let bigf = {
      Visitor_c.default_visitor_c_s with
        Visitor_c.kinfo_s = (fun (k,bigf) i ->
          let pos = Ast_c.info_to_fixpos i in
          match () with
          | _ when Ast_cocci.equal_pos pos maxpos &&
	      Ast_cocci.equal_pos pos minpos -> bop i
          | _ when Ast_cocci.equal_pos pos maxpos -> rop i
          | _ when Ast_cocci.equal_pos pos minpos -> lop i
          | _ -> mop i
        )
    } in
    bigf

  let distribute_mck_expr (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_expr_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_assignOp (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_assignOp_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_binaryOp (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_binaryOp_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_pragma_info (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_info_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_args (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_args_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_type (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_type_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_decl (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_decl_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_field (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_struct_field_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_ini (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_ini_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_attr_arg (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_attr_arg_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_attr (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_attribute_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_inis (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_inis_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_param (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_param_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x ->
    Visitor_c.vk_params_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
      x

  let distribute_mck_template_param (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
    Visitor_c.vk_template_param_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_template_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x ->
    Visitor_c.vk_template_params_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
      x

  let distribute_mck_fragments (maxpos, minpos) =
    fun (lop,mop,rop,bop) ->fun x ->
      Visitor_c.vk_string_fragments_splitted_s
	(mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
	x

  let distribute_mck_format (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x ->
    Visitor_c.vk_string_format_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
      x

  let distribute_mck_node (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x ->
    Visitor_c.vk_node_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
      x

  let distribute_mck_enum_fields (maxpos, minpos) =
    fun (lop,mop,rop,bop) ->fun x ->
      Visitor_c.vk_enum_fields_splitted_s
	(mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
        x

  let distribute_mck_struct_fields (maxpos, minpos) =
    fun (lop,mop,rop,bop) ->fun x ->
      Visitor_c.vk_struct_fields_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
        x

  let distribute_mck_cst (maxpos, minpos) =
    fun (lop,mop,rop,bop) ->fun x ->
      Visitor_c.vk_cst_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
        x

  let distribute_mck_define_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->
   fun x ->
    Visitor_c.vk_define_params_splitted_s
      (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
      x

  let distribute_mck_ident_list (maxpos, minpos) = fun (lop,mop,rop,bop) ->
   fun x ->
    Visitor_c.vk_ident_list_splitted_s
       (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x

  let distribute_mck_exec_code_list (maxpos, minpos) =
    fun (lop,mop,rop,bop) -> fun x ->
      Visitor_c.vk_exec_code_list_splitted_s
	(mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
	x

  let distribute_mck_attrs (maxpos, minpos) =
    fun (lop,mop,rop,bop) -> fun x ->
      Visitor_c.vk_attrs_splitted_s
	(mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
	x

   let get_pos mck =
     match mck with
     | Ast_cocci.PLUS _ -> raise (Impossible 54)
     | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
     | Ast_cocci.MINUS   (Ast_cocci.FixPos (i1,i2),_,_,_) ->
         Ast_cocci.FixPos (i1,i2)
     | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
     | Ast_cocci.MINUS   (Ast_cocci.DontCarePos,_,_,_) ->
         Ast_cocci.DontCarePos
     | _ -> failwith "weird: don't have position info for the mcodekind 2"

  let distrf (ii_of_x_f, distribute_mck_x_f) =
    fun ia x -> fun tin ->
    let mck = Ast_cocci.get_mcodekind ia in
    let (max, min) = Lib_parsing_c.max_min_by_pos (ii_of_x_f x)
    in
    if
      (* bug: check_pos mck max && check_pos mck min
       *
       * if do that then if have - f(...); and in C f(1,2); then we
       * would get a "already tagged" because the '...' would success in
       * transformaing both '1' and '1,2'. So being in the range is not
       * enough. We must be equal exactly to the range!
       *)
      (match get_pos mck with
      | Ast_cocci.DontCarePos -> true
      | Ast_cocci.FixPos (i1, i2) ->
          i1 = min && i2 = max
      | _ -> raise (Impossible 55)
      )

    then
      return (
        ia,
        distribute_mck mck (distribute_mck_x_f (max,min))  x tin
      ) tin
    else fail tin


  let distrf_e    = distrf (Lib_parsing_c.ii_of_expr,  distribute_mck_expr)
  let distrf_assignOp = distrf (Lib_parsing_c.ii_of_assignOp, distribute_mck_assignOp)
  let distrf_binaryOp = distrf (Lib_parsing_c.ii_of_binaryOp, distribute_mck_binaryOp)
  let distrf_pragma_info = distrf ((fun x -> [x]), distribute_mck_pragma_info)
  let distrf_args = distrf (Lib_parsing_c.ii_of_args,  distribute_mck_args)
  let distrf_type = distrf (Lib_parsing_c.ii_of_type,  distribute_mck_type)
  let distrf_param  = distrf (Lib_parsing_c.ii_of_param, distribute_mck_param)
  let distrf_params = distrf (Lib_parsing_c.ii_of_params,distribute_mck_params)
  let distrf_template_param =
    distrf (Lib_parsing_c.ii_of_template_param, distribute_mck_template_param)
  let distrf_template_params =
    distrf (Lib_parsing_c.ii_of_template_params,distribute_mck_template_params)
  let distrf_ini = distrf (Lib_parsing_c.ii_of_ini,distribute_mck_ini)
  let distrf_inis = distrf (Lib_parsing_c.ii_of_inis,distribute_mck_inis)
  let distrf_decl = distrf (Lib_parsing_c.ii_of_decl,distribute_mck_decl)
  let distrf_field = distrf (Lib_parsing_c.ii_of_field,distribute_mck_field)
  let distrf_node = distrf (Lib_parsing_c.ii_of_node,distribute_mck_node)
  let distrf_fragments =
    distrf (Lib_parsing_c.ii_of_fragments,distribute_mck_fragments)
  let distrf_format = distrf (Lib_parsing_c.ii_of_format,distribute_mck_format)
  let distrf_enum_fields =
    distrf (Lib_parsing_c.ii_of_enum_fields, distribute_mck_enum_fields)
  let distrf_struct_fields =
    distrf (Lib_parsing_c.ii_of_struct_fields, distribute_mck_struct_fields)
  let distrf_cst =
    distrf (Lib_parsing_c.ii_of_cst, distribute_mck_cst)
  let distrf_define_params =
    distrf (Lib_parsing_c.ii_of_define_params,distribute_mck_define_params)
  let distrf_ident_list =
    distrf (Lib_parsing_c.ii_of_ident_list,distribute_mck_ident_list)
  let distrf_exec_code_list =
    distrf (Lib_parsing_c.ii_of_exec_code_list,distribute_mck_exec_code_list)
  let distrf_attr_arg =
    distrf (Lib_parsing_c.ii_of_attr_arg,distribute_mck_attr_arg)
  let distrf_attr =
    distrf (Lib_parsing_c.ii_of_attr,distribute_mck_attr)
  let distrf_attrs =
    distrf (Lib_parsing_c.ii_of_attrs,distribute_mck_attrs)


  (* ------------------------------------------------------------------------*)
  (* Environment *)
  (* ------------------------------------------------------------------------*)
  let meta_name_to_str (s1, s2) = s1 ^ "." ^ s2

  let envf keep inherited = fun (s, value, _) f tin ->
    let s = Ast_cocci.unwrap_mcode s in
    let v =
      if keep = Ast_cocci.Saved
      then (
        try Some (List.assoc s tin.binding)
        with Not_found ->
          pr2 (Printf.sprintf
		"Don't find value for metavariable %s in the environment"
                (meta_name_to_str s));
          None)
      else
        (* not raise Impossible! *)
        Some (value)
    in
    match v with
    | None -> fail tin
    | Some (value') ->

        (* Ex: in cocci_vs_c someone wants to add a binding. Here in
         * transformation3 the value for this var may be already in the
         * env, because for instance its value were fixed in a previous
         * SmPL rule. So here we want to check that this is the same value.
         * If forget to do the check, what can happen ? Because of Exp
         * and other disjunctive feature of cocci_vs_c (>||>), we
         * may accept a match at a wrong position. Maybe later this
         * will be detected via the pos system on tokens, but maybe
         * not. So safer to keep the check.
         *)

        (*f () tin*)
	let equal =
	  if inherited
	  then Cocci_vs_c.equal_inh_metavarval
	  else Cocci_vs_c.equal_metavarval in
        if equal value value'
        then f () tin
        else fail tin


  let check_constraints ida idb constraints = fun f tin -> f () tin
  let check_re_constraints ida constraints = fun f tin -> f () tin
  let check_constraints_ne matcher constraints exp = fun f tin -> f () tin

  (* ------------------------------------------------------------------------*)
  (* Environment, allbounds *)
  (* ------------------------------------------------------------------------*)
  let (all_bound : Ast_cocci.meta_name list -> tin -> bool) = fun l tin ->
    true (* in transform we don't care ? *)

end

(*****************************************************************************)
(* Entry point  *)
(*****************************************************************************)
module TRANS  = Cocci_vs_c.COCCI_VS_C (XTRANS)


let transform_re_node a b tin =
  match TRANS.rule_elem_node a b tin with
  | None -> raise (Impossible 56)
  | Some (_sp, b') -> b'

let (transform2: string (* rule name *) -> string list (* dropped_isos *) ->
  Lib_engine.metavars_binding (* inherited bindings *) ->
  Lib_engine.numbered_transformation_info -> F.cflow -> F.cflow) =
 fun rule_name dropped_isos binding0 xs cflow ->
   let extra = {
     optional_storage_iso   = not(List.mem "optional_storage" dropped_isos);
     optional_qualifier_iso = not(List.mem "optional_qualifier" dropped_isos);
     value_format_iso = not(List.mem "value_format" dropped_isos);
     optional_declarer_semicolon_iso =
       not(List.mem "optional_declarer_semicolon"   dropped_isos);
     optional_attributes_iso =
       not(List.mem "optional_attributes" dropped_isos);
     current_rule_name = rule_name;
     index = [];
   } in

  (* find the node, transform, update the node,  and iter for all elements *)

   xs +> List.fold_left (fun acc (index, (nodei, binding, rule_elem)) ->
      (* subtil: not cflow#nodes but acc#nodes *)
      let node  = F.KeyMap.find nodei acc#nodes in

      if !Flag.show_transinfo
      then pr2 (Printf.sprintf "transform one node: %d" nodei);

      let tin = {
        XTRANS.extra = {extra with index = index};
        XTRANS.binding = binding0@binding;
        XTRANS.binding0 = []; (* not used - everything constant for trans *)
      } in

      let node' = transform_re_node rule_elem node tin in

      (* assert that have done something. But with metaruleElem sometimes
         don't modify fake nodes. So special case before on Fake nodes. *)
      (match F.unwrap node with
      | F.Enter | F.PreExit _ | F.Exit | F.ErrorExit
      | F.EndStatement _ | F.CaseNode _
      | F.Fake
      | F.TrueNode _ | F.FalseNode | F.AfterNode _ | F.FallThroughNode
          -> ()
      | _ -> () (* assert (not (node = node')); *)
      );

      (* useless, we don't go back from flow to ast now *)
      (* let node' = lastfix_comma_struct node' in *)

      acc#replace_node (nodei, node');
      acc
   ) cflow



let transform a b c d e =
  Common.profile_code "Transformation3.transform"
    (fun () -> transform2 a b c d e)
