pgm_env.ml 907 Bytes
Newer Older
1 2

open Why
3
open Pgm_module
4

5 6 7 8
type t = {
  env      : Env.env;
  retrieve : retrieve_module;
  memo     : (string list, Pgm_module.t Mnm.t) Hashtbl.t;
9 10
}

11
and retrieve_module = t -> string -> in_channel -> Pgm_module.t Mnm.t
12

13
let get_env penv = penv.env
14

15 16 17 18
let create env retrieve = {
  env = env;
  retrieve = retrieve;
  memo = Hashtbl.create 17;
19
}
20

21 22 23 24 25 26 27 28 29 30 31
exception ModuleNotFound of string list * string

let rec add_suffix = function
  | [] -> assert false
  | [f] -> [f ^ ".mlw"]
  | p :: f -> p :: add_suffix f

let find_library penv sl =
  try Hashtbl.find penv.memo sl
  with Not_found ->
    Hashtbl.add penv.memo sl Mnm.empty;
32 33
    let file, c = Env.find_channel penv.env (add_suffix sl) in
    let m = penv.retrieve penv file c in
34 35 36 37 38 39 40
    close_in c;
    Hashtbl.replace penv.memo sl m;
    m

let find_module penv sl s =
  try Mnm.find s (find_library penv sl)
  with Not_found -> raise (ModuleNotFound (sl, s))