src/asta.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                               TAToo                                 *)
   4 (*                                                                     *)
   5 (*                  ?   *)
   6 (*                  ?   *)
   7 (*                                                                     *)
   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   *)
  12 (*  ../LICENSE.                                                        *)
  13 (*                                                                     *)
  14 (***********************************************************************)
  15
  16 open Format
  17
  18 type state = State.t
  19
  20 type label = QNameSet.t
  21
  22 type formula = Formula.t
  23
  24 module Transition =
  25 struct
  26   type t = state * label * formula
  27
  28   let compare (st,la,f) (st',la',f') =
  29     let x_1 = State.compare st st' in
  30     if x_1 != 0 then x_1
  31     else let x_2 = QNameSet.compare la la' in
  32          if x_2 != 0 then x_2
  33          else Formula.compare f f'
  34   let st (st,la,f) = st
  35   let la (st,la,f) = la
  36   let fo (st,la,f) = f
  37 end
  38
  39 module  SetT =
  40 struct
  41   include Set.Make(Transition)
  42 end
  43
  44 type t = {
  45   reco : StateSet.t;
  46   selec : StateSet.t;
  47   bottom : StateSet.t;
  48   top : StateSet.t;
  49   trans : SetT.t;
  50 }
  51
  52 exception Not_found_transition
  53 exception Transition_not_injective
  54
  55 let transition asta st lab =
  56   let filter (s,l,f) =
  57     (State.compare s st = 0) && (QNameSet.compare l lab = 0) in
  58   let tr_set = SetT.elements (SetT.filter filter asta.trans) in
  59   match tr_set with
  60     | [] -> raise Not_found_transition
  61     | x::y::z -> raise Transition_not_injective
  62     | [l] -> Transition.fo l
  63
  64 let transitions asta st =
  65   let filter (s,l,f) = State.compare s st = 0 in
  66   let rec remove_states l = match l with
  67     | [] -> []
  68     | (a,s,l) :: tl -> (s,l) :: (remove_states tl) in
  69   remove_states (SetT.elements (SetT.filter filter asta.trans))
  70
  71 let print fmt asta = ()
  72
  73 let to_file out asta = ()