/usr/lib/ocaml/galax/dfa.mli is in libgalax-ocaml-dev 1.1-12.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | (***********************************************************************)
(* *)
(* GALAX *)
(* XQuery Engine *)
(* *)
(* Copyright 2001-2007. *)
(* Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id: dfa.mli,v 1.5 2007/02/01 22:08:46 simeon Exp $ *)
(* Module Dfa
Description:
This module implements Deterministic finite States Automatas. DFA
is a functor parameterized by an letter and a state types.
*)
module type DFA =
sig
type state
type letter
module StateSet : Set.S
module Alphabet : Set.S
module StateToTransitionMap : Map.S
module TransitionMap : Map.S
type dfa = {
mutable dfa_states : StateSet.t;
mutable dfa_alphabet : Alphabet.t;
mutable dfa_start_state : StateSet.elt option;
mutable dfa_final_states : StateSet.t;
mutable dfa_transitions :
StateSet.elt TransitionMap.t StateToTransitionMap.t;
}
val dfa_empty : dfa
val fresh_dfa_empty : unit -> dfa
val get_dfa_alphabet : dfa -> Alphabet.t
val add_letter : dfa -> Alphabet.elt -> unit
val add_all_letters : dfa -> Alphabet.t -> unit
val get_dfa_states : dfa -> StateSet.t
val get_dfa_start_state : dfa -> StateSet.elt
val get_dfa_final_states : dfa -> StateSet.t
val add_state : dfa -> StateSet.elt -> unit
val set_start_state : dfa -> StateSet.elt -> unit
val set_final_states : dfa -> StateSet.t -> unit
val add_final_state : dfa -> StateSet.elt -> unit
val get_dfa_transitions :
dfa -> StateSet.elt TransitionMap.t StateToTransitionMap.t
val get_TransitionMap :
dfa -> StateToTransitionMap.key -> StateSet.elt TransitionMap.t
val get_destStateSet :
StateSet.elt TransitionMap.t -> TransitionMap.key -> StateSet.t
val get_destStateSet_s :
dfa -> StateToTransitionMap.key -> TransitionMap.key -> StateSet.t
val add_transitions_aux :
dfa ->
StateToTransitionMap.key -> Alphabet.elt * StateSet.elt -> unit
val add_transitions :
dfa -> StateSet.elt -> (Alphabet.elt * StateSet.elt) list -> unit
val print_automata :
dfa -> (Alphabet.elt -> unit) -> (StateSet.elt -> unit) -> unit
end
module MakeDFA (State : Set.OrderedType) (Letter : Set.OrderedType) :
DFA with
type state = State.t
and type letter = Letter.t
and type StateSet.elt = State.t
and type Alphabet.elt = Letter.t
and type StateToTransitionMap.key = State.t
and type TransitionMap.key = Letter.t
|