tools/spp.ml

   1 (*
   2  * Copyright 2010, INRIA, University of Copenhagen
   3  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   4  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   5  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   6  * This file is part of Coccinelle.
   7  *
   8  * Coccinelle is free software: you can redistribute it and/or modify
   9  * it under the terms of the GNU General Public License as published by
  10  * the Free Software Foundation, according to version 2 of the License.
  11  *
  12  * Coccinelle is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  19  *
  20  * The authors reserve the right to distribute this or future versions of
  21  * Coccinelle under other licenses.
  22  *)
  23
  24
  25 (*
  26  * Copyright 2010, INRIA, University of Copenhagen
  27  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
  28  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
  29  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  30  * This file is part of Coccinelle.
  31  *
  32  * Coccinelle is free software: you can redistribute it and/or modify
  33  * it under the terms of the GNU General Public License as published by
  34  * the Free Software Foundation, according to version 2 of the License.
  35  *
  36  * Coccinelle is distributed in the hope that it will be useful,
  37  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  38  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  39  * GNU General Public License for more details.
  40  *
  41  * You should have received a copy of the GNU General Public License
  42  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  43  *
  44  * The authors reserve the right to distribute this or future versions of
  45  * Coccinelle under other licenses.
  46  *)
  47
  48
  49 open Common
  50
  51 exception WrongArguments
  52
  53 (* could do via a List.filter because cpp flags are simple as it's
  54  * "-I/usr/include" not ["-I";"/usr/include"] like in ocaml so no
  55  * need to look multiple args.
  56  *)
  57 let rec cpp_flags_filter xs =
  58   match xs with
  59   | [] -> []
  60   | x::xs ->
  61       (match x with
  62       | s  when x =~ "-D.*" ->
  63           s::cpp_flags_filter xs
  64       | s  when s =~ "-I.*" ->
  65           s::cpp_flags_filter xs
  66       | _ ->
  67           cpp_flags_filter xs
  68       )
  69
  70 let is_compile_command xs =
  71   List.mem "-c" xs
  72
  73 let source_file xs =
  74   xs +> List.filter (fun s -> s =~ ".*\\.c$")
  75
  76 let rec fix_args args file =
  77   match args with
  78       [] -> []
  79     | hd::tail ->
  80         if hd = file then
  81           (hd^".i") :: tail
  82         else
  83           hd::fix_args tail file
  84
  85 let rec get_outputfile args =
  86   match args with
  87       [] -> ([],"")
  88     | hd::tail ->
  89         if hd = "-o" then
  90           let (hd',tail') = match tail with
  91               hd'::tail' -> (hd',tail')
  92             | _          -> raise WrongArguments
  93           in
  94             (tail', hd')
  95         else
  96           let (ntail, out) = get_outputfile tail in
  97             (hd::ntail, out)
  98
  99 let main () =
 100   let args = List.tl (Array.to_list Sys.argv) in
 101   (*args +> List.iter pr2;*)
 102   if is_compile_command args
 103   then begin
 104     let file = source_file args in
 105       (match file with
 106          | [file] ->
 107              let cpp_flags = cpp_flags_filter args in
 108              let cmd2 =
 109                (spf "cpp %s %s > %s.i"
 110                   (Common.join " " cpp_flags)
 111                   file
 112                   file)
 113              in
 114                pr2 cmd2;
 115                let ret2 = Sys.command cmd2 in
 116                  if ret2 > 0 then exit ret2;
 117                  let sp_args = fix_args args file in
 118                  let cmd = "spatch " ^ (Common.join " " sp_args) in
 119                    pr2 cmd;
 120                    let ret = Sys.command cmd in
 121                      exit ret
 122
 123          | [] -> failwith "could not find name of source file"
 124          | x::y::xs -> failwith "multiple source files"
 125       );
 126   end
 127   else
 128     begin
 129       let (nargs, outfile) = get_outputfile args in
 130       let cmd2 =
 131         (spf "cat %s > %s"
 132                   (Common.join " " nargs)
 133                   outfile)
 134       in
 135         pr2 cmd2;
 136         Sys.command cmd2
 137     end
 138
 139 let _ = main ()