Commit e08a6bc4 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2006-04-21 16:03:53 by afrisch] Tracing the cache

Original author: afrisch
Date: 2006-04-21 16:03:53+00:00
parent a699b619
......@@ -1240,7 +1240,9 @@ module Cache = struct
~atom:f
let rec type_has_witness t = function (* Special case for empty, any ? *)
let rec type_has_witness t w =
print_char '?'; flush stdout;
match w with
| WInt i -> Intervals.contains i t.ints
| WChar c -> Chars.contains c t.chars
| WAtom a -> Atoms.contains_sample a t.atoms
......@@ -1276,32 +1278,53 @@ module Cache = struct
| WAbsent -> t.absent
| WAbstract a -> Abstract.contains_sample a t.abstract
(*
let type_has_witness t w =
Format.fprintf Format.std_formatter
"check wit:%a@." print_witness w;
let r = type_has_witness t w in
Format.fprintf Format.std_formatter "Done@.";
r
*)
type 'a cache =
| Empty
| Type of t * 'a
| Split of witness * 'a cache * 'a cache
let steps = ref 0
let rec find f t = function
| Empty ->
let r = f t in Type (t,r), r
| Split (w,yes,no) ->
incr steps;
print_char '.'; flush stdout;
if type_has_witness t w
then let yes,r = find f t yes in Split (w,yes,no), r
else let no,r = find f t no in Split (w,yes,no), r
| Type (s,rs) as c ->
Format.fprintf Format.std_formatter "!@.";
try
let w = witness (diff t s) in
(* Format.fprintf Format.std_formatter "wit:%a@." print_witness w; *)
let rt = f t in
Split (w, Type (t,rt), c), rt
with Not_found -> try
let w = witness (diff s t) in
(* Format.fprintf Format.std_formatter "wit:%a@." print_witness w; *)
let rt = f t in
Split (w, c, Type (t,rt)), rt
with Not_found ->
c, rs
let find f t c =
steps := 0;
Format.fprintf Format.std_formatter "begin find@.";
let r = find f t c in
Format.fprintf Format.std_formatter "steps:%i@." !steps;
r
let emp = Empty
let memo f =
......@@ -1380,9 +1403,12 @@ struct
module DescrPairMap = Map.Make(Custom.Pair(Descr)(Descr))
let uniq = (*Cache.memo*) (fun t -> t)
let named = ref DescrMap.empty
let named_xml = ref DescrPairMap.empty
let register_global cu (name : Ns.QName.t) d =
let d = uniq d in
if equal { d with xml = BoolPair.empty } empty then
(let l = (*Product.merge_same_2*) (Product.get ~kind:`XML d) in
match l with
......@@ -1395,6 +1421,7 @@ struct
else named := DescrMap.add d (cu,name) !named
let unregister_global d =
let d = uniq d in
if equal { d with xml = BoolPair.empty } empty then
(let l = Product.get ~kind:`XML d in
match l with
......@@ -1439,6 +1466,7 @@ struct
n >= 5
let rec prepare d =
let d = uniq d in
try DescrHash.find memo d
with Not_found ->
try
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment