ocamlbuild/ppcache.ml

   1 (***********************************************************************)
   2 (*                             ocamlbuild                              *)
   3 (*                                                                     *)
   4 (*  Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
   5 (*                                                                     *)
   6 (*  Copyright 2007 Institut National de Recherche en Informatique et   *)
   7 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   8 (*  under the terms of the Q Public License version 1.0.               *)
   9 (*                                                                     *)
  10 (***********************************************************************)
  11
  12 (* $Id: ppcache.ml,v 1.1.4.1 2007-11-21 20:55:26 ertai Exp $ *)
  13 (* Original author: Nicolas Pouillard *)
  14 open My_std
  15 open Command
  16 open Pathname.Operators
  17 let () = Log.level := -1000
  18
  19 let usage () =
  20   Format.eprintf "Usage: %s <preprocess-command> <preprocess-args>@." Sys.argv.(0);
  21   exit 4
  22
  23 let () = if Array.length Sys.argv < 2 then usage ()
  24
  25 let args = List.tl (Array.to_list Sys.argv)
  26
  27 let buf = Buffer.create 2048
  28
  29 let digest_file file =
  30   Buffer.add_string buf (Digest.file file)
  31 let digest_string string =
  32   Buffer.add_string buf (Digest.string string)
  33
  34 let search_in_path x =
  35   if Sys.file_exists x then x else
  36   try search_in_path x
  37   with Not_found -> (Format.eprintf "Command not found %s@." x; exit 3)
  38
  39 let cmd =
  40   match args with
  41   | ocamlrun :: x :: _ when String.contains_string ocamlrun 0 "ocamlrun" <> None ->
  42       digest_file (search_in_path ocamlrun); x
  43   | x :: _ -> x
  44   | _ -> usage ()
  45
  46 let output = ref ""
  47
  48 let () = digest_file (search_in_path cmd)
  49
  50 let rec loop =
  51   function
  52   | [] -> Digest.string (Buffer.contents buf)
  53   | ("-impl"|"-intf") :: x :: xs ->
  54       digest_string x; digest_file x; loop xs
  55   | "-o" :: x :: xs ->
  56       output := x; loop xs
  57   | x :: xs ->
  58       let ext = Pathname.get_extension x in
  59       digest_string x;
  60       (match ext with
  61       | "cmo" | "cma" | "ml" | "mli" -> digest_file x
  62       | _ -> ());
  63       loop xs
  64
  65 let digest = loop args;;
  66
  67 let cache_dir = "/tmp/ppcache";; (* FIXME *)
  68
  69 let () = Shell.mkdir_p cache_dir;;
  70
  71 let path = cache_dir/(Digest.to_hex digest);;
  72
  73 let cat path = with_input_file ~bin:true path (fun ic -> copy_chan ic stdout);;
  74
  75 if sys_file_exists path then
  76   if !output = "" then
  77     cat path
  78   else
  79     Shell.cp path !output
  80 else
  81   let cmd = atomize args in
  82   if !output = "" then begin
  83     let tmp = path^".tmp" in
  84     Command.execute (Cmd(S[cmd; Sh ">"; A tmp]));
  85     Shell.mv tmp path;
  86     cat path
  87   end else begin
  88     Command.execute (Cmd cmd);
  89     Shell.cp !output path
  90   end