ocamlbuild/ocaml_compiler.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$ *)
  13 (* Original author: Nicolas Pouillard *)
  14 open My_std
  15 open Format
  16 open Log
  17 open Pathname.Operators
  18 open Tools
  19 open Command
  20 open Rule
  21 open Tags.Operators
  22 open Ocaml_utils
  23 open Rule.Common_commands
  24 open Outcome
  25
  26 let forpack_flags arg tags =
  27   if Tags.mem "pack" tags then
  28     Ocaml_arch.forpack_flags_of_pathname arg
  29   else N
  30
  31 let ocamlc_c tags arg out =
  32   let tags = tags++"ocaml"++"byte" in
  33   Cmd (S [!Options.ocamlc; A"-c"; T(tags++"compile");
  34           ocaml_ppflags tags; flags_of_pathname arg;
  35           ocaml_include_flags arg; A"-o"; Px out; P arg])
  36
  37 let ocamlc_link flag tags deps out =
  38   Cmd (S [!Options.ocamlc; flag; T tags;
  39           atomize_paths deps; flags_of_pathname out; A"-o"; Px out])
  40
  41 let ocamlc_link_lib = ocamlc_link (A"-a")
  42 let ocamlc_link_prog = ocamlc_link N
  43
  44 let ocamlmklib tags deps out =
  45   Cmd (S [!Options.ocamlmklib; T tags;
  46           atomize_paths deps; flags_of_pathname out; A"-o"; Px (Pathname.remove_extensions out)])
  47
  48 let ocamlmktop tags deps out =
  49   Cmd( S [!Options.ocamlmktop; T tags;
  50           atomize_paths deps; flags_of_pathname out; A"-o"; Px out])
  51
  52 let byte_lib_linker tags =
  53   if Tags.mem "ocamlmklib" tags then
  54     ocamlmklib tags
  55   else
  56     ocamlc_link_lib tags
  57
  58 let byte_lib_linker_tags tags = tags++"ocaml"++"link"++"byte"++"library"
  59
  60 let ocamlc_p tags deps out =
  61   Cmd (S [!Options.ocamlc; A"-pack"; T tags;
  62           atomize_paths deps; flags_of_pathname out; A"-o"; Px out])
  63
  64 let ocamlopt_c tags arg out =
  65   let tags = tags++"ocaml"++"native" in
  66   Cmd (S [!Options.ocamlopt; A"-c"; Ocaml_arch.forpack_flags_of_pathname arg;
  67           T(tags++"compile"); ocaml_ppflags tags; flags_of_pathname arg;
  68           flags_of_pathname out; ocaml_include_flags arg;
  69           A"-o"; Px out (* FIXME ocamlopt bug -o cannot be after the input file *); P arg])
  70
  71 let ocamlopt_link flag tags deps out =
  72   Cmd (S [!Options.ocamlopt; flag; forpack_flags out tags; T tags;
  73           atomize_paths deps; flags_of_pathname out; A"-o"; Px out])
  74
  75 let ocamlopt_link_lib = ocamlopt_link (A"-a")
  76 let ocamlopt_link_prog = ocamlopt_link N
  77
  78 let ocamlopt_p tags deps out =
  79   let dirnames = List.union [] (List.map Pathname.dirname deps) in
  80   let include_flags = List.fold_right ocaml_add_include_flag dirnames [] in
  81   let mli = Pathname.update_extensions "mli" out in
  82   let cmd =
  83     S [!Options.ocamlopt; A"-pack"; forpack_flags out tags; T tags;
  84        S include_flags; atomize_paths deps; flags_of_pathname out;
  85        A"-o"; Px out] in
  86   if (*FIXME true ||*) Pathname.exists mli then Cmd cmd
  87   else
  88     let rm = S[A"rm"; A"-f"; P mli] in
  89     Cmd(S[A"touch"; P mli; Sh" ; if "; cmd; Sh" ; then "; rm; Sh" ; else ";
  90           rm; Sh" ; exit 1; fi"])
  91
  92 let native_lib_linker tags =
  93   if Tags.mem "ocamlmklib" tags then
  94     ocamlmklib tags
  95   else
  96     ocamlopt_link_lib tags
  97
  98 let native_lib_linker_tags tags = tags++"ocaml"++"link"++"native"++"library"
  99
 100 let prepare_compile build ml =
 101   let dir = Pathname.dirname ml in
 102   let include_dirs = Pathname.include_dirs_of dir in
 103   let modules = path_dependencies_of ml in
 104   let results =
 105     build (List.map (fun (_, x) -> expand_module include_dirs x ["cmi"]) modules) in
 106   List.iter2 begin fun (mandatory, name) res ->
 107     match mandatory, res with
 108     | _, Good _ -> ()
 109     | `mandatory, Bad exn ->
 110         if !Options.ignore_auto then
 111           dprintf 3 "Warning: Failed to build the module \
 112                      %s requested by ocamldep" name
 113         else raise exn
 114     | `just_try, Bad _ -> ()
 115   end modules results
 116
 117 let byte_compile_ocaml_interf mli cmi env build =
 118   let mli = env mli and cmi = env cmi in
 119   prepare_compile build mli;
 120   ocamlc_c (tags_of_pathname mli++"interf") mli cmi
 121
 122 let byte_compile_ocaml_implem ?tag ml cmo env build =
 123   let ml = env ml and cmo = env cmo in
 124   prepare_compile build ml;
 125   ocamlc_c (tags_of_pathname ml++"implem"+++tag) ml cmo
 126
 127 let cache_prepare_link = Hashtbl.create 107
 128 let rec prepare_link tag cmx extensions build =
 129   let key = (tag, cmx, extensions) in
 130   let dir = Pathname.dirname cmx in
 131   let include_dirs = Pathname.include_dirs_of dir in
 132   let ml = Pathname.update_extensions "ml" cmx in
 133   let mli = Pathname.update_extensions "mli" cmx in
 134   let modules =
 135     List.union
 136       (if Pathname.exists (ml-.-"depends") then path_dependencies_of ml else [])
 137       (if Pathname.exists (mli-.-"depends") then path_dependencies_of mli else [])
 138   in
 139   if modules <> [] && not (Hashtbl.mem cache_prepare_link key) then
 140     let () = Hashtbl.add cache_prepare_link key true in
 141     let modules' = List.map (fun (_, x) -> expand_module include_dirs x extensions) modules in
 142     List.iter2 begin fun (mandatory, _) result ->
 143       match mandatory, result with
 144       | _, Good p -> prepare_link tag p extensions build
 145       | `mandatory, Bad exn -> if not !Options.ignore_auto then raise exn
 146       | `just_try, Bad _ -> ()
 147     end modules (build modules')
 148
 149 let native_compile_ocaml_implem ?tag ?(cmx_ext="cmx") ml env build =
 150   let ml = env ml in
 151   let cmi = Pathname.update_extensions "cmi" ml in
 152   let cmx = Pathname.update_extensions cmx_ext ml in
 153   prepare_link cmx cmi [cmx_ext; "cmi"] build;
 154   ocamlopt_c (tags_of_pathname ml++"implem"+++tag) ml cmx
 155
 156 let libs_of_use_lib tags =
 157   Tags.fold begin fun tag acc ->
 158     try let libpath, extern = Hashtbl.find info_libraries tag in
 159         if extern then acc else libpath :: acc
 160     with Not_found -> acc
 161   end tags []
 162
 163 let prepare_libs cma_ext a_ext out build =
 164   let out_no_ext = Pathname.remove_extension out in
 165   let libs1 = List.union (libraries_of out_no_ext) (libs_of_use_lib (tags_of_pathname out)) in
 166   let () = dprintf 10 "prepare_libs: %S -> %a" out pp_l libs1 in
 167   let libs = List.map (fun x -> x-.-cma_ext) libs1 in
 168   let libs2 = List.map (fun lib -> [lib-.-a_ext]) libs1 in
 169   List.iter ignore_good (build libs2); libs
 170
 171 let library_index = Hashtbl.create 32
 172 let package_index = Hashtbl.create 32
 173 let hidden_packages = ref []
 174
 175 let hide_package_contents package = hidden_packages := package :: !hidden_packages
 176
 177 module Ocaml_dependencies_input = struct
 178   let fold_dependencies = Resource.Cache.fold_dependencies
 179   let fold_libraries f = Hashtbl.fold f library_index
 180   let fold_packages f = Hashtbl.fold f package_index
 181 end
 182 module Ocaml_dependencies = Ocaml_dependencies.Make(Ocaml_dependencies_input)
 183
 184 let caml_transitive_closure = Ocaml_dependencies.caml_transitive_closure
 185
 186 let link_gen cmX_ext cma_ext a_ext extensions linker tagger cmX out env build =
 187   let cmX = env cmX and out = env out in
 188   let tags = tagger (tags_of_pathname out) in
 189   let dyndeps = Rule.build_deps_of_tags build (tags++"link_with") in
 190   let cmi = Pathname.update_extensions "cmi" cmX in
 191   prepare_link cmX cmi extensions build;
 192   let libs = prepare_libs cma_ext a_ext out build in
 193   let hidden_packages = List.map (fun x -> x-.-cmX_ext) !hidden_packages in
 194   let deps =
 195     caml_transitive_closure
 196       ~caml_obj_ext:cmX_ext ~caml_lib_ext:cma_ext
 197       ~used_libraries:libs ~hidden_packages (cmX :: dyndeps) in
 198   let deps = (List.filter (fun l -> not (List.mem l deps)) libs) @ deps in
 199
 200   (* Hack to avoid linking twice with the standard library. *)
 201   let stdlib = "stdlib/stdlib"-.-cma_ext in
 202   let is_not_stdlib x = x <> stdlib in
 203   let deps = List.filter is_not_stdlib deps in
 204
 205   if deps = [] then failwith "Link list cannot be empty";
 206   let () = dprintf 6 "link: %a -o %a" print_string_list deps Pathname.print out in
 207   linker (tags++"dont_link_with") deps out
 208
 209 let byte_link_gen = link_gen "cmo" "cma" "cma" ["cmo"; "cmi"]
 210
 211 let byte_link = byte_link_gen ocamlc_link_prog
 212   (fun tags -> tags++"ocaml"++"link"++"byte"++"program")
 213
 214 let byte_library_link = byte_link_gen byte_lib_linker byte_lib_linker_tags
 215
 216 let byte_debug_link_gen =
 217   link_gen "d.cmo" "d.cma" "d.cma" ["d.cmo"; "cmi"]
 218
 219 let byte_debug_link = byte_debug_link_gen ocamlc_link_prog
 220   (fun tags -> tags++"ocaml"++"link"++"byte"++"debug"++"program")
 221
 222 let byte_debug_library_link = byte_debug_link_gen byte_lib_linker
 223   (fun tags -> byte_lib_linker_tags tags++"debug")
 224
 225 let native_link_gen linker =
 226   link_gen "cmx" "cmxa" !Options.ext_lib [!Options.ext_obj; "cmi"] linker
 227
 228 let native_link x = native_link_gen ocamlopt_link_prog
 229   (fun tags -> tags++"ocaml"++"link"++"native"++"program") x
 230
 231 let native_library_link x =
 232   native_link_gen native_lib_linker native_lib_linker_tags x
 233
 234 let native_profile_link_gen linker =
 235   link_gen "p.cmx" "p.cmxa" ("p" -.- !Options.ext_lib) ["p" -.- !Options.ext_obj; "cmi"] linker
 236
 237 let native_profile_link x = native_profile_link_gen ocamlopt_link_prog
 238   (fun tags -> tags++"ocaml"++"link"++"native"++"profile"++"program") x
 239
 240 let native_profile_library_link x = native_profile_link_gen native_lib_linker
 241   (fun tags -> native_lib_linker_tags tags++"profile") x
 242
 243 let link_units table extensions cmX_ext cma_ext a_ext linker tagger contents_list cmX env build =
 244   let cmX = env cmX in
 245   let tags = tagger (tags_of_pathname cmX) in
 246   let _ = Rule.build_deps_of_tags build tags in
 247   let dir =
 248     let dir1 = Pathname.remove_extensions cmX in
 249     if Resource.exists_in_source_dir dir1 then dir1
 250     else Pathname.dirname cmX in
 251   let include_dirs = Pathname.include_dirs_of dir in
 252   let extension_keys = List.map fst extensions in
 253   let libs = prepare_libs cma_ext a_ext cmX build in
 254   let results =
 255     build begin
 256       List.map begin fun module_name ->
 257         expand_module include_dirs module_name extension_keys
 258       end contents_list
 259     end in
 260   let module_paths =
 261     List.map begin function
 262       | Good p ->
 263           let extension_values = List.assoc (Pathname.get_extensions p) extensions in
 264           List.iter begin fun ext ->
 265             List.iter ignore_good (build [[Pathname.update_extensions ext p]])
 266           end extension_values; p
 267       | Bad exn -> raise exn
 268     end results in
 269   Hashtbl.replace table cmX module_paths;
 270   let hidden_packages = List.map (fun x -> x-.-cmX_ext) !hidden_packages in
 271   let deps =
 272     caml_transitive_closure
 273       ~caml_obj_ext:cmX_ext ~caml_lib_ext:cma_ext
 274       ~hidden_packages ~pack_mode:true module_paths in
 275   let full_contents = libs @ module_paths in
 276   let deps = List.filter (fun x -> List.mem x full_contents) deps in
 277   let deps = (List.filter (fun l -> not (List.mem l deps)) libs) @ deps in
 278
 279   (* Hack to avoid linking twice with the standard library. *)
 280   let stdlib = "stdlib/stdlib"-.-cma_ext in
 281   let is_not_stdlib x = x <> stdlib in
 282   let deps = List.filter is_not_stdlib deps in
 283
 284   linker tags deps cmX
 285
 286 let link_modules = link_units library_index
 287 let pack_modules = link_units package_index
 288
 289 let link_from_file link modules_file cmX env build =
 290   let modules_file = env modules_file in
 291   let contents_list = string_list_of_file modules_file in
 292   link contents_list cmX env build
 293
 294 let byte_library_link_modules =
 295   link_modules [("cmo",[])] "cmo" "cma" "cma" byte_lib_linker byte_lib_linker_tags
 296
 297 let byte_library_link_mllib = link_from_file byte_library_link_modules
 298
 299 let byte_toplevel_link_modules =
 300   link_modules [("cmo",[])] "cmo" "cma" "cma" ocamlmktop
 301                (fun tags -> tags++"ocaml"++"link"++"byte"++"toplevel")
 302
 303 let byte_toplevel_link_mltop = link_from_file byte_toplevel_link_modules
 304
 305 let byte_debug_library_link_modules =
 306   link_modules [("d.cmo",[])] "d.cmo" "d.cma" "d.cma" byte_lib_linker
 307     (fun tags -> byte_lib_linker_tags tags++"debug")
 308
 309 let byte_debug_library_link_mllib = link_from_file byte_debug_library_link_modules
 310
 311 let byte_pack_modules =
 312   pack_modules [("cmo",["cmi"]); ("cmi",[])] "cmo" "cma" "cma" ocamlc_p
 313     (fun tags -> tags++"ocaml"++"pack"++"byte")
 314
 315 let byte_pack_mlpack = link_from_file byte_pack_modules
 316
 317 let byte_debug_pack_modules =
 318   pack_modules [("d.cmo",["cmi"]); ("cmi",[])] "d.cmo" "d.cma" "d.cma" ocamlc_p
 319     (fun tags -> tags++"ocaml"++"pack"++"byte"++"debug")
 320
 321 let byte_debug_pack_mlpack = link_from_file byte_debug_pack_modules
 322
 323 let native_pack_modules x =
 324   pack_modules [("cmx",["cmi"; !Options.ext_obj]); ("cmi",[])] "cmx" "cmxa" !Options.ext_lib ocamlopt_p
 325     (fun tags -> tags++"ocaml"++"pack"++"native") x
 326
 327 let native_pack_mlpack = link_from_file native_pack_modules
 328
 329 let native_profile_pack_modules x =
 330   pack_modules [("p.cmx",["cmi"; "p" -.- !Options.ext_obj]); ("cmi",[])] "p.cmx" "p.cmxa"
 331     ("p" -.- !Options.ext_lib) ocamlopt_p
 332     (fun tags -> tags++"ocaml"++"pack"++"native"++"profile") x
 333
 334 let native_profile_pack_mlpack = link_from_file native_profile_pack_modules
 335
 336 let native_library_link_modules x =
 337   link_modules [("cmx",[!Options.ext_obj])] "cmx" "cmxa"
 338      !Options.ext_lib native_lib_linker native_lib_linker_tags x
 339
 340 let native_library_link_mllib = link_from_file native_library_link_modules
 341
 342 let native_profile_library_link_modules x =
 343   link_modules [("p.cmx",["p" -.- !Options.ext_obj])] "p.cmx" "p.cmxa"
 344     ("p" -.- !Options.ext_lib) native_lib_linker
 345     (fun tags -> native_lib_linker_tags tags++"profile") x
 346
 347 let native_profile_library_link_mllib = link_from_file native_profile_library_link_modules