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

[r2006-09-11 12:20:06 by afrisch] Empty log message

Original author: afrisch
Date: 2006-09-11 12:20:06+00:00
parent 714edc2f
...@@ -975,6 +975,11 @@ module Cache = struct ...@@ -975,6 +975,11 @@ module Cache = struct
else else
try f2 () with Not_found -> try f1 () with Not_found -> c, rs try f2 () with Not_found -> try f1 () with Not_found -> c, rs
let rec lookup t = function
| Empty -> None
| Split (w,yes,no) -> lookup t (if Witness.type_has t w then yes else no)
| Type (s,rs) -> if equiv s t then Some rs else None
let emp = Empty let emp = Empty
...@@ -987,9 +992,9 @@ module Cache = struct ...@@ -987,9 +992,9 @@ module Cache = struct
let memo f = let memo f =
let c = ref emp in let c = ref emp in
fun t -> fun t ->
let c',r = find f t !c in let c',r = find f t !c in
c := c'; c := c';
r r
end end
...@@ -1425,7 +1430,13 @@ struct ...@@ -1425,7 +1430,13 @@ struct
module DescrPairMap = Map.Make(Custom.Pair(Descr)(Descr)) module DescrPairMap = Map.Make(Custom.Pair(Descr)(Descr))
let uniq = Cache.memo (fun t -> t) let memo = ref Cache.emp
let uniq t =
let c',r = Cache.find (fun t -> t) t !memo in
memo := c';
r
let lookup t = match Cache.lookup t !memo with Some t -> t | None -> t
let named = ref DescrMap.empty let named = ref DescrMap.empty
let named_xml = ref DescrPairMap.empty let named_xml = ref DescrPairMap.empty
...@@ -1488,6 +1499,7 @@ struct ...@@ -1488,6 +1499,7 @@ struct
n >= 5 n >= 5
let rec prepare d = let rec prepare d =
let d = lookup d in
try DescrHash.find memo d try DescrHash.find memo d
with Not_found -> with Not_found ->
try 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