]> matita.cs.unibo.it Git - helm.git/blob - helm/software/matita/matitadep.ml
ok up to pr3
[helm.git] / helm / software / matita / matitadep.ml
1 (* Copyright (C) 2005, HELM Team.
2  * 
3  * This file is part of HELM, an Hypertextual, Electronic
4  * Library of Mathematics, developed at the Computer Science
5  * Department, University of Bologna, Italy.
6  * 
7  * HELM is free software; you can redistribute it and/or
8  * modify it under the terms of the GNU General Public License
9  * as published by the Free Software Foundation; either version 2
10  * of the License, or (at your option) any later version.
11  * 
12  * HELM is distributed in the hope that it will be useful,
13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with HELM; if not, write to the Free Software
19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
20  * MA  02111-1307, USA.
21  * 
22  * For details, see the HELM World-Wide-Web page,
23  * http://helm.cs.unibo.it/
24  *)
25
26 (* $Id$ *)
27
28 module GA = GrafiteAst 
29 module U = UriManager
30                 
31 let obj_file_of_baseuri writable baseuri = 
32   try 
33     LibraryMisc.obj_file_of_baseuri 
34      ~must_exist:true ~baseuri ~writable
35   with 
36   | Http_getter_types.Unresolvable_URI _ 
37   | Http_getter_types.Key_not_found _ ->  
38     LibraryMisc.obj_file_of_baseuri 
39      ~must_exist:false ~baseuri ~writable:true
40 ;;
41
42 let main () =
43   (* all are maps from "file" to "something" *)
44   let include_deps = Hashtbl.create (Array.length Sys.argv) in
45   let include_deps_dot = Hashtbl.create (Array.length Sys.argv) in
46   let baseuri_of = Hashtbl.create (Array.length Sys.argv) in
47   let baseuri_of_inv = Hashtbl.create (Array.length Sys.argv) in
48   let uri_deps = Hashtbl.create (Array.length Sys.argv) in
49   let buri alias = U.buri_of_uri (U.uri_of_string alias) in
50   let resolve alias current_buri =
51     let buri = buri alias in
52     if buri <> current_buri then Some buri else None in
53   MatitaInit.fill_registry ();
54   let do_dot = ref false in
55   MatitaInit.add_cmdline_spec 
56     ["-dot",Arg.Unit (fun () -> do_dot:=true),
57       "Generate deps for dot instead of make"];
58   MatitaInit.parse_cmdline ();
59   MatitaInit.load_configuration_file ();
60   let include_paths =
61    Helm_registry.get_list Helm_registry.string "matita.includes" in
62   let args = Helm_registry.get_list Helm_registry.string "matita.args" in
63   if args = [] then
64     begin
65       prerr_endline "At least one .ma file must be specified";
66       exit 1
67     end;
68   let ma_files = args in
69   List.iter
70    (fun ma_file -> 
71     let ic = open_in ma_file in
72       let istream = Ulexing.from_utf8_channel ic in
73       let dependencies = DependenciesParser.parse_dependencies istream in
74     close_in ic;
75     List.iter 
76      (function
77        | DependenciesParser.UriDep uri -> 
78           let uri = UriManager.string_of_uri uri in
79           if not (Http_getter_storage.is_legacy uri) then
80             Hashtbl.add uri_deps ma_file uri
81        | DependenciesParser.BaseuriDep uri -> 
82           let uri = Http_getter_misc.strip_trailing_slash uri in
83           Hashtbl.add baseuri_of ma_file uri;
84           Hashtbl.add baseuri_of_inv uri ma_file
85        | DependenciesParser.IncludeDep path -> 
86           try 
87             let baseuri,_ =
88               DependenciesParser.baseuri_of_script ~include_paths path in
89             if not (Http_getter_storage.is_legacy baseuri) then
90               (let moo_file = obj_file_of_baseuri false baseuri in
91               Hashtbl.add include_deps ma_file moo_file;
92               Hashtbl.add include_deps_dot ma_file baseuri)
93           with Sys_error _ -> 
94             HLog.warn 
95               ("Unable to find " ^ path ^ " that is included in " ^ ma_file))
96      dependencies)
97    ma_files;
98   Hashtbl.iter 
99     (fun file alias -> 
100       try 
101         let dep = resolve alias (Hashtbl.find baseuri_of file) in
102         match dep with 
103         | None -> ()
104         | Some u -> 
105            Hashtbl.add include_deps file (obj_file_of_baseuri false u)
106       with Not_found -> 
107         prerr_endline ("File "^ file^" has no baseuri. Use set baseuri");
108         exit 1)
109   uri_deps;
110   if !do_dot then
111     begin
112       let fmt = Format.formatter_of_out_channel stdout in 
113       GraphvizPp.Dot.header (* ~graph_attrs:["rankdir","LR"] *) fmt;
114       List.iter
115        (fun ma_file -> 
116         let deps = Hashtbl.find_all include_deps_dot ma_file in
117         let deps = 
118           HExtlib.filter_map 
119             (fun u -> 
120               try Some (Hashtbl.find baseuri_of_inv u) 
121               with Not_found -> None) 
122             deps 
123         in
124         let deps = List.fast_sort Pervasives.compare deps in
125         let deps = HExtlib.list_uniq deps in
126         GraphvizPp.Dot.node ma_file fmt;
127         List.iter (fun dep -> GraphvizPp.Dot.edge ma_file dep fmt) deps)
128        ma_files;
129       GraphvizPp.Dot.trailer fmt;
130       close_out stdout
131     end
132   else
133     begin
134       List.iter
135        (fun ma_file -> 
136          try
137           let deps = Hashtbl.find_all include_deps ma_file in
138           let deps = List.fast_sort Pervasives.compare deps in
139           let deps = HExtlib.list_uniq deps in
140           let deps = ma_file :: deps in
141           let baseuri = Hashtbl.find baseuri_of ma_file in
142           let moo = obj_file_of_baseuri true baseuri in
143           Printf.printf "%s: %s\n%s: %s\n%s: %s\n" 
144             moo (String.concat " " deps)
145             (Filename.basename(Pcre.replace ~pat:"ma$" ~templ:"mo" ma_file)) moo
146             (Pcre.replace ~pat:"ma$" ~templ:"mo" ma_file) moo
147          with Not_found -> 
148            prerr_endline ("File "^ma_file^" has no baseuri. Use set baseuri");
149            exit 1)
150         ma_files
151     end
152 ;;