tools/spp.ml

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