X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2FmatitamakeLib.ml;h=eed971f4514568a466e167165ef4781ed02c865d;hb=1776f357e1a69fa1133956660b65d7bafdfe5c25;hp=38f8123888ecdf2a3644788d153faf805e548fae;hpb=3158b6cbc3b374a7840e79c2cd35dd46ffeaf324;p=helm.git diff --git a/matita/matitamakeLib.ml b/matita/matitamakeLib.ml index 38f812388..eed971f45 100644 --- a/matita/matitamakeLib.ml +++ b/matita/matitamakeLib.ml @@ -33,7 +33,6 @@ let logger = fun mark -> | `Warning -> HLog.warn | `Debug -> HLog.debug | `Message -> HLog.message -;; type development = { root: string ; name: string } @@ -43,6 +42,21 @@ let developments = ref [] let pool () = Helm_registry.get "matita.basedir" ^ "/matitamake/" ;; let rootfile = "/root" ;; +(* /foo/./bar/..//baz -> /foo/baz *) +let normalize_path s = + let s = Str.global_replace (Str.regexp "//") "/" s in + let l = Str.split (Str.regexp "/") s in + let rec aux = function + | [] -> [] + | he::".."::tl -> aux tl + | he::"."::tl -> aux (he::tl) + | he::tl -> he :: aux tl + in + (if Str.string_match (Str.regexp "^/") s 0 then "/" else "") ^ + String.concat "/" (aux l) + ^ (if Str.string_match (Str.regexp "/$") s 0 then "/" else "") +;; + let ls_dir dir = try let d = Unix.opendir dir in @@ -76,17 +90,26 @@ let initialize () = match root with | None -> () | Some root -> - developments := {root = root ; name = name} :: !developments) + developments := {root = root ; name = name} :: !developments; + let inc = Helm_registry.get_list + Helm_registry.string "matita.includes" in + Helm_registry.set_list Helm_registry.of_string + ~key:"matita.includes" ~value:(inc @ [root]) + ) l (* finds the makefile path for development devel *) let makefile_for_development devel = let develdir = pool () ^ devel.name in develdir ^ "/makefile" -;; + +let dot_for_development devel = + let dot_fname = pool () ^ devel.name ^ "/depend.dot" in + if Sys.file_exists dot_fname then Some dot_fname else None (* given a dir finds a development that is radicated in it or below *) let development_for_dir dir = + let dir = normalize_path dir in let is_prefix_of d1 d2 = let len1 = String.length d1 in let len2 = String.length d2 in @@ -94,13 +117,11 @@ let development_for_dir dir = false else let pref = String.sub d2 0 len1 in - pref = d1 + pref = d1 && (len1 = len2 || d2.[len1] = '/') in - (* it must be unique *) try Some (List.find (fun d -> is_prefix_of d.root dir) !developments) - with Not_found -> None -;; + with Not_found | Failure _ -> None let development_for_name name = try @@ -112,7 +133,6 @@ let dump_development devel = let devel_dir = pool () ^ devel.name in HExtlib.mkdir devel_dir; HExtlib.output_file ~filename:(devel_dir ^ rootfile) ~text:devel.root -;; let list_known_developments () = List.map (fun r -> r.name,r.root) !developments @@ -126,9 +146,14 @@ let rebuild_makefile development = HExtlib.input_file BuildTimeConf.matitamake_makefile_template in let ext = Lazy.force am_i_opt in - let cc = BuildTimeConf.runtime_base_dir ^ "/matitac" ^ ext in - let rm = BuildTimeConf.runtime_base_dir ^ "/matitaclean" ^ ext in - let mm = BuildTimeConf.runtime_base_dir ^ "/matitadep" ^ ext in + let binpath = + if HExtlib.is_executable + (BuildTimeConf.runtime_base_dir ^ "/matitac" ^ ext) + then BuildTimeConf.runtime_base_dir ^ "/" else "" + in + let cc = binpath ^ "matitac" ^ ext in + let rm = binpath ^ "matitaclean" ^ ext in + let mm = binpath ^ "matitadep" ^ ext in let df = pool () ^ development.name ^ "/depend" in let template = Pcre.replace ~pat:"@ROOT@" ~templ:development.root template in let template = Pcre.replace ~pat:"@CC@" ~templ:cc template in @@ -137,34 +162,36 @@ let rebuild_makefile development = let template = Pcre.replace ~pat:"@CLEAN@" ~templ:rm template in HExtlib.output_file ~filename:makefilepath ~text:template +let rebuild_makefile_devel development = + let path = development.root ^ "/makefile" in + if not (Sys.file_exists path) then + begin + let template = + HExtlib.input_file BuildTimeConf.matitamake_makefile_template_devel + in + let template = + Pcre.replace ~pat:"@MATITA_RT_BASE_DIR@" + ~templ:BuildTimeConf.runtime_base_dir template + in + HExtlib.output_file ~filename:path ~text:template + end + (* creates a new development if possible *) let initialize_development name dir = + let dir = normalize_path dir in let name = Pcre.replace ~pat:" " ~templ:"_" name in let dev = {name = name ; root = dir} in - match development_for_dir dir with - | Some dev -> - if dir <> dev.root then begin - logger `Error - (sprintf ("Dir \"%s\" is already handled by development \"%s\"\n" - ^^ "Development \"%s\" is rooted in \"%s\"\n" - ^^ "Dir \"%s\" is a sub-dir of \"%s\"") - dir dev.name dev.name dev.root dir dev.root); - None - end else (* requirement development alreay exists, do nothing *) - Some dev - | None -> - dump_development dev; - rebuild_makefile dev; - developments := dev :: !developments; - Some dev + dump_development dev; + rebuild_makefile dev; + rebuild_makefile_devel dev; + developments := dev :: !developments; + Some dev let make chdir args = let old = Unix.getcwd () in try Unix.chdir chdir; let cmd = String.concat " " ("make" :: List.map Filename.quote args) in - if Helm_registry.get_int "matita.verbosity" > 1 then - HLog.debug (sprintf "MATITAMAKE: %s" cmd); let rc = Unix.system cmd in Unix.chdir old; match rc with @@ -175,24 +202,38 @@ let make chdir args = logger `Warning ("Unix Error: " ^ cmd ^ ": " ^ err); false -let call_make development target make = +let call_make ?matita_flags development target make = + let matita_flags = + let already_defined = + match matita_flags with + | None -> (try Sys.getenv "MATITA_FLAGS" with Not_found -> "") + | Some s -> s + in + let bench = + if Helm_registry.get_bool "matita.bench" then " -bench" else "" + in + let system = + if Helm_registry.get_bool "matita.system" then " -system" else "" + in + already_defined ^ bench ^ system + in + let csc = try ["SRC=" ^ Sys.getenv "SRC"] with Not_found -> [] in rebuild_makefile development; let makefile = makefile_for_development development in - let nodb = - Helm_registry.get_opt_default Helm_registry.bool ~default:false "db.nodb" - in - let flags = [] in - let flags = flags @ if nodb then ["NODB=true"] else [] in + let flags = [] in let flags = try - flags @ [ sprintf "MATITA_FLAGS=%s" (Sys.getenv "MATITA_FLAGS") ] + flags @ [ sprintf "MATITA_FLAGS=%s" matita_flags ] with Not_found -> flags in - make development.root - (["--no-print-directory"; "-s"; "-k"; "-f"; makefile; target] - @ flags) + let flags = flags @ csc in + let args = + ["--no-print-directory"; "-s"; "-k"; "-f"; makefile; target] @ flags + in + (* prerr_endline (String.concat " " args); *) + make development.root args -let build_development ?(target="all") development = - call_make development target make +let build_development ?matita_flags ?(target="all") development = + call_make ?matita_flags development target make (* not really good vt100 *) let vt100 s = @@ -229,8 +270,9 @@ let mk_maker refresh_cb = let out_r,out_w = Unix.pipe () in let err_r,err_w = Unix.pipe () in let pid = ref ~-1 in - ignore(Sys.signal Sys.sigchld (Sys.Signal_ignore)); - try + let oldhandler = Sys.signal Sys.sigchld (Sys.Signal_ignore) in + try +(* prerr_endline (String.concat " " args); *) let argv = Array.of_list ("make"::args) in pid := Unix.create_process "make" argv Unix.stdin out_w err_w; Unix.close out_w; @@ -252,28 +294,26 @@ let mk_maker refresh_cb = aux r; refresh_cb () done; + ignore(Sys.signal Sys.sigchld oldhandler); true with | Unix.Unix_error (_,"read",_) - | Unix.Unix_error (_,"select",_) -> true) + | Unix.Unix_error (_,"select",_) -> + ignore(Sys.signal Sys.sigchld oldhandler); + true) -let build_development_in_bg ?(target="all") refresh_cb development = - call_make development target (mk_maker refresh_cb) -;; +let build_development_in_bg ?matita_flags ?(target="all") refresh_cb development = + call_make ?matita_flags development target (mk_maker refresh_cb) -let clean_development development = - call_make development "clean" make +let clean_development ?matita_flags development = + call_make ?matita_flags development "clean" make -let clean_development_in_bg refresh_cb development = - call_make development "clean" (mk_maker refresh_cb) +let clean_development_in_bg ?matita_flags refresh_cb development = + call_make development ?matita_flags "clean" (mk_maker refresh_cb) let destroy_development_aux development clean_development = let delete_development development = - let unlink file = - try - Unix.unlink file - with Unix.Unix_error _ -> logger `Debug ("Unable to delete " ^ file) - in + let unlink = HExtlib.safe_remove in let rmdir dir = try Unix.rmdir dir @@ -287,6 +327,8 @@ let destroy_development_aux development clean_development = unlink (makefile_for_development development); unlink (pool () ^ development.name ^ rootfile); unlink (pool () ^ development.name ^ "/depend"); + unlink (pool () ^ development.name ^ "/depend.errors"); + unlink (pool () ^ development.name ^ "/depend.dot"); rmdir (pool () ^ development.name); developments := List.filter (fun d -> d.name <> development.name) !developments @@ -298,12 +340,51 @@ let destroy_development_aux development clean_development = end; delete_development development -let destroy_development development = - destroy_development_aux development clean_development +let destroy_development ?matita_flags development = + destroy_development_aux development (clean_development ?matita_flags) -let destroy_development_in_bg refresh development = - destroy_development_aux development (clean_development_in_bg refresh) +let destroy_development_in_bg ?matita_flags refresh development = + destroy_development_aux development + (clean_development_in_bg refresh ?matita_flags ) let root_for_development development = development.root let name_for_development development = development.name +let publish_development_bstract build clean devel = + let matita_flags, matita_flags_system = + let orig_matita_flags = + try Sys.getenv "MATITA_FLAGS" with Not_found -> "" + in + orig_matita_flags, orig_matita_flags ^ " -system" + in + HLog.message "cleaning the development before publishing"; + if clean ~matita_flags devel then + begin + HLog.message "rebuilding the development in 'system' space"; + (* here we should use pristine metadata if we use sqlite *) + if build ~matita_flags:matita_flags_system devel then + begin + HLog.message "publishing succeded"; + true + end + else + begin + HLog.error "building process failed, reverting"; + if not (clean ~matita_flags devel) then + HLog.error "cleaning failed, end of the world (2)"; + false + end + end + else + (HLog.error "unable to clean the development, publishing failed"; false) + +let publish_development devel = + publish_development_bstract + (fun ~matita_flags devel -> build_development ~matita_flags devel) + (fun ~matita_flags devel -> clean_development ~matita_flags devel) devel +let publish_development_in_bg cb devel = + publish_development_bstract + (fun ~matita_flags devel -> build_development_in_bg cb ~matita_flags devel) + (fun ~matita_flags devel -> clean_development_in_bg cb ~matita_flags devel) + devel +