| 966 |
(int * (capture, int) SortedMap.t) list |
(int * (capture, int) SortedMap.t) list |
| 967 |
|
|
| 968 |
and interface = |
and interface = |
| 969 |
[ `Result of int * Types.descr * int (* code, accepted type, arity *) |
[ `Result of int |
| 970 |
| `Switch of (capture, int) SortedMap.t * interface * interface |
| `Switch of interface * interface |
| 971 |
| `None ] |
| `None ] |
| 972 |
|
|
| 973 |
and dispatcher = { |
and dispatcher = { |
| 1091 |
try DispMap.find (t,pl) !dispatchers |
try DispMap.find (t,pl) !dispatchers |
| 1092 |
with Not_found -> |
with Not_found -> |
| 1093 |
let nb = ref 0 in |
let nb = ref 0 in |
| 1094 |
let rec aux t arity i = |
let codes = ref [] in |
| 1095 |
|
let rec aux t arity i accu = |
| 1096 |
if Types.is_empty t then `None |
if Types.is_empty t then `None |
| 1097 |
else |
else |
| 1098 |
if i = Array.length pl |
if i = Array.length pl |
| 1099 |
then (incr nb; `Result (!nb - 1, t, arity)) |
then (incr nb; codes := (t,arity,accu)::!codes; `Result (!nb - 1)) |
| 1100 |
else |
else |
| 1101 |
let p = pl.(i) in |
let p = pl.(i) in |
| 1102 |
let tp = p.Normal.na in |
let tp = p.Normal.na in |
| 1103 |
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; |
|
|
*) |
|
|
|
|
| 1104 |
(* let tp = Types.normalize tp in *) |
(* let tp = Types.normalize tp in *) |
| 1105 |
|
let accu' = (i,num arity v) :: accu in |
| 1106 |
`Switch |
`Switch |
| 1107 |
(num arity v, |
( |
| 1108 |
aux (Types.cap t tp) (arity + (List.length v)) (i+1), |
aux (Types.cap t tp) (arity + (List.length v)) (i+1) accu', |
| 1109 |
aux (Types.diff t tp) arity (i+1) |
aux (Types.diff t tp) arity (i+1) accu |
| 1110 |
) |
) |
| 1111 |
in |
in |
| 1112 |
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; |
|
| 1113 |
let res = { id = !cur_id; |
let res = { id = !cur_id; |
| 1114 |
t = t; |
t = t; |
| 1115 |
pl = pl; |
pl = pl; |
| 1116 |
interface = iface; |
interface = iface; |
| 1117 |
codes = codes; |
codes = Array.of_list (List.rev !codes); |
| 1118 |
actions = None } in |
actions = None } in |
| 1119 |
incr cur_id; |
incr cur_id; |
| 1120 |
dispatchers := DispMap.add (t,pl) res !dispatchers; |
dispatchers := DispMap.add (t,pl) res !dispatchers; |
| 1121 |
res |
res |
| 1122 |
|
|
|
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 |
|
|
|
|
| 1123 |
let find_code d a = |
let find_code d a = |
| 1124 |
let rec aux i = function |
let rec aux i = function |
| 1125 |
| `Result (code,_,_) -> code |
| `Result code -> code |
| 1126 |
| `None -> |
| `None -> assert false |
| 1127 |
assert false |
| `Switch (yes,_) when a.(i) <> None -> aux (i + 1) yes |
| 1128 |
| `Switch (_,yes,no) -> |
| `Switch (_,no) -> aux (i + 1) no |
|
match a.(i) with Some _ -> aux (i + 1) yes | None -> aux (i + 1) no |
|
| 1129 |
in |
in |
| 1130 |
aux 0 d.interface |
aux 0 d.interface |
| 1131 |
|
|
| 1164 |
|
|
| 1165 |
|
|
| 1166 |
let dispatch_basic disp : (Types.descr * result) list = |
let dispatch_basic disp : (Types.descr * result) list = |
| 1167 |
|
(* TODO: try other algo, using disp.codes .... *) |
| 1168 |
let pl = Array.map (fun p -> p.Normal.nbasic) disp.pl in |
let pl = Array.map (fun p -> p.Normal.nbasic) disp.pl in |
| 1169 |
let tests = |
let tests = |
| 1170 |
let accu = ref [] in |
let accu = ref [] in |
Parent Directory
| 
Revision Log
| 
Patch