Commit 4fc1fc84 authored by Pietro Abate's avatar Pietro Abate

[r2006-05-29 12:31:49 by afrisch] Empty log message

Original author: afrisch
Date: 2006-05-29 12:31:50+00:00
parent a976a9f7
......@@ -30,7 +30,7 @@ and 'a dispatch =
and state = {
uid : int;
arity : int array;
arity : int array;
mutable actions: actions;
mutable fail_code: int;
mutable expected_type: string;
......
......@@ -63,6 +63,10 @@ let print s = match get s with
type 'a map = 'a Imap.t * 'a Imap.t * 'a option
let map_map f (m1,m2,o) =
Imap.map f m1, Imap.map f m2,
(match o with Some x -> Some (f x) | None -> None)
(* TODO: optimize this get_map *)
let get_map q (mtags,mns,def) =
try Imap.find mtags (Upool.int q)
......
......@@ -39,4 +39,4 @@ val contains_sample: sample -> t -> bool
type 'a map
val mk_map: (t * 'a) list -> 'a map
val get_map: V.t -> 'a map -> 'a
val map_map: ('a -> 'b) -> 'a map -> 'b map
......@@ -131,6 +131,9 @@ let dump ppf t =
type 'a map = (int * 'a) list
let map_map f l = List.map (fun (i,x) -> (i, f x)) l
(* Optimize lookup:
- decision tree
- merge adjacent segment with same result
......
......@@ -34,3 +34,4 @@ val single : t -> V.t
type 'a map
val mk_map: (t * 'a) list -> 'a map
val get_map: V.t-> 'a map -> 'a
val map_map: ('a -> 'b) -> 'a map -> 'b map
......@@ -1112,7 +1112,9 @@ module Compile = struct
(* Build continuation *)
let result (t,ar,m) =
let get (req,info) a =
let (var,nil,r') = NfMap.find req !factorized in
let (var,nil,r') =
try NfMap.find req !factorized
with Not_found -> assert false in
try
let i = NfMap.find r' idx in
match m.(i) with Some res -> ((var,nil,res),info)::a | _ -> a
......@@ -1125,6 +1127,61 @@ module Compile = struct
let res = Array.map result disp.codes in
post (disp,res)
let add_factorized disp rhs =
let result ((code,srcs,pop) as r) =
match rhs.(code) with
| Fail -> r
| Match (_,(var,nil,xs,_)) ->
let pos = ref (-1) in
let var x =
if IdSet.mem var x then Catch
else if IdSet.mem nil x then Nil
else (incr pos; srcs.(!pos)) in
let srcs' = Array.of_list (List.map var (IdSet.get xs)) in
assert(succ !pos = Array.length srcs);
(code,srcs',pop) in
let dispatch1 = function
| Dispatch (s,a) -> Dispatch (s, Array.map result a)
| TailCall s ->
let f code (_,ar,_) =
let srcs = Array.init ar (fun i -> Stack (ar - i)) in
result (code,srcs,ar) in
Dispatch (s, Array.mapi f disp.codes)
| Ignore r -> Ignore (result r)
| Impossible -> Impossible in
let dispatch2 = function
| Dispatch (s,a) -> Dispatch (s, Array.map dispatch1 a)
| TailCall s ->
let f code (_,ar,_) =
let srcs = Array.init ar (fun i -> Stack (ar - i)) in
Ignore (result (code,srcs,ar)) in
Dispatch (s, Array.mapi f disp.codes)
| Ignore r -> Ignore (dispatch1 r)
| Impossible -> Impossible in
let state = disp.state in
let actions = match state.actions with
| AIgnore r -> AIgnore (result r)
| AKind k ->
AKind {
basic = List.map (fun (t,r) -> (t,result r)) k.basic;
atoms = Atoms.map_map result k.atoms;
chars = Chars.map_map result k.chars;
prod = dispatch2 k.prod;
xml = dispatch2 k.xml;
record =
(match k.record with
| None -> None
| Some (RecLabel (l,x)) -> Some (RecLabel (l,dispatch2 x))
| Some (RecNolabel (x,y)) ->
Some (RecNolabel (
(match x with None -> None
| Some r -> Some (result r)),
(match y with None -> None
| Some r -> Some (result r)))))
}
in
{ state with actions = actions }
let make_branches t brs =
let t0 = ref t in
let aux (p,e) =
......@@ -1135,16 +1192,22 @@ module Compile = struct
[(nnf, (xs, e))] in
let res _ _ pl =
let aux r = function
| [(([],[],res), (xs,e))] -> assert (r == Fail);
| [((var,nil,res), (xs,e))] -> assert (r == Fail);
let i = ref 0 in
List.iter (fun x -> assert (IdMap.assoc x res = !i); incr i) xs;
Match (List.length xs, e)
List.iter (fun x ->
if IdSet.mem var x || IdSet.mem nil x then ()
else (assert (IdMap.assoc x res = !i); incr i)) xs;
Match (List.length xs, (var,nil,xs,e))
| [] -> r | _ -> assert false in
Array.fold_left aux Fail pl in
(* Format.fprintf Format.std_formatter
"make_branches t=%a #branches=%i@." Types.Print.print t (List.length brs); *)
let pl = Array.map aux (Array.of_list brs) in
get_tests false pl (fun x -> x) t res (fun (disp,rhs) -> disp.state,rhs)
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 rec dispatch_prod0 disp t pl =
......@@ -1299,7 +1362,7 @@ module Compile = struct
let (d,rhs) = make_branches t0 [ (p,()) ] in
let code = ref (-1) in
Array.iteri
(fun (i : int) (rhs : unit rhs) ->
(fun (i : int) rhs ->
match rhs with
| Fail -> assert (!code < 0); code := i | _ -> ()) rhs;
if (!code >= 0) then prepare_checker !code d;
......
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