1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6(* *) 7(* Copyright 1999 Institut National de Recherche en Informatique et *) 8(* en Automatique. *) 9(* *) 10(* All rights reserved. This file is distributed under the terms of *) 11(* the GNU Lesser General Public License version 2.1, with the *) 12(* special exception on linking described in the file LICENSE. *) 13(* *) 14(**************************************************************************) 15 16open Compenv 17open Parsetree 18module StringMap = Depend.StringMap 19 20let ppf = Format.err_formatter 21(* Print the dependencies *) 22 23type file_kind = ML | MLI;; 24 25let load_path = ref ([] : (string * string array) list) 26let ml_synonyms = ref [".ml"] 27let mli_synonyms = ref [".mli"] 28let native_only = ref false 29let bytecode_only = ref false 30let error_occurred = ref false 31let raw_dependencies = ref false 32let sort_files = ref false 33let all_dependencies = ref false 34let one_line = ref false 35let files = ref [] 36let allow_approximation = ref false 37let map_files = ref [] 38let module_map = ref StringMap.empty 39let debug = ref false 40 41(* Fix path to use '/' as directory separator instead of '\'. 42 Only under Windows. *) 43 44let fix_slash s = 45 if Sys.os_type = "Unix" then s else begin 46 String.map (function '\\' -> '/' | c -> c) s 47 end 48 49(* Since we reinitialize load_path after reading OCAMLCOMP, 50 we must use a cache instead of calling Sys.readdir too often. *) 51let dirs = ref StringMap.empty 52let readdir dir = 53 try 54 StringMap.find dir !dirs 55 with Not_found -> 56 let contents = 57 try 58 Sys.readdir dir 59 with Sys_error msg -> 60 Format.fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg; 61 error_occurred := true; 62 [||] 63 in 64 dirs := StringMap.add dir contents !dirs; 65 contents 66 67let add_to_list li s = 68 li := s :: !li 69 70let add_to_load_path dir = 71 try 72 let dir = Misc.expand_directory Config.standard_library dir in 73 let contents = readdir dir in 74 add_to_list load_path (dir, contents) 75 with Sys_error msg -> 76 Format.fprintf Format.err_formatter "@[Bad -I option: %s@]@." msg; 77 error_occurred := true 78 79let add_to_synonym_list synonyms suffix = 80 if (String.length suffix) > 1 && suffix.[0] = '.' then 81 add_to_list synonyms suffix 82 else begin 83 Format.fprintf Format.err_formatter "@[Bad suffix: '%s'@]@." suffix; 84 error_occurred := true 85 end 86 87(* Find file 'name' (capitalized) in search path *) 88let find_file name = 89 let uname = String.uncapitalize_ascii name in 90 let rec find_in_array a pos = 91 if pos >= Array.length a then None else begin 92 let s = a.(pos) in 93 if s = name || s = uname then Some s else find_in_array a (pos + 1) 94 end in 95 let rec find_in_path = function 96 [] -> raise Not_found 97 | (dir, contents) :: rem -> 98 match find_in_array contents 0 with 99 Some truename -> 100 if dir = "." then truename else Filename.concat dir truename 101 | None -> find_in_path rem in 102 find_in_path !load_path 103 104let rec find_file_in_list = function 105 [] -> raise Not_found 106| x :: rem -> try find_file x with Not_found -> find_file_in_list rem 107 108 109let find_dependency target_kind modname (byt_deps, opt_deps) = 110 try 111 let candidates = List.map ((^) modname) !mli_synonyms in 112 let filename = find_file_in_list candidates in 113 let basename = Filename.chop_extension filename in 114 let cmi_file = basename ^ ".cmi" in 115 let cmx_file = basename ^ ".cmx" in 116 let ml_exists = 117 List.exists (fun ext -> Sys.file_exists (basename ^ ext)) !ml_synonyms in 118 let new_opt_dep = 119 if !all_dependencies then 120 match target_kind with 121 | MLI -> [ cmi_file ] 122 | ML -> 123 cmi_file :: (if ml_exists then [ cmx_file ] else []) 124 else 125 (* this is a make-specific hack that makes .cmx to be a 'proxy' 126 target that would force the dependency on .cmi via transitivity *) 127 if ml_exists 128 then [ cmx_file ] 129 else [ cmi_file ] 130 in 131 ( cmi_file :: byt_deps, new_opt_dep @ opt_deps) 132 with Not_found -> 133 try 134 (* "just .ml" case *) 135 let candidates = List.map ((^) modname) !ml_synonyms in 136 let filename = find_file_in_list candidates in 137 let basename = Filename.chop_extension filename in 138 let cmi_file = basename ^ ".cmi" in 139 let cmx_file = basename ^ ".cmx" in 140 let bytenames = 141 if !all_dependencies then 142 match target_kind with 143 | MLI -> [ cmi_file ] 144 | ML -> [ cmi_file ] 145 else 146 (* again, make-specific hack *) 147 [basename ^ (if !native_only then ".cmx" else ".cmo")] in 148 let optnames = 149 if !all_dependencies 150 then match target_kind with 151 | MLI -> [ cmi_file ] 152 | ML -> [ cmi_file; cmx_file ] 153 else [ cmx_file ] 154 in 155 (bytenames @ byt_deps, optnames @ opt_deps) 156 with Not_found -> 157 (byt_deps, opt_deps) 158 159let (depends_on, escaped_eol) = (":", " \\\n ") 160 161let print_filename s = 162 let s = if !Clflags.force_slash then fix_slash s else s in 163 if not (String.contains s ' ') then begin 164 print_string s; 165 end else begin 166 let rec count n i = 167 if i >= String.length s then n 168 else if s.[i] = ' ' then count (n+1) (i+1) 169 else count n (i+1) 170 in 171 let spaces = count 0 0 in 172 let result = Bytes.create (String.length s + spaces) in 173 let rec loop i j = 174 if i >= String.length s then () 175 else if s.[i] = ' ' then begin 176 Bytes.set result j '\\'; 177 Bytes.set result (j+1) ' '; 178 loop (i+1) (j+2); 179 end else begin 180 Bytes.set result j s.[i]; 181 loop (i+1) (j+1); 182 end 183 in 184 loop 0 0; 185 print_bytes result; 186 end 187;; 188 189let print_dependencies target_files deps = 190 let rec print_items pos = function 191 [] -> print_string "\n" 192 | dep :: rem -> 193 if !one_line || (pos + 1 + String.length dep <= 77) then begin 194 if pos <> 0 then print_string " "; print_filename dep; 195 print_items (pos + String.length dep + 1) rem 196 end else begin 197 print_string escaped_eol; print_filename dep; 198 print_items (String.length dep + 4) rem 199 end in 200 print_items 0 (target_files @ [depends_on] @ deps) 201 202let print_raw_dependencies source_file deps = 203 print_filename source_file; print_string depends_on; 204 Depend.StringSet.iter 205 (fun dep -> 206 (* filter out "*predef*" *) 207 if (String.length dep > 0) 208 && (match dep.[0] with 209 | 'A'..'Z' | '\128'..'\255' -> true 210 | _ -> false) then 211 begin 212 print_char ' '; 213 print_string dep 214 end) 215 deps; 216 print_char '\n' 217 218 219(* Process one file *) 220 221let report_err exn = 222 error_occurred := true; 223 match exn with 224 | Sys_error msg -> 225 Format.fprintf Format.err_formatter "@[I/O error:@ %s@]@." msg 226 | x -> 227 match Location.error_of_exn x with 228 | Some err -> 229 Format.fprintf Format.err_formatter "@[%a@]@." 230 Location.report_error err 231 | None -> raise x 232 233let tool_name = "ocamldep" 234 235let rec lexical_approximation lexbuf = 236 (* Approximation when a file can't be parsed. 237 Heuristic: 238 - first component of any path starting with an uppercase character is a 239 dependency. 240 - always skip the token after a dot, unless dot is preceded by a 241 lower-case identifier 242 - always skip the token after a backquote 243 *) 244 try 245 let rec process after_lident lexbuf = 246 match Lexer.token lexbuf with 247 | Parser.UIDENT name -> 248 Depend.free_structure_names := 249 Depend.StringSet.add name !Depend.free_structure_names; 250 process false lexbuf 251 | Parser.LIDENT _ -> process true lexbuf 252 | Parser.DOT when after_lident -> process false lexbuf 253 | Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf 254 | Parser.EOF -> () 255 | _ -> process false lexbuf 256 and skip_one lexbuf = 257 match Lexer.token lexbuf with 258 | Parser.DOT | Parser.BACKQUOTE -> skip_one lexbuf 259 | Parser.EOF -> () 260 | _ -> process false lexbuf 261 262 in 263 process false lexbuf 264 with Lexer.Error _ -> lexical_approximation lexbuf 265 266let read_and_approximate inputfile = 267 error_occurred := false; 268 Depend.free_structure_names := Depend.StringSet.empty; 269 let ic = open_in_bin inputfile in 270 try 271 seek_in ic 0; 272 Location.input_name := inputfile; 273 let lexbuf = Lexing.from_channel ic in 274 Location.init lexbuf inputfile; 275 lexical_approximation lexbuf; 276 close_in ic; 277 !Depend.free_structure_names 278 with exn -> 279 close_in ic; 280 report_err exn; 281 !Depend.free_structure_names 282 283let read_parse_and_extract parse_function extract_function def ast_kind 284 source_file = 285 Depend.free_structure_names := Depend.StringSet.empty; 286 try 287 let input_file = Pparse.preprocess source_file in 288 begin try 289 let ast = 290 Pparse.file ~tool_name Format.err_formatter 291 input_file parse_function ast_kind 292 in 293 let bound_vars = 294 List.fold_left 295 (fun bv modname -> 296 Depend.open_module bv (Longident.parse modname)) 297 !module_map ((* PR#7248 *) List.rev !Clflags.open_modules) 298 in 299 let r = extract_function bound_vars ast in 300 Pparse.remove_preprocessed input_file; 301 (!Depend.free_structure_names, r) 302 with x -> 303 Pparse.remove_preprocessed input_file; 304 raise x 305 end 306 with x -> begin 307 report_err x; 308 if not !allow_approximation 309 then (Depend.StringSet.empty, def) 310 else (read_and_approximate source_file, def) 311 end 312 313let print_ml_dependencies source_file extracted_deps = 314 let basename = Filename.chop_extension source_file in 315 let byte_targets = [ basename ^ ".cmo" ] in 316 let native_targets = 317 if !all_dependencies 318 then [ basename ^ ".cmx"; basename ^ ".o" ] 319 else [ basename ^ ".cmx" ] in 320 let init_deps = if !all_dependencies then [source_file] else [] in 321 let cmi_name = basename ^ ".cmi" in 322 let init_deps, extra_targets = 323 if List.exists (fun ext -> Sys.file_exists (basename ^ ext)) 324 !mli_synonyms 325 then (cmi_name :: init_deps, cmi_name :: init_deps), [] 326 else (init_deps, init_deps), 327 (if !all_dependencies then [cmi_name] else []) 328 in 329 let (byt_deps, native_deps) = 330 Depend.StringSet.fold (find_dependency ML) 331 extracted_deps init_deps in 332 if not !native_only then 333 print_dependencies (byte_targets @ extra_targets) byt_deps; 334 if not !bytecode_only then 335 print_dependencies (native_targets @ extra_targets) native_deps 336 337let print_mli_dependencies source_file extracted_deps = 338 let basename = Filename.chop_extension source_file in 339 let (byt_deps, _opt_deps) = 340 Depend.StringSet.fold (find_dependency MLI) 341 extracted_deps ([], []) in 342 print_dependencies [basename ^ ".cmi"] byt_deps 343 344let print_file_dependencies (source_file, kind, extracted_deps) = 345 if !raw_dependencies then begin 346 print_raw_dependencies source_file extracted_deps 347 end else 348 match kind with 349 | ML -> print_ml_dependencies source_file extracted_deps 350 | MLI -> print_mli_dependencies source_file extracted_deps 351 352 353let ml_file_dependencies source_file = 354 let parse_use_file_as_impl lexbuf = 355 let f x = 356 match x with 357 | Ptop_def s -> s 358 | Ptop_dir _ -> [] 359 in 360 List.flatten (List.map f (Parse.use_file lexbuf)) 361 in 362 let (extracted_deps, ()) = 363 read_parse_and_extract parse_use_file_as_impl Depend.add_implementation () 364 Pparse.Structure source_file 365 in 366 files := (source_file, ML, extracted_deps) :: !files 367 368let mli_file_dependencies source_file = 369 let (extracted_deps, ()) = 370 read_parse_and_extract Parse.interface Depend.add_signature () 371 Pparse.Signature source_file 372 in 373 files := (source_file, MLI, extracted_deps) :: !files 374 375let process_file_as process_fun def source_file = 376 Compenv.readenv ppf (Before_compile source_file); 377 load_path := []; 378 List.iter add_to_load_path ( 379 (!Compenv.last_include_dirs @ 380 !Clflags.include_dirs @ 381 !Compenv.first_include_dirs 382 )); 383 Location.input_name := source_file; 384 try 385 if Sys.file_exists source_file then process_fun source_file else def 386 with x -> report_err x; def 387 388let process_file source_file ~ml_file ~mli_file ~def = 389 if List.exists (Filename.check_suffix source_file) !ml_synonyms then 390 process_file_as ml_file def source_file 391 else if List.exists (Filename.check_suffix source_file) !mli_synonyms then 392 process_file_as mli_file def source_file 393 else def 394 395let file_dependencies source_file = 396 process_file source_file ~def:() 397 ~ml_file:ml_file_dependencies 398 ~mli_file:mli_file_dependencies 399 400let file_dependencies_as kind = 401 match kind with 402 | ML -> process_file_as ml_file_dependencies () 403 | MLI -> process_file_as mli_file_dependencies () 404 405let sort_files_by_dependencies files = 406 let h = Hashtbl.create 31 in 407 let worklist = ref [] in 408 409(* Init Hashtbl with all defined modules *) 410 let files = List.map (fun (file, file_kind, deps) -> 411 let modname = 412 String.capitalize_ascii (Filename.chop_extension (Filename.basename file)) 413 in 414 let key = (modname, file_kind) in 415 let new_deps = ref [] in 416 Hashtbl.add h key (file, new_deps); 417 worklist := key :: !worklist; 418 (modname, file_kind, deps, new_deps) 419 ) files in 420 421(* Keep only dependencies to defined modules *) 422 List.iter (fun (modname, file_kind, deps, new_deps) -> 423 let add_dep modname kind = 424 new_deps := (modname, kind) :: !new_deps; 425 in 426 Depend.StringSet.iter (fun modname -> 427 match file_kind with 428 ML -> (* ML depends both on ML and MLI *) 429 if Hashtbl.mem h (modname, MLI) then add_dep modname MLI; 430 if Hashtbl.mem h (modname, ML) then add_dep modname ML 431 | MLI -> (* MLI depends on MLI if exists, or ML otherwise *) 432 if Hashtbl.mem h (modname, MLI) then add_dep modname MLI 433 else if Hashtbl.mem h (modname, ML) then add_dep modname ML 434 ) deps; 435 if file_kind = ML then (* add dep from .ml to .mli *) 436 if Hashtbl.mem h (modname, MLI) then add_dep modname MLI 437 ) files; 438 439(* Print and remove all files with no remaining dependency. Iterate 440 until all files have been removed (worklist is empty) or 441 no file was removed during a turn (cycle). *) 442 let printed = ref true in 443 while !printed && !worklist <> [] do 444 let files = !worklist in 445 worklist := []; 446 printed := false; 447 List.iter (fun key -> 448 let (file, deps) = Hashtbl.find h key in 449 let set = !deps in 450 deps := []; 451 List.iter (fun key -> 452 if Hashtbl.mem h key then deps := key :: !deps 453 ) set; 454 if !deps = [] then begin 455 printed := true; 456 Printf.printf "%s " file; 457 Hashtbl.remove h key; 458 end else 459 worklist := key :: !worklist 460 ) files 461 done; 462 463 if !worklist <> [] then begin 464 Format.fprintf Format.err_formatter 465 "@[Warning: cycle in dependencies. End of list is not sorted.@]@."; 466 let sorted_deps = 467 let li = ref [] in 468 Hashtbl.iter (fun _ file_deps -> li := file_deps :: !li) h; 469 List.sort (fun (file1, _) (file2, _) -> String.compare file1 file2) !li 470 in 471 List.iter (fun (file, deps) -> 472 Format.fprintf Format.err_formatter "\t@[%s: " file; 473 List.iter (fun (modname, kind) -> 474 Format.fprintf Format.err_formatter "%s.%s " modname 475 (if kind=ML then "ml" else "mli"); 476 ) !deps; 477 Format.fprintf Format.err_formatter "@]@."; 478 Printf.printf "%s " file) sorted_deps; 479 end; 480 Printf.printf "\n%!"; 481 () 482 483(* Map *) 484 485let rec dump_map s0 ppf m = 486 let open Depend in 487 StringMap.iter 488 (fun key (Node(s1,m')) -> 489 let s = StringSet.diff s1 s0 in 490 if StringSet.is_empty s then 491 Format.fprintf ppf "@ @[<hv2>module %s : sig%a@;<1 -2>end@]" 492 key (dump_map (StringSet.union s1 s0)) m' 493 else 494 Format.fprintf ppf "@ module %s = %s" key (StringSet.choose s)) 495 m 496 497let process_ml_map = 498 read_parse_and_extract Parse.implementation Depend.add_implementation_binding 499 StringMap.empty Pparse.Structure 500 501let process_mli_map = 502 read_parse_and_extract Parse.interface Depend.add_signature_binding 503 StringMap.empty Pparse.Signature 504 505let parse_map fname = 506 map_files := fname :: !map_files ; 507 let old_transp = !Clflags.transparent_modules in 508 Clflags.transparent_modules := true; 509 let (deps, m) = 510 process_file fname ~def:(Depend.StringSet.empty, StringMap.empty) 511 ~ml_file:process_ml_map 512 ~mli_file:process_mli_map 513 in 514 Clflags.transparent_modules := old_transp; 515 let modname = 516 String.capitalize_ascii 517 (Filename.basename (Filename.chop_extension fname)) in 518 if StringMap.is_empty m then 519 report_err (Failure (fname ^ " : empty map file or parse error")); 520 let mm = Depend.make_node m in 521 if !debug then begin 522 Format.printf "@[<v>%s:%t%a@]@." fname 523 (fun ppf -> Depend.StringSet.iter (Format.fprintf ppf " %s") deps) 524 (dump_map deps) (StringMap.add modname mm StringMap.empty) 525 end; 526 let mm = Depend.(weaken_map (StringSet.singleton modname) mm) in 527 module_map := StringMap.add modname mm !module_map 528;; 529 530 531(* Entry point *) 532 533let usage = "Usage: ocamldep [options] <source files>\nOptions are:" 534 535let print_version () = 536 Format.printf "ocamldep, version %s@." Sys.ocaml_version; 537 exit 0; 538;; 539 540let print_version_num () = 541 Format.printf "%s@." Sys.ocaml_version; 542 exit 0; 543;; 544 545let _ = 546 Clflags.classic := false; 547 add_to_list first_include_dirs Filename.current_dir_name; 548 Compenv.readenv ppf Before_args; 549 Clflags.add_arguments __LOC__ [ 550 "-absname", Arg.Set Location.absname, 551 " Show absolute filenames in error messages"; 552 "-all", Arg.Set all_dependencies, 553 " Generate dependencies on all files"; 554 "-allow-approx", Arg.Set allow_approximation, 555 " Fallback to a lexer-based approximation on unparseable files"; 556 "-as-map", Arg.Set Clflags.transparent_modules, 557 " Omit delayed dependencies for module aliases (-no-alias-deps -w -49)"; 558 (* "compiler uses -no-alias-deps, and no module is coerced"; *) 559 "-debug-map", Arg.Set debug, 560 " Dump the delayed dependency map for each map file"; 561 "-I", Arg.String (add_to_list Clflags.include_dirs), 562 "<dir> Add <dir> to the list of include directories"; 563 "-impl", Arg.String (file_dependencies_as ML), 564 "<f> Process <f> as a .ml file"; 565 "-intf", Arg.String (file_dependencies_as MLI), 566 "<f> Process <f> as a .mli file"; 567 "-map", Arg.String parse_map, 568 "<f> Read <f> and propagate delayed dependencies to following files"; 569 "-ml-synonym", Arg.String(add_to_synonym_list ml_synonyms), 570 "<e> Consider <e> as a synonym of the .ml extension"; 571 "-mli-synonym", Arg.String(add_to_synonym_list mli_synonyms), 572 "<e> Consider <e> as a synonym of the .mli extension"; 573 "-modules", Arg.Set raw_dependencies, 574 " Print module dependencies in raw form (not suitable for make)"; 575 "-native", Arg.Set native_only, 576 " Generate dependencies for native-code only (no .cmo files)"; 577 "-bytecode", Arg.Set bytecode_only, 578 " Generate dependencies for bytecode-code only (no .cmx files)"; 579 "-one-line", Arg.Set one_line, 580 " Output one line per file, regardless of the length"; 581 "-open", Arg.String (add_to_list Clflags.open_modules), 582 "<module> Opens the module <module> before typing"; 583 "-plugin", Arg.String Compplugin.load, 584 "<plugin> Load dynamic plugin <plugin>"; 585 "-pp", Arg.String(fun s -> Clflags.preprocessor := Some s), 586 "<cmd> Pipe sources through preprocessor <cmd>"; 587 "-ppx", Arg.String (add_to_list first_ppx), 588 "<cmd> Pipe abstract syntax trees through preprocessor <cmd>"; 589 "-slash", Arg.Set Clflags.force_slash, 590 " (Windows) Use forward slash / instead of backslash \\ in file paths"; 591 "-sort", Arg.Set sort_files, 592 " Sort files according to their dependencies"; 593 "-version", Arg.Unit print_version, 594 " Print version and exit"; 595 "-vnum", Arg.Unit print_version_num, 596 " Print version number and exit"; 597 "-args", Arg.Expand Arg.read_arg, 598 "<file> Read additional newline separated command line arguments \n\ 599 \ from <file>"; 600 "-args0", Arg.Expand Arg.read_arg0, 601 "<file> Read additional NUL separated command line arguments from \n\ 602 \ <file>" 603 ]; 604 Clflags.parse_arguments file_dependencies usage; 605 Compenv.readenv ppf Before_link; 606 if !sort_files then sort_files_by_dependencies !files 607 else List.iter print_file_dependencies (List.sort compare !files); 608 exit (if !error_occurred then 2 else 0) 609