cparser/Main.ml

   1 (* *********************************************************************)
   2 (*                                                                     *)
   3 (*              The Compcert verified compiler                         *)
   4 (*                                                                     *)
   5 (*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
   6 (*                                                                     *)
   7 (*  Copyright Institut National de Recherche en Informatique et en     *)
   8 (*  Automatique.  All rights reserved.  This file is distributed       *)
   9 (*  under the terms of the GNU General Public License as published by  *)
  10 (*  the Free Software Foundation, either version 2 of the License, or  *)
  11 (*  (at your option) any later version.  This file is also distributed *)
  12 (*  under the terms of the INRIA Non-Commercial License Agreement.     *)
  13 (*                                                                     *)
  14 (* *********************************************************************)
  15
  16 (* Wrapper around gcc to parse, transform, pretty-print, and call gcc on result *)
  17
  18 let transfs = ref ""
  19
  20 let safe_remove name =
  21   try Sys.remove name with Sys_error _ -> ()
  22
  23 let process_c_file prepro_opts name =
  24   let ppname = Filename.temp_file "cparser" ".i" in
  25   let cpname = Filename.chop_suffix name ".c" ^ ".i" in
  26   let rc =
  27     Sys.command
  28       (Printf.sprintf "gcc -E -U__GNUC__ %s %s > %s"
  29                       (String.concat " " (List.map Filename.quote prepro_opts))
  30                       (Filename.quote name) (Filename.quote ppname)) in
  31   if rc <> 0 then begin
  32     safe_remove ppname;
  33     exit 2
  34   end;
  35   let ic = open_in ppname in
  36   let lexbuf = Lexing.from_channel ic in
  37   lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = ppname };
  38   let r = Parse.preprocessed_file !transfs name lexbuf in
  39   close_in ic;
  40   safe_remove ppname;
  41   match r with
  42   | None -> exit 2
  43   | Some p ->
  44       let oc = open_out cpname in
  45       let oform = Format.formatter_of_out_channel oc in
  46       Cprint.program oform p;
  47       close_out oc;
  48       cpname
  49
  50 let starts_with pref s =
  51   String.length s >= String.length pref
  52   && String.sub s 0 (String.length pref) = pref
  53
  54 let ends_with suff s =
  55   String.length s >= String.length suff
  56   && String.sub s (String.length s - String.length suff) (String.length suff)
  57      = suff
  58
  59 let rec parse_cmdline prepro args i =
  60   if i >= Array.length Sys.argv then List.rev args else begin
  61     (* should skip arguments more cleanly... *)
  62     let s = Sys.argv.(i) in
  63     if s = "-Xsimplif" && i + 1 < Array.length Sys.argv then begin
  64       transfs := Sys.argv.(i+1);
  65       parse_cmdline prepro args (i+2)
  66     end else if (s = "-I" || s = "-D" || s = "-U")
  67              && i + 1 < Array.length Sys.argv then
  68       parse_cmdline (Sys.argv.(i+1) :: s :: prepro) args (i+2)
  69     else if starts_with "-I" s
  70              || starts_with "-D" s
  71              || starts_with "-U" s then
  72       parse_cmdline (s :: prepro) args (i + 1)
  73     else if s = "-Wall" then
  74       parse_cmdline prepro ("-Wno-parentheses" :: "-Wall" :: args) (i+1)
  75     else if ends_with ".c" s then begin
  76       let s' = process_c_file (List.rev prepro) s in
  77       parse_cmdline prepro (s' :: args) (i + 1)
  78     end else
  79       parse_cmdline prepro (s :: args) (i + 1)
  80   end
  81
  82
  83 let _ =
  84   Builtins.set GCC.builtins;
  85   let args = parse_cmdline [] [] 1 in
  86   let cmd = "gcc " ^ String.concat " " (List.map Filename.quote args) in
  87   let rc = Sys.command cmd in
  88   exit rc
  89