ocamlbuild/ocaml_utils.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: ocaml_utils.ml,v 1.3.2.3 2007-11-21 18:29:37 ertai Exp $ *)
  13 (* Original author: Nicolas Pouillard *)
  14 open My_std
  15 open Format
  16 open Log
  17 open Pathname.Operators
  18 open Tags.Operators
  19 open Tools
  20 open Flags
  21 open Command;;
  22
  23
  24 module S = Set.Make(String)
  25
  26 let stdlib_dir = lazy begin
  27   (* FIXME *)
  28   let ocamlc_where = sprintf "%s/ocamlc.where" (Pathname.pwd / !Options.build_dir) in
  29   let () = Command.execute ~quiet:true (Cmd(S[!Options.ocamlc; A"-where"; Sh">"; P ocamlc_where])) in
  30   String.chomp (read_file ocamlc_where)
  31 end
  32
  33 let module_name_of_filename f = String.capitalize (Pathname.remove_extensions f)
  34 let module_name_of_pathname x =
  35   module_name_of_filename (Pathname.to_string (Pathname.basename x))
  36
  37 let ignore_stdlib x =
  38   if !Options.nostdlib then false
  39   else
  40     let x' = !*stdlib_dir/((String.uncapitalize x)-.-"cmi") in
  41     Pathname.exists x'
  42
  43 let non_dependencies = ref []
  44 let non_dependency m1 m2 =
  45   (* non_dependency was not supposed to accept pathnames without extension. *)
  46   if String.length (Pathname.get_extensions m1) = 0 then
  47     invalid_arg "non_dependency: no extension";
  48   non_dependencies := (m1, m2) :: !non_dependencies
  49
  50 let path_importance path x =
  51   if List.mem (path, x) !non_dependencies
  52   || (List.mem x !Options.ignore_list) then begin
  53     let () = dprintf 3 "This module (%s) is ignored by %s" x path in
  54     `ignored
  55   end
  56   else if ignore_stdlib x then `just_try else `mandatory
  57
  58 let expand_module include_dirs module_name exts =
  59   let dirname = Pathname.dirname module_name in
  60   let basename = Pathname.basename module_name in
  61   let module_name_cap = dirname/(String.capitalize basename) in
  62   let module_name_uncap = dirname/(String.uncapitalize basename) in
  63   List.fold_right begin fun include_dir ->
  64     List.fold_right begin fun ext acc ->
  65       include_dir/(module_name_uncap-.-ext) ::
  66       include_dir/(module_name_cap-.-ext) :: acc
  67     end exts
  68   end include_dirs []
  69
  70 let string_list_of_file file =
  71   with_input_file file begin fun ic ->
  72     Lexers.blank_sep_strings (Lexing.from_channel ic)
  73   end
  74 let print_path_list = Pathname.print_path_list
  75
  76 let ocaml_ppflags tags =
  77   let flags = Flags.of_tags (tags++"ocaml"++"pp") in
  78   let reduced = Command.reduce flags in
  79   if reduced = N then N else S[A"-pp"; Quote reduced]
  80
  81 let ocaml_add_include_flag x acc =
  82   if x = Pathname.current_dir_name then acc else A"-I" :: A x :: acc
  83
  84 let ocaml_include_flags path =
  85   S (List.fold_right ocaml_add_include_flag (Pathname.include_dirs_of (Pathname.dirname path)) [])
  86
  87 let info_libraries = Hashtbl.create 103
  88
  89 let libraries = Hashtbl.create 103
  90 let libraries_of m =
  91   try Hashtbl.find libraries m with Not_found -> []
  92 let use_lib m lib = Hashtbl.replace libraries m (lib :: libraries_of m)
  93
  94 let ocaml_lib ?(extern=false) ?(byte=true) ?(native=true) ?dir ?tag_name libpath =
  95   let add_dir x =
  96     match dir with
  97     | Some dir -> S[A"-I"; P dir; x]
  98     | None -> x
  99   in
 100   let tag_name =
 101     match tag_name with
 102     | Some x -> x
 103     | None -> "use_" ^ Pathname.basename libpath
 104   in
 105   Hashtbl.replace info_libraries tag_name (libpath, extern);
 106   if extern then begin
 107     if byte then
 108       flag ["ocaml"; tag_name; "link"; "byte"] (add_dir (A (libpath^".cma")));
 109     if native then
 110       flag ["ocaml"; tag_name; "link"; "native"] (add_dir (A (libpath^".cmxa")));
 111   end else begin
 112     if not byte && not native then
 113       invalid_arg "ocaml_lib: ~byte:false or ~native:false only works with ~extern:true";
 114   end;
 115   match dir with
 116   | None -> ()
 117   | Some dir -> flag ["ocaml"; tag_name; "compile"] (S[A"-I"; P dir])
 118
 119 let cmi_of = Pathname.update_extensions "cmi"
 120
 121 exception Ocamldep_error of string
 122
 123 let read_path_dependencies =
 124   let path_dependencies = Hashtbl.create 103 in
 125   let read path =
 126     let module_name = module_name_of_pathname path in
 127     let depends = path-.-"depends" in
 128     with_input_file depends begin fun ic ->
 129       let ocamldep_output =
 130         try Lexers.ocamldep_output (Lexing.from_channel ic)
 131         with Lexers.Error msg -> raise (Ocamldep_error(Printf.sprintf "Ocamldep.ocamldep: bad output (%s)" msg)) in
 132       let deps =
 133         List.fold_right begin fun (path, deps) acc ->
 134           let module_name' = module_name_of_pathname path in
 135           if module_name' = module_name
 136           then List.union deps acc
 137           else raise (Ocamldep_error(Printf.sprintf "Ocamldep.ocamldep: multiple files in ocamldep output (%s not expected)" path))
 138         end ocamldep_output [] in
 139       let deps =
 140         if !Options.nostdlib && not (Tags.mem "nopervasives" (tags_of_pathname path)) then
 141           "Pervasives" :: deps
 142         else deps in
 143       let deps' = List.fold_right begin fun dep acc ->
 144         match path_importance path dep with
 145         | `ignored -> acc
 146         | (`just_try | `mandatory) as importance -> (importance, dep) :: acc
 147       end deps [] in
 148       Hashtbl.replace path_dependencies path
 149         (List.union (try Hashtbl.find path_dependencies path with Not_found -> []) deps');
 150       deps'
 151     end
 152   in read
 153
 154 let path_dependencies_of = memo read_path_dependencies