parsing_cocci/command_line.ml

   1 (*
   2  * Copyright 2012, INRIA
   3  * Julia Lawall, Gilles Muller
   4  * Copyright 2010-2011, INRIA, University of Copenhagen
   5  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   6  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   7  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   8  * This file is part of Coccinelle.
   9  *
  10  * Coccinelle is free software: you can redistribute it and/or modify
  11  * it under the terms of the GNU General Public License as published by
  12  * the Free Software Foundation, according to version 2 of the License.
  13  *
  14  * Coccinelle is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17  * GNU General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU General Public License
  20  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  21  *
  22  * The authors reserve the right to distribute this or future versions of
  23  * Coccinelle under other licenses.
  24  *)
  25
  26
  27 (* ---------------------------------------------------------------------- *)
  28 (* useful functions *)
  29
  30 let starts_with c s =
  31   if String.length s > 0 && String.get s 0 = c
  32   then Some (String.sub s 1 ((String.length s) - 1))
  33   else None
  34
  35 let ends_with c s =
  36   if String.length s > 0 && String.get s ((String.length s) - 1) = c
  37   then Some (String.sub s 0 ((String.length s) - 1))
  38   else None
  39
  40 let split_when fn l =
  41   let rec loop acc = function
  42   | []    -> raise Not_found
  43   | x::xs ->
  44       (match fn x with
  45         Some x -> List.rev acc, x, xs
  46       | None -> loop (x :: acc) xs) in
  47   loop [] l
  48
  49 (* ---------------------------------------------------------------------- *)
  50 (* make a semantic patch from a string *)
  51
  52 let find_metavariables tokens =
  53   let rec loop env = function
  54       [] -> (env,[])
  55     | x :: xs ->
  56         (* single upper case letter is a metavariable *)
  57         let (x,xs,env) =
  58 (*
  59   Testing for uppercase and length is not enough as "+" is
  60   a single character identical in upper/lower case.
  61 *)
  62           (*
  63                 The ":" delimiter could not be used two times
  64                 1) Str.split
  65                 2) split_when (ends_with ...)
  66
  67                 Otherwise split_when will raise a Not_found exception.
  68           *)
  69           match Str.bounded_split (Str.regexp ":") x 2 with
  70             [before;after] ->
  71               let (ty,endty,afterty) = split_when (ends_with ':') (after::xs) in
  72               let decl =
  73                 Printf.sprintf "%s %s;\n"
  74                   (String.concat "" (ty@[endty]))
  75                   before in
  76               (try
  77                 if decl = List.assoc before env
  78                 then (before,afterty,env)
  79                 else failwith (before^" already declared with another type")
  80               with Not_found ->
  81                 let env = (before, decl) :: env in
  82                 (before,afterty,env))
  83           | _ ->
  84               if Str.string_match (Str.regexp "[A-Z]") x 0
  85               then
  86                 begin
  87                   try let _ = Some(List.assoc x env) in (x,xs,env)
  88                   with Not_found ->
  89                     let env =
  90                       (x,(Printf.sprintf "metavariable %s;\n" x)) :: env in
  91                     (x,xs,env)
  92                 end
  93               else (x,xs,env) in
  94         let (env,sp) = loop env xs in
  95         (env,x::sp) in
  96   loop [] tokens
  97
  98 let find_when_dots tokens =
  99   let rec loop = function
 100       [] -> []
 101     | "when !=" :: e :: rest ->
 102         "when != " :: e :: "\n" :: (loop rest)
 103     | "when ==" :: e :: rest ->
 104         "when == " :: e :: "\n" :: (loop rest)
 105     | "when" :: " " :: e :: rest ->
 106         "when" :: " " :: e :: "\n" :: (loop rest)
 107     | "..." :: "when" :: rest -> "\n" :: "..." :: (loop ("when" :: rest))
 108     | "..." :: rest -> "\n" :: "..." :: "\n" :: (loop rest)
 109     | x::xs -> x::(loop xs) in
 110   loop tokens
 111
 112 let add_stars tokens =
 113   let rec loop = function
 114       [] -> []
 115     | "." :: "." :: "." :: rest -> "..." :: skip rest
 116     | "<" :: "." :: "." :: "." :: rest -> "<..." :: skip rest
 117     | "<" :: "+" :: "." :: "." :: "." :: rest -> "<+..." :: skip rest
 118     | "\n" :: rest -> "\n" :: loop rest
 119     | x :: xs -> ("* " ^ x) :: (skip xs)
 120   and skip = function
 121       [] -> []
 122     | "\n" :: rest -> "\n" :: loop rest
 123     | x :: xs -> x :: skip xs in
 124   loop tokens
 125
 126 let rec add_spaces = function
 127     [] -> []
 128   | x :: "\n" :: rest -> x :: "\n" :: (add_spaces rest)
 129   | "\n" :: rest -> "\n" :: (add_spaces rest)
 130   | x :: rest -> x :: " " :: (add_spaces rest)
 131
 132 let reparse tokens =
 133   let (env,code) = find_metavariables tokens in
 134   let env = String.concat "" (List.map snd env) in
 135   let code = find_when_dots code in
 136   let code = add_stars code in
 137   let code = String.concat "" code in
 138   let res = "@@\n"^env^"@@\n"^code in
 139   Printf.printf "%s\n\n" res;
 140   let out = Common.new_temp_file "sp" ".cocci" in
 141   let o = open_out out in
 142   Printf.fprintf o "%s\n" res;
 143   close_out o;
 144   out
 145
 146 let tokenize first =
 147   let lexbuf = Lexing.from_string first in
 148   let rec loop b =
 149     let tok = Lexer_cli.token b in
 150     if not (tok = Lexer_cli.EOF) then
 151       let s = Lexer_cli.pretty_print tok in
 152       s :: loop b
 153     else
 154       []
 155   in loop lexbuf
 156
 157 (* ---------------------------------------------------------------------- *)
 158 (* entry point *)
 159
 160 let command_line args =
 161   let info =
 162     try Some (Common.split_when (function x -> List.mem x ["-sp";"--sp"]) args)
 163     with Not_found -> None in
 164   match info with
 165     None -> args
 166   | Some(pre_args,sp,post_args) ->
 167       (match post_args with
 168         first::post_args ->
 169           pre_args @ "--sp_file" ::
 170                      (reparse (tokenize first)) ::
 171                      post_args
 172       | [] -> failwith "--sp needs an argument")