ocamake.ml 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661
  1. (* ************************************************************************ *)
  2. (* *)
  3. (* OCAMAKE - OCaml Automatic compilation *)
  4. (* (c)2002 Nicolas Cannasse *)
  5. (* (c)2002 Motion-Twin *)
  6. (* *)
  7. (* Last version : http://tech.motion-twin.com *)
  8. (* *)
  9. (* ************************************************************************ *)
  10. open Unix
  11. open Printf
  12. open Arg
  13. type compile_mode =
  14. | CM_DEFAULT
  15. | CM_BYTE
  16. | CM_OPT
  17. type file_ext =
  18. | ML | MLI | MLL | MLY
  19. | CMO | CMX | CMA | CMXA
  20. | DLL | SO | EXE | LIB
  21. | CMI | O | OBJ | A
  22. type file = {
  23. name : string;
  24. ext : file_ext;
  25. target : string;
  26. deps : string list;
  27. }
  28. (* ************************************************************************ *)
  29. (* GLOBALS *)
  30. let verbose = ref false (* print command calls in verbose mode *)
  31. let project_name = ref None (* for VC++ DSP *)
  32. let error_process = ref false (* VC++ error message processing *)
  33. let chars_process = ref false (* replace chars range in errors by file data *)
  34. (* ************************************************************************ *)
  35. (* USEFUL FUNCTIONS *)
  36. let if_some f opt def =
  37. match opt with
  38. | None -> def
  39. | Some v -> f v
  40. let print str = print_endline str; flush Pervasives.stdout
  41. let (???) file =
  42. failwith ("Don't know what to do with file " ^ file)
  43. let str_suffix = function
  44. | ML -> "ml" | MLI -> "mli" | MLL -> "mll" | MLY -> "mly" | CMO -> "cmo"
  45. | CMX -> "cmx" | CMA -> "cma" | CMXA -> "cmxa" | DLL -> "dll" | SO -> "so"
  46. | EXE -> "exe" | CMI -> "cmi" | O -> "o" | A -> "a" | OBJ -> "obj"
  47. | LIB -> "lib"
  48. let unescape file =
  49. let l = String.length file in
  50. if l >= 2 && file.[0] = '"' && file.[l-1] = '"' then String.sub file 1 (l-2) else file
  51. let extension file =
  52. let rsplit_char str ch =
  53. let p = String.rindex str ch in
  54. let len = String.length str in
  55. (String.sub str 0 p, String.sub str (p + 1) (len - p - 1))
  56. in
  57. let file = unescape file in
  58. let s = try snd(rsplit_char file '.') with Not_found -> "" in
  59. String.uppercase s
  60. let (+!) file suff =
  61. let base = Filename.chop_extension file in
  62. base ^ "." ^ str_suffix suff
  63. let filter_all_in func ic =
  64. let rec treat acc =
  65. try
  66. match func (input_line ic) with
  67. | None -> treat acc
  68. | Some data -> treat (data :: acc)
  69. with
  70. End_of_file -> close_in ic; acc
  71. in
  72. List.rev (treat [])
  73. let rec remove_duplicates = function
  74. | [] -> []
  75. | item :: q when List.exists ((=) item) q -> remove_duplicates q
  76. | item :: q -> item :: remove_duplicates q
  77. let file_time fname =
  78. try (Unix.stat fname).st_mtime with Unix_error _ -> 0.
  79. let flatten = String.concat " "
  80. let escape str =
  81. try
  82. ignore(String.index str ' ');
  83. "\"" ^ str ^ "\"";
  84. with Not_found -> str
  85. let delete_file file =
  86. try Sys.remove file with Sys_error _ -> ()
  87. let check_existence (ext,name) =
  88. match ext with
  89. | ML | MLI ->
  90. if not (Sys.file_exists name) then
  91. failwith ("No such file : "^(escape name))
  92. | _ -> ()
  93. (* Others files can be found in Ocaml stdlib or
  94. user -I paths *)
  95. exception Found_pos of int
  96. let print_errors output msg =
  97. let split str sep =
  98. let find_sub str sub =
  99. let len = String.length sub in
  100. try
  101. for i = 0 to String.length str - len do
  102. if String.sub str i len = sub then raise (Found_pos i);
  103. done;
  104. raise Not_found
  105. with Found_pos i -> i
  106. in
  107. let p = find_sub str sep in
  108. let len = String.length sep in
  109. let slen = String.length str in
  110. (String.sub str 0 p, String.sub str (p + len) (slen - p - len))
  111. in
  112. let process_chars file chars line =
  113. let cmin, cmax = split chars "-" in
  114. let cmin, cmax = int_of_string cmin, int_of_string cmax in
  115. if cmax > cmin then begin
  116. let f = open_in file in
  117. for i = 1 to line-1 do ignore(input_line f) done;
  118. seek_in f ((pos_in f)+cmin);
  119. let s = String.create (cmax - cmin) in
  120. ignore(input f s 0 (cmax - cmin));
  121. prerr_endline (try
  122. (String.sub s 0 (String.index s '\n'))^"..."
  123. with
  124. Not_found -> s);
  125. end
  126. in
  127. let printer =
  128. (match !error_process , !chars_process with
  129. | true , _ -> (function line ->
  130. try
  131. let data, chars = split line ", characters " in
  132. let data, lnumber = split data "\", line " in
  133. let _, file = split data "File \"" in
  134. prerr_string (file ^ "(" ^ lnumber ^ ") : ");
  135. let chars, _ = split chars ":" in
  136. if !chars_process then
  137. (try process_chars file chars (int_of_string lnumber) with _ -> raise Not_found)
  138. with
  139. Not_found ->
  140. prerr_endline line)
  141. | false , true -> (function line ->
  142. try
  143. let edata, chars = split line ", characters " in
  144. let data, lnumber = split edata "\", line " in
  145. let _, file = split data "File \"" in
  146. let chars, _ = split chars ":" in
  147. prerr_string (edata^" : ");
  148. if !chars_process then
  149. process_chars file chars (int_of_string lnumber);
  150. with
  151. Not_found ->
  152. prerr_endline line)
  153. | false , false ->
  154. prerr_endline)
  155. in
  156. List.iter printer output;
  157. failwith msg
  158. let exec ?(stdout=false) ?(outfirst=false) cmd errmsg =
  159. if !verbose then print cmd;
  160. let pout, pin, perr = open_process_full cmd (Unix.environment()) in
  161. let read = filter_all_in (fun s -> Some s) in
  162. let data, edata =
  163. (* this is made to prevent the program lock when one
  164. buffer is full and the process is waiting for us
  165. to read it before exiting... while we're reading
  166. the other output buffer ! *)
  167. (if outfirst then
  168. let d = read pout in
  169. let ed = read perr in
  170. d,ed
  171. else
  172. let ed = read perr in
  173. let d = read pout in
  174. d,ed) in
  175. match close_process_full (pout, pin, perr) with
  176. | WEXITED 0 -> data,edata
  177. | WEXITED exitcode -> print_errors (if stdout then edata @ data else edata) errmsg
  178. | _ -> failwith "Build aborted by signal"
  179. (* ************************************************************************ *)
  180. (* DEPENDENCIES *)
  181. let line_regexp = Str.regexp "^\\([0-9A-Za-z:_\\./\\\\-]+\\.cm[oi]\\):\\( .*\\)$"
  182. let dep_regexp = Str.regexp " \\([0-9A-Za-z:_\\./\\\\-]+\\.cm[oi]\\)"
  183. let build_graph opt paramlist files =
  184. let srcfiles = List.filter (fun (e,_) ->
  185. match e with
  186. | ML | MLI -> true
  187. | _ -> false) files in
  188. let get_name (_,f) = escape f in
  189. let file_names = flatten (List.map get_name srcfiles) in
  190. let params = flatten paramlist in
  191. let command = sprintf "ocamldep %s %s" params file_names in
  192. let output,_ = exec command "Failed to make dependencies" ~outfirst:true in
  193. let data = String.concat "\n" output in
  194. let data = Str.global_replace (Str.regexp "\\\\\r\n") "" data in (* win *)
  195. let data = Str.global_replace (Str.regexp "\\\\\n") "" data in (* unix *)
  196. let rec get_deps data p =
  197. try
  198. let newp = Str.search_forward dep_regexp data p in
  199. let file = Str.matched_group 1 data in
  200. if opt && extension file = "CMO" then
  201. (file +! CMX)::(get_deps data (newp+1))
  202. else
  203. file::(get_deps data (newp+1))
  204. with
  205. Not_found -> []
  206. in
  207. let rec get_lines p =
  208. try
  209. let newp = Str.search_forward line_regexp data p in
  210. let file = Str.matched_group 1 data in
  211. let lines = get_deps (Str.matched_group 2 data) 0 in
  212. (Filename.basename file,lines)::(get_lines (newp+1))
  213. with
  214. Not_found -> []
  215. in
  216. let lines = get_lines 0 in
  217. let init_infos (ext,fname) =
  218. let deptarget = Filename.basename (match ext with
  219. | ML -> fname +! CMO
  220. | MLI -> fname +! CMI
  221. | _ -> fname) in
  222. let target = (match ext with
  223. | ML -> fname +! (if opt then CMX else CMO)
  224. | MLI -> fname +! CMI
  225. | _ -> fname) in
  226. {
  227. name = fname;
  228. ext = ext;
  229. target = target;
  230. deps =
  231. (try
  232. snd (List.find (fun (n,_) -> n = deptarget) lines)
  233. with
  234. Not_found -> []);
  235. }
  236. in
  237. let deps = List.map init_infos files in
  238. match !verbose with
  239. | false -> deps
  240. | true ->
  241. let print_dep d =
  242. let dl = String.concat " " (List.map Filename.basename d.deps) in
  243. printf "%s: %s\n" (Filename.basename d.target) dl;
  244. in
  245. List.iter print_dep deps;
  246. deps
  247. let rec graph_topological_sort all g priority acc =
  248. let has_dep where dep =
  249. List.exists (fun f -> Filename.basename f.target =
  250. Filename.basename dep) where
  251. in
  252. let modified a b = (file_time a) < (file_time b) in
  253. let is_free file = not(List.exists (has_dep g) file.deps) in
  254. let rec has_priority = function
  255. | [] -> raise Not_found
  256. | x :: l ->
  257. try
  258. List.find (fun f -> x = (Filename.basename f.name)) g
  259. with
  260. Not_found -> has_priority l
  261. in
  262. let to_build file =
  263. all || (* rebuild all *)
  264. List.exists (has_dep acc) file.deps || (* a dep is rebuild *)
  265. List.exists (modified file.target) file.deps || (* dep modified *)
  266. (file_time file.target) < (file_time file.name) (* is modified *)
  267. in
  268. match g with
  269. | [] -> acc
  270. | _ ->
  271. let free,g = List.partition is_free g in
  272. match free with
  273. | [] ->
  274. (try
  275. let free = has_priority priority in
  276. let g = List.filter ((<>) free) g in
  277. if to_build free then
  278. graph_topological_sort all g priority (acc@[free])
  279. else
  280. graph_topological_sort all g priority acc;
  281. with Not_found ->
  282. List.iter (fun f -> prerr_endline f.name) g;
  283. failwith "Cycle detected in file dependencies !")
  284. | _ ->
  285. let to_build = List.filter to_build free in
  286. graph_topological_sort all g priority (acc@to_build)
  287. (* ************************************************************************ *)
  288. (* COMPILATION *)
  289. let compile ?(precomp=false) opt paramlist f =
  290. try
  291. let command = (match f.ext with
  292. | ML | MLI ->
  293. let params = flatten paramlist in
  294. let compiler = (if opt then "ocamlopt" else "ocamlc") in
  295. sprintf "%s -c %s %s" compiler params (escape f.name)
  296. | MLL when precomp -> "ocamllex " ^ (escape f.name)
  297. | MLY when precomp -> "ocamlyacc " ^ (escape f.name)
  298. | _ -> raise Exit) in
  299. print (Filename.basename (unescape f.name));
  300. let stdout,stderr = exec command "Build failed" in
  301. try
  302. print_errors (stderr@stdout) "";
  303. with
  304. Failure _ -> ()
  305. with
  306. Exit -> ()
  307. let pre_compile all (ext,name) =
  308. match ext with
  309. | MLL | MLY ->
  310. let time = file_time name in
  311. if time = 0. then failwith ("No such file : "^(escape name));
  312. if all || (file_time (name +! ML)) < time then
  313. compile ~precomp:true false [] {
  314. name = name;
  315. ext = ext;
  316. deps = [];
  317. target = "";
  318. }
  319. | _ -> () (* other files type does not need pre-compilation *)
  320. let clean_targets opt acc (ext,name) =
  321. match ext with
  322. | MLY ->
  323. (name +! ML) :: (name +! MLI) :: acc
  324. | MLL ->
  325. (name +! ML) :: acc
  326. | ML when opt ->
  327. (name +! (if Sys.os_type = "Win32" then OBJ else O)) :: (name +! CMX) :: (name +! CMI) :: acc
  328. | ML ->
  329. (name +! CMO) :: (name +! CMI) :: acc
  330. | MLI ->
  331. (name +! CMI) :: acc
  332. | _ ->
  333. acc
  334. (*
  335. In order to link, we need to order the CMO files.
  336. We currently have a ML/MLI dependency graph (in fact, tree) generated
  337. by ocamldep.
  338. To build the CMO list, we are reducing the dep-tree into one graph merging
  339. corresponding ML & MLI nodes. ML-ML edges are keeped, ML-MLI edges
  340. become ML-ML edges only if they do not create a cycle in the reduced
  341. graph.
  342. Then we sort the graph using topological ordering.
  343. *)
  344. let graph_reduce opt g =
  345. let ext = (if opt then CMX else CMO) in
  346. let rec path_exists g a b =
  347. if a = b then true else
  348. try
  349. let f = List.find (fun f -> f.target = a) g in
  350. List.exists (fun d -> path_exists g d b) f.deps
  351. with
  352. Not_found -> false
  353. in
  354. let rec deps_reduce f g = function
  355. | [] -> []
  356. | dep::deps ->
  357. match extension dep with
  358. | "CMI" when not(path_exists g (dep +! ext) f.target) ->
  359. (dep +! ext)::(deps_reduce f g deps)
  360. | "CMO" | "CMX" ->
  361. dep::(deps_reduce f g deps)
  362. | _ -> deps_reduce f g deps
  363. in
  364. let rec do_reduce g acc =
  365. match g with
  366. | [] -> acc
  367. | f::g' ->
  368. let f = { f with deps = deps_reduce f (g@acc) f.deps } in
  369. do_reduce g' (f::acc)
  370. in
  371. do_reduce g []
  372. let is_lib f = match f.ext with
  373. | CMA | CMXA | CMO | CMX | DLL | SO | LIB | A | O | OBJ -> true
  374. | _ -> false
  375. let link opt paramlist files priority output =
  376. print "Linking...";
  377. let sources = List.filter (fun f -> f.ext = ML) files in
  378. let libs = List.filter is_lib files in
  379. let sources = graph_topological_sort true (graph_reduce opt sources) priority [] in
  380. let lparams = flatten (List.map (fun f -> escape f.name) libs) in
  381. let sparams = flatten (List.map (fun f -> escape f.target) sources) in
  382. let params = flatten paramlist in
  383. let cc = (if opt then "ocamlopt" else "ocamlc") in
  384. let cmd = sprintf "%s %s %s %s -o %s" cc params lparams sparams output in
  385. ignore(exec ~stdout:true cmd "Linking failed")
  386. (* ************************************************************************ *)
  387. (* FILE PROCESSING *)
  388. let dsp_get_files dsp_file =
  389. let get_file line =
  390. if String.length line > 7 && String.sub line 0 7 = "SOURCE=" then
  391. Some (unescape (String.sub line 7 (String.length line-7)))
  392. else
  393. None
  394. in
  395. filter_all_in get_file (open_in dsp_file)
  396. let vcproj_get_files vcp_file =
  397. let get_file line =
  398. let len = String.length line in
  399. let p = ref 0 in
  400. while !p < len && (line.[!p] = ' ' || line.[!p] = '\t') do
  401. incr p;
  402. done;
  403. let line = String.sub line !p (len - !p) in
  404. if String.length line > 13 && String.sub line 0 13 = "RelativePath=" then begin
  405. let str = String.sub line 13 (String.length line - 14) in
  406. Some (unescape str)
  407. end else
  408. None
  409. in
  410. filter_all_in get_file (open_in vcp_file)
  411. let rec list_files errors file =
  412. match extension file with
  413. | "ML" -> [(ML,file)]
  414. | "MLI" -> [(MLI,file)]
  415. | "VCPROJ" ->
  416. project_name := Some (Filename.basename file);
  417. error_process := true;
  418. chars_process := true;
  419. List.concat (List.map (list_files false) (vcproj_get_files file))
  420. | "DSP" ->
  421. project_name := Some (Filename.basename file);
  422. error_process := true;
  423. chars_process := true;
  424. List.concat (List.map (list_files false) (dsp_get_files file))
  425. | "CMA" -> [(CMA,file)]
  426. | "CMXA" -> [(CMXA,file)]
  427. | "CMX" -> [(CMX,file)]
  428. | "CMO" -> [(CMO,file)]
  429. | "DLL" -> [(DLL,file)]
  430. | "LIB" -> [(LIB,file)]
  431. | "A" -> [(A,file)]
  432. | "O" -> [(O,file)]
  433. | "OBJ" -> [(OBJ,file)]
  434. | "SO" -> [(SO,file)]
  435. | "MLY" -> [(MLY,file);(ML,file +! ML);(MLI,file +! MLI)]
  436. | "MLL" -> [(MLL,file);(ML,file +! ML)]
  437. | _ -> if errors then ??? file else []
  438. let rec get_compile_mode cm = function
  439. | [] -> cm
  440. | (ext,name)::files ->
  441. let error() = failwith "Mixed bytecode and native compilation files." in
  442. match ext with
  443. | ML | MLI | MLL | MLY | DLL | SO ->
  444. get_compile_mode cm files
  445. | CMA | CMO ->
  446. if cm = CM_OPT then error() else get_compile_mode CM_BYTE files
  447. | CMXA | CMX | A | O | OBJ | LIB ->
  448. if cm = CM_BYTE then error() else get_compile_mode CM_OPT files
  449. | EXE | CMI ->
  450. assert false
  451. let rec get_output_file islib cm =
  452. match !project_name,islib,cm with
  453. | None, _ , _ -> None
  454. | Some name,false,_ -> Some (name +! EXE)
  455. | Some name,true,CM_OPT -> Some (name +! CMXA)
  456. | Some name,true,_ -> Some (name +! CMA)
  457. (* ************************************************************************ *)
  458. (* MAIN *)
  459. ;;
  460. try
  461. let usage =
  462. "OCAMAKE v1.4 - Copyright (C)2002-2005 Nicolas Cannasse"
  463. ^"\r\nLast version : http://tech.motion-twin.com" in
  464. let compile_mode = ref CM_DEFAULT in
  465. let compile_cma = ref false in
  466. let do_clean = ref false in
  467. let gen_make = ref false in
  468. let rebuild_all = ref false in
  469. let output_file = ref None in
  470. let preprocessor = ref None in
  471. let argfiles = ref [] in
  472. let paths = ref [] in
  473. let cflags = ref [] in
  474. let lflags = ref [] in
  475. let remf = ref [] in
  476. let priority = ref [] in
  477. let arg_spec = [
  478. ("-all", Unit (fun () -> rebuild_all := true), ": rebuild all files");
  479. ("-o", String (fun f -> output_file := Some f), "<file> : set output");
  480. ("-a", Unit (fun () -> compile_cma := true), ": build a library");
  481. ("-opt", Unit (fun () -> compile_mode := CM_OPT), ": native compilation");
  482. ("-clean", Unit (fun () -> do_clean := true), ": delete intermediate files");
  483. ("-I", String (fun p -> paths := p::!paths), "<path> : additional path");
  484. ("-v", Unit (fun () -> verbose := true), ": turn on verbose mode");
  485. ("-n", String (fun f -> remf := f::!remf),"<file>: don't compile this file");
  486. ("-mak", Unit (fun () -> gen_make := true), ": generate Makefile");
  487. ("-lp", String (fun f -> lflags := f::!lflags), "<p> : linker parameter");
  488. ("-cp", String (fun f -> cflags := f::!cflags), "<p> : compiler parameter");
  489. ("-pp", String (fun c -> preprocessor := Some c), "<cmd> : preprocessor");
  490. ("-epp", Unit (fun() -> error_process := true), ": use MSVC error messages format");
  491. ("-cpp", Unit (fun() -> chars_process := true), ": convert characters range in errors to file expression");
  492. ("-g", Unit (fun () -> lflags := "-g"::!lflags; cflags := "-g"::!cflags), ": compile/link in debug mode");
  493. ("-P", String (fun f -> priority := f::!priority), ": give linking priority to a file when linking ordering failed");
  494. ] in
  495. Arg.parse arg_spec (fun arg -> argfiles := arg :: !argfiles) usage;
  496. let files = List.concat (List.map (list_files true) (List.rev !argfiles)) in
  497. let files = List.filter (fun (_,f) ->
  498. let name = Filename.basename f in
  499. not(List.exists (fun f -> Filename.basename f = name) !remf)) files in
  500. let compile_mode = get_compile_mode !compile_mode files in
  501. let output_file , compile_mode = (match !output_file with
  502. | None -> get_output_file !compile_cma compile_mode , compile_mode
  503. | Some file ->
  504. match extension file , compile_mode with
  505. | "CMA" , CM_OPT
  506. | "CMXA", CM_BYTE -> failwith "Mixed bytecode and native compilation files."
  507. | "CMA" , _ ->
  508. compile_cma := true;
  509. Some file , CM_BYTE
  510. | "CMXA" , _ ->
  511. compile_cma := true;
  512. Some file , CM_OPT
  513. | _ , _ ->
  514. Some file , compile_mode)
  515. in
  516. let opt = (compile_mode = CM_OPT) in
  517. if !compile_cma then lflags := "-a"::!lflags;
  518. match files with
  519. | [] -> Arg.usage arg_spec usage
  520. | _ ->
  521. let files = remove_duplicates files in
  522. let get_path (_,f) = "-I " ^ escape (Filename.dirname f) in
  523. let paths = List.map (fun p -> "-I " ^ (escape p)) !paths in
  524. let paths = remove_duplicates (paths@(List.map get_path files)) in
  525. let p4param = if_some (fun cmd -> "-pp " ^ (escape cmd)) !preprocessor "" in
  526. match !do_clean,!gen_make with
  527. | true,true ->
  528. failwith "Cannot have -mak & -clean at the same time"
  529. | false,false ->
  530. if_some delete_file output_file ();
  531. List.iter (pre_compile !rebuild_all) files;
  532. List.iter check_existence files;
  533. let g = build_graph opt (p4param::paths) files in
  534. let files = graph_topological_sort !rebuild_all g [] [] in
  535. List.iter (compile opt (!cflags @ p4param::paths)) files;
  536. if_some (link opt (!lflags @ paths) g (List.rev !priority)) output_file ();
  537. print "Done";
  538. | true,false ->
  539. print "Cleaning...";
  540. if_some delete_file output_file ();
  541. let to_clean = List.fold_left (clean_targets opt) [] files in
  542. List.iter delete_file to_clean;
  543. if opt && !compile_cma then
  544. if_some (fun f -> delete_file (f +! (if Sys.os_type = "Win32" then LIB else A))) output_file ();
  545. | false,true ->
  546. List.iter (pre_compile !rebuild_all) files;
  547. let g = build_graph opt (p4param::paths) files in
  548. let out = open_out "Makefile" in
  549. let fprint s = output_string out (s^"\n") in
  550. let genmak f =
  551. let ext = if opt then CMX else CMO in
  552. match f.ext with
  553. | MLL ->
  554. fprint ((f.name +! ext)^": "^(f.name +! ML)^"\n")
  555. | MLY ->
  556. fprint ((f.name +! ext)^": "^(f.name +! ML)^"\n");
  557. fprint ((f.name +! CMI)^": "^(f.name +! ML)^" "^(f.name +! MLI)^"\n")
  558. | _ when f.deps <> [] ->
  559. fprint (f.target^": "^(flatten f.deps)^"\n")
  560. | _ ->
  561. ()
  562. in
  563. let compiles = graph_topological_sort true g [] [] in
  564. let libs = List.filter is_lib compiles in
  565. let cmos = List.filter (fun f -> f.ext = ML) compiles in
  566. fprint "# Makefile generated by OCamake ";
  567. fprint "# http://tech.motion-twin.com";
  568. fprint ".SUFFIXES : .ml .mli .cmo .cmi .cmx .mll .mly";
  569. fprint "";
  570. fprint ("ALL_CFLAGS= $(CFLAGS) "^(flatten (!cflags @ p4param::paths)));
  571. fprint ("LIBS="^(flatten (List.map (fun f -> f.name) libs)));
  572. let targets = flatten (List.map (fun f -> f.target) cmos) in
  573. (match output_file with
  574. | None ->
  575. fprint "";
  576. fprint ("all: "^targets^"\n");
  577. | Some out ->
  578. fprint ("LFLAGS= -o "^out^" "^(flatten (!lflags @ paths)));
  579. fprint "";
  580. fprint ("all: "^out^"\n");
  581. fprint (out^": "^targets);
  582. (* I need to reuse the list of targets since $^ is for Make and $** for NMake *)
  583. fprint ("\t"^(if opt then "ocamlopt" else "ocamlc")^" $(LFLAGS) $(LIBS) "^targets^"\n"));
  584. List.iter genmak g;
  585. fprint "";
  586. fprint "clean:";
  587. let cleanfiles = flatten (List.fold_left (clean_targets opt) [] files) in
  588. if_some (fun o ->
  589. fprint ("\trm -f "^o);
  590. if opt && !compile_cma then fprint ("\trm -f "^(o +! LIB)^" "^(o +! A));
  591. ) output_file ();
  592. fprint ("\trm -f "^cleanfiles);
  593. fprint "";
  594. fprint "wclean:";
  595. if_some (fun o ->
  596. fprint ("\t-@del "^o^" 2>NUL");
  597. if opt && !compile_cma then fprint ("\t-@del "^(o +! LIB)^" "^(o +! A)^" 2>NUL");
  598. ) output_file ();
  599. fprint ("\t-@del "^cleanfiles^" 2>NUL");
  600. fprint "";
  601. fprint "# SUFFIXES";
  602. fprint ".ml.cmo:\n\tocamlc $(ALL_CFLAGS) -c $<\n";
  603. fprint ".ml.cmx:\n\tocamlopt $(ALL_CFLAGS) -c $<\n";
  604. fprint ".mli.cmi:\n\tocamlc $(ALL_CFLAGS) $<\n";
  605. fprint ".mll.ml:\n\tocamllex $<\n";
  606. fprint ".mly.ml:\n\tocamlyacc $<\n";
  607. close_out out
  608. with
  609. Failure msg ->
  610. Pervasives.flush Pervasives.stdout;
  611. prerr_endline msg;
  612. Pervasives.flush Pervasives.stderr;
  613. exit 1;
  614. (* ************************************************************************ *)