1 (***********************************************************************)
5 (* Lucca Hirschi, LRI UMR8623 *)
6 (* Université Paris-Sud & CNRS *)
8 (* Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
9 (* Recherche Scientifique. All rights reserved. This file is *)
10 (* distributed under the terms of the GNU Lesser General Public *)
11 (* License, with the special exception on linking described in file *)
14 (***********************************************************************)
16 (* utils.ml-> INCLUDE "utils.ml" HASHINT2 () *)
20 type label = QNameSet.t
22 type formula = Formula.t
26 type t = state * label * formula
28 let compare (st,la,f) (st',la',f') =
29 let x_1 = State.compare st st' in
31 else let x_2 = QNameSet.compare la la' in
33 else Formula.compare f f'
37 let print fmt (st,la,f) =
38 Format.fprintf fmt "%a ----%s---> %a"
40 (QNameSet.to_string la)
46 include Set.Make(Transition)
49 type transition = Transition.t
52 mutable quer : StateSet.t;
53 mutable reco : StateSet.t;
54 mutable selec : StateSet.t;
55 mutable bottom : StateSet.t;
56 mutable top : StateSet.t;
57 mutable trans_q : SetT.t;
58 mutable trans_r : SetT.t;
61 exception Not_found_transition
62 exception Transition_not_injective
64 let transition asta st lab =
66 (State.compare s st = 0) && (QNameSet.compare l lab = 0) in
67 let tr_set = (SetT.elements (SetT.filter filter asta.trans_q)) @
68 (SetT.elements (SetT.filter filter asta.trans_r))
71 | [] -> raise Not_found_transition
72 | x::y::z -> raise Transition_not_injective
73 | [l] -> Transition.fo l
75 let transitions asta st =
76 let filter (s,l,f) = State.compare s st = 0 in
77 let rec remove_states = function
79 | (s,l,f) :: tl -> (l,f) :: (remove_states tl) in
80 (remove_states (SetT.elements (SetT.filter filter asta.trans_q)),
81 (remove_states (SetT.elements (SetT.filter filter asta.trans_r))))
83 let transitions_lab asta lab =
84 let filter (s,l,f) = QNameSet.mem lab l in
85 let rec remove_lab = function
87 | (s,l,f) :: tl -> (s,f) :: (remove_lab tl) in
88 (remove_lab (SetT.elements (SetT.filter filter asta.trans_q)),
89 (remove_lab (SetT.elements (SetT.filter filter asta.trans_r))))
91 let transitions_st_lab asta q lab =
92 let filter (s,l,f) = q = s && QNameSet.mem lab l in
93 let rec remove_st_lab = function
95 | (s,l,f) :: tl -> f :: (remove_st_lab tl) in
96 (remove_st_lab (SetT.elements (SetT.filter filter asta.trans_q)),
97 (remove_st_lab (SetT.elements (SetT.filter filter asta.trans_r))))
100 quer = StateSet.empty;
101 reco = StateSet.empty;
102 selec = StateSet.empty;
103 bottom = StateSet.empty;
104 top = StateSet.empty;
105 trans_q = SetT.empty;
109 let any_label = QNameSet.complement (QNameSet.empty)
111 let new_state () = State.make()
113 let add_tr ast tr flag =
115 then ast.trans_q <- (SetT.add tr (ast.trans_q))
116 else ast.trans_r <- (SetT.add tr (ast.trans_r))
118 let add_quer ast st = ast.quer <- (StateSet.add st (ast.quer))
120 let add_reco ast st = ast.reco <- (StateSet.add st (ast.reco))
122 let add_selec ast st = ast.selec <- (StateSet.add st (ast.selec))
124 let add_bot ast st = ast.bottom <- (StateSet.add st (ast.bottom))
126 let add_top ast st = ast.top <- (StateSet.add st (ast.top))
128 let init_top ast = ast.top <- (StateSet.empty)
130 let top_states ast = StateSet.elements ast.top
132 let top_states_s ast = ast.top
134 let bot_states_s ast = ast.bottom
136 let selec_states ast = ast.selec
139 let print_box fmt flag =
140 let pp = Format.fprintf fmt in
141 pp "@[<v 0># Query states: %a@ @]"
142 StateSet.print asta.quer;
143 pp "@[<v 0># Recognizing states: %a@ @]"
144 StateSet.print asta.reco;
145 pp "@[<v 0># Selecting states: %a@ @]"
146 StateSet.print asta.selec;
147 pp "@[<v 0># Bottom states: %a@ @]"
148 StateSet.print asta.bottom;
149 pp "@[<v 0># Top states: %a@ @]"
150 StateSet.print asta.top;
151 let print_list_tr fmt z =
153 then Format.fprintf fmt "ø"
155 SetT.iter (fun x -> Format.fprintf fmt "| %a @ " Transition.print x) z in
156 let print_box_list fmt trans =
157 Format.fprintf fmt " @[<hov 0>%a @]" print_list_tr trans in
158 Format.fprintf fmt "@[<v 0># Queries transitions:@ %a@ @]"
159 print_box_list asta.trans_q;
160 Format.fprintf fmt "@[<v 0># Recognizing transitions:@ %a@]"
161 print_box_list asta.trans_r in
162 Format.fprintf fmt "@[<v 1>##### ASTA #####@. %a@ @]@." print_box 0
164 let to_file out asta = ()