Last active
October 19, 2015 18:30
-
-
Save mjambon/59500ccc519c9f0907b2 to your computer and use it in GitHub Desktop.
Mutual module dependencies in OCaml
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(* | |
One-time initialization. | |
Useful to create mutual dependencies between modules. | |
Usage: | |
(* Module A *) | |
let init_foo, foo = create "foo" | |
let f () = | |
... | |
foo x y (* <-- must take place after initialization *) | |
... | |
(* Module B | |
Function foo is initialized in this module. | |
*) | |
let foo x y = | |
... | |
let () = A.init_foo foo (* <-- initialization *) | |
*) | |
let uninitialized = Hashtbl.create 10 | |
let create_id = | |
let n = ref 0 in | |
fun () -> | |
let id = !n in | |
assert (id >= 0); | |
incr n; | |
id | |
let create name = | |
let r = ref None in | |
let id = create_id () in | |
Hashtbl.add uninitialized id name; | |
let init f = | |
match !r with | |
| None -> | |
Hashtbl.remove uninitialized id; | |
r := Some f | |
| Some _ -> | |
failwith (name ^ " was already initialized") | |
in | |
let call x = | |
match !r with | |
| None -> | |
failwith ("Uninitialized function " ^ name) | |
| Some f -> | |
f x | |
in | |
init, call | |
(* | |
Return the list of uninitialized functions, sorted by creation date. | |
*) | |
let get_all_uninitialized () = | |
let l = | |
Hashtbl.fold (fun id name acc -> (id, name) :: acc) uninitialized [] | |
in | |
let sorted = List.sort (fun (a, _) (b, _) -> compare a b) l in | |
List.map snd sorted | |
(* | |
Print an error and exit the process if anything is uninitialized. | |
*) | |
let check_all () = | |
match get_all_uninitialized () with | |
| [] -> () | |
| l -> | |
Printf.eprintf | |
"The following functions were not initialized: %s\n%!" | |
(String.concat ", " l); | |
exit 1 | |
let test_late_initialization () = | |
let n0 = List.length (get_all_uninitialized ()) in | |
let init_foo, foo = create "foo" in | |
assert (List.length (get_all_uninitialized ()) = n0 + 1); | |
(try | |
ignore (foo 1 2); | |
assert false | |
with _ -> ()); | |
let real_foo x y = x + y in | |
init_foo real_foo; | |
assert (List.length (get_all_uninitialized ()) = n0); | |
(try | |
init_foo real_foo; | |
assert false | |
with _ -> ()); | |
assert (foo 3 4 = 7); | |
true | |
let tests = [ | |
"late initialization", test_late_initialization; | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment