[bpt/coccinelle.git] / parsing_cocci / disjdistr.ml

module Ast = Ast_cocci
module V = Visitor_ast

let setify l = (* keep first *)
  let rec loop seen = function
      [] -> []
    | x::xs ->
	if List.mem x seen then loop seen xs else x::(loop (x::seen) xs) in
  loop [] l

let disjmult2 e1 e2 k =
  List.concat
    (List.map (function e1 -> List.map (function e2 -> k e1 e2) e2) e1)

let disjmult3 e1 e2 e3 k =
  List.concat
    (List.map
       (function e1 ->
	 List.concat
	   (List.map
	      (function e2 -> List.map (function e3 -> k e1 e2 e3) e3)
	      e2))
       e1)

let rec disjmult f = function
    [] -> [[]]
  | x::xs ->
      let cur = f x in
      let rest = disjmult f xs in
      disjmult2 cur rest (function cur -> function rest -> cur :: rest)

let disjoption f = function
    None -> [None]
  | Some x -> List.map (function x -> Some x) (f x)

let disjdots f d =
  match Ast.unwrap d with
    Ast.DOTS(l) ->
      List.map (function l -> Ast.rewrap d (Ast.DOTS(l))) (disjmult f l)
  | Ast.CIRCLES(l) ->
      List.map (function l -> Ast.rewrap d (Ast.CIRCLES(l))) (disjmult f l)
  | Ast.STARS(l) ->
      List.map (function l -> Ast.rewrap d (Ast.STARS(l))) (disjmult f l)

let rec disjty ft =
  match Ast.unwrap ft with
    Ast.Type(cv,ty) ->
      let ty = disjtypeC ty in
      List.map (function ty -> Ast.rewrap ft (Ast.Type(cv,ty))) ty
  | Ast.DisjType(types) -> List.concat (List.map disjty types)
  | Ast.OptType(ty) ->
      let ty = disjty ty in
      List.map (function ty -> Ast.rewrap ft (Ast.OptType(ty))) ty
  | Ast.UniqueType(ty) ->
      let ty = disjty ty in
      List.map (function ty -> Ast.rewrap ft (Ast.UniqueType(ty))) ty

and disjtypeC bty =
  match Ast.unwrap bty with
    Ast.BaseType(_) | Ast.SignedT(_,_) -> [bty]
  | Ast.Pointer(ty,star) ->
      let ty = disjty ty in
      List.map (function ty -> Ast.rewrap bty (Ast.Pointer(ty,star))) ty
  | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
      let ty = disjty ty in
      List.map
	(function ty ->
	  Ast.rewrap bty (Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2)))
	ty
  | Ast.FunctionType (s,ty,lp1,params,rp1) ->
      let ty = disjoption disjty ty in
      List.map
	(function ty ->
	  Ast.rewrap bty (Ast.FunctionType (s,ty,lp1,params,rp1)))
	ty
  | Ast.Array(ty,lb,size,rb) ->
      disjmult2 (disjty ty) (disjoption disjexp size)
	(function ty -> function size ->
	  Ast.rewrap bty (Ast.Array(ty,lb,size,rb)))
  | Ast.EnumName(_,_) | Ast.StructUnionName(_,_) -> [bty]
  | Ast.StructUnionDef(ty,lb,decls,rb) ->
      disjmult2 (disjty ty) (disjdots disjdecl decls)
	(function ty -> function decls ->
	  Ast.rewrap bty (Ast.StructUnionDef(ty,lb,decls,rb)))
  | Ast.TypeName(_) | Ast.MetaType(_,_,_) -> [bty]

and disjexp e =
  match Ast.unwrap e with
    Ast.Ident(_) | Ast.Constant(_) -> [e]
  | Ast.FunCall(fn,lp,args,rp) ->
      disjmult2 (disjexp fn) (disjdots disjexp args)
	(function fn -> function args ->
	  Ast.rewrap e (Ast.FunCall(fn,lp,args,rp)))
  | Ast.Assignment(left,op,right,simple) ->
      disjmult2 (disjexp left) (disjexp right)
	(function left -> function right ->
	  Ast.rewrap e (Ast.Assignment(left,op,right,simple)))
  | Ast.CondExpr(exp1,why,Some exp2,colon,exp3) ->
      let res = disjmult disjexp [exp1;exp2;exp3] in
      List.map
	(function
	    [exp1;exp2;exp3] ->
	      Ast.rewrap e (Ast.CondExpr(exp1,why,Some exp2,colon,exp3))
	  | _ -> failwith "not possible")
	res
  | Ast.CondExpr(exp1,why,None,colon,exp3) ->
      disjmult2 (disjexp exp1) (disjexp exp3)
	(function exp1 -> function exp3 ->
	  Ast.rewrap e (Ast.CondExpr(exp1,why,None,colon,exp3)))
  | Ast.Postfix(exp,op) ->
      let exp = disjexp exp in
      List.map (function exp -> Ast.rewrap e (Ast.Postfix(exp,op))) exp
  | Ast.Infix(exp,op) ->
      let exp = disjexp exp in
      List.map (function exp -> Ast.rewrap e (Ast.Infix(exp,op))) exp
  | Ast.Unary(exp,op) ->
      let exp = disjexp exp in
      List.map (function exp -> Ast.rewrap e (Ast.Unary(exp,op))) exp
  | Ast.Binary(left,op,right) ->
      disjmult2 (disjexp left) (disjexp right)
	(function left -> function right ->
	  Ast.rewrap e (Ast.Binary(left,op,right)))
  | Ast.Nested(exp,op,right) ->
      (* disj not possible in right *)
      let exp = disjexp exp in
      List.map (function exp -> Ast.rewrap e (Ast.Nested(exp,op,right))) exp
  | Ast.Paren(lp,exp,rp) ->
      let exp = disjexp exp in
      List.map (function exp -> Ast.rewrap e (Ast.Paren(lp,exp,rp))) exp
  | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
      disjmult2 (disjexp exp1) (disjexp exp2)
	(function exp1 -> function exp2 ->
	  Ast.rewrap e (Ast.ArrayAccess(exp1,lb,exp2,rb)))
  | Ast.RecordAccess(exp,pt,field) ->
      let exp = disjexp exp in
      List.map
	(function exp -> Ast.rewrap e (Ast.RecordAccess(exp,pt,field))) exp
  | Ast.RecordPtAccess(exp,ar,field) ->
      let exp = disjexp exp in
      List.map
	(function exp -> Ast.rewrap e (Ast.RecordPtAccess(exp,ar,field))) exp
  | Ast.Cast(lp,ty,rp,exp) ->
      disjmult2 (disjty ty) (disjexp exp)
	(function ty -> function exp -> Ast.rewrap e (Ast.Cast(lp,ty,rp,exp)))
  | Ast.SizeOfExpr(szf,exp) ->
      let exp = disjexp exp in
      List.map (function exp -> Ast.rewrap e (Ast.SizeOfExpr(szf,exp))) exp
  | Ast.SizeOfType(szf,lp,ty,rp) ->
      let ty = disjty ty in
      List.map
	(function ty -> Ast.rewrap e (Ast.SizeOfType(szf,lp,ty,rp))) ty
  | Ast.TypeExp(ty) ->
      let ty = disjty ty in
      List.map (function ty -> Ast.rewrap e (Ast.TypeExp(ty))) ty
  | Ast.MetaErr(_,_,_,_) | Ast.MetaExpr(_,_,_,_,_,_)
  | Ast.MetaExprList(_,_,_,_) | Ast.EComma(_) -> [e]
  | Ast.DisjExpr(exp_list) ->
      List.concat (List.map disjexp exp_list)
  | Ast.NestExpr(expr_dots,whencode,multi) ->
      (* not sure what to do here, so ambiguities still possible *)
      [e]
  | Ast.Edots(dots,_) | Ast.Ecircles(dots,_) | Ast.Estars(dots,_) -> [e]
  | Ast.OptExp(exp) ->
      let exp = disjexp exp in
      List.map (function exp -> Ast.rewrap e (Ast.OptExp(exp))) exp
  | Ast.UniqueExp(exp) ->
      let exp = disjexp exp in
      List.map (function exp -> Ast.rewrap e (Ast.UniqueExp(exp))) exp

and disjparam p =
  match Ast.unwrap p with
    Ast.VoidParam(ty) -> [p] (* void is the only possible value *)
  | Ast.Param(ty,id) ->
      let ty = disjty ty in
      List.map (function ty -> Ast.rewrap p (Ast.Param(ty,id))) ty
  | Ast.MetaParam(_,_,_) | Ast.MetaParamList(_,_,_,_) | Ast.PComma(_) -> [p]
  | Ast.Pdots(dots) | Ast.Pcircles(dots) -> [p]
  | Ast.OptParam(param) ->
      let param = disjparam param in
      List.map (function param -> Ast.rewrap p (Ast.OptParam(param))) param
  | Ast.UniqueParam(param) ->
      let param = disjparam param in
      List.map (function param -> Ast.rewrap p (Ast.UniqueParam(param))) param

and disjini i =
  match Ast.unwrap i with
    Ast.MetaInit(_,_,_) -> [i]
  | Ast.InitExpr(exp) ->
      let exp = disjexp exp in
      List.map (function exp -> Ast.rewrap i (Ast.InitExpr(exp))) exp
  | Ast.InitList(lb,initlist,rb,whencode) ->
      List.map
	(function initlist ->
	  Ast.rewrap i (Ast.InitList(lb,initlist,rb,whencode)))
	(disjmult disjini initlist)
  | Ast.InitGccExt(designators,eq,ini) ->
      let designators = disjmult designator designators in
      let ini = disjini ini in
      disjmult2 designators ini
	(function designators -> function ini ->
	  Ast.rewrap i (Ast.InitGccExt(designators,eq,ini)))
  | Ast.InitGccName(name,eq,ini) ->
      let ini = disjini ini in
      List.map
	(function ini -> Ast.rewrap i (Ast.InitGccName(name,eq,ini)))
	ini
  | Ast.IComma(comma) -> [i]
  | Ast.OptIni(ini) ->
      let ini = disjini ini in
      List.map (function ini -> Ast.rewrap i (Ast.OptIni(ini))) ini
  | Ast.UniqueIni(ini) ->
      let ini = disjini ini in
      List.map (function ini -> Ast.rewrap i (Ast.UniqueIni(ini))) ini

and designator = function
    Ast.DesignatorField(dot,id) -> [Ast.DesignatorField(dot,id)]
  | Ast.DesignatorIndex(lb,exp,rb) ->
      let exp = disjexp exp in
      List.map (function exp -> Ast.DesignatorIndex(lb,exp,rb)) exp
  | Ast.DesignatorRange(lb,min,dots,max,rb) ->
      disjmult2 (disjexp min) (disjexp max)
	(function min -> function max ->
	  Ast.DesignatorRange(lb,min,dots,max,rb))

and disjdecl d =
  match Ast.unwrap d with
    Ast.Init(stg,ty,id,eq,ini,sem) ->
      disjmult2 (disjty ty) (disjini ini)
	(function ty -> function ini ->
	  Ast.rewrap d (Ast.Init(stg,ty,id,eq,ini,sem)))
  | Ast.UnInit(stg,ty,id,sem) ->
      let ty = disjty ty in
      List.map (function ty -> Ast.rewrap d (Ast.UnInit(stg,ty,id,sem))) ty
  | Ast.MacroDecl(name,lp,args,rp,sem) ->
      List.map
	(function args -> Ast.rewrap d (Ast.MacroDecl(name,lp,args,rp,sem)))
	(disjdots disjexp args)
  | Ast.TyDecl(ty,sem) ->
      let ty = disjty ty in
      List.map (function ty -> Ast.rewrap d (Ast.TyDecl(ty,sem))) ty
  | Ast.Typedef(stg,ty,id,sem) ->
      let ty = disjty ty in (* disj not allowed in id *)
      List.map (function ty -> Ast.rewrap d (Ast.Typedef(stg,ty,id,sem))) ty
  | Ast.DisjDecl(decls) -> List.concat (List.map disjdecl decls)
  | Ast.Ddots(_,_) | Ast.MetaDecl(_,_,_) -> [d]
  | Ast.OptDecl(decl) ->
      let decl = disjdecl decl in
      List.map (function decl -> Ast.rewrap d (Ast.OptDecl(decl))) decl
  | Ast.UniqueDecl(decl) ->
      let decl = disjdecl decl in
      List.map (function decl -> Ast.rewrap d (Ast.UniqueDecl(decl))) decl

let generic_orify_rule_elem f re exp rebuild =
  match f exp with
    [exp] -> re
  | orexps ->
      Ast.rewrap re (Ast.DisjRuleElem (setify(List.map rebuild orexps)))

let orify_rule_elem re exp rebuild =
  generic_orify_rule_elem disjexp re exp rebuild

let orify_rule_elem_ty = generic_orify_rule_elem disjty
let orify_rule_elem_param = generic_orify_rule_elem disjparam
let orify_rule_elem_decl = generic_orify_rule_elem disjdecl
let orify_rule_elem_ini = generic_orify_rule_elem disjini

let rec disj_rule_elem r k re =
  match Ast.unwrap re with
    Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) ->
      generic_orify_rule_elem (disjdots disjparam) re params
	(function params ->
	  Ast.rewrap re
	    (Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp)))
  | Ast.Decl(bef,allminus,decl) ->
      orify_rule_elem_decl re decl
	(function decl -> Ast.rewrap re (Ast.Decl(bef,allminus,decl)))
  | Ast.SeqStart(brace) -> re
  | Ast.SeqEnd(brace) -> re
  | Ast.ExprStatement(exp,sem) ->
      orify_rule_elem re exp
	(function exp -> Ast.rewrap re (Ast.ExprStatement(exp,sem)))
  | Ast.IfHeader(iff,lp,exp,rp) ->
      orify_rule_elem re exp
	(function exp -> Ast.rewrap re (Ast.IfHeader(iff,lp,exp,rp)))
  | Ast.Else(els) -> re
  | Ast.WhileHeader(whl,lp,exp,rp) ->
      orify_rule_elem re exp
	(function exp -> Ast.rewrap re (Ast.WhileHeader(whl,lp,exp,rp)))
  | Ast.DoHeader(d) -> re
  | Ast.WhileTail(whl,lp,exp,rp,sem) ->
      orify_rule_elem re exp
	(function exp -> Ast.rewrap re (Ast.WhileTail(whl,lp,exp,rp,sem)))
  | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
      generic_orify_rule_elem (disjmult (disjoption disjexp)) re [e1;e2;e3]
	(function
	    [exp1;exp2;exp3] ->
	      Ast.rewrap re (Ast.ForHeader(fr,lp,exp1,sem1,exp2,sem2,exp3,rp))
	  | _ -> failwith "not possible")
  | Ast.IteratorHeader(whl,lp,args,rp) ->
      generic_orify_rule_elem (disjdots disjexp) re args
	(function args -> Ast.rewrap re (Ast.IteratorHeader(whl,lp,args,rp)))
  | Ast.SwitchHeader(switch,lp,exp,rp) ->
      orify_rule_elem re exp
	(function exp -> Ast.rewrap re (Ast.SwitchHeader(switch,lp,exp,rp)))
  | Ast.Break(_,_) | Ast.Continue(_,_) | Ast.Label(_,_) | Ast.Goto(_,_,_)
  | Ast.Return(_,_) -> re
  | Ast.ReturnExpr(ret,exp,sem) ->
      orify_rule_elem re exp
	(function exp -> Ast.rewrap re (Ast.ReturnExpr(ret,exp,sem)))
  | Ast.MetaRuleElem(_,_,_) | Ast.MetaStmt(_,_,_,_)
  | Ast.MetaStmtList(_,_,_) -> re
  | Ast.Exp(exp) ->
      orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.Exp(exp)))
  | Ast.TopExp(exp) ->
      orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.TopExp(exp)))
  | Ast.Ty(ty) ->
      orify_rule_elem_ty re ty (function ty -> Ast.rewrap ty (Ast.Ty(ty)))
  | Ast.TopInit(init) ->
      orify_rule_elem_ini re init
	(function init -> Ast.rewrap init (Ast.TopInit(init)))
  | Ast.Include(inc,s) -> re
  | Ast.DefineHeader(def,id,params) -> re
  | Ast.Default(def,colon) -> re
  | Ast.Case(case,exp,colon) ->
      orify_rule_elem re exp
	(function exp -> Ast.rewrap re (Ast.Case(case,exp,colon)))
  | Ast.DisjRuleElem(l) ->
      (* only case lines *)
      Ast.rewrap re(Ast.DisjRuleElem(setify(List.map (disj_rule_elem r k) l)))

let disj_all =
  let mcode x = x in
  let donothing r k e = k e in
  V.rebuilder
    mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
    donothing donothing donothing donothing
    donothing donothing donothing donothing donothing donothing donothing
    disj_rule_elem donothing donothing donothing donothing

(* ----------------------------------------------------------------------- *)
(* collect iso information at the rule_elem level *)

let collect_all_isos =
  let bind = (@) in
  let option_default = [] in
  let mcode r x = [] in
  let donothing r k e = Common.union_set (Ast.get_isos e) (k e) in
  let doanything r k e = k e in
  V.combiner bind option_default
    mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
    donothing donothing donothing donothing donothing donothing donothing
    donothing donothing donothing donothing donothing donothing donothing
    donothing doanything

let collect_iso_info =
  let mcode x = x in
  let donothing r k e = k e in
  let rule_elem r k e =
    match Ast.unwrap e with
      Ast.DisjRuleElem(l) -> k e
    | _ ->
	let isos = collect_all_isos.V.combiner_rule_elem e in
	Ast.set_isos e isos in
  V.rebuilder
    mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
    donothing donothing donothing donothing donothing donothing donothing
    donothing donothing donothing donothing rule_elem donothing donothing
    donothing donothing

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

let disj rules =
  List.map
    (function (mv,r) ->
      match r with
        Ast.ScriptRule _
      | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> (mv, r)
      | Ast.CocciRule (nm, rule_info, r, isexp, ruletype) ->
	  let res =
	    List.map
	      (function x ->
		let res = disj_all.V.rebuilder_top_level x in
		if !Flag.track_iso_usage
		then collect_iso_info.V.rebuilder_top_level res
		else res)
	      r in
	  (mv, Ast.CocciRule (nm,rule_info,res,isexp,ruletype)))
    rules
Commit	Line	Data
34e49164 C	1	module Ast = Ast_cocci
	2	module V = Visitor_ast
	3
7f004419 C	4	let setify l = (* keep first *)
	5	let rec loop seen = function
	6	[] -> []
	7	\| x::xs ->
	8	if List.mem x seen then loop seen xs else x::(loop (x::seen) xs) in
	9	loop [] l
	10
34e49164 C	11	let disjmult2 e1 e2 k =
	12	List.concat
	13	(List.map (function e1 -> List.map (function e2 -> k e1 e2) e2) e1)
	14
	15	let disjmult3 e1 e2 e3 k =
	16	List.concat
	17	(List.map
	18	(function e1 ->
	19	List.concat
	20	(List.map
	21	(function e2 -> List.map (function e3 -> k e1 e2 e3) e3)
	22	e2))
	23	e1)
	24
	25	let rec disjmult f = function
	26	[] -> [[]]
	27	\| x::xs ->
	28	let cur = f x in
	29	let rest = disjmult f xs in
	30	disjmult2 cur rest (function cur -> function rest -> cur :: rest)
	31
	32	let disjoption f = function
	33	None -> [None]
	34	\| Some x -> List.map (function x -> Some x) (f x)
	35
	36	let disjdots f d =
	37	match Ast.unwrap d with
	38	Ast.DOTS(l) ->
	39	List.map (function l -> Ast.rewrap d (Ast.DOTS(l))) (disjmult f l)
	40	\| Ast.CIRCLES(l) ->
	41	List.map (function l -> Ast.rewrap d (Ast.CIRCLES(l))) (disjmult f l)
	42	\| Ast.STARS(l) ->
	43	List.map (function l -> Ast.rewrap d (Ast.STARS(l))) (disjmult f l)
	44
	45	let rec disjty ft =
	46	match Ast.unwrap ft with
	47	Ast.Type(cv,ty) ->
	48	let ty = disjtypeC ty in
	49	List.map (function ty -> Ast.rewrap ft (Ast.Type(cv,ty))) ty
	50	\| Ast.DisjType(types) -> List.concat (List.map disjty types)
	51	\| Ast.OptType(ty) ->
	52	let ty = disjty ty in
	53	List.map (function ty -> Ast.rewrap ft (Ast.OptType(ty))) ty
	54	\| Ast.UniqueType(ty) ->
	55	let ty = disjty ty in
	56	List.map (function ty -> Ast.rewrap ft (Ast.UniqueType(ty))) ty
	57
	58	and disjtypeC bty =
	59	match Ast.unwrap bty with
faf9a90c	60	Ast.BaseType(_) \| Ast.SignedT(_,_) -> [bty]
34e49164 C	61	\| Ast.Pointer(ty,star) ->
	62	let ty = disjty ty in
	63	List.map (function ty -> Ast.rewrap bty (Ast.Pointer(ty,star))) ty
	64	\| Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
	65	let ty = disjty ty in
	66	List.map
	67	(function ty ->
	68	Ast.rewrap bty (Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2)))
	69	ty
	70	\| Ast.FunctionType (s,ty,lp1,params,rp1) ->
	71	let ty = disjoption disjty ty in
	72	List.map
	73	(function ty ->
	74	Ast.rewrap bty (Ast.FunctionType (s,ty,lp1,params,rp1)))
	75	ty
	76	\| Ast.Array(ty,lb,size,rb) ->
	77	disjmult2 (disjty ty) (disjoption disjexp size)
	78	(function ty -> function size ->
	79	Ast.rewrap bty (Ast.Array(ty,lb,size,rb)))
faf9a90c	80	\| Ast.EnumName(_,_) \| Ast.StructUnionName(_,_) -> [bty]
34e49164 C	81	\| Ast.StructUnionDef(ty,lb,decls,rb) ->
	82	disjmult2 (disjty ty) (disjdots disjdecl decls)
	83	(function ty -> function decls ->
	84	Ast.rewrap bty (Ast.StructUnionDef(ty,lb,decls,rb)))
	85	\| Ast.TypeName(_) \| Ast.MetaType(_,_,_) -> [bty]
	86
	87	and disjexp e =
	88	match Ast.unwrap e with
	89	Ast.Ident(_) \| Ast.Constant(_) -> [e]
	90	\| Ast.FunCall(fn,lp,args,rp) ->
	91	disjmult2 (disjexp fn) (disjdots disjexp args)
	92	(function fn -> function args ->
	93	Ast.rewrap e (Ast.FunCall(fn,lp,args,rp)))
	94	\| Ast.Assignment(left,op,right,simple) ->
	95	disjmult2 (disjexp left) (disjexp right)
	96	(function left -> function right ->
	97	Ast.rewrap e (Ast.Assignment(left,op,right,simple)))
	98	\| Ast.CondExpr(exp1,why,Some exp2,colon,exp3) ->
	99	let res = disjmult disjexp [exp1;exp2;exp3] in
	100	List.map
	101	(function
	102	[exp1;exp2;exp3] ->
	103	Ast.rewrap e (Ast.CondExpr(exp1,why,Some exp2,colon,exp3))
	104	\| _ -> failwith "not possible")
	105	res
	106	\| Ast.CondExpr(exp1,why,None,colon,exp3) ->
	107	disjmult2 (disjexp exp1) (disjexp exp3)
	108	(function exp1 -> function exp3 ->
	109	Ast.rewrap e (Ast.CondExpr(exp1,why,None,colon,exp3)))
	110	\| Ast.Postfix(exp,op) ->
	111	let exp = disjexp exp in
	112	List.map (function exp -> Ast.rewrap e (Ast.Postfix(exp,op))) exp
	113	\| Ast.Infix(exp,op) ->
	114	let exp = disjexp exp in
	115	List.map (function exp -> Ast.rewrap e (Ast.Infix(exp,op))) exp
	116	\| Ast.Unary(exp,op) ->
	117	let exp = disjexp exp in
	118	List.map (function exp -> Ast.rewrap e (Ast.Unary(exp,op))) exp
	119	\| Ast.Binary(left,op,right) ->
	120	disjmult2 (disjexp left) (disjexp right)
	121	(function left -> function right ->
	122	Ast.rewrap e (Ast.Binary(left,op,right)))
	123	\| Ast.Nested(exp,op,right) ->
	124	(* disj not possible in right *)
	125	let exp = disjexp exp in
	126	List.map (function exp -> Ast.rewrap e (Ast.Nested(exp,op,right))) exp
	127	\| Ast.Paren(lp,exp,rp) ->
	128	let exp = disjexp exp in
	129	List.map (function exp -> Ast.rewrap e (Ast.Paren(lp,exp,rp))) exp
	130	\| Ast.ArrayAccess(exp1,lb,exp2,rb) ->
	131	disjmult2 (disjexp exp1) (disjexp exp2)
	132	(function exp1 -> function exp2 ->
	133	Ast.rewrap e (Ast.ArrayAccess(exp1,lb,exp2,rb)))
	134	\| Ast.RecordAccess(exp,pt,field) ->
	135	let exp = disjexp exp in
	136	List.map
	137	(function exp -> Ast.rewrap e (Ast.RecordAccess(exp,pt,field))) exp
	138	\| Ast.RecordPtAccess(exp,ar,field) ->
	139	let exp = disjexp exp in
	140	List.map
	141	(function exp -> Ast.rewrap e (Ast.RecordPtAccess(exp,ar,field))) exp
	142	\| Ast.Cast(lp,ty,rp,exp) ->
	143	disjmult2 (disjty ty) (disjexp exp)
	144	(function ty -> function exp -> Ast.rewrap e (Ast.Cast(lp,ty,rp,exp)))
145	\| Ast.SizeOfExpr(szf,exp) ->
146	let exp = disjexp exp in
147	List.map (function exp -> Ast.rewrap e (Ast.SizeOfExpr(szf,exp))) exp
148	\| Ast.SizeOfType(szf,lp,ty,rp) ->
149	let ty = disjty ty in
150	List.map
151	(function ty -> Ast.rewrap e (Ast.SizeOfType(szf,lp,ty,rp))) ty
152	\| Ast.TypeExp(ty) ->
153	let ty = disjty ty in
154	List.map (function ty -> Ast.rewrap e (Ast.TypeExp(ty))) ty
155	\| Ast.MetaErr(_,_,_,_) \| Ast.MetaExpr(_,_,_,_,_,_)
156	\| Ast.MetaExprList(_,_,_,_) \| Ast.EComma(_) -> [e]
faf9a90c C	157	\| Ast.DisjExpr(exp_list) ->
faf9a90c C	158	List.concat (List.map disjexp exp_list)
34e49164 C	159	\| Ast.NestExpr(expr_dots,whencode,multi) ->
	160	(* not sure what to do here, so ambiguities still possible *)
	161	[e]
	162	\| Ast.Edots(dots,_) \| Ast.Ecircles(dots,_) \| Ast.Estars(dots,_) -> [e]
	163	\| Ast.OptExp(exp) ->
	164	let exp = disjexp exp in
	165	List.map (function exp -> Ast.rewrap e (Ast.OptExp(exp))) exp
	166	\| Ast.UniqueExp(exp) ->
	167	let exp = disjexp exp in
	168	List.map (function exp -> Ast.rewrap e (Ast.UniqueExp(exp))) exp
	169
	170	and disjparam p =
	171	match Ast.unwrap p with
	172	Ast.VoidParam(ty) -> [p] (* void is the only possible value *)
	173	\| Ast.Param(ty,id) ->
	174	let ty = disjty ty in
	175	List.map (function ty -> Ast.rewrap p (Ast.Param(ty,id))) ty
	176	\| Ast.MetaParam(_,_,_) \| Ast.MetaParamList(_,_,_,_) \| Ast.PComma(_) -> [p]
	177	\| Ast.Pdots(dots) \| Ast.Pcircles(dots) -> [p]
	178	\| Ast.OptParam(param) ->
	179	let param = disjparam param in
	180	List.map (function param -> Ast.rewrap p (Ast.OptParam(param))) param
	181	\| Ast.UniqueParam(param) ->
	182	let param = disjparam param in
	183	List.map (function param -> Ast.rewrap p (Ast.UniqueParam(param))) param
	184
	185	and disjini i =
	186	match Ast.unwrap i with
113803cf C	187	Ast.MetaInit(_,_,_) -> [i]
113803cf C	188	\| Ast.InitExpr(exp) ->
34e49164 C	189	let exp = disjexp exp in
	190	List.map (function exp -> Ast.rewrap i (Ast.InitExpr(exp))) exp
	191	\| Ast.InitList(lb,initlist,rb,whencode) ->
	192	List.map
	193	(function initlist ->
	194	Ast.rewrap i (Ast.InitList(lb,initlist,rb,whencode)))
	195	(disjmult disjini initlist)
113803cf C	196	\| Ast.InitGccExt(designators,eq,ini) ->
113803cf C	197	let designators = disjmult designator designators in
34e49164	198	let ini = disjini ini in
113803cf C	199	disjmult2 designators ini
	200	(function designators -> function ini ->
	201	Ast.rewrap i (Ast.InitGccExt(designators,eq,ini)))
34e49164 C	202	\| Ast.InitGccName(name,eq,ini) ->
	203	let ini = disjini ini in
	204	List.map
	205	(function ini -> Ast.rewrap i (Ast.InitGccName(name,eq,ini)))
	206	ini
34e49164	207	\| Ast.IComma(comma) -> [i]
faf9a90c	208	\| Ast.OptIni(ini) ->
34e49164 C	209	let ini = disjini ini in
34e49164 C	210	List.map (function ini -> Ast.rewrap i (Ast.OptIni(ini))) ini
faf9a90c	211	\| Ast.UniqueIni(ini) ->
34e49164 C	212	let ini = disjini ini in
	213	List.map (function ini -> Ast.rewrap i (Ast.UniqueIni(ini))) ini
	214
113803cf C	215	and designator = function
	216	Ast.DesignatorField(dot,id) -> [Ast.DesignatorField(dot,id)]
	217	\| Ast.DesignatorIndex(lb,exp,rb) ->
	218	let exp = disjexp exp in
	219	List.map (function exp -> Ast.DesignatorIndex(lb,exp,rb)) exp
	220	\| Ast.DesignatorRange(lb,min,dots,max,rb) ->
	221	disjmult2 (disjexp min) (disjexp max)
	222	(function min -> function max ->
	223	Ast.DesignatorRange(lb,min,dots,max,rb))
	224
34e49164 C	225	and disjdecl d =
	226	match Ast.unwrap d with
	227	Ast.Init(stg,ty,id,eq,ini,sem) ->
	228	disjmult2 (disjty ty) (disjini ini)
	229	(function ty -> function ini ->
	230	Ast.rewrap d (Ast.Init(stg,ty,id,eq,ini,sem)))
	231	\| Ast.UnInit(stg,ty,id,sem) ->
	232	let ty = disjty ty in
	233	List.map (function ty -> Ast.rewrap d (Ast.UnInit(stg,ty,id,sem))) ty
	234	\| Ast.MacroDecl(name,lp,args,rp,sem) ->
	235	List.map
	236	(function args -> Ast.rewrap d (Ast.MacroDecl(name,lp,args,rp,sem)))
	237	(disjdots disjexp args)
	238	\| Ast.TyDecl(ty,sem) ->
	239	let ty = disjty ty in
	240	List.map (function ty -> Ast.rewrap d (Ast.TyDecl(ty,sem))) ty
	241	\| Ast.Typedef(stg,ty,id,sem) ->
	242	let ty = disjty ty in (* disj not allowed in id *)
	243	List.map (function ty -> Ast.rewrap d (Ast.Typedef(stg,ty,id,sem))) ty
	244	\| Ast.DisjDecl(decls) -> List.concat (List.map disjdecl decls)
	245	\| Ast.Ddots(_,_) \| Ast.MetaDecl(_,_,_) -> [d]
	246	\| Ast.OptDecl(decl) ->
	247	let decl = disjdecl decl in
	248	List.map (function decl -> Ast.rewrap d (Ast.OptDecl(decl))) decl
	249	\| Ast.UniqueDecl(decl) ->
	250	let decl = disjdecl decl in
	251	List.map (function decl -> Ast.rewrap d (Ast.UniqueDecl(decl))) decl
	252
	253	let generic_orify_rule_elem f re exp rebuild =
	254	match f exp with
	255	[exp] -> re
7f004419 C	256	\| orexps ->
7f004419 C	257	Ast.rewrap re (Ast.DisjRuleElem (setify(List.map rebuild orexps)))
34e49164 C	258
	259	let orify_rule_elem re exp rebuild =
	260	generic_orify_rule_elem disjexp re exp rebuild
	261
	262	let orify_rule_elem_ty = generic_orify_rule_elem disjty
	263	let orify_rule_elem_param = generic_orify_rule_elem disjparam
	264	let orify_rule_elem_decl = generic_orify_rule_elem disjdecl
1be43e12	265	let orify_rule_elem_ini = generic_orify_rule_elem disjini
34e49164	266
fc1ad971	267	let rec disj_rule_elem r k re =
faf9a90c	268	match Ast.unwrap re with
34e49164 C	269	Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) ->
	270	generic_orify_rule_elem (disjdots disjparam) re params
	271	(function params ->
	272	Ast.rewrap re
	273	(Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp)))
	274	\| Ast.Decl(bef,allminus,decl) ->
	275	orify_rule_elem_decl re decl
	276	(function decl -> Ast.rewrap re (Ast.Decl(bef,allminus,decl)))
	277	\| Ast.SeqStart(brace) -> re
	278	\| Ast.SeqEnd(brace) -> re
	279	\| Ast.ExprStatement(exp,sem) ->
	280	orify_rule_elem re exp
	281	(function exp -> Ast.rewrap re (Ast.ExprStatement(exp,sem)))
	282	\| Ast.IfHeader(iff,lp,exp,rp) ->
	283	orify_rule_elem re exp
	284	(function exp -> Ast.rewrap re (Ast.IfHeader(iff,lp,exp,rp)))
	285	\| Ast.Else(els) -> re
	286	\| Ast.WhileHeader(whl,lp,exp,rp) ->
	287	orify_rule_elem re exp
	288	(function exp -> Ast.rewrap re (Ast.WhileHeader(whl,lp,exp,rp)))
	289	\| Ast.DoHeader(d) -> re
	290	\| Ast.WhileTail(whl,lp,exp,rp,sem) ->
	291	orify_rule_elem re exp
	292	(function exp -> Ast.rewrap re (Ast.WhileTail(whl,lp,exp,rp,sem)))
	293	\| Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
	294	generic_orify_rule_elem (disjmult (disjoption disjexp)) re [e1;e2;e3]
	295	(function
	296	[exp1;exp2;exp3] ->
	297	Ast.rewrap re (Ast.ForHeader(fr,lp,exp1,sem1,exp2,sem2,exp3,rp))
	298	\| _ -> failwith "not possible")
	299	\| Ast.IteratorHeader(whl,lp,args,rp) ->
	300	generic_orify_rule_elem (disjdots disjexp) re args
	301	(function args -> Ast.rewrap re (Ast.IteratorHeader(whl,lp,args,rp)))
	302	\| Ast.SwitchHeader(switch,lp,exp,rp) ->
	303	orify_rule_elem re exp
	304	(function exp -> Ast.rewrap re (Ast.SwitchHeader(switch,lp,exp,rp)))
	305	\| Ast.Break(_,_) \| Ast.Continue(_,_) \| Ast.Label(_,_) \| Ast.Goto(_,_,_)
	306	\| Ast.Return(_,_) -> re
	307	\| Ast.ReturnExpr(ret,exp,sem) ->
	308	orify_rule_elem re exp
	309	(function exp -> Ast.rewrap re (Ast.ReturnExpr(ret,exp,sem)))
	310	\| Ast.MetaRuleElem(_,_,_) \| Ast.MetaStmt(_,_,_,_)
	311	\| Ast.MetaStmtList(_,_,_) -> re
	312	\| Ast.Exp(exp) ->
	313	orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.Exp(exp)))
	314	\| Ast.TopExp(exp) ->
	315	orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.TopExp(exp)))
	316	\| Ast.Ty(ty) ->
	317	orify_rule_elem_ty re ty (function ty -> Ast.rewrap ty (Ast.Ty(ty)))
1be43e12 C	318	\| Ast.TopInit(init) ->
	319	orify_rule_elem_ini re init
	320	(function init -> Ast.rewrap init (Ast.TopInit(init)))
34e49164 C	321	\| Ast.Include(inc,s) -> re
	322	\| Ast.DefineHeader(def,id,params) -> re
	323	\| Ast.Default(def,colon) -> re
	324	\| Ast.Case(case,exp,colon) ->
	325	orify_rule_elem re exp
	326	(function exp -> Ast.rewrap re (Ast.Case(case,exp,colon)))
fc1ad971 C	327	\| Ast.DisjRuleElem(l) ->
fc1ad971 C	328	(* only case lines *)
7f004419	329	Ast.rewrap re(Ast.DisjRuleElem(setify(List.map (disj_rule_elem r k) l)))
34e49164 C	330
	331	let disj_all =
	332	let mcode x = x in
	333	let donothing r k e = k e in
	334	V.rebuilder
	335	mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
34e49164 C	336	donothing donothing donothing donothing
	337	donothing donothing donothing donothing donothing donothing donothing
	338	disj_rule_elem donothing donothing donothing donothing
	339
	340	(* ----------------------------------------------------------------------- *)
	341	(* collect iso information at the rule_elem level *)
	342
	343	let collect_all_isos =
	344	let bind = (@) in
	345	let option_default = [] in
	346	let mcode r x = [] in
	347	let donothing r k e = Common.union_set (Ast.get_isos e) (k e) in
	348	let doanything r k e = k e in
	349	V.combiner bind option_default
	350	mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
34e49164 C	351	donothing donothing donothing donothing donothing donothing donothing
	352	donothing donothing donothing donothing donothing donothing donothing
	353	donothing doanything
	354
	355	let collect_iso_info =
	356	let mcode x = x in
	357	let donothing r k e = k e in
	358	let rule_elem r k e =
	359	match Ast.unwrap e with
	360	Ast.DisjRuleElem(l) -> k e
	361	\| _ ->
	362	let isos = collect_all_isos.V.combiner_rule_elem e in
	363	Ast.set_isos e isos in
	364	V.rebuilder
	365	mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
34e49164 C	366	donothing donothing donothing donothing donothing donothing donothing
	367	donothing donothing donothing donothing rule_elem donothing donothing
	368	donothing donothing
	369
	370	(* ----------------------------------------------------------------------- *)
	371
	372	let disj rules =
	373	List.map
	374	(function (mv,r) ->
	375	match r with
b1b2de81 C	376	Ast.ScriptRule _
b1b2de81 C	377	\| Ast.InitialScriptRule _ \| Ast.FinalScriptRule _ -> (mv, r)
faf9a90c C	378	\| Ast.CocciRule (nm, rule_info, r, isexp, ruletype) ->
	379	let res =
	380	List.map
	381	(function x ->
	382	let res = disj_all.V.rebuilder_top_level x in
	383	if !Flag.track_iso_usage
	384	then collect_iso_info.V.rebuilder_top_level res
	385	else res)
	386	r in
	387	(mv, Ast.CocciRule (nm,rule_info,res,isexp,ruletype)))
34e49164	388	rules