Commit 2f1dde50 authored by Pietro Abate's avatar Pietro Abate

[r2006-05-30 08:24:14 by afrisch] Empty log message

Original author: afrisch
Date: 2006-05-30 08:24:14+00:00
parent d0f5780a
......@@ -990,8 +990,6 @@ module Compile = struct
incr cur_id;
Hashtbl.add dispatcher_of_state state.uid disp;
dispatchers := DispMap.add (t,pl) disp !dispatchers;
(* dump_disp disp;
Format.fprintf Format.std_formatter "IFACE=%a@." print_iface iface; *)
!compute_actions disp;
disp
......@@ -1193,12 +1191,14 @@ module Compile = struct
let nnf = (Normal.NodeSet.singleton p, Types.cap !t0 tp, xs) in
t0 := Types.diff !t0 tp;
[(nnf, (xs, e))] in
let has_facto = ref false in
let res _ _ pl =
let aux r = function
| [((var,nil,res), (xs,e))] -> assert (r == Fail);
let i = ref 0 in
List.iter (fun x ->
if IdSet.mem var x || IdSet.mem nil x then ()
if IdSet.mem var x || IdSet.mem nil x
then has_facto := true
else (assert (IdMap.assoc x res = !i); incr i)) xs;
Match (List.length xs, (var,nil,xs,e))
| [] -> r | _ -> assert false in
......@@ -1207,11 +1207,10 @@ module Compile = struct
"make_branches t=%a #branches=%i@." Types.Print.print t (List.length brs); *)
let pl = Array.map aux (Array.of_list brs) in
let disp,rhs = get_tests true pl (fun x -> x) t res (fun x -> x) in
let state = add_factorized disp rhs in
state,
(Array.map
(function Match (n,(_,_,_,e)) -> Match (n,e) | Fail -> Fail) rhs)
let state = if !has_facto then add_factorized disp rhs else disp.state in
state,
Array.map
(function Match (n,(_,_,_,e)) -> Match (n,e) | Fail -> Fail) rhs
let rec dispatch_prod0 disp t pl =
get_tests true pl
......
......@@ -1307,13 +1307,10 @@ module Cache = struct
| Type of t * 'a
| Split of Witness.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;
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
......@@ -1332,13 +1329,6 @@ module Cache = struct
else
try f2 () with Not_found -> try f1 () 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
......@@ -1354,6 +1344,7 @@ module Cache = struct
let c',r = find f t !c in
c := c';
r
end
......
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