1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
6(*                                                                        *)
7(*   Copyright 2001 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
16(** Main module for bytecode.
17@todo todo*)
18
19module M = Odoc_messages
20
21let print_DEBUG s = print_string s ; print_newline ()
22
23(* we check if we must load a module given on the command line *)
24let arg_list = Array.to_list Sys.argv
25let (plugins, paths) =
26  let rec iter (files, incs) = function
27      [] | _ :: [] -> (List.rev files, List.rev incs)
28    | "-g" :: file :: q when
29        ((Filename.check_suffix file "cmo") ||
30         (Filename.check_suffix file "cma") ||
31           (Filename.check_suffix file "cmxs")) ->
32      iter (file :: files, incs) q
33  | "-i" :: dir :: q ->
34      iter (files, dir :: incs) q
35  | _ :: q ->
36        iter (files, incs) q
37  in
38  iter ([], []) arg_list
39
40let _ = print_DEBUG "Fin analyse des arguments pour le dynamic load"
41
42(** Return the real name of the file to load,
43   searching it in the paths if it is
44   a simple name and not in the current directory. *)
45let get_real_filename name =
46   if Filename.basename name <> name then
47     name
48   else
49     (
50      let paths = Filename.current_dir_name :: paths @ [Odoc_config.custom_generators_path] in
51      try
52        let d = List.find
53            (fun d -> Sys.file_exists (Filename.concat d name))
54            paths
55        in
56        Filename.concat d name
57      with
58        Not_found ->
59          failwith (M.file_not_found_in_paths paths name)
60     )
61
62let load_plugin file =
63  let file = Dynlink.adapt_filename file in
64  Dynlink.allow_unsafe_modules true;
65  try
66    let real_file = get_real_filename file in
67    ignore(Dynlink.loadfile real_file)
68  with
69    Dynlink.Error e ->
70      prerr_endline (Odoc_messages.load_file_error file (Dynlink.error_message e)) ;
71      exit 1
72  | Not_found ->
73      prerr_endline (Odoc_messages.load_file_error file "Not_found");
74      exit 1
75  | Sys_error s
76  | Failure s ->
77      prerr_endline (Odoc_messages.load_file_error file s);
78      exit 1
79;;
80List.iter load_plugin plugins;;
81
82let () = print_DEBUG "Fin du chargement dynamique eventuel"
83
84let () = Odoc_args.parse ()
85
86
87let loaded_modules =
88  List.flatten
89    (List.map
90       (fun f ->
91         Odoc_info.verbose (Odoc_messages.loading f);
92         try
93           let l = Odoc_analyse.load_modules f in
94           Odoc_info.verbose Odoc_messages.ok;
95           l
96         with Failure s ->
97           prerr_endline s ;
98           incr Odoc_global.errors ;
99           []
100       )
101       !Odoc_global.load
102    )
103
104let modules = Odoc_analyse.analyse_files ~init: loaded_modules !Odoc_global.files
105
106let _ =
107  match !Odoc_global.dump with
108    None -> ()
109  | Some f ->
110      try Odoc_analyse.dump_modules f modules
111      with Failure s ->
112        prerr_endline s ;
113        incr Odoc_global.errors
114
115
116let _ =
117  match !Odoc_args.current_generator with
118    None ->
119      ()
120  | Some gen ->
121      let generator = Odoc_gen.get_minimal_generator gen in
122      Odoc_info.verbose Odoc_messages.generating_doc;
123      generator#generate modules;
124      Odoc_info.verbose Odoc_messages.ok
125
126let _ =
127  if !Odoc_global.errors > 0 then
128  (
129   prerr_endline (Odoc_messages.errors_occured !Odoc_global.errors) ;
130   exit 1
131  )
132  else
133    exit 0
134