let cu = Types.CompUnit.mk (Encodings.Utf8.mk "OCAML") let () = Types.CompUnit.enter cu; Types.caml_mode := true let init = ref [] let serialize = ref [] module Mk(X : Custom.T) = struct module A = Custom.Array(X) let lst = ref [] and nb = ref (-1) let put x = lst := x :: !lst; incr nb; !nb let init () = lst := []; nb := (-1) let serialize s = Serialize.Put.array X.serialize s (Array.of_list (List.rev !lst)) type 'a entry = Serialized of X.t | Computed of 'a type 'a chunk = 'a entry array let deserialize s = Serialize.Get.array (fun s -> Serialized (X.deserialize s)) s let get f a i = match a.(i) with | Serialized x -> let x = f x in a.(i) <- Computed x; x | Computed x -> x end module PM = Mk(Custom.Pair(Types)(Custom.List(Patterns.Node))) module CONST = Mk(Types.Const) module P = struct let init () = PM.init (); CONST.init () let serialize s () = PM.serialize s; CONST.serialize s let pm = PM.put let const = CONST.put let mk () = let s = Serialize.Put.run serialize () in ignore (Types.CompUnit.close_serialize ()); s end module G = struct type chunk = { pm : (Patterns.Compile.dispatcher * int Patterns.Compile.rhs array) PM.chunk; cst : Value.t CONST.chunk; } let deserialize s = let pm = PM.deserialize s in let cst = CONST.deserialize s in { pm = pm; cst = cst } let mk s = Types.clear_deserialize_table (); Serialize.Get.run deserialize s let mk_pm (t,brs) = let brs = Array.to_list (Array.mapi (fun i x -> (x,i)) (Array.of_list brs)) in Patterns.Compile.make_branches t brs let pm chunk i v = let (d,rhs) = PM.get mk_pm chunk.pm i in let (code,bindings) = Run_dispatch.run_dispatcher d v in match rhs.(code) with | Patterns.Compile.Fail -> (-1,[||]) | Patterns.Compile.Match (bind,i) -> i, Array.map (fun (_,i) -> if (i == -1) then v else bindings.(i)) (Array.of_list bind) let const chunk i = CONST.get Value.const chunk.cst i end