X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fasta.ml;h=3189b273bc8a166a199419feaecf716e508fe00a;hb=83c90cb5eeebfffa05d0383430eb80e7905b46a0;hp=9682bd1b76ab95231b1d3ddbdabfb5540ac8f79a;hpb=91c3b3585a018dd5f98949e4838ef3d6c5c120fc;p=tatoo.git diff --git a/src/asta.ml b/src/asta.ml index 9682bd1..3189b27 100644 --- a/src/asta.ml +++ b/src/asta.ml @@ -2,8 +2,8 @@ (* *) (* TAToo *) (* *) -(* Lucca Hirschi, ? *) -(* ? *) +(* Lucca Hirschi, LRI UMR8623 *) +(* Université Paris-Sud & CNRS *) (* *) (* Copyright 2010-2012 Université Paris-Sud and Centre National de la *) (* Recherche Scientifique. All rights reserved. This file is *) @@ -13,6 +13,8 @@ (* *) (***********************************************************************) +(* utils.ml-> INCLUDE "utils.ml" HASHINT2 () *) + type state = State.t type label = QNameSet.t @@ -52,16 +54,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 @@ -69,10 +74,19 @@ let transition asta st lab = let transitions asta st = let filter (s,l,f) = State.compare s st = 0 in - let rec remove_states l = match l with + let rec remove_states = function | [] -> [] - | (a,s,l) :: tl -> (s,l) :: (remove_states tl) in - remove_states (SetT.elements (SetT.filter filter asta.trans)) + | (s,l,f) :: tl -> (l,f) :: (remove_states tl) in + (remove_states (SetT.elements (SetT.filter filter asta.trans_q)), + (remove_states (SetT.elements (SetT.filter filter asta.trans_r)))) + +let transitions_lab asta lab = + let filter (s,l,f) = QNameSet.mem lab l in + let rec remove_lab = function + | [] -> [] + | (s,l,f) :: tl -> (s,f) :: (remove_lab tl) in + (remove_lab (SetT.elements (SetT.filter filter asta.trans_q)), + (remove_lab (SetT.elements (SetT.filter filter asta.trans_r)))) let empty = { quer = StateSet.empty; @@ -80,14 +94,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)) @@ -103,25 +121,34 @@ let init_top ast = ast.top <- (StateSet.empty) let top_states ast = StateSet.elements ast.top +let bot_states ast = ast.bottom + +let selec_states ast = ast.selec + 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 + pp "@[# Query states: %a@ @]" + StateSet.print asta.quer; + pp "@[# Recognizing states: %a@ @]" + StateSet.print asta.reco; + pp "@[# Selecting states: %a@ @]" + StateSet.print asta.selec; + pp "@[# Bottom states: %a@ @]" + StateSet.print asta.bottom; + pp "@[# Top states: %a@ @]" + StateSet.print asta.top; + let print_list_tr fmt z = + if SetT.is_empty z + then Format.fprintf fmt "ø" + else + 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 = ()