Commit 5afe3e5f authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2002-11-24 16:49:22 by cvscast] Simplifications in patterns.ml

Original author: cvscast
Date: 2002-11-24 16:49:22+00:00
parent 3a61c941
...@@ -966,8 +966,8 @@ struct ...@@ -966,8 +966,8 @@ struct
(int * (capture, int) SortedMap.t) list (int * (capture, int) SortedMap.t) list
and interface = and interface =
[ `Result of int * Types.descr * int (* code, accepted type, arity *) [ `Result of int
| `Switch of (capture, int) SortedMap.t * interface * interface | `Switch of interface * interface
| `None ] | `None ]
and dispatcher = { and dispatcher = {
...@@ -1091,68 +1091,41 @@ struct ...@@ -1091,68 +1091,41 @@ struct
try DispMap.find (t,pl) !dispatchers try DispMap.find (t,pl) !dispatchers
with Not_found -> with Not_found ->
let nb = ref 0 in let nb = ref 0 in
let rec aux t arity i = let codes = ref [] in
let rec aux t arity i accu =
if Types.is_empty t then `None if Types.is_empty t then `None
else else
if i = Array.length pl if i = Array.length pl
then (incr nb; `Result (!nb - 1, t, arity)) then (incr nb; codes := (t,arity,accu)::!codes; `Result (!nb - 1))
else else
let p = pl.(i) in let p = pl.(i) in
let tp = p.Normal.na in let tp = p.Normal.na in
let v = p.Normal.nfv in let v = SortedList.diff p.Normal.nfv p.Normal.ncatchv in
let v = SortedList.diff v p.Normal.ncatchv in
(*
Printf.eprintf "ncatchv = (";
List.iter (fun s -> Printf.eprintf "%s;" s) p.Normal.ncatchv;
Printf.eprintf ")\n";
flush stderr;
*)
(* let tp = Types.normalize tp in *) (* let tp = Types.normalize tp in *)
let accu' = (i,num arity v) :: accu in
`Switch `Switch
(num arity v, (
aux (Types.cap t tp) (arity + (List.length v)) (i+1), aux (Types.cap t tp) (arity + (List.length v)) (i+1) accu',
aux (Types.diff t tp) arity (i+1) aux (Types.diff t tp) arity (i+1) accu
) )
in in
let iface = aux t 0 0 in let iface = aux t 0 0 [] in
let codes = Array.create !nb (Types.empty,0,[]) in
let rec aux i accu = function
| `None -> ()
| `Switch (pos, yes, no) ->
aux (i + 1) ((i,pos) :: accu) yes; aux (i + 1) accu no
| `Result (code,t,arity) ->
codes.(code) <- (t,arity, accu)
in
aux 0 [] iface;
let res = { id = !cur_id; let res = { id = !cur_id;
t = t; t = t;
pl = pl; pl = pl;
interface = iface; interface = iface;
codes = codes; codes = Array.of_list (List.rev !codes);
actions = None } in actions = None } in
incr cur_id; incr cur_id;
dispatchers := DispMap.add (t,pl) res !dispatchers; dispatchers := DispMap.add (t,pl) res !dispatchers;
res res
let compare_masks a1 a2 =
try
for i = 0 to Array.length a1 - 1 do
match a1.(i),a2.(i) with
| None,Some _| Some _, None -> raise Exit
| _ -> ()
done;
true
with Exit -> false
let find_code d a = let find_code d a =
let rec aux i = function let rec aux i = function
| `Result (code,_,_) -> code | `Result code -> code
| `None -> | `None -> assert false
assert false | `Switch (yes,_) when a.(i) <> None -> aux (i + 1) yes
| `Switch (_,yes,no) -> | `Switch (_,no) -> aux (i + 1) no
match a.(i) with Some _ -> aux (i + 1) yes | None -> aux (i + 1) no
in in
aux 0 d.interface aux 0 d.interface
...@@ -1191,6 +1164,7 @@ struct ...@@ -1191,6 +1164,7 @@ struct
let dispatch_basic disp : (Types.descr * result) list = let dispatch_basic disp : (Types.descr * result) list =
(* TODO: try other algo, using disp.codes .... *)
let pl = Array.map (fun p -> p.Normal.nbasic) disp.pl in let pl = Array.map (fun p -> p.Normal.nbasic) disp.pl in
let tests = let tests =
let accu = ref [] in let accu = ref [] 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