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