tools/spp.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 open Common
  28
  29 exception WrongArguments
  30
  31 (* could do via a List.filter because cpp flags are simple as it's
  32  * "-I/usr/include" not ["-I";"/usr/include"] like in ocaml so no
  33  * need to look multiple args.
  34  *)
  35 let rec cpp_flags_filter xs =
  36   match xs with
  37   | [] -> []
  38   | x::xs ->
  39       (match x with
  40       | s  when x =~ "-D.*" ->
  41           s::cpp_flags_filter xs
  42       | s  when s =~ "-I.*" ->
  43           s::cpp_flags_filter xs
  44       | _ ->
  45           cpp_flags_filter xs
  46       )
  47
  48 let is_compile_command xs =
  49   List.mem "-c" xs
  50
  51 let source_file xs =
  52   xs +> List.filter (fun s -> s =~ ".*\\.c$")
  53
  54 let rec fix_args args file =
  55   match args with
  56       [] -> []
  57     | hd::tail ->
  58         if hd = file then
  59           (hd^".i") :: tail
  60         else
  61           hd::fix_args tail file
  62
  63 let rec get_outputfile args =
  64   match args with
  65       [] -> ([],"")
  66     | hd::tail ->
  67         if hd = "-o" then
  68           let (hd',tail') = match tail with
  69               hd'::tail' -> (hd',tail')
  70             | _          -> raise WrongArguments
  71           in
  72             (tail', hd')
  73         else
  74           let (ntail, out) = get_outputfile tail in
  75             (hd::ntail, out)
  76
  77 let main () =
  78   let args = List.tl (Array.to_list Sys.argv) in
  79   (*args +> List.iter pr2;*)
  80   if is_compile_command args
  81   then begin
  82     let file = source_file args in
  83       (match file with
  84          | [file] ->
  85              let cpp_flags = cpp_flags_filter args in
  86              let cmd2 =
  87                (spf "cpp %s %s > %s.i"
  88                   (Common.join " " cpp_flags)
  89                   file
  90                   file)
  91              in
  92                pr2 cmd2;
  93                let ret2 = Sys.command cmd2 in
  94                  if ret2 > 0 then exit ret2;
  95                  let sp_args = fix_args args file in
  96                  let cmd = "spatch " ^ (Common.join " " sp_args) in
  97                    pr2 cmd;
  98                    let ret = Sys.command cmd in
  99                      exit ret
 100
 101          | [] -> failwith "could not find name of source file"
 102          | x::y::xs -> failwith "multiple source files"
 103       );
 104   end
 105   else
 106     begin
 107       let (nargs, outfile) = get_outputfile args in
 108       let cmd2 =
 109         (spf "cat %s > %s"
 110                   (Common.join " " nargs)
 111                   outfile)
 112       in
 113         pr2 cmd2;
 114         Sys.command cmd2
 115     end
 116
 117 let _ = main ()