X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fasta.ml;h=2f4083638686b4fbe38c52b8c869c7f752581900;hp=9682bd1b76ab95231b1d3ddbdabfb5540ac8f79a;hb=7f20d23e406e81e6e7271d2621cb868d9fe63aae;hpb=a3db3281c936a50107f9e73ec06c3a6171d61dbd diff --git a/src/asta.ml b/src/asta.ml index 9682bd1..2f40836 100644 --- a/src/asta.ml +++ b/src/asta.ml @@ -52,16 +52,19 @@ type t = { mutable selec : StateSet.t; mutable bottom : StateSet.t; mutable top : StateSet.t; - mutable trans : SetT.t; + mutable trans_q : SetT.t; + mutable trans_r : SetT.t; } exception Not_found_transition exception Transition_not_injective - + let transition asta st lab = let filter (s,l,f) = (State.compare s st = 0) && (QNameSet.compare l lab = 0) in - let tr_set = SetT.elements (SetT.filter filter asta.trans) in + let tr_set = (SetT.elements (SetT.filter filter asta.trans_q)) @ + (SetT.elements (SetT.filter filter asta.trans_r)) + in match tr_set with | [] -> raise Not_found_transition | x::y::z -> raise Transition_not_injective @@ -72,7 +75,8 @@ let transitions asta st = let rec remove_states l = match l with | [] -> [] | (a,s,l) :: tl -> (s,l) :: (remove_states tl) in - remove_states (SetT.elements (SetT.filter filter asta.trans)) + (remove_states (SetT.elements (SetT.filter filter asta.trans_q)), + (remove_states (SetT.elements (SetT.filter filter asta.trans_r)))) let empty = { quer = StateSet.empty; @@ -80,14 +84,18 @@ let empty = { selec = StateSet.empty; bottom = StateSet.empty; top = StateSet.empty; - trans = SetT.empty; + trans_q = SetT.empty; + trans_r = SetT.empty } let any_label = QNameSet.complement (QNameSet.empty) let new_state () = State.make() -let add_tr ast tr = ast.trans <- (SetT.add tr (ast.trans)) +let add_tr ast tr flag = + if flag + then ast.trans_q <- (SetT.add tr (ast.trans_q)) + else ast.trans_r <- (SetT.add tr (ast.trans_r)) let add_quer ast st = ast.quer <- (StateSet.add st (ast.quer)) @@ -104,24 +112,26 @@ let init_top ast = ast.top <- (StateSet.empty) let top_states ast = StateSet.elements ast.top let print fmt asta = - let pp = Format.fprintf fmt in - pp "Query states: "; - StateSet.print fmt asta.quer; - pp "\nRecognizing states: "; - StateSet.print fmt asta.reco; - pp "\nSelecting states: "; - StateSet.print fmt asta.selec; - pp "\nBottom states: "; - StateSet.print fmt asta.bottom; - pp "\nTop states: "; - StateSet.print fmt asta.top; - pp "\nTransitions: \n"; - Format.fprintf fmt "{"; - Format.open_vbox 20; - SetT.iter (fun x -> Format.fprintf fmt "%a @." Transition.print x) - (asta.trans); - Format.print_flush (); - Format.fprintf fmt "}" - + let print_box fmt flag = + let pp = Format.fprintf fmt in + Format.fprintf fmt "@[# Query states: %a@ @]" + StateSet.print asta.quer; + Format.fprintf fmt "@[# Recognizing states: %a@ @]" + StateSet.print asta.reco; + Format.fprintf fmt "@[# Selecting states: %a@ @]" + StateSet.print asta.selec; + Format.fprintf fmt "@[# Bottom states: %a@ @]" + StateSet.print asta.bottom; + Format.fprintf fmt "@[# Tom states: %a@ @]" + StateSet.print asta.top; + let print_list_tr fmt z= + SetT.iter (fun x -> Format.fprintf fmt "| %a@ " Transition.print x) z in + let print_box_list fmt trans = + Format.fprintf fmt " @[%a @]" print_list_tr trans in + Format.fprintf fmt "@[# Queries transitions:@ %a@ @]" + print_box_list asta.trans_q; + Format.fprintf fmt "@[# Recognizing transitions:@ %a@ @]" + print_box_list asta.trans_r in + Format.fprintf fmt "@[ ##### ASTA #####@. %a@ @]@ " print_box 0 let to_file out asta = ()