(* * * Copyright (C) 2003-2004 Damien Pous * * YaM is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * YaM is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with YaM; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * *) open Printf let print_deps = ref false let print_cmds = ref true let debug_status = ref false let debug_deps = ref false let debug_build = ref false (* ---- Définition des unités de compilation ---- *) (* environnement / options *) type options_t = { ocaml: string ref; ocamlc: string ref; ocamlopt: string ref; ocamldep: string ref; ocamldoc: string ref; ocamlyacc: string ref; ocamllex: string ref; ocamlglade: string ref; ocaml_P4: string ref; ocaml_P4_opt: string ref; ocaml_Flags: string ref; ocaml_OptFlags: string ref; ocaml_ByteFlags: string ref; ocaml_LinkFlags: string ref; ocaml_ForPack: string ref; ocaml_Includes: string list ref; ocaml_ExtIncludes: string list ref; ocaml_ExtLibraries: string list ref; } (* options par défaut *) let getenv n d = try Sys.getenv n with Not_found -> d let options = ref { ocaml = ref (getenv "OCAML" "ocaml"); ocamlc = ref (getenv "OCAMLC" "ocamlc.opt"); ocamlopt = ref (getenv "OCAMLOPT" "ocamlopt.opt"); ocamldep = ref (getenv "OCAMLDEP" "ocamldep.opt"); ocamldoc = ref (getenv "OCAMLDOC" "ocamldoc.opt"); ocamlyacc = ref (getenv "OCAMLYACC" "ocamlyacc"); ocamllex = ref (getenv "OCAMLLEX" "ocamllex.opt"); ocamlglade = ref (getenv "OCAMLGLADE" "lablgladecc2 -hide-default"); ocaml_P4 = ref ""; ocaml_P4_opt = ref ""; ocaml_Flags = ref ""; ocaml_OptFlags = ref ""; ocaml_ByteFlags = ref ""; ocaml_LinkFlags = ref ""; ocaml_ForPack = ref ""; ocaml_Includes = ref []; ocaml_ExtIncludes = ref []; ocaml_ExtLibraries = ref []; } let dir = ref "" (* calcul d'une valeur dans un nouvel environnement (options) *) let new_scope v = let options' = !options in options := { ocaml = ref !(options'.ocaml); ocamlc = ref !(options'.ocamlc); ocamlopt = ref !(options'.ocamlopt); ocamldep = ref !(options'.ocamldep); ocamldoc = ref !(options'.ocamldoc); ocamlyacc = ref !(options'.ocamlyacc); ocamllex = ref !(options'.ocamllex); ocamlglade = ref !(options'.ocamlglade); ocaml_P4 = ref !(options'.ocaml_P4); ocaml_P4_opt = ref !(options'.ocaml_P4_opt); ocaml_Flags = ref !(options'.ocaml_Flags); ocaml_OptFlags = ref !(options'.ocaml_OptFlags); ocaml_ByteFlags = ref !(options'.ocaml_ByteFlags); ocaml_LinkFlags = ref !(options'.ocaml_LinkFlags); ocaml_ForPack = ref !(options'.ocaml_ForPack); ocaml_Includes = ref !(options'.ocaml_Includes); ocaml_ExtIncludes = ref !(options'.ocaml_ExtIncludes); ocaml_ExtLibraries = ref !(options'.ocaml_ExtLibraries); }; let v' = Lazy.force v in options := options'; v' (* type (interne) des unités *) type unit_t = { name: string; (* ensembles de fichiers : *) sources: string list; (* sources *) targets: string list; (* générés ET ciblés *) pregenerated: string list; (* à créer avant de calculer des dépendances *) trash: string list; (* générables "à nettoyer" *) (* cibles automatiques (quand aucune cible n'est spécifiée) *) auto_targets: string list; (* éventuelles sous-unités *) sub_units: unit_t list; (* objet généré (à lier) *) objects: (string*string) option; (* natif / bytecode *) (* dépendances d'une cible f *) dependencies: native: bool -> string -> string list; (* fichiers dont dépendent le résultat précédent *) dep_files: string -> string list; (* commande pour la compilation d'une cible f * renvoie (cmd, out) où * - cmd est la commande à exécuter * - out est l'ensemble des fichiers générés par cette commande *) compile_cmd: string -> string * string list; } (* ---- Utilitaires ---- *) let (^=) r s = r := if !r="" then s else !r^" "^s let (+=) l x = l := x :: !l let (@=) l x = l := !l @ x let (^^) s t = if t="" then s else if s="" then t else s^" "^t let id x = x let fcons f = fun x q -> f x::q let rec rev_map_append f l1 l2 = match l1 with | [] -> l2 | x::q -> rev_map_append f q (f x::l2) let string_of_list f = List.fold_left (fun acc x -> acc^^(f x)) "" let flatten = List.fold_left (^^) "" let select b = if b then fst else snd let select_set b = if b then (fun (_,y) z -> z,y) else (fun (x,_) z -> x,z) let rec print_inc = function | [] -> "" | x::q -> "-I "^x^^(print_inc q) let print_p4 = function "" -> "" | s -> "-pp "^s let oget x = function Some x -> x | _ -> x let ofold f = List.fold_right (function Some o -> f o | _ -> id) let omap f l = ofold (fcons f) l [] let otfold f = List.fold_right (function {objects=Some o} -> f o | _ -> id) let otmap f l = otfold (fcons f) l [] let mtime f = (Unix.stat f).Unix.st_mtime let file_newer f1 f2 = not (Sys.file_exists f2) || mtime f1 > mtime f2 let exists_file_newer f = let mtf = mtime f in List.exists (fun f' -> mtime f' > mtf) let silent_remove f = try Sys.remove f with Sys_error _ -> () let touch_file f = if not (Sys.file_exists f) then close_out (open_out f) exception CmdError of string let call = Sys.command let ecall cmd = if (call cmd) <> 0 then raise (CmdError cmd) let exitf ?(err=1) x = kprintf (fun msg -> eprintf "%s" msg; exit err) x let mk_ext e = (fun n -> n^e), (fun n -> Filename.check_suffix n e) let ml , is_ml = mk_ext ".ml" let mli , is_mli = mk_ext ".mli" let mly , is_mly = mk_ext ".mly" let mll , is_mll = mk_ext ".mll" let glade, is_glade = mk_ext ".glade" let cmo , is_cmo = mk_ext ".cmo" let cmi , is_cmi = mk_ext ".cmi" let cmx , is_cmx = mk_ext ".cmx" let cma , is_cma = mk_ext ".cma" let cmxa , is_cmxa = mk_ext ".cmxa" let oo , is_o = mk_ext ".o" let aa , is_a = mk_ext ".a" let cc , is_c = mk_ext ".c" let run , is_run = mk_ext ".run" let opt , is_opt = mk_ext ".opt" let annot, is_annot = mk_ext ".annot" let rec iter_units f = function | [] -> () | u::q -> f u; iter_units f u.sub_units; iter_units f q let rec fold_units f a = function | [] -> a | u::q -> fold_units f (f u (fold_units f a u.sub_units)) q let get_line c = let s = input_line c in s, String.length s (* ---- Outils OCaml (c,dep,opt...) ---- *) (* parsing de la sortie d'ocamldep *) let tokenize ?(skip=false) c = try if skip then ( (* ignorage du premier bloc (cmo/cmx) *) let last c = let s = input_line c in s.[String.length s - 1] in try while last c = '\\' do () done with End_of_file -> () ); let s,ls = get_line c in let i = String.index s ':' in let rec aux i acc ((s,ls) as sls) = if s.[i]='\\' then aux 4 acc (get_line c) else let j = String.index_from s i ' ' in if j+1 = ls then String.sub s i (j-i) :: acc else let k,sls' = if s.[j+1]='\\' then 4, get_line c else j+1, sls in aux k (String.sub s i (j-i) :: acc) sls' in aux (i+2) [] (s,ls) with End_of_file -> [] let ocamldep ~native ~depc ~sf = let nat = if native then "-native " else "" in let cmd = depc^^nat^^sf in if !print_deps then printf "%s\n%!" cmd; let c_in = Unix.open_process_in cmd in let deps = tokenize ~skip:(native && is_ml sf) c_in in let deps' = if native then deps else List.map (fun f -> if is_cmo f then cmi (Filename.chop_extension f) else f) deps in ignore (Unix.close_process_in c_in); sf::deps' let ocamldepi ~native ~depc ~f ~n = ocamldep ~native ~depc ~sf:(if is_cmi f then mli n else ml n) let ocamlobj ~bytec ~optc ~f ~n = (select (is_cmx f) (optc, bytec))^" -c "^(ml n), [f; cmi n] let ocamlobji ~bytec ~optc ~impl_flags ~f ~n = if is_cmi f then bytec^" -c "^(mli n), [f] else (select (is_cmx f) (optc, bytec))^^impl_flags^^"-c"^^(ml n), [f] let for_pack o = if !(o.ocaml_ForPack) = "" then "" else "-for-pack" ^^ !(o.ocaml_ForPack) let ocaml_options ?(o= !options) ?(flags="") ?(byte_flags="") ?(opt_flags="") ?pp ?(includes=[]) ?(ext_includes=[]) n = let flags' = (print_inc !(o.ocaml_Includes))^^(print_inc includes)^^(print_p4 (oget !(o.ocaml_P4) pp)) in let depc = !(o.ocamldep)^^flags' in let flags' = !(o.ocaml_Flags)^^flags^^(print_inc !(o.ocaml_ExtIncludes))^^(print_inc ext_includes)^^flags' in let bytec = !(o.ocamlc) ^^flags'^^byte_flags^^ !(o.ocaml_ByteFlags) in let opt_flags' = (print_inc !(o.ocaml_Includes))^^(print_inc includes)^^(print_p4 (oget !(o.ocaml_P4_opt) pp)) in let opt_flags' = !(o.ocaml_Flags)^^flags^^(print_inc !(o.ocaml_ExtIncludes))^^(print_inc ext_includes)^^opt_flags' in let optc = !(o.ocamlopt)^^(for_pack o)^^opt_flags'^^opt_flags ^^ !(o.ocaml_OptFlags) in (Filename.concat !dir n), depc, bytec, optc (* fabrication générique d'unités *) let generic_unit ~name ?(sources=[]) ~targets ?(trash=targets) ?(auto_targets=[]) ?(sub_units=[]) ?(pregenerated=[]) ?objects ~dependencies ?(dep_files=fun _->[]) ~compile_cmd () = { name=name; sources=sources; targets=targets; objects=objects; trash=trash; auto_targets=auto_targets; sub_units=sub_units; pregenerated=pregenerated; dependencies=dependencies; compile_cmd=compile_cmd; dep_files=dep_files; } (* ----- Différents types d'unités ----- *) (* module ocaml, sans interface *) let ocaml_Module ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n = let n, depc, bytec, optc = ocaml_options ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n in let ml_n, cmo_n, cmi_n, cmx_n = ml n, cmo n, cmi n, cmx n in let targets = [cmo_n; cmi_n; cmx_n] in generic_unit ~name:n ~sources:[ml_n] ~targets ~trash:(oo n :: annot n :: targets) ~objects:(cmx_n, cmo_n) ~dependencies:(fun ~native f -> if is_cmi f then [select native (cmx_n, cmo_n)] else ocamldep ~native ~depc ~sf:(ml_n)) ~compile_cmd: (fun f -> ocamlobj ~bytec ~optc ~f ~n) ~dep_files: (fun f -> if is_cmi f then [] else [ml_n]) () let generic_ocaml_Module_extension extension command = fun ?o ?flags ?byte_flags ?opt_flags ?(cmd_flags="") ?pp ?includes ?ext_includes n -> let n', depc, _, _ = ocaml_options ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n in let ext_n, ml_n = n'^extension, n'^".ml" in let cmd = command cmd_flags ext_n ml_n in generic_unit ~name:n ~sources:[ext_n] ~targets:[ml_n] ~trash:[] ~objects:(n'^".cmx", n'^".cmo") ~pregenerated:[ml_n] ~sub_units:[ocaml_Module ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n] ~dependencies:(fun ~native f -> [ext_n]) (* ~dependencies:(fun ~native f -> ocamldep ~native ~depc ~sf:(ext_n)) *) ~compile_cmd: (fun f -> cmd, [f]) () (* module ocaml, avec interface *) let ocaml_IModule ?o ?flags ?byte_flags ?opt_flags ?(impl_flags = "") ?pp ?includes ?ext_includes n = let n, depc, bytec, optc = ocaml_options ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n in let ml_n, mli_n, cmo_n, cmi_n, cmx_n = ml n, mli n, cmo n, cmi n, cmx n in let targets = [cmo_n; cmi_n; cmx_n] in generic_unit ~name:n ~sources:[ml_n; mli_n] ~targets ~trash:(oo n :: annot n :: targets) ~objects:(cmx_n, cmo_n) ~dependencies:(fun ~native f -> ocamldepi ~native ~depc ~f ~n) ~compile_cmd: (fun f -> ocamlobji ~bytec ~impl_flags ~optc ~f ~n) ~dep_files: (fun f -> if is_cmi f then [mli_n] else [ml_n]) () (* interface ocaml pure *) let ocaml_Interface ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n = let n, depc, bytec, optc = ocaml_options ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n in let mli_n, cmi_n = mli n, cmi n in let targets = [cmi_n] in generic_unit ~name:n ~sources:[mli_n] ~targets ~trash:(annot n :: targets) ~dependencies:(fun ~native f -> ocamldep ~native ~depc ~sf:mli_n) ~compile_cmd: (fun f -> bytec^" -c "^(mli_n), [f]) ~dep_files: (fun f -> [mli_n]) () (* objet C *) let c_Module ?(o= !options) ?(flags="") ?(source_deps=[]) n = let n = Filename.concat !dir n in let sources = List.map (Filename.concat !dir) source_deps in let c_n, o_n = cc n, oo n in let cc = !(o.ocamlc)^" -c"^^flags^^c_n in let sources = c_n::sources in generic_unit ~name:n ~sources ~targets:[o_n] ~dependencies:(fun ~native f -> sources) ~objects:(o_n,o_n) ~compile_cmd: (fun f -> cc, [f]) () (* lexer ocaml *) let ocaml_Lexer ?(o= !options) ?flags ?byte_flags ?opt_flags ?(lex_flags="") ?pp ?includes ?ext_includes n = let n' = Filename.concat !dir n in let mll_n, ml_n = mll n', ml n' in let ocamllex = !(o.ocamllex)^^lex_flags^^mll_n in generic_unit ~name:n ~sources:[mll_n] ~targets:[ml_n] ~objects:(cmx n', cmo n') ~pregenerated:[ml_n] ~sub_units:[ocaml_Module ~o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n] ~dependencies:(fun ~native f -> [mll_n]) ~compile_cmd: (fun f -> ocamllex, [f]) () (* parser ocaml *) let ocaml_Parser ?(o= !options) ?flags ?byte_flags ?opt_flags ?(yacc_flags="") ?pp ?includes ?ext_includes n = let n' = Filename.concat !dir n in let mly_n, ml_n, mli_n = mly n', ml n', mli n' in let ocamlyacc = !(o.ocamlyacc)^^yacc_flags^^mly_n in let gen = [ml_n; mli_n] in generic_unit ~name:n ~sources:[mly_n] ~targets:gen ~trash:((n'^".output") :: gen) ~objects:(cmx n', cmo n') ~pregenerated:gen ~sub_units:[ocaml_IModule ~o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n] ~dependencies:(fun ~native f -> [mly_n] ) ~compile_cmd: (fun f -> ocamlyacc, gen) () (* interface glade à compiler en ocaml *) let ocaml_Glade ?(o= !options) ?flags ?byte_flags ?opt_flags ?(glade_flags="") ?pp ?includes ?ext_includes n = let n' = Filename.concat !dir n in let glade_n, ml_n = glade n', ml n' in let ocamlglade = !(o.ocamlglade)^^glade_flags^^glade_n^" > "^ml_n in generic_unit ~name:n ~sources:[glade_n] ~targets:[ml_n] ~objects:(cmx n', cmo n') ~pregenerated:[ml_n] ~sub_units:[ocaml_Module ~o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n] ~dependencies:(fun ~native f -> [glade_n]) ~compile_cmd: (fun f -> ocamlglade, [f]) () (* paquet de modules ocaml *) let ocaml_Package ?(o= !options) n sub_units = let n = Filename.concat !dir n in let ml_n, cmo_n, cmi_n, cmx_n, o_n = ml n, cmo n, cmi n, cmx n, oo n in let otmap2 f = List.fold_right (function { objects=None; targets=[x] } when is_cmi x && Sys.file_exists (mli (Filename.chop_extension x)) -> (fun accu -> x :: accu) | { objects=Some x } -> fcons f x | _ -> id) sub_units [] in let objs, sobjs = let x = otmap2 fst in let y = otmap2 snd in let sx = flatten x in let sy = flatten y in (x, y), (sx, sy) in let targets = [cmo_n; cmi_n; cmx_n] in generic_unit ~name:n ~targets ~objects:(cmx_n, cmo_n) ~trash:(ml_n::o_n::targets) ~pregenerated:[ml_n] ~sub_units ~dependencies:(fun ~native f -> if is_cmi f then [select native (cmx_n, cmo_n)] else select native objs ) ~compile_cmd: (fun f -> if is_cmx f then !(o.ocamlopt)^^(for_pack o)^^"-I"^^n^^"-pack -o"^^f^^(fst sobjs), [cmx_n; cmi_n] else !(o.ocamlc)^^"-pack -o"^^cmo_n^^(snd sobjs), [cmo_n; cmi_n]) () let add_for_pack o n = if !(o.ocaml_ForPack) = "" then o.ocaml_ForPack := n else o.ocaml_ForPack := !(o.ocaml_ForPack)^"."^n (* paquet de modules regroupés dans un sous répertoire *) let ocaml_PackageDir ?o n l = let n' = Filename.concat !dir n in let dir' = !dir in dir := Filename.concat n' ""; let l' = new_scope (lazy (!options.ocaml_Includes += n'; add_for_pack !options n; Lazy.force l)) in dir := dir'; ocaml_Package ?o n l' (* librairie ocaml *) let ocaml_Library ?(o= !options) ?flags ?byte_flags ?opt_flags ?includes ?(libraries=[]) ?(default=`Byte) n sub_units = let n, depc, bytec, optc = ocaml_options ~o ?flags ?byte_flags ?opt_flags ?includes n in let objs b = let scma = select b (cmxa, cma) in (* (map scma extlib) @ (map scma libs) @ (otmap (select b) sub_units) *) List.rev_append (rev_map_append scma libraries (List.rev_map scma !(o.ocaml_ExtLibraries)) ) (otmap (select b) sub_units) in let objs, sobjs = let x, y = objs true, objs false in let sx = flatten x in let sy = flatten y in (x,y), (sx,sy) in let cma_n, cmxa_n, a_n = cma n, cmxa n, aa n in generic_unit ~name:n ~targets:[cma_n; cmxa_n] ~trash:[a_n] ~objects:(cmxa_n, cma_n) ~sub_units ~auto_targets:[if default=`Byte; then cma_n else cmxa_n] ~dependencies:(fun ~native f -> select (is_cmxa f) objs) ~compile_cmd: (fun f -> if is_cmxa f then optc ^" -a -o "^f^^(fst sobjs), [f] else bytec^" -a -o "^f^^(snd sobjs), [f]) () (* exécutable ocaml *) let ocaml_Program ?(o= !options) ?flags ?byte_flags ?opt_flags ?includes ?(libraries=[]) ?(default=`Byte) n sub_units = let n, depc, bytec, optc = ocaml_options ~o ?flags ?byte_flags ?opt_flags ?includes n in let objs b = let scma = select b (cmxa, cma) in (* (map scma extlib) @ (map scma libs) @ (otmap (select b) sub_units) *) List.rev_append (rev_map_append scma libraries (List.rev_map scma !(o.ocaml_ExtLibraries)) ) (otmap (select b) sub_units) in let objs, sobjs = let x, y = objs true, objs false in let sx = flatten x in let sy = flatten y in (x,y), (sx,sy) in let run_n, opt_n = run n, opt n in generic_unit ~name:n ~targets:[run_n; opt_n] ~sub_units ~auto_targets:[if default=`Byte; then run_n else opt_n] ~dependencies:(fun ~native f -> select (is_opt f) objs) ~compile_cmd: (fun f -> if is_opt f then optc ^" -o "^f^^(fst sobjs), [f] else bytec^" -o "^f^^(snd sobjs), [f]) () (* cible silencieuse *) let phony_unit ?(depends=["@FORCE@"]) ?(command="") name = generic_unit ~targets:[name] ~name ~dependencies:(fun ~native f -> depends) ~compile_cmd: (fun _ -> command,[]) () let fold_units_sources units f = let rec fold units accu = List.fold_left (fun accu u -> f u.name u.sources (fold u.sub_units) accu) accu units in fold units (* (\* unité utilisateur *\) *) (* let user_unit ?trash ~command ~depends name = *) (* let targets = [Filename.concat !dir name] in *) (* let trash = oget targets trash in *) (* generic_unit ~targets ~trash *) (* ~dependencies:(fun ~native _ -> depends) *) (* ~compile_cmd: command *) (* () *) (* récupération des fichiers sources OCaml *) let ocaml_sources = let rec crev_append l1 l2 = match l1 with | [] -> l2 | x::q when is_ml x || is_mli x -> crev_append q (x::l2) | x::q -> crev_append q l2 in fold_units (fun u -> crev_append u.sources) [] (* ---- Statuts des fichiers ---- *) (* statut d'un fichier *) type status_t = { mutable modified: int; (* dernière fois que l'on a _réellement_ été modifié *) mutable updated: int; (* date de la dernière mise à jour *) mutable mtime: float; (* mtime lors de la dernière mise à jour *) mutable digest: Digest.t; (* digest lors de la dernière mise à jour *) mutable cmd: Digest.t; (* digest de la commande utiliséee lors de la dernière mise à jour *) mutable depended: int*int; (* date du dernier calcul des dépendances (mode natif et non natif) *) mutable deps: string list*string list; (* listes des dépendances *) } let make_status ~t ~f = { modified = if Sys.file_exists f then t else 0; updated = 0; depended = -1,-1; mtime = 0.0; digest = Digest.string "$*%"; deps = [],[]; cmd = Digest.string "%*$" } let update_status ?cmdd ~t ~f st = if !debug_status then printf "UPDATE (%s) : " f; if Sys.file_exists f then (if st.updated < t then ( st.updated <- t; (match cmdd with Some d -> st.cmd <- d | None -> ()); let mt = mtime f in if mt > st.mtime then ( st.mtime <- mt; let d = Digest.file f in if st.digest <> d then ( st.digest <- d; if !debug_status then printf "modified"; st.modified <- t ) ) ) ) else st.updated <- 0; if !debug_status then printf "\n" (* s1 plus récent que s2 *) let (>>) s1 s2 = s1.modified > s2.updated (* ---- Gestion des projets ---- *) (* type des "projets" *) type project_t = { units: unit_t list; (* liste des unités *) get_unit: string -> unit_t; (* obtention de l'unité correspondant à une cible *) date: int; (* date courante *) get_status: string -> status_t; (* statut d'un fichier *) write_cache: unit -> unit; (* sauvegarde du cache des statuts *) } exception NoRuleFor of string (* un fichier donné est-il une cible *) let is_target p = fun f -> try ignore (p.get_unit f); true with _ -> false (* récupération des fichiers sources *) let sources_of_project p = let rec crev_append l1 l2 = match l1 with | [] -> l2 | x::q when is_target p x -> crev_append q l2 | x::q -> crev_append q (x::l2) in fold_units (fun u -> crev_append u.sources) [] p.units (* alias pour le type des expressions mises en cache *) type status_ct = int * (string, status_t) Hashtbl.t let st_cache = ".cache-status" (* création d'un projet *) let project ?(rebuild="ocaml build.ml") ?(deps=["Makefile.ml"]) units = (* mise à jour éventuelle de YaM *) let () = if exists_file_newer Sys.executable_name deps then ( let rebuild = ref rebuild in for i=1 to Array.length Sys.argv -1 do rebuild := !rebuild^" "^Sys.argv.(i) done; printf "yam is out-dated, rebuilding it (%s)\n%!" !rebuild; exit (Sys.command !rebuild) ) in (* construction de la table cible -> unités *) let get_unit = let table = Hashtbl.create 23 in iter_units (fun u -> List.iter (fun t -> Hashtbl.add table t u) u.targets ) units; (fun x -> try Hashtbl.find table x with Not_found -> raise (NoRuleFor x)) in (* récupération des statuts *) let date, get_status, write_cache = let get_status (d,gt) = let t = d-1 in (fun f -> try Hashtbl.find gt f with Not_found -> let s = make_status ~t ~f in Hashtbl.add gt f s; s ) in let write_cache v = (fun () -> let c_out = open_out_bin st_cache in output_value c_out (v: status_ct); close_out c_out ) in let get ((d,_) as v) = d, get_status v, write_cache v in if Sys.file_exists st_cache then let c_in = open_in_bin st_cache in let d,gt = (input_value c_in: status_ct) in close_in c_in; get (d+1, gt) else get (1, Hashtbl.create 50) in { units=units; get_unit=get_unit; date=date; get_status=get_status; write_cache=write_cache } (* nettoyage d'un projet *) let clean p = silent_remove st_cache; iter_units (fun u -> List.iter silent_remove u.trash) p.units (* (\* génération de la documentation *\) *) (* let doc p = *) (* let cmd = *) (* let rec crev_append l1 l2 = match l1 with *) (* | [] -> l2 *) (* | x::q when is_ml x || is_mli x && not (is_target p x) -> crev_append q (l2^^x) *) (* | x::q -> crev_append q l2 *) (* in *) (* fold_units (fun u -> crev_append u.sources) !(!options.ocamldoc) p.units *) (* in *) (* if !print_cmds then printf "%s\n%!" cmd; *) (* ecall cmd *) (* ---- Compilation ---- *) (* compilation d'un projet (ou d'une de ses cibles) *) let build ?target p = let date = p.date in let get_status = p.get_status in let get_unit = p.get_unit in (* FIXME unused let is_target = is_target p in *) (* compilation d'une cible *) let compile u f stf (cmd,cmdd,out) = if !print_cmds then printf "%s\n%!" cmd; ecall cmd; List.iter (fun f -> update_status ~cmdd ~t:date ~f (get_status f)) out in (* calcul de la liste des dépendances de f d'unité u et de statut st *) let rec dependencies ~native f u st = let stf = get_status f in List.iter (fun sf -> try ignore(get_unit sf); build ~native [sf] with NoRuleFor _ -> update_status ~t:date ~f:sf (get_status sf) ) u.sources; if !debug_deps then printf "DEP: `%s' -> " f; let l = u.dep_files f in let ddate = select native stf.depended in let recent df = (get_status df).modified > ddate in if l=[] || List.exists recent l then let deps = u.dependencies ~native f in stf.deps <- select_set native stf.deps deps; stf.depended <- select_set native stf.depended date; if !debug_deps then printf "[%s]\n" (flatten deps); deps else ( if !debug_deps then printf "cached [%s]\n" (flatten (select native stf.deps)); select native stf.deps ) (* compilation par continuations d'une pile de cibles *) and build ?(native=false) ?(k=fun ()->()) = function | [] -> k() | f::q -> let stf = get_status f in if stf.updated < date then ( if !debug_build then printf "BUILD: `%s'\n" f; let u = get_unit f in let native = native || is_cmx f || is_opt f || is_cmxa f in let cmd, out = u.compile_cmd f in let deps = dependencies ~native f u stf in let deps' = List.filter (fun f -> try ignore(get_unit f); true with NoRuleFor _ -> false) deps in let cmdd = Digest.string cmd in let k' () = if stf.cmd <> cmdd || List.exists (fun f' -> get_status f' >> stf) deps then compile u f stf (cmd,cmdd,out) else update_status ~cmdd ~t:date ~f stf; build ~native ~k q in build ~native ~k:k' deps' ) else build ~native ~k q in (* ensemble des cibles à compiler *) let targets = match target with | Some t -> [t] | _ -> List.fold_left (fun acc u -> List.rev_append u.auto_targets acc) [] p.units in (* pré-génération des fichiers nécessaires au calcul des dépendances *) iter_units (fun u -> List.iter touch_file u.pregenerated) p.units; (* compilation des cibles *) try build ~k:p.write_cache targets with | CmdError _ -> p.write_cache(); exit 1 | NoRuleFor t -> eprintf "No rule to build `%s'\n" t; p.write_cache(); exit 1 (* ---- Point d'entrée par défaut ---- *) let main ?rebuild ?deps l = let p = project ?rebuild ?deps l in let cwd() = Sys.chdir (Filename.dirname Sys.executable_name) in let targets = ref [] in let main = ref (fun () -> match !targets with | [] -> build p | l -> List.iter (fun target -> build ~target p) (List.rev l) ) in let alone s = if !targets <> [] || !Arg.current <> Array.length Sys.argv - 1 then Printf.eprintf "Warning: `%s' specified, other arguments are ignored.\n" s in let version() = alone "-version"; Printf.printf "YaM version 1.0\n"; exit 0 in let clean() = alone "-clean"; clean p; exit 0 in Arg.parse [ "-version", Arg.Unit version, " \tdisplay version information"; "-clean", Arg.Unit clean, " \tremove all generated files"; "-v", Arg.Set print_deps, " \t\tbe verbose: print dependencies commands"; "-q", Arg.Clear print_cmds, " \t\tbe quiet: do not print commands"; "-r", Arg.String Sys.chdir, " \tset `dir' as root directory"; "-R", Arg.Unit cwd, " \t\tset directory of YaM as root directory"; "-db", Arg.Set debug_build, " \tdebug build"; "-dd", Arg.Set debug_deps, " \tdebug deps"; "-ds", Arg.Set debug_status, " \tdebug status"; ] ((+=) targets) "usage: yam {-version, -clean, [options] [targets...]}"; !main ()