Commit 714edc2f authored by Pietro Abate's avatar Pietro Abate

[r2006-09-11 12:01:39 by afrisch] Empty log message

Original author: afrisch
Date: 2006-09-11 12:01:39+00:00
parent 8ebed49b
......@@ -937,6 +937,62 @@ let subtype d1 d2 =
let equiv d1 d2 = (subtype d1 d2) && (subtype d2 d1)
module Cache = struct
(*
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.witness * 'a cache * 'a cache
let rec find f t = function
| Empty ->
let r = f t in Type (t,r), r
| Split (w,yes,no) ->
if Witness.type_has 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 ->
let f1 ()=
let w = witness (diff t s) in
let rt = f t in
Split (w, Type (t,rt), c), rt
and f2 () =
let w = witness (diff s t) in
let rt = f t in
Split (w, c, Type (t,rt)), rt in
if Random.int 2 = 0 then
try f1 () with Not_found -> try f2 () with Not_found -> c, rs
else
try f2 () with Not_found -> try f1 () with Not_found -> c, rs
let emp = Empty
let rec dump_cache f ppf = function
| Empty -> Format.fprintf ppf "Empty"
| Type (_,s) -> Format.fprintf ppf "*%a" f s
| Split (w,c1,c2) -> Format.fprintf ppf "?(%a,%a)"
(*Witness.print_witness w *)(dump_cache f) c1 (dump_cache f) c2
let memo f =
let c = ref emp in
fun t ->
let c',r = find f t !c in
c := c';
r
end
module Product =
struct
type t = (descr * descr) list
......@@ -1082,6 +1138,22 @@ struct
n
let merge_same_first tr =
let trs = ref [] in
let _ =
List.fold_left
(fun memo (t1,t2) ->
let memo',l =
Cache.find
(fun t1 -> let l = ref empty in trs := (t1,l) :: !trs; l)
t1 memo in
l := cup t2 !l;
memo')
Cache.emp tr in
List.map (fun (t1,l) -> (t1,!l)) !trs
(* same on second component: use the same implem? *)
let clean_normal l =
let rec aux accu (t1,t2) =
match accu with
......@@ -1292,62 +1364,6 @@ struct
end
module Cache = struct
(*
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.witness * 'a cache * 'a cache
let rec find f t = function
| Empty ->
let r = f t in Type (t,r), r
| Split (w,yes,no) ->
if Witness.type_has 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 ->
let f1 ()=
let w = witness (diff t s) in
let rt = f t in
Split (w, Type (t,rt), c), rt
and f2 () =
let w = witness (diff s t) in
let rt = f t in
Split (w, c, Type (t,rt)), rt in
if Random.int 2 = 0 then
try f1 () with Not_found -> try f2 () with Not_found -> c, rs
else
try f2 () with Not_found -> try f1 () with Not_found -> c, rs
let emp = Empty
let rec dump_cache f ppf = function
| Empty -> Format.fprintf ppf "Empty"
| Type (_,s) -> Format.fprintf ppf "*%a" f s
| Split (w,c1,c2) -> Format.fprintf ppf "?(%a,%a)"
(*Witness.print_witness w *)(dump_cache f) c1 (dump_cache f) c2
let memo f =
let c = ref emp in
fun t ->
let c',r = find f t !c in
c := c';
r
end
module Print =
struct
let rec print_const ppf = function
......@@ -1542,6 +1558,7 @@ struct
Decompile.decompile
(fun t ->
let tr = Product.get t in
let tr = Product.merge_same_first tr in
let tr = Product.clean_normal tr in
let eps = Atoms.contains nil_atom t.atoms in
......
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