diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/libobject.ml | 16 | ||||
| -rw-r--r-- | library/library.ml | 36 |
2 files changed, 25 insertions, 27 deletions
diff --git a/library/libobject.ml b/library/libobject.ml index c5cd01525..79a3fed1b 100644 --- a/library/libobject.ml +++ b/library/libobject.ml @@ -98,7 +98,7 @@ let declare_object_full odecl = declare_object_full odecl (* this function describes how the cache, load, open, and export functions are triggered. *) -let apply_dyn_fun deflt f lobj = +let apply_dyn_fun f lobj = let tag = object_tag lobj in let dodecl = try Hashtbl.find cache_tab tag @@ -107,24 +107,24 @@ let apply_dyn_fun deflt f lobj = f dodecl let cache_object ((_,lobj) as node) = - apply_dyn_fun () (fun d -> d.dyn_cache_function node) lobj + apply_dyn_fun (fun d -> d.dyn_cache_function node) lobj let load_object i ((_,lobj) as node) = - apply_dyn_fun () (fun d -> d.dyn_load_function i node) lobj + apply_dyn_fun (fun d -> d.dyn_load_function i node) lobj let open_object i ((_,lobj) as node) = - apply_dyn_fun () (fun d -> d.dyn_open_function i node) lobj + apply_dyn_fun (fun d -> d.dyn_open_function i node) lobj let subst_object ((_,lobj) as node) = - apply_dyn_fun lobj (fun d -> d.dyn_subst_function node) lobj + apply_dyn_fun (fun d -> d.dyn_subst_function node) lobj let classify_object lobj = - apply_dyn_fun Dispose (fun d -> d.dyn_classify_function lobj) lobj + apply_dyn_fun (fun d -> d.dyn_classify_function lobj) lobj let discharge_object ((_,lobj) as node) = - apply_dyn_fun None (fun d -> d.dyn_discharge_function node) lobj + apply_dyn_fun (fun d -> d.dyn_discharge_function node) lobj let rebuild_object lobj = - apply_dyn_fun lobj (fun d -> d.dyn_rebuild_function lobj) lobj + apply_dyn_fun (fun d -> d.dyn_rebuild_function lobj) lobj let dump = Dyn.dump diff --git a/library/library.ml b/library/library.ml index 400f3dcf1..0ff82d7cc 100644 --- a/library/library.ml +++ b/library/library.ml @@ -167,7 +167,7 @@ let opened_libraries () = !libraries_imports_list let register_loaded_library m = let libname = m.libsum_name in - let link m = + let link () = let dirname = Filename.dirname (library_full_filename libname) in let prefix = Nativecode.mod_uid_of_dirpath libname ^ "." in let f = prefix ^ "cmo" in @@ -176,7 +176,7 @@ let register_loaded_library m = Nativelib.link_library ~prefix ~dirname ~basename:f in let rec aux = function - | [] -> link m; [libname] + | [] -> link (); [libname] | m'::_ as l when DirPath.equal m' libname -> l | m'::l' -> m' :: aux l' in libraries_loaded_list := aux !libraries_loaded_list; @@ -288,16 +288,15 @@ let locate_absolute_library dir = try let name = Id.to_string base ^ ext in let _, file = System.where_in_path ~warn:false loadpath name in - [file] - with Not_found -> [] in - match find ".vo" @ find ".vio" with - | [] -> raise LibNotFound - | [file] -> file - | [vo;vi] when Unix.((stat vo).st_mtime < (stat vi).st_mtime) -> + Some file + with Not_found -> None in + match find ".vo", find ".vio" with + | None, None -> raise LibNotFound + | Some file, None | None, Some file -> file + | Some vo, Some vi when Unix.((stat vo).st_mtime < (stat vi).st_mtime) -> warn_several_object_files (vi, vo); vi - | [vo;vi] -> vo - | _ -> assert false + | Some vo, Some _ -> vo let locate_qualified_library ?root ?(warn = true) qid = (* Search library in loadpath *) @@ -309,18 +308,17 @@ let locate_qualified_library ?root ?(warn = true) qid = let name = Id.to_string base ^ ext in let lpath, file = System.where_in_path ~warn (List.map fst loadpath) name in - [lpath, file] - with Not_found -> [] in + Some (lpath, file) + with Not_found -> None in let lpath, file = - match find ".vo" @ find ".vio" with - | [] -> raise LibNotFound - | [lpath, file] -> lpath, file - | [lpath_vo, vo; lpath_vi, vi] + match find ".vo", find ".vio" with + | None, None -> raise LibNotFound + | Some res, None | None, Some res -> res + | Some (_, vo), Some (_, vi as resvi) when Unix.((stat vo).st_mtime < (stat vi).st_mtime) -> warn_several_object_files (vi, vo); - lpath_vi, vi - | [lpath_vo, vo; _ ] -> lpath_vo, vo - | _ -> assert false + resvi + | Some resvo, Some _ -> resvo in let dir = add_dirpath_suffix (String.List.assoc lpath loadpath) base in (* Look if loaded *) |