parsing_cocci/iso_compile.ml

   1 module V0 = Visitor_ast0
   2 module VT0 = Visitor_ast0_types
   3 module Ast0 = Ast0_cocci
   4 module Ast = Ast_cocci
   5
   6 (* Detects where position variables can be present in the match of an
   7 isomorpshims.  This is allowed if all elements of an isomorphism have only
   8 one token or if we can somehow match up equal tokens of all of the
   9 isomorphic variants. *)
  10
  11 let sequence_tokens =
  12   let mcode x =
  13     (* sort of unpleasant to convert the token representation to a string
  14        but we can't make a list of mcodes otherwise because the types are all
  15        different *)
  16     [(Common.dump (Ast0.unwrap_mcode x),Ast0.get_pos_ref x)] in
  17   let donothing r k e = k e in
  18   let bind x y = x @ y in
  19   let option_default = [] in
  20   V0.flat_combiner bind option_default
  21     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
  22     donothing donothing donothing donothing donothing donothing
  23     donothing donothing
  24     donothing donothing donothing donothing donothing donothing donothing
  25
  26 (* In general, we will get a list of lists:
  27
  28 [[tokens1;tokens2;tokens3];[tokens4;tokens5;tokens6];[tokens7;tokens8]]
  29
  30 If all of the lists tokens contain only one element, we are done.
  31
  32 Otherwise, we focus on tokens1.  For each of its elements, if they are
  33 present in all of the others, then a position is assigned, and if not then
  34 a position is not.  The order of the elements in the other lists is
  35 irrelevant; we just take the first unannotated element that matches.  Once
  36 we are done with the elements of tokens1, we skip to tokens 4 and repeat,
  37 including considering the one-element special case. *)
  38
  39 let pctr = ref 0
  40 let get_p _ =
  41   let c = !pctr in
  42   pctr := c + 1;
  43   let name = ("",Printf.sprintf "p%d" c) in
  44   Ast0.MetaPos(Ast0.make_mcode name,[],Ast.PER)
  45
  46 let process_info l =
  47    let rec loop = function
  48        [] -> ()
  49      | ((f::r)::xs) as a ->
  50          if List.for_all (List.for_all (function e -> List.length e = 1)) a
  51          then
  52            let p = get_p() in
  53            List.iter (List.iter (List.iter (function (_,pos) -> pos := p))) a
  54          else
  55            let all = r @ List.concat xs in
  56            let rec find_first_available a = function
  57                [] -> raise Not_found
  58              | (str,pos)::xs ->
  59                  if str = a && !pos = Ast0.NoMetaPos
  60                  then pos
  61                  else find_first_available a xs in
  62            List.iter
  63              (function (str,pos) ->
  64                match !pos with
  65                  Ast0.NoMetaPos ->
  66                    (try
  67                      let entries = List.map (find_first_available str) all in
  68                      let p = get_p() in
  69                      pos := p;
  70                      List.iter (function pos -> pos := p) entries
  71                    with Not_found -> ())
  72                | _ -> (* already have a variable *) ())
  73              f;
  74            loop xs
  75      | _ -> failwith "bad iso" in
  76    loop l
  77
  78 (* Entry point *)
  79
  80 let process (metavars,alts,name) =
  81   let toks =
  82     List.map (List.map sequence_tokens.VT0.combiner_rec_anything) alts in
  83   process_info toks