X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fmatita%2FmatitacLib.ml;h=7a6d48663927cf590837a30b3516b7677a5f11b8;hb=238b544db1786fbc68354fd62aa6b05983906997;hp=923354cbda7058c4a7c4635594b301cc5564ee81;hpb=1108f4fe01ea2dccd8d3b591f2cdc131dab7913e;p=helm.git diff --git a/helm/software/matita/matitacLib.ml b/helm/software/matita/matitacLib.ml index 923354cbd..7a6d48663 100644 --- a/helm/software/matita/matitacLib.ml +++ b/helm/software/matita/matitacLib.ml @@ -29,305 +29,387 @@ open Printf open GrafiteTypes -exception AttemptToInsertAnAlias +exception AttemptToInsertAnAlias of LexiconEngine.status -let pp_ast_statement = - GrafiteAstPp.pp_statement ~term_pp:CicNotationPp.pp_term - ~lazy_term_pp:CicNotationPp.pp_term ~obj_pp:CicNotationPp.pp_obj +let out = ref ignore +let set_callback f = out := f -(** {2 Initialization} *) -let grafite_status = (ref None : GrafiteTypes.status option ref) -let lexicon_status = (ref None : LexiconEngine.status option ref) +let slash_n_RE = Pcre.regexp "\\n" ;; -let run_script is eval_function = - let lexicon_status',grafite_status' = - match !lexicon_status,!grafite_status with - | Some ss, Some s -> ss,s - | _,_ -> assert false +let pp_ast_statement grafite_status stm = + let stm = GrafiteAstPp.pp_statement + ~map_unicode_to_tex:(Helm_registry.get_bool "matita.paste_unicode_as_tex") + ~term_pp:CicNotationPp.pp_term + ~lazy_term_pp:CicNotationPp.pp_term ~obj_pp:(CicNotationPp.pp_obj + CicNotationPp.pp_term) stm in - let slash_n_RE = Pcre.regexp "\\n" in - let cb = - if Helm_registry.get_int "matita.verbosity" < 1 then - (fun _ _ -> ()) - else - (fun grafite_status stm -> - (* dump_status grafite_status; *) - let stm = pp_ast_statement stm in - let stm = Pcre.replace ~rex:slash_n_RE stm in - let stm = - if String.length stm > 50 then - String.sub stm 0 50 ^ " ..." - else - stm - in - HLog.debug ("Executing: ``" ^ stm ^ "''")) + let stm = Pcre.replace ~rex:slash_n_RE stm in + let stm = + if String.length stm > 50 then String.sub stm 0 50 ^ " ..." + else stm in - try - let grafite_status'', lexicon_status'' = - match eval_function lexicon_status' grafite_status' is cb with - [] -> assert false - | (s,None)::_ -> s - | (s,Some _)::_ -> raise AttemptToInsertAnAlias + HLog.debug ("Executing: ``" ^ stm ^ "''") +;; + +let clean_exit baseuri rc = + LibraryClean.clean_baseuris ~verbose:false [baseuri]; rc +;; + +let dump f = + let module G = GrafiteAst in + let module L = LexiconAst in + let module H = HExtlib in + Helm_registry.set_bool "matita.moo" false; + let floc = H.dummy_floc in + let nl_ast = G.Comment (floc, G.Note (floc, "")) in + let pp_statement stm = + GrafiteAstPp.pp_statement ~term_pp:CicNotationPp.pp_term + ~map_unicode_to_tex:(Helm_registry.get_bool + "matita.paste_unicode_as_tex") + ~lazy_term_pp:CicNotationPp.pp_term + ~obj_pp:(CicNotationPp.pp_obj CicNotationPp.pp_term) stm + in + let pp_lexicon = LexiconAstPp.pp_command in + let och = open_out f in + let nl () = output_string och (pp_statement nl_ast) in + MatitaMisc.out_preamble och; + let grafite_parser_cb status = function + | G.Executable (_, G.Macro (_, G.Inline _)) -> () + | stm -> + output_string och (pp_statement stm); nl (); nl () in - lexicon_status := Some lexicon_status''; - grafite_status := Some grafite_status'' - with - | GrafiteEngine.Drop - | End_of_file - | CicNotationParser.Parse_error _ as exn -> raise exn - | exn -> - HLog.error (snd (MatitaExcPp.to_string exn)); - raise exn + let lexicon_parser_cb status cmd = + output_string och (pp_lexicon cmd); nl (); nl () + in +(* + let matita_engine_cb = function + | G.Executable (_, G.Macro (_, G.Inline _)) + | G.Executable (_, G.Command (_, G.Include _)) -> () + | ast -> +*) + let matitac_lib_cb = output_string och in + begin fun () -> + GrafiteParser.set_grafite_callback grafite_parser_cb; + GrafiteParser.set_lexicon_callback lexicon_parser_cb; +(* + MatitaEngine.set_callback matita_engine_cb; +*) + set_callback matitac_lib_cb + end, + begin fun x -> + close_out och; + GrafiteParser.set_grafite_callback (fun _ _ -> ()); + GrafiteParser.set_lexicon_callback (fun _ _ -> ()); + set_callback ignore; x + end +;; -let fname () = - match Helm_registry.get_list Helm_registry.string "matita.args" with - | [x] -> x - | l -> - prerr_endline ("Wrong commands: " ^ String.concat " " l); - MatitaInit.die_usage () +let get_macro_context = function + | Some {GrafiteTypes.proof_status = GrafiteTypes.No_proof} -> [] + | Some status -> + let stack = GrafiteTypes.get_stack status in + let goal = Continuationals.Stack.find_goal stack in + GrafiteTypes.get_proof_context status goal + | None -> assert false +;; + +let pp_times fname rc big_bang big_bang_u big_bang_s = + if not (Helm_registry.get_bool "matita.verbose") then + let { Unix.tms_utime = u ; Unix.tms_stime = s} = Unix.times () in + let r = Unix.gettimeofday () -. big_bang in + let u = u -. big_bang_u in + let s = s -. big_bang_s in + let extra = try Sys.getenv "BENCH_EXTRA_TEXT" with Not_found -> "" in + let rc,rcascii = + if rc then "OK","Ok" else "FAIL","Fail" in + let times = + let fmt t = + let seconds = int_of_float t in + let cents = int_of_float ((t -. floor t) *. 100.0) in + let minutes = seconds / 60 in + let seconds = seconds mod 60 in + Printf.sprintf "%dm%02d.%02ds" minutes seconds cents + in + Printf.sprintf "%s %s %s" (fmt r) (fmt u) (fmt s) + in + let s = Printf.sprintf "%-4s %s %s" rc times extra in + print_endline s; + flush stdout; + HLog.message ("Compilation of "^Filename.basename fname^": "^rc) +;; -let pp_ocaml_mode () = - HLog.message ""; - HLog.message " ** Entering Ocaml mode ** "; - HLog.message ""; - HLog.message "Type 'go ();;' to enter an interactive matitac"; - HLog.message "" - -let clean_exit n = - let opt_exit = - function - None -> () - | Some n -> exit n - in - match !grafite_status with - None -> opt_exit n - | Some grafite_status -> - try - let baseuri = GrafiteTypes.get_string_option grafite_status "baseuri" in - LibraryClean.clean_baseuris ~verbose:false [baseuri]; - opt_exit n - with GrafiteTypes.Option_error("baseuri", "not found") -> - (* no baseuri ==> nothing to clean yet *) - opt_exit n - -let rec interactive_loop () = - let str = Ulexing.from_utf8_channel stdin in - try - run_script str - (MatitaEngine.eval_from_stream ~first_statement_only:false ~prompt:true - ~include_paths:(Helm_registry.get_list Helm_registry.string - "matita.includes")) - with - | GrafiteEngine.Drop -> pp_ocaml_mode () - | GrafiteEngine.Macro (floc,_) -> - let x, y = HExtlib.loc_of_floc floc in - HLog.error - (sprintf "A macro has been found in a script at %d-%d" x y); - interactive_loop () - | Sys.Break -> HLog.error "user break!"; interactive_loop () - | GrafiteTypes.Command_error _ -> interactive_loop () - | End_of_file -> - print_newline (); - clean_exit (Some 0) - | HExtlib.Localized (floc,CicNotationParser.Parse_error err) -> - let x, y = HExtlib.loc_of_floc floc in - HLog.error (sprintf "Parse error at %d-%d: %s" x y err); - interactive_loop () - | exn -> HLog.error (Printexc.to_string exn); interactive_loop () +let cut prefix s = + let lenp = String.length prefix in + let lens = String.length s in + assert (lens > lenp); + assert (String.sub s 0 lenp = prefix); + String.sub s lenp (lens-lenp) +;; -let go () = - Helm_registry.load_from BuildTimeConf.matita_conf; - Http_getter.init (); - MetadataTypes.ownerize_tables (Helm_registry.get "matita.owner"); - LibraryDb.create_owner_environment (); - CicEnvironment.set_trust (* environment trust *) - (let trust = - Helm_registry.get_opt_default Helm_registry.get_bool - ~default:true "matita.environment_trust" in - fun _ -> trust); - let include_paths = - Helm_registry.get_list Helm_registry.string "matita.includes" in - grafite_status := Some (GrafiteSync.init ()); - lexicon_status := - Some (CicNotation2.load_notation ~include_paths - BuildTimeConf.core_notation_script); - Sys.catch_break true; - interactive_loop () +let get_include_paths options = + let include_paths = + try List.assoc "include_paths" options with Not_found -> "" + in + let include_paths = Str.split (Str.regexp " ") include_paths in + let include_paths = + include_paths @ + Helm_registry.get_list Helm_registry.string "matita.includes" + in + include_paths +;; -let pp_times fname bench_mode rc big_bang = - if bench_mode then - begin - let { Unix.tms_utime = u ; Unix.tms_stime = s} = Unix.times () in - let r = Unix.gettimeofday () -. big_bang in - let extra = try Sys.getenv "BENCH_EXTRA_TEXT" with Not_found -> "" in - let cc = - if Str.string_match (Str.regexp ".*opt$") Sys.argv.(0) 0 then - "matitac.opt" - else - "matitac" - in - let rc = if rc then "OK" else "FAIL" in - let times = - let fmt t = - let seconds = int_of_float t in - let cents = int_of_float ((t -. floor t) *. 100.0) in - let minutes = seconds / 60 in - let seconds = seconds mod 60 in - Printf.sprintf "%dm%02d.%02ds" minutes seconds cents - in - Printf.sprintf "%s %s %s" (fmt r) (fmt u) (fmt s) - in - let fname = - match MatitamakeLib.development_for_dir (Filename.dirname fname) with - | None -> fname - | Some d -> - let rootlen = String.length(MatitamakeLib.root_for_development d)in - let fnamelen = String.length fname in - assert (fnamelen > rootlen); - String.sub fname rootlen (fnamelen - rootlen) - in - let s = - Printf.sprintf "%s %-35s %-4s %s %s" cc fname rc times extra - in - print_endline s; - flush stdout - end +let activate_extraction baseuri fname = + if Helm_registry.get_bool "matita.extract" then + let mangled_baseuri = + let baseuri = String.sub baseuri 5 (String.length baseuri - 5) in + let baseuri = Pcre.replace ~pat:"/" ~templ:"_" baseuri in + String.uncapitalize baseuri in + let f = + open_out + (Filename.dirname fname ^ "/" ^ mangled_baseuri ^ ".ml") in + LibrarySync.add_object_declaration_hook + (fun ~add_obj ~add_coercion _ obj -> + output_string f (CicExportation.ppobj baseuri obj); + flush f; []); ;; -let main ~mode = +let compile atstart options fname = + let matita_debug = Helm_registry.get_bool "matita.debug" in + let include_paths = get_include_paths options in + let root,baseuri,fname,_tgt = + Librarian.baseuri_of_script ~include_paths fname in + if Http_getter_storage.is_read_only baseuri then assert false; + activate_extraction baseuri fname ; + let lexicon_status = + CicNotation2.load_notation ~include_paths:[] + BuildTimeConf.core_notation_script + in + atstart (); (* FG: do not invoke before loading the core notation script *) + let grafite_status = GrafiteSync.init lexicon_status baseuri in let big_bang = Unix.gettimeofday () in - MatitaInit.initialize_all (); - (* must be called after init since args are set by cmdline parsing *) - let fname = fname () in - let system_mode = Helm_registry.get_bool "matita.system" in - let bench_mode = Helm_registry.get_bool "matita.bench" in - if bench_mode then - Helm_registry.set_int "matita.verbosity" 0; - let include_paths = - Helm_registry.get_list Helm_registry.string "matita.includes" in - grafite_status := Some (GrafiteSync.init ()); - lexicon_status := - Some (CicNotation2.load_notation ~include_paths - BuildTimeConf.core_notation_script); - Sys.catch_break true; - let origcb = HLog.get_log_callback () in - let origcb t s = origcb t ((if system_mode then "[S] " else "") ^ s) in - let newcb tag s = - match tag with - | `Debug | `Message -> () - | `Warning | `Error -> origcb tag s + let { Unix.tms_utime = big_bang_u ; Unix.tms_stime = big_bang_s} = + Unix.times () in - if Helm_registry.get_int "matita.verbosity" < 1 then - HLog.set_log_callback newcb; - if bench_mode then MatitaMisc.shutup (); - let matita_debug = Helm_registry.get_bool "matita.debug" in + let time = Unix.time () in try - let time = Unix.time () in - if Helm_registry.get_int "matita.verbosity" < 1 && not bench_mode then - origcb `Message ("compiling " ^ Filename.basename fname ^ "...") - else - HLog.message (sprintf "execution of %s started:" fname); - let is = - Ulexing.from_utf8_channel - (match fname with - | "stdin" -> stdin - | fname -> open_in fname) in - let include_paths = - Helm_registry.get_list Helm_registry.string "matita.includes" in - (try - run_script is - (MatitaEngine.eval_from_stream ~first_statement_only:false ~include_paths - ~clean_baseuri:(not (Helm_registry.get_bool "matita.preserve"))) - with End_of_file -> ()); - let elapsed = Unix.time () -. time in - let tm = Unix.gmtime elapsed in - let sec = string_of_int tm.Unix.tm_sec ^ "''" in - let min = - if tm.Unix.tm_min > 0 then (string_of_int tm.Unix.tm_min ^ "' ") else "" + (* sanity checks *) + let moo_fname = + LibraryMisc.obj_file_of_baseuri ~must_exist:false ~baseuri ~writable:true + in + let lexicon_fname= + LibraryMisc.lexicon_file_of_baseuri + ~must_exist:false ~baseuri ~writable:true in - let hou = - if tm.Unix.tm_hour > 0 then (string_of_int tm.Unix.tm_hour ^ "h ") else "" + (* cleanup of previously compiled objects *) + if (not (Http_getter_storage.is_empty ~local:true baseuri) || + LibraryClean.db_uris_of_baseuri baseuri <> []) + then begin + HLog.message ("baseuri " ^ baseuri ^ " is not empty"); + HLog.message ("cleaning baseuri " ^ baseuri); + LibraryClean.clean_baseuris [baseuri]; + end; + HLog.message ("compiling " ^ Filename.basename fname ^ " in " ^ baseuri); + if not (Helm_registry.get_bool "matita.verbose") then + (let cc = + let rex = Str.regexp ".*opt$" in + if Str.string_match rex Sys.argv.(0) 0 then "matitac.opt" + else "matitac" + in + let s = Printf.sprintf "%s %-35s " cc (cut (root^"/") fname) in + print_string s; flush stdout); + (* we dalay this error check until we print 'matitac file ' *) + assert (Http_getter_storage.is_empty ~local:true baseuri); + (* create dir for XML files *) + if not (Helm_registry.get_opt_default Helm_registry.bool "matita.nodisk" + ~default:false) + then + HExtlib.mkdir + (Filename.dirname + (Http_getter.filename ~local:true ~writable:true (baseuri ^ + "foo.con"))); + let buf = Ulexing.from_utf8_channel (open_in fname) in + let print_cb = + if not (Helm_registry.get_bool "matita.verbose") then (fun _ _ -> ()) + else pp_ast_statement + in + let lexicon_status, grafite_status = + let rec aux_for_dump x lexicon_status grafite_status = + try + match + MatitaEngine.eval_from_stream ~first_statement_only:false ~include_paths + lexicon_status grafite_status buf x + with + | [] -> lexicon_status, grafite_status + | ((grafite,lexicon),None)::_ -> lexicon, grafite + | ((_,l),Some _)::_ -> raise (AttemptToInsertAnAlias l) + + with MatitaEngine.EnrichedWithStatus + (GrafiteEngine.Macro (floc, f), lexicon, grafite) as exn -> + match f (get_macro_context (Some grafite)) with + | _, GrafiteAst.Inline (_, style, suri, prefix, flavour) -> + let str = + ApplyTransformation.txt_of_inline_macro style prefix suri + ?flavour + ~map_unicode_to_tex:(Helm_registry.get_bool + "matita.paste_unicode_as_tex") + in + !out str; + aux_for_dump x lexicon grafite + |_-> raise exn + in + aux_for_dump print_cb lexicon_status grafite_status in - let proof_status,moo_content_rev,metadata,lexicon_content_rev = - match !lexicon_status,!grafite_status with - | Some ss, Some s -> - s.proof_status, s.moo_content_rev, ss.LexiconEngine.metadata, - ss.LexiconEngine.lexicon_content_rev - | _,_ -> assert false + let elapsed = Unix.time () -. time in + let proof_status,moo_content_rev,lexicon_content_rev = + grafite_status.proof_status, grafite_status.moo_content_rev, + lexicon_status.LexiconEngine.lexicon_content_rev in if proof_status <> GrafiteTypes.No_proof then - begin - HLog.error - "there are still incomplete proofs at the end of the script"; - pp_times fname bench_mode true big_bang; - clean_exit (Some 2) - end + (HLog.error + "there are still incomplete proofs at the end of the script"; + pp_times fname false big_bang big_bang_u big_bang_s; +(* + LexiconSync.time_travel + ~present:lexicon_status ~past:initial_lexicon_status; +*) + clean_exit baseuri false) else - begin - let baseuri = - DependenciesParser.baseuri_of_script ~include_paths fname in - let moo_fname = - LibraryMisc.obj_file_of_baseuri ~baseuri ~writable:true - in - let lexicon_fname= - LibraryMisc.lexicon_file_of_baseuri ~baseuri ~writable:true - in - let metadata_fname = - LibraryMisc.metadata_file_of_baseuri ~baseuri ~writable:true - in - GrafiteMarshal.save_moo moo_fname moo_content_rev; - LibraryNoDb.save_metadata metadata_fname metadata; - LexiconMarshal.save_lexicon lexicon_fname lexicon_content_rev; - HLog.message - (sprintf "execution of %s completed in %s." fname (hou^min^sec)); - pp_times fname bench_mode true big_bang; - exit 0 - end + (if not (Helm_registry.get_bool "matita.moo" && + Filename.check_suffix fname ".mma") then begin + (* FG: we do not generate .moo when dumping .mma files *) + GrafiteMarshal.save_moo moo_fname moo_content_rev; + LexiconMarshal.save_lexicon lexicon_fname lexicon_content_rev; + end; + let tm = Unix.gmtime elapsed in + let sec = string_of_int tm.Unix.tm_sec ^ "''" in + let min = + if tm.Unix.tm_min > 0 then (string_of_int tm.Unix.tm_min^"' ") else "" + in + let hou = + if tm.Unix.tm_hour > 0 then (string_of_int tm.Unix.tm_hour^"h ") else "" + in + HLog.message + (sprintf "execution of %s completed in %s." fname (hou^min^sec)); + pp_times fname true big_bang big_bang_u big_bang_s; +(* + LexiconSync.time_travel + ~present:lexicon_status ~past:initial_lexicon_status; +*) + true) with - | Sys.Break -> - HLog.error "user break!"; - pp_times fname bench_mode false big_bang; - if mode = `COMPILER then - clean_exit (Some ~-1) + (* all exceptions should be wrapped to allow lexicon-undo (LS.time_travel) *) + | AttemptToInsertAnAlias lexicon_status -> + pp_times fname false big_bang big_bang_u big_bang_s; +(* + LexiconSync.time_travel + ~present:lexicon_status ~past:initial_lexicon_status; +*) + clean_exit baseuri false + | MatitaEngine.EnrichedWithStatus (exn, _lexicon, _grafite) as exn' -> + (match exn with + | Sys.Break -> HLog.error "user break!" + | HExtlib.Localized (floc,CicNotationParser.Parse_error err) -> + let (x, y) = HExtlib.loc_of_floc floc in + HLog.error (sprintf "Parse error at %d-%d: %s" x y err) + | exn when matita_debug -> raise exn' + | exn -> HLog.error (snd (MatitaExcPp.to_string exn)) + ); +(* LexiconSync.time_travel ~present:lexicon ~past:initial_lexicon_status; + * *) + pp_times fname false big_bang big_bang_u big_bang_s; + clean_exit baseuri false + | Sys.Break when not matita_debug -> + HLog.error "user break!"; + pp_times fname false big_bang big_bang_u big_bang_s; + clean_exit baseuri false + | exn when not matita_debug -> + HLog.error + ("Unwrapped exception, please fix: "^ snd (MatitaExcPp.to_string exn)); + pp_times fname false big_bang big_bang_u big_bang_s; + clean_exit baseuri false + +module F = + struct + type source_object = string + type target_object = string + let string_of_source_object s = s;; + let string_of_target_object s = s;; + + let is_readonly_buri_of opts file = + let buri = List.assoc "baseuri" opts in + Http_getter_storage.is_read_only (Librarian.mk_baseuri buri file) + ;; + + let root_and_target_of opts mafile = + try + let include_paths = get_include_paths opts in + let root,baseuri,_,_ = + Librarian.baseuri_of_script ~include_paths mafile + in + let obj_writeable, obj_read_only = + if Filename.check_suffix mafile ".mma" then + Filename.chop_suffix mafile ".mma" ^ ".ma", + Filename.chop_suffix mafile ".mma" ^ ".ma" + else + LibraryMisc.obj_file_of_baseuri + ~must_exist:false ~baseuri ~writable:true, + LibraryMisc.obj_file_of_baseuri + ~must_exist:false ~baseuri ~writable:false + in + Some root, obj_writeable, obj_read_only + with Librarian.NoRootFor x -> None, "", "" + ;; + + let mtime_of_source_object s = + try Some (Unix.stat s).Unix.st_mtime + with Unix.Unix_error (Unix.ENOENT, "stat", f) when f = s -> None + ;; + + let mtime_of_target_object s = + try Some (Unix.stat s).Unix.st_mtime + with Unix.Unix_error (Unix.ENOENT, "stat", f) when f = s -> None + ;; + +(* FG: a problem was noticed in relising memory between subsequent *) +(* invocations of the compiler. The following might help *) + let compact r = Gc.compact (); r + + let build options fname = + let matita_debug = Helm_registry.get_bool "matita.debug" in + let compile atstart opts fname = + try + GrafiteSync.push (); + GrafiteParser.push (); + let rc = compile atstart opts fname in + GrafiteParser.pop (); + GrafiteSync.pop (); + rc + with + | Sys.Break -> + GrafiteParser.pop (); + GrafiteSync.pop (); + false + | exn when not matita_debug -> + HLog.error ("Unexpected " ^ snd(MatitaExcPp.to_string exn)); + assert false + in + if Filename.check_suffix fname ".mma" then + let generated = Filename.chop_suffix fname ".mma" ^ ".ma" in + let atstart, atexit = dump generated in + let res = compile atstart options fname in + let r = compact (atexit res) in + if r then r else begin +(* Sys.remove generated; *) + Printf.printf "rm %s\n" generated; flush stdout; r + end else - pp_ocaml_mode () - | GrafiteEngine.Drop -> - if mode = `COMPILER then - begin - pp_times fname bench_mode false big_bang; - clean_exit (Some 1) - end - else - pp_ocaml_mode () - | GrafiteEngine.Macro (floc,_) -> - let x, y = HExtlib.loc_of_floc floc in - HLog.error - (sprintf "A macro has been found in a script at %d-%d" x y); - if mode = `COMPILER then - begin - pp_times fname bench_mode false big_bang; - clean_exit (Some 1) - end - else - pp_ocaml_mode () - | HExtlib.Localized (floc,CicNotationParser.Parse_error err) -> - let (x, y) = HExtlib.loc_of_floc floc in - HLog.error (sprintf "Parse error at %d-%d: %s" x y err); - if mode = `COMPILER then - begin - pp_times fname bench_mode false big_bang; - clean_exit (Some 1) - end - else - pp_ocaml_mode () - | exn -> - if matita_debug then raise exn; - if mode = `COMPILER then - begin - pp_times fname bench_mode false big_bang; - clean_exit (Some 3) - end - else - pp_ocaml_mode () + compile ignore options fname + ;; + + let load_deps_file = Librarian.load_deps_file;; + + end + +module Make = Librarian.Make(F)