X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=ata.ml;h=0132b36cb04b534f5b0d378c1187385c868ffc54;hb=8b3283c30149065d761e38cf0818c8ede62d48ab;hp=6cdd9efec5baae2ddf5b9bfe60c34a4036dbb4d3;hpb=09870a49122b3d7048422818dbb0a038513b4d14;p=SXSI%2Fxpathcomp.git diff --git a/ata.ml b/ata.ml index 6cdd9ef..0132b36 100644 --- a/ata.ml +++ b/ata.ml @@ -2,10 +2,6 @@ INCLUDE "debug.ml" INCLUDE "utils.ml" type jump_kind = [ `TAG of Tag.t | `CONTAINS of string | `NOTHING ] -let cpt_trans = ref 0 -let miss_trans = ref 0 -let cpt_eval = ref 0 -let miss_eval = ref 0 (* Todo : move elsewhere *) external vb : bool -> int = "%identity" @@ -69,8 +65,8 @@ struct match f.pos with | False -> 0 | True -> 1 - | Or (f1,f2) -> HASHINT3(PRIME2,HNode.hash f1,HNode.hash f2) - | And (f1,f2) -> HASHINT3(PRIME3,HNode.hash f1,HNode.hash f2) + | Or (f1,f2) -> HASHINT3(PRIME2,HNode.uid f1,HNode.uid f2) + | And (f1,f2) -> HASHINT3(PRIME3,HNode.uid f1,HNode.uid f2) | Atom(d,p,s) -> HASHINT4(PRIME4,hash_const_variant d,vb p,s) end @@ -213,14 +209,16 @@ module Transition = struct s == s' && b==b' && m==m' && Formula.equal f f' end) - let print ppf f = let (st,mark,form,_) = node f in + let print ppf f = let (st,mark,form,b) = node f in Format.fprintf ppf "%i %s" st (if mark then "⇒" else "→"); Formula.print ppf form; - Format.pp_print_flush ppf () + Format.fprintf ppf "%s%!" (if b then " (b)" else "") + + module Infix = struct let ( ?< ) x = x - let ( >< ) state (l,mark) = state,(l,mark,true) - let ( ><@ ) state (l,mark) = state,(l,mark,false) + let ( >< ) state (l,mark) = state,(l,mark,false) + let ( ><@ ) state (l,mark) = state,(l,mark,true) let ( >=> ) (state,(label,mark,bur)) form = (state,label,(make (state,mark,form,bur))) end @@ -230,14 +228,14 @@ module SetTagKey = struct type t = Ptset.Int.t*Tag.t let equal (s1,t1) (s2,t2) = (t1 == t2) && Ptset.Int.equal s1 s2 - let hash (s,t) = HASHINT2(Ptset.Int.hash s,Tag.hash t) + let hash (s,t) = HASHINT2(Ptset.Int.uid s, t) end module TransTable = Hashtbl module CachedTransTable = Hashtbl.Make(SetTagKey) module Formlist = struct - include Ptset.Make(Transition) + include Hlist.Make(Transition) let print ppf fl = iter (fun t -> Transition.print ppf t; Format.pp_print_newline ppf ()) fl end @@ -288,87 +286,146 @@ let dump ppf a = Format.fprintf ppf "%s\n%!" (String.make (maxt+maxh+3) '_') +module FormTable = Hashtbl.Make(struct + type t = Formula.t*StateSet.t*StateSet.t + let equal (f1,s1,t1) (f2,s2,t2) = + Formula.equal f1 f2 && StateSet.equal s1 s2 && StateSet.equal t1 t2 + let hash (f,s,t) = + HASHINT3(Formula.uid f ,StateSet.uid s,StateSet.uid t) + end) +(* Too slow module MemoForm = Memoizer.Make( - Hashtbl.Make(struct - type t = Formula.t*(StateSet.t*StateSet.t) - let equal (f1,(s1,t1)) (f2,(s2,t2)) = - Formula.equal f1 f2 && StateSet.equal s1 s2 && StateSet.equal t1 t2 - let hash (f,(s,t)) = - HASHINT3(Formula.uid f ,StateSet.uid s,StateSet.uid t) - end)) - -module F = Formula - - let eval_form_bool f s1 s2 = - let sets = (s1,s2) in - let eval = MemoForm.make_rec( - fun eval (f,_) -> - match F.expr f with - | F.True -> true,true,true - | F.False -> false,false,false - | F.Atom((`Left|`LLeft),b,q) -> - if b == (StateSet.mem q s1) - then (true,true,false) - else false,false,false - | F.Atom(_,b,q) -> - if b == (StateSet.mem q s2) - then (true,false,true) - else false,false,false - | F.Or(f1,f2) -> - let b1,rl1,rr1 = eval (f1,sets) - in - if b1 && rl1 && rr1 then (true,true,true) else - let b2,rl2,rr2 = eval (f2,sets) in - let rl1,rr1 = if b1 then rl1,rr1 else false,false - and rl2,rr2 = if b2 then rl2,rr2 else false,false - in (b1 || b2, rl1||rl2,rr1||rr2) +module F = Formula +(* +let eval_form_bool = + MemoForm.make_rec( + fun eval (f, ((s1,s2) as sets)) -> + match F.expr f with + | F.True -> true,true,true + | F.False -> false,false,false + | F.Atom((`Left|`LLeft),b,q) -> + if b == (StateSet.mem q s1) + then (true,true,false) + else false,false,false + | F.Atom(_,b,q) -> + if b == (StateSet.mem q s2) + then (true,false,true) + else false,false,false + | F.Or(f1,f2) -> + let b1,rl1,rr1 = eval (f1,sets) + in + if b1 && rl1 && rr1 then (true,true,true) else + let b2,rl2,rr2 = eval (f2,sets) in + let rl1,rr1 = if b1 then rl1,rr1 else false,false + and rl2,rr2 = if b2 then rl2,rr2 else false,false + in (b1 || b2, rl1||rl2,rr1||rr2) + | F.And(f1,f2) -> let b1,rl1,rr1 = eval (f1,sets) in if b1 && rl1 && rr1 then (true,true,true) else - if b1 then - let b2,rl2,rr2 = eval (f2,sets) in - if b2 then (true,rl1||rl2,rr1||rr2) else (false,false,false) - else (false,false,false) - ) - in - eval (f,sets) - - - module MemoFormlist = Memoizer.Make( - Hashtbl.Make(struct - type t = Formlist.t*(StateSet.t*StateSet.t) - let equal (f1,(s1,t1)) (f2,(s2,t2)) = - Formlist.equal f1 f2 && StateSet.equal s1 s2 && StateSet.equal t1 t2 - let hash (f,(s,t)) = - HASHINT3(Formlist.uid f ,StateSet.uid s,StateSet.uid t) - end)) - - let eval_formlist ?(memo=true) s1 s2 fl = - let sets = (s1,s2) in - let eval = MemoFormlist.make_rec ( - fun eval (fl,_) -> - if Formlist.is_empty fl - then StateSet.empty,false,false,false,false - else - let f,fll = Formlist.uncons fl in - let q,mark,f,_ = Transition.node f in - let b,b1,b2 = eval_form_bool f s1 s2 in - let s,b',b1',b2',amark = eval (fll,sets) in - if b then (StateSet.add q s, b, b1'||b1,b2'||b2,mark||amark) - else s,b',b1',b2',amark ) - in eval (fl,sets) - + if b1 then + let b2,rl2,rr2 = eval (f2,sets) in + if b2 then (true,rl1||rl2,rr1||rr2) else (false,false,false) + else (false,false,false) + ) + +*) *) +module F = Formula + +let eval_form_bool = + let h_f = FormTable.create BIG_H_SIZE in + fun f s1 s2 -> + let rec loop f = + match F.expr f with + | F.True -> true,true,true + | F.False -> false,false,false + | F.Atom((`Left|`LLeft),b,q) -> + if b == (StateSet.mem q s1) + then (true,true,false) + else false,false,false + | F.Atom(_,b,q) -> + if b == (StateSet.mem q s2) + then (true,false,true) + else false,false,false + | f' -> + try FormTable.find h_f (f,s1,s2) + with Not_found -> let r = + match f' with + | F.Or(f1,f2) -> + let b1,rl1,rr1 = loop f1 + in + if b1 && rl1 && rr1 then (true,true,true) else + let b2,rl2,rr2 = loop f2 in + let rl1,rr1 = if b1 then rl1,rr1 else false,false + and rl2,rr2 = if b2 then rl2,rr2 else false,false + in (b1 || b2, rl1||rl2,rr1||rr2) + + | F.And(f1,f2) -> + let b1,rl1,rr1 = loop f1 in + if b1 && rl1 && rr1 then (true,true,true) else + if b1 then + let b2,rl2,rr2 = loop f2 in + if b2 then (true,rl1||rl2,rr1||rr2) else (false,false,false) + else (false,false,false) + | _ -> assert false + in FormTable.add h_f (f,s1,s2) r;r + in loop f + +module FTable = Hashtbl.Make( + struct + type t = Formlist.t*StateSet.t*StateSet.t + let equal (f1,s1,t1) (f2,s2,t2) = + Formlist.equal f1 f2 && StateSet.equal s1 s2 && StateSet.equal t1 t2;; + let hash (f,s,t) = HASHINT3(Formlist.uid f ,StateSet.uid s,StateSet.uid t);; + end) + +(* +module MemoFormlist = Memoizer.Make(FTable) + + Too slow + let eval_formlist = MemoFormlist.make_rec ( + fun eval (fl,((s1,s2)as sets)) -> + match Formlist.node fl with + | Formlist.Nil -> StateSet.empty,false,false,false,false + | Formlist.Cons(f,fll) -> + let q,mark,f,_ = Transition.node f in + let b,b1,b2 = eval_form_bool f s1 s2 in + let s,b',b1',b2',amark = eval (fll,sets) in + if b then (StateSet.add q s, b, b1'||b1,b2'||b2,mark||amark) + else s,b',b1',b2',amark ) +*) + + + + let eval_formlist = + let h_f = FTable.create BIG_H_SIZE in + fun s1 s2 fl -> + let rec loop fl = + let key = (fl,s1,s2) in + try + FTable.find h_f key + with + | Not_found -> + match Formlist.node fl with + | Formlist.Nil -> StateSet.empty,false,false,false,false + | Formlist.Cons(f,fll) -> + let q,mark,f,_ = Transition.node f in + let b,b1,b2 = eval_form_bool f s1 s2 in + let s,b',b1',b2',amark = loop fll in + let r = if b then (StateSet.add q s, b, b1'||b1,b2'||b2,mark||amark) + else s,b',b1',b2',amark + in FTable.add h_f key r;r + in loop fl let tags_of_state a q = Hashtbl.fold (fun p l acc -> if p == q then List.fold_left - - (fun acc (ts,t) -> - let _,_,_,aux = Transition.node t in - if aux then acc else - TagSet.cup ts acc) acc l + (fun acc (ts,t) -> + let _,_,_,aux = Transition.node t in + if aux then acc else + TagSet.cup ts acc) acc l else acc) a.trans TagSet.empty @@ -390,7 +447,6 @@ module F = Formula let next_sibling_ctx x _ = Tree.next_sibling x let r_ignore _ x = x - let set_get_tag r t = r := (fun _ -> t) module type ResultSet = sig @@ -463,58 +519,13 @@ module F = Formula module Run (RS : ResultSet) = struct + module SList = Hlist.Make (StateSet) - let fmt = Format.err_formatter - let pr x = Format.fprintf fmt x - - type ptset_list = Nil | Cons of Ptset.Int.t*int*ptset_list - let hpl l = match l with - | Nil -> 0 - | Cons (_,i,_) -> i - - let cons s l = Cons (s,(Ptset.Int.hash s) + 65599 * (hpl l), l) - - let rec empty_size n = - if n == 0 then Nil - else cons Ptset.Int.empty (empty_size (n-1)) - - let fold_pl f l acc = - let rec loop l acc = match l with - Nil -> acc - | Cons(s,h,pl) -> loop pl (f s h acc) - in - loop l acc - let map_pl f l = - let rec loop = - function Nil -> Nil - | Cons(s,h,ll) -> cons (f s) (loop ll) - in loop l - let iter_pl f l = - let rec loop = - function Nil -> () - | Cons(s,h,ll) -> (f s);(loop ll) - in loop l - - let rev_pl l = - let rec loop acc l = match l with - | Nil -> acc - | Cons(s,_,ll) -> loop (cons s acc) ll - in - loop Nil l - - let rev_map_pl f l = - let rec loop acc l = - match l with - | Nil -> acc - | Cons(s,_,ll) -> loop (cons (f s) acc) ll - in - loop Nil l - - module IntSet = Set.Make(struct type t = int let compare = (-) end) IFDEF DEBUG THEN + module IntSet = Set.Make(struct type t = int let compare = (-) end) INCLUDE "html_trace.ml" END @@ -561,18 +572,18 @@ END (mk_fun (Tree.text_next) "Tree.text_next") (mk_fun (fun _ -> Tree.node_sibling_ctx) "[TaggedSibling]Tree.node_sibling_ctx")(* !! no tagged_sibling in Tree.ml *) (mk_fun (fun _ -> Tree.node_sibling_ctx) "[SelectSibling]Tree.node_sibling_ctx")(* !! no select_sibling in Tree.ml *) - (mk_fun (Tree.tagged_foll_below) "Tree.tagged_foll_below") + (mk_fun (Tree.tagged_foll_ctx) "Tree.tagged_foll_ctx") (mk_fun (fun _ -> Tree.node_sibling_ctx) "[SelectFoll]Tree.node_sibling_ctx")(* !! no select_foll *) (mk_fun (Tree.node_sibling_ctx) "Tree.node_sibling_ctx") let get_trans slist tag a t = try - Hashtbl.find td_trans (tag,hpl slist) + Hashtbl.find td_trans (tag,SList.hash slist) with | Not_found -> let fl_list,llist,rlist,ca,da,sa,fa = - fold_pl - (fun set _ (fll_acc,lllacc,rllacc,ca,da,sa,fa) -> (* For each set *) + SList.fold + (fun set (fll_acc,lllacc,rllacc,ca,da,sa,fa) -> (* For each set *) let fl,ll,rr,ca,da,sa,fa = StateSet.fold (fun q acc -> @@ -583,7 +594,7 @@ END then let _,_,f,_ = Transition.node t in let (child,desc,below),(sibl,foll,after) = Formula.st f in - (Formlist.add t fl_acc, + (Formlist.cons t fl_acc, StateSet.union ll_acc below, StateSet.union rl_acc after, StateSet.union child c_acc, @@ -597,16 +608,16 @@ END q;[] ) - ) set (Formlist.empty,StateSet.empty,StateSet.empty,ca,da,sa,fa) - in fl::fll_acc, cons ll lllacc, cons rr rllacc,ca,da,sa,fa) - slist ([],Nil,Nil,StateSet.empty,StateSet.empty,StateSet.empty,StateSet.empty) + ) set (Formlist.nil,StateSet.empty,StateSet.empty,ca,da,sa,fa) + in fl::fll_acc, (SList.cons ll lllacc), (SList.cons rr rllacc),ca,da,sa,fa) + slist ([],SList.nil,SList.nil,StateSet.empty,StateSet.empty,StateSet.empty,StateSet.empty) in (* Logic to chose the first and next function *) let tags_below,tags_after = Tree.tags t tag in let first = choose_jump_down tags_below ca da a and next = choose_jump_next tags_after sa fa a in let v = (fl_list,llist,rlist,first,next) in - Hashtbl.add td_trans (tag, hpl slist) v; v + Hashtbl.add td_trans (tag, SList.hash slist) v; v let merge rb rb1 rb2 mark t res1 res2 = if rb @@ -617,27 +628,35 @@ END if mark then RS.cons t (RS.concat res1 res2) else RS.concat res1 res2 else RS.empty - + + let empty_size n = + let rec loop acc = function 0 -> acc + | n -> loop (SList.cons StateSet.empty acc) (n-1) + in loop SList.nil n + let top_down ?(noright=false) a t slist ctx slot_size = let pempty = empty_size slot_size in let eval_fold2_slist fll sl1 sl2 res1 res2 t = let res = Array.copy res1 in - let rec fold l1 l2 fll i aq = match l1,l2,fll with - | Cons(s1,_,ll1), Cons(s2, _ ,ll2),fl::fll -> + let rec fold l1 l2 fll i aq = + match SList.node l1,SList.node l2, fll with + | SList.Cons(s1,ll1), + SList.Cons(s2,ll2), + fl::fll -> let r',rb,rb1,rb2,mark = eval_formlist s1 s2 fl in let _ = res.(i) <- merge rb rb1 rb2 mark t res1.(i) res2.(i) in - fold ll1 ll2 fll (i+1) (cons r' aq) - | Nil, Nil,[] -> aq,res + fold ll1 ll2 fll (i+1) (SList.cons r' aq) + | SList.Nil, SList.Nil,[] -> aq,res | _ -> assert false in - fold sl1 sl2 fll 0 Nil + fold sl1 sl2 fll 0 SList.nil in let null_result() = (pempty,Array.make slot_size RS.empty) in let rec loop t slist ctx = if Tree.is_nil t then null_result() else - let tag = Tree.tag t in + let tag = Tree.tag t in let fl_list,llist,rlist,first,next = get_trans slist tag a t in let sl1,res1 = loop (first t) llist t in let sl2,res2 = loop (next t ctx) rlist ctx in @@ -651,7 +670,7 @@ END if Tree.is_nil t then null_result() else let tag = Tree.tag t in - let fl_list,llist,rlist,first,next = get_trans slist tag a t in + let fl_list,llist,_,first,next = get_trans slist tag a t in let sl1,res1 = loop (first t) llist t in let sl2,res2 = null_result() in let res = eval_fold2_slist fl_list sl1 sl2 res1 res2 t @@ -664,7 +683,7 @@ END let run_top_down a t = - let init = cons a.init Nil in + let init = SList.cons a.init SList.nil in let _,res = top_down a t init t 1 in D_IGNORE_( @@ -689,7 +708,7 @@ END if Ptss.mem s c.sets then { c with results = IMap.add s (RS.concat r (IMap.find s c.results)) c.results} else - { hash = HASHINT2(c.hash,Ptset.Int.hash s); + { hash = HASHINT2(c.hash,Ptset.Int.uid s); sets = Ptss.add s c.sets; results = IMap.add s r c.results } @@ -721,7 +740,7 @@ END in let h,s = Ptss.fold - (fun s (ah,ass) -> (HASHINT2(ah,Ptset.Int.hash s), + (fun s (ah,ass) -> (HASHINT2(ah,Ptset.Int.uid s), Ptss.add s ass)) (Ptss.union c1.sets c2.sets) (0,Ptss.empty) in @@ -735,29 +754,19 @@ END let fold_f_conf t slist fl_list conf dir= let rec loop sl fl acc = - match sl,fl with - |Nil,[] -> acc - | Cons(s,hs,sll), formlist::fll -> - let r',rb,rb1,rb2,mark = - try - Hashtbl.find h_fold (hs,Formlist.hash formlist,dir) - with - Not_found -> let res = - if dir then eval_formlist ~memo:false s Ptset.Int.empty formlist - else eval_formlist ~memo:false Ptset.Int.empty s formlist - in (Hashtbl.add h_fold (hs,Formlist.hash formlist,dir) res;res) - in(* - let _ = pr "Evaluating on set (%s) with tree %s=%s" - (if dir then "left" else "right") - (Tag.to_string (Tree.tag t)) - (Tree.dump_node t) ; - StateSet.print fmt (Ptset.Int.elements s); - pr ", formualae (with hash %i): \n" (Formlist.hash formlist); - Formlist.pr fmt formlist; - pr "result is "; - StateSet.print fmt (Ptset.Int.elements r'); - pr " %b %b %b %b \n%!" rb rb1 rb2 mark ; - in *) + match SList.node sl,fl with + |SList.Nil,[] -> acc + |SList.Cons(s,sll), formlist::fll -> + let r',rb,rb1,rb2,mark = + let key = SList.hash sl,Formlist.hash formlist,dir in + try + Hashtbl.find h_fold key + with + Not_found -> let res = + if dir then eval_formlist s Ptset.Int.empty formlist + else eval_formlist Ptset.Int.empty s formlist + in (Hashtbl.add h_fold key res;res) + in if rb && ((dir&&rb1)|| ((not dir) && rb2)) then let acc = @@ -776,7 +785,7 @@ END let h_trans = Hashtbl.create 4096 let get_up_trans slist ptag a tree = - let key = (HASHINT2(hpl slist,Tag.hash ptag)) in + let key = (HASHINT2(SList.uid slist,ptag)) in try Hashtbl.find h_trans key with @@ -784,13 +793,13 @@ END let f_list = Hashtbl.fold (fun q l acc -> List.fold_left (fun fl_acc (ts,t) -> - if TagSet.mem ptag ts then Formlist.add t fl_acc + if TagSet.mem ptag ts then Formlist.cons t fl_acc else fl_acc) acc l) - a.trans Formlist.empty + a.trans Formlist.nil in - let res = fold_pl (fun _ _ acc -> f_list::acc) slist [] + let res = SList.fold (fun _ acc -> f_list::acc) slist [] in (Hashtbl.add h_trans key res;res) @@ -798,71 +807,42 @@ END let h_tdconf = Hashtbl.create 511 let rec bottom_up a tree conf next jump_fun root dotd init accu = if (not dotd) && (Configuration.is_empty conf ) then -(* let _ = pr "Returning early from %s, with accu %i, next is %s\n%!" - (Tree.dump_node tree) (Obj.magic accu) (Tree.dump_node next) - in *) + accu,conf,next else -(* let _ = - pr "Going bottom up for tree with tag %s configuration is" - (if Tree.is_nil tree then "###" else Tag.to_string (Tree.tag tree)); - Configuration.pr fmt conf - in *) + let below_right = Tree.is_below_right tree next in - (* let _ = Format.fprintf Format.err_formatter "below_right %s %s = %b\n%!" - (Tree.dump_node tree) (Tree.dump_node next) below_right - in *) + let accu,rightconf,next_of_next = - if below_right then (* jump to the next *) -(* let _ = pr "Jumping to %s tag %s\n%!" (Tree.dump_node next) (Tag.to_string (Tree.tag next)) in *) - bottom_up a next conf (jump_fun next) jump_fun (Tree.next_sibling tree) true init accu - else accu,Configuration.empty,next - in -(* let _ = if below_right then pr "Returning from jump to next = %s\n" (Tree.dump_node next)in *) + if below_right then (* jump to the next *) + bottom_up a next conf (jump_fun next) jump_fun (Tree.next_sibling tree) true init accu + else accu,Configuration.empty,next + in let sub = if dotd then - if below_right then (* only recurse on the left subtree *) -(* let _ = pr "Topdown on left subtree\n%!" in *) - prepare_topdown a tree true - else -(* let _ = pr "Topdown on whole tree\n%!" in *) - prepare_topdown a tree false + if below_right then prepare_topdown a tree true + else prepare_topdown a tree false else conf in let conf,next = (Configuration.merge rightconf sub, next_of_next) in - if Tree.equal tree root then -(* let _ = pr "Stopping at root, configuration after topdown is:" ; - Configuration.pr fmt conf; - pr "\n%!" - in *) accu,conf,next + if Tree.equal tree root then accu,conf,next else let parent = Tree.binary_parent tree in let ptag = Tree.tag parent in let dir = Tree.is_left tree in - let slist = Configuration.Ptss.fold (fun e a -> cons e a) conf.Configuration.sets Nil in + let slist = Configuration.Ptss.fold (fun e a -> SList.cons e a) conf.Configuration.sets SList.nil in let fl_list = get_up_trans slist ptag a parent in - let slist = rev_pl (slist) in -(* let _ = pr "Current conf is : %s " (Tree.dump_node tree); - Configuration.pr fmt conf; - pr "\n" - in *) + let slist = SList.rev (slist) in let newconf = fold_f_conf parent slist fl_list conf dir in -(* let _ = pr "New conf before pruning is (dir=%b):" dir; - Configuration.pr fmt newconf ; - pr "accu is %i\n" (RS.length accu); - in *) let accu,newconf = Configuration.IMap.fold (fun s res (ar,nc) -> if Ptset.Int.intersect s init then ( RS.concat res ar ,nc) else (ar,Configuration.add nc s res)) (newconf.Configuration.results) (accu,Configuration.empty) in -(* let _ = pr "New conf after pruning is (dir=%b):" dir; - Configuration.pr fmt newconf ; - pr "accu is %i\n" (RS.length accu); - in *) + bottom_up a parent newconf next jump_fun root false init accu and prepare_topdown a t noright = @@ -884,10 +864,10 @@ END StateSet.print fmt (Ptset.Int.elements r); pr "\n%!"; in *) - let r = cons r Nil in + let r = SList.cons r SList.nil in let set,res = top_down (~noright:noright) a t r t 1 in - let set = match set with - | Cons(x,_,Nil) ->x + let set = match SList.node set with + | SList.Cons(x,_) ->x | _ -> assert false in (* pr "Result of topdown run is %!"; @@ -911,7 +891,7 @@ END match k with | `TAG (tag) -> (*Tree.tagged_lowest t tag, fun tree -> Tree.tagged_next tree tag*) - (Tree.tagged_desc tag t, fun tree -> Tree.tagged_foll_below tag tree t) + (Tree.tagged_desc tag t, fun tree -> Tree.tagged_foll_ctx tag tree t) | `CONTAINS(_) -> (Tree.text_below t,fun tree -> Tree.text_next tree t) | _ -> assert false in