> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module:    LTK.Factors
> Copyright: (c) 2017-2019,2023 Dakotah Lambert
> License:   MIT

> This module provides a means to define
> positive and negative factors
> over the adjacency or precedence relations,
> as well as unions and intersections thereof.
> -}

> module LTK.Factors
>        ( -- *Constructions
>          required
>        , forbidden
>        , buildLiteral
>        , build
>        , makeConstraint
>        -- *Logical Expressions
>        , Factor(..)
>        , Literal(..)
>        , Disjunction(..)
>        , Conjunction(..)
>        ) where

> import Control.DeepSeq (NFData)
> import Data.Set (Set)
> import qualified Data.Set as Set

> import LTK.FSA

> -- |A substring or subsequence, from which to build constraints.
> data Factor e
>     = Substring
>       { forall e. Factor e -> [Set e]
substring :: [Set e] -- ^The sequence of symbol types,
>                              -- e.g. @[wxs0, wxs0]@
>                              -- for two consecutive unstressed syllables.
>       , forall e. Factor e -> Bool
headAnchored :: Bool -- ^Anchored to the head of the word?
>       , forall e. Factor e -> Bool
tailAnchored :: Bool -- ^Anchored to the tail of the word?
>       }
>     | Subsequence [Set e]
>     deriving (Factor e -> Factor e -> Bool
(Factor e -> Factor e -> Bool)
-> (Factor e -> Factor e -> Bool) -> Eq (Factor e)
forall e. Eq e => Factor e -> Factor e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => Factor e -> Factor e -> Bool
== :: Factor e -> Factor e -> Bool
$c/= :: forall e. Eq e => Factor e -> Factor e -> Bool
/= :: Factor e -> Factor e -> Bool
Eq, Eq (Factor e)
Eq (Factor e) =>
(Factor e -> Factor e -> Ordering)
-> (Factor e -> Factor e -> Bool)
-> (Factor e -> Factor e -> Bool)
-> (Factor e -> Factor e -> Bool)
-> (Factor e -> Factor e -> Bool)
-> (Factor e -> Factor e -> Factor e)
-> (Factor e -> Factor e -> Factor e)
-> Ord (Factor e)
Factor e -> Factor e -> Bool
Factor e -> Factor e -> Ordering
Factor e -> Factor e -> Factor e
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall e. Ord e => Eq (Factor e)
forall e. Ord e => Factor e -> Factor e -> Bool
forall e. Ord e => Factor e -> Factor e -> Ordering
forall e. Ord e => Factor e -> Factor e -> Factor e
$ccompare :: forall e. Ord e => Factor e -> Factor e -> Ordering
compare :: Factor e -> Factor e -> Ordering
$c< :: forall e. Ord e => Factor e -> Factor e -> Bool
< :: Factor e -> Factor e -> Bool
$c<= :: forall e. Ord e => Factor e -> Factor e -> Bool
<= :: Factor e -> Factor e -> Bool
$c> :: forall e. Ord e => Factor e -> Factor e -> Bool
> :: Factor e -> Factor e -> Bool
$c>= :: forall e. Ord e => Factor e -> Factor e -> Bool
>= :: Factor e -> Factor e -> Bool
$cmax :: forall e. Ord e => Factor e -> Factor e -> Factor e
max :: Factor e -> Factor e -> Factor e
$cmin :: forall e. Ord e => Factor e -> Factor e -> Factor e
min :: Factor e -> Factor e -> Factor e
Ord, ReadPrec [Factor e]
ReadPrec (Factor e)
Int -> ReadS (Factor e)
ReadS [Factor e]
(Int -> ReadS (Factor e))
-> ReadS [Factor e]
-> ReadPrec (Factor e)
-> ReadPrec [Factor e]
-> Read (Factor e)
forall e. (Read e, Ord e) => ReadPrec [Factor e]
forall e. (Read e, Ord e) => ReadPrec (Factor e)
forall e. (Read e, Ord e) => Int -> ReadS (Factor e)
forall e. (Read e, Ord e) => ReadS [Factor e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall e. (Read e, Ord e) => Int -> ReadS (Factor e)
readsPrec :: Int -> ReadS (Factor e)
$creadList :: forall e. (Read e, Ord e) => ReadS [Factor e]
readList :: ReadS [Factor e]
$creadPrec :: forall e. (Read e, Ord e) => ReadPrec (Factor e)
readPrec :: ReadPrec (Factor e)
$creadListPrec :: forall e. (Read e, Ord e) => ReadPrec [Factor e]
readListPrec :: ReadPrec [Factor e]
Read, Int -> Factor e -> ShowS
[Factor e] -> ShowS
Factor e -> String
(Int -> Factor e -> ShowS)
-> (Factor e -> String) -> ([Factor e] -> ShowS) -> Show (Factor e)
forall e. Show e => Int -> Factor e -> ShowS
forall e. Show e => [Factor e] -> ShowS
forall e. Show e => Factor e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> Factor e -> ShowS
showsPrec :: Int -> Factor e -> ShowS
$cshow :: forall e. Show e => Factor e -> String
show :: Factor e -> String
$cshowList :: forall e. Show e => [Factor e] -> ShowS
showList :: [Factor e] -> ShowS
Show)

> -- |A constraint.
> data Literal e = Literal Bool (Factor e) deriving (Literal e -> Literal e -> Bool
(Literal e -> Literal e -> Bool)
-> (Literal e -> Literal e -> Bool) -> Eq (Literal e)
forall e. Eq e => Literal e -> Literal e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => Literal e -> Literal e -> Bool
== :: Literal e -> Literal e -> Bool
$c/= :: forall e. Eq e => Literal e -> Literal e -> Bool
/= :: Literal e -> Literal e -> Bool
Eq, Eq (Literal e)
Eq (Literal e) =>
(Literal e -> Literal e -> Ordering)
-> (Literal e -> Literal e -> Bool)
-> (Literal e -> Literal e -> Bool)
-> (Literal e -> Literal e -> Bool)
-> (Literal e -> Literal e -> Bool)
-> (Literal e -> Literal e -> Literal e)
-> (Literal e -> Literal e -> Literal e)
-> Ord (Literal e)
Literal e -> Literal e -> Bool
Literal e -> Literal e -> Ordering
Literal e -> Literal e -> Literal e
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall e. Ord e => Eq (Literal e)
forall e. Ord e => Literal e -> Literal e -> Bool
forall e. Ord e => Literal e -> Literal e -> Ordering
forall e. Ord e => Literal e -> Literal e -> Literal e
$ccompare :: forall e. Ord e => Literal e -> Literal e -> Ordering
compare :: Literal e -> Literal e -> Ordering
$c< :: forall e. Ord e => Literal e -> Literal e -> Bool
< :: Literal e -> Literal e -> Bool
$c<= :: forall e. Ord e => Literal e -> Literal e -> Bool
<= :: Literal e -> Literal e -> Bool
$c> :: forall e. Ord e => Literal e -> Literal e -> Bool
> :: Literal e -> Literal e -> Bool
$c>= :: forall e. Ord e => Literal e -> Literal e -> Bool
>= :: Literal e -> Literal e -> Bool
$cmax :: forall e. Ord e => Literal e -> Literal e -> Literal e
max :: Literal e -> Literal e -> Literal e
$cmin :: forall e. Ord e => Literal e -> Literal e -> Literal e
min :: Literal e -> Literal e -> Literal e
Ord, ReadPrec [Literal e]
ReadPrec (Literal e)
Int -> ReadS (Literal e)
ReadS [Literal e]
(Int -> ReadS (Literal e))
-> ReadS [Literal e]
-> ReadPrec (Literal e)
-> ReadPrec [Literal e]
-> Read (Literal e)
forall e. (Read e, Ord e) => ReadPrec [Literal e]
forall e. (Read e, Ord e) => ReadPrec (Literal e)
forall e. (Read e, Ord e) => Int -> ReadS (Literal e)
forall e. (Read e, Ord e) => ReadS [Literal e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall e. (Read e, Ord e) => Int -> ReadS (Literal e)
readsPrec :: Int -> ReadS (Literal e)
$creadList :: forall e. (Read e, Ord e) => ReadS [Literal e]
readList :: ReadS [Literal e]
$creadPrec :: forall e. (Read e, Ord e) => ReadPrec (Literal e)
readPrec :: ReadPrec (Literal e)
$creadListPrec :: forall e. (Read e, Ord e) => ReadPrec [Literal e]
readListPrec :: ReadPrec [Literal e]
Read, Int -> Literal e -> ShowS
[Literal e] -> ShowS
Literal e -> String
(Int -> Literal e -> ShowS)
-> (Literal e -> String)
-> ([Literal e] -> ShowS)
-> Show (Literal e)
forall e. Show e => Int -> Literal e -> ShowS
forall e. Show e => [Literal e] -> ShowS
forall e. Show e => Literal e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> Literal e -> ShowS
showsPrec :: Int -> Literal e -> ShowS
$cshow :: forall e. Show e => Literal e -> String
show :: Literal e -> String
$cshowList :: forall e. Show e => [Literal e] -> ShowS
showList :: [Literal e] -> ShowS
Show)

> -- |Multiple constraints, joined by @OR@.
> newtype Disjunction e = Disjunction (Set (Literal e))
>     deriving (Disjunction e -> Disjunction e -> Bool
(Disjunction e -> Disjunction e -> Bool)
-> (Disjunction e -> Disjunction e -> Bool) -> Eq (Disjunction e)
forall e. Eq e => Disjunction e -> Disjunction e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => Disjunction e -> Disjunction e -> Bool
== :: Disjunction e -> Disjunction e -> Bool
$c/= :: forall e. Eq e => Disjunction e -> Disjunction e -> Bool
/= :: Disjunction e -> Disjunction e -> Bool
Eq, Eq (Disjunction e)
Eq (Disjunction e) =>
(Disjunction e -> Disjunction e -> Ordering)
-> (Disjunction e -> Disjunction e -> Bool)
-> (Disjunction e -> Disjunction e -> Bool)
-> (Disjunction e -> Disjunction e -> Bool)
-> (Disjunction e -> Disjunction e -> Bool)
-> (Disjunction e -> Disjunction e -> Disjunction e)
-> (Disjunction e -> Disjunction e -> Disjunction e)
-> Ord (Disjunction e)
Disjunction e -> Disjunction e -> Bool
Disjunction e -> Disjunction e -> Ordering
Disjunction e -> Disjunction e -> Disjunction e
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall e. Ord e => Eq (Disjunction e)
forall e. Ord e => Disjunction e -> Disjunction e -> Bool
forall e. Ord e => Disjunction e -> Disjunction e -> Ordering
forall e. Ord e => Disjunction e -> Disjunction e -> Disjunction e
$ccompare :: forall e. Ord e => Disjunction e -> Disjunction e -> Ordering
compare :: Disjunction e -> Disjunction e -> Ordering
$c< :: forall e. Ord e => Disjunction e -> Disjunction e -> Bool
< :: Disjunction e -> Disjunction e -> Bool
$c<= :: forall e. Ord e => Disjunction e -> Disjunction e -> Bool
<= :: Disjunction e -> Disjunction e -> Bool
$c> :: forall e. Ord e => Disjunction e -> Disjunction e -> Bool
> :: Disjunction e -> Disjunction e -> Bool
$c>= :: forall e. Ord e => Disjunction e -> Disjunction e -> Bool
>= :: Disjunction e -> Disjunction e -> Bool
$cmax :: forall e. Ord e => Disjunction e -> Disjunction e -> Disjunction e
max :: Disjunction e -> Disjunction e -> Disjunction e
$cmin :: forall e. Ord e => Disjunction e -> Disjunction e -> Disjunction e
min :: Disjunction e -> Disjunction e -> Disjunction e
Ord, ReadPrec [Disjunction e]
ReadPrec (Disjunction e)
Int -> ReadS (Disjunction e)
ReadS [Disjunction e]
(Int -> ReadS (Disjunction e))
-> ReadS [Disjunction e]
-> ReadPrec (Disjunction e)
-> ReadPrec [Disjunction e]
-> Read (Disjunction e)
forall e. (Read e, Ord e) => ReadPrec [Disjunction e]
forall e. (Read e, Ord e) => ReadPrec (Disjunction e)
forall e. (Read e, Ord e) => Int -> ReadS (Disjunction e)
forall e. (Read e, Ord e) => ReadS [Disjunction e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall e. (Read e, Ord e) => Int -> ReadS (Disjunction e)
readsPrec :: Int -> ReadS (Disjunction e)
$creadList :: forall e. (Read e, Ord e) => ReadS [Disjunction e]
readList :: ReadS [Disjunction e]
$creadPrec :: forall e. (Read e, Ord e) => ReadPrec (Disjunction e)
readPrec :: ReadPrec (Disjunction e)
$creadListPrec :: forall e. (Read e, Ord e) => ReadPrec [Disjunction e]
readListPrec :: ReadPrec [Disjunction e]
Read, Int -> Disjunction e -> ShowS
[Disjunction e] -> ShowS
Disjunction e -> String
(Int -> Disjunction e -> ShowS)
-> (Disjunction e -> String)
-> ([Disjunction e] -> ShowS)
-> Show (Disjunction e)
forall e. Show e => Int -> Disjunction e -> ShowS
forall e. Show e => [Disjunction e] -> ShowS
forall e. Show e => Disjunction e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> Disjunction e -> ShowS
showsPrec :: Int -> Disjunction e -> ShowS
$cshow :: forall e. Show e => Disjunction e -> String
show :: Disjunction e -> String
$cshowList :: forall e. Show e => [Disjunction e] -> ShowS
showList :: [Disjunction e] -> ShowS
Show)

> -- |Multiple disjunctions, joined by @AND@.
> newtype Conjunction e = Conjunction (Set (Disjunction e))
>     deriving (Conjunction e -> Conjunction e -> Bool
(Conjunction e -> Conjunction e -> Bool)
-> (Conjunction e -> Conjunction e -> Bool) -> Eq (Conjunction e)
forall e. Eq e => Conjunction e -> Conjunction e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => Conjunction e -> Conjunction e -> Bool
== :: Conjunction e -> Conjunction e -> Bool
$c/= :: forall e. Eq e => Conjunction e -> Conjunction e -> Bool
/= :: Conjunction e -> Conjunction e -> Bool
Eq, Eq (Conjunction e)
Eq (Conjunction e) =>
(Conjunction e -> Conjunction e -> Ordering)
-> (Conjunction e -> Conjunction e -> Bool)
-> (Conjunction e -> Conjunction e -> Bool)
-> (Conjunction e -> Conjunction e -> Bool)
-> (Conjunction e -> Conjunction e -> Bool)
-> (Conjunction e -> Conjunction e -> Conjunction e)
-> (Conjunction e -> Conjunction e -> Conjunction e)
-> Ord (Conjunction e)
Conjunction e -> Conjunction e -> Bool
Conjunction e -> Conjunction e -> Ordering
Conjunction e -> Conjunction e -> Conjunction e
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall e. Ord e => Eq (Conjunction e)
forall e. Ord e => Conjunction e -> Conjunction e -> Bool
forall e. Ord e => Conjunction e -> Conjunction e -> Ordering
forall e. Ord e => Conjunction e -> Conjunction e -> Conjunction e
$ccompare :: forall e. Ord e => Conjunction e -> Conjunction e -> Ordering
compare :: Conjunction e -> Conjunction e -> Ordering
$c< :: forall e. Ord e => Conjunction e -> Conjunction e -> Bool
< :: Conjunction e -> Conjunction e -> Bool
$c<= :: forall e. Ord e => Conjunction e -> Conjunction e -> Bool
<= :: Conjunction e -> Conjunction e -> Bool
$c> :: forall e. Ord e => Conjunction e -> Conjunction e -> Bool
> :: Conjunction e -> Conjunction e -> Bool
$c>= :: forall e. Ord e => Conjunction e -> Conjunction e -> Bool
>= :: Conjunction e -> Conjunction e -> Bool
$cmax :: forall e. Ord e => Conjunction e -> Conjunction e -> Conjunction e
max :: Conjunction e -> Conjunction e -> Conjunction e
$cmin :: forall e. Ord e => Conjunction e -> Conjunction e -> Conjunction e
min :: Conjunction e -> Conjunction e -> Conjunction e
Ord, ReadPrec [Conjunction e]
ReadPrec (Conjunction e)
Int -> ReadS (Conjunction e)
ReadS [Conjunction e]
(Int -> ReadS (Conjunction e))
-> ReadS [Conjunction e]
-> ReadPrec (Conjunction e)
-> ReadPrec [Conjunction e]
-> Read (Conjunction e)
forall e. (Read e, Ord e) => ReadPrec [Conjunction e]
forall e. (Read e, Ord e) => ReadPrec (Conjunction e)
forall e. (Read e, Ord e) => Int -> ReadS (Conjunction e)
forall e. (Read e, Ord e) => ReadS [Conjunction e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall e. (Read e, Ord e) => Int -> ReadS (Conjunction e)
readsPrec :: Int -> ReadS (Conjunction e)
$creadList :: forall e. (Read e, Ord e) => ReadS [Conjunction e]
readList :: ReadS [Conjunction e]
$creadPrec :: forall e. (Read e, Ord e) => ReadPrec (Conjunction e)
readPrec :: ReadPrec (Conjunction e)
$creadListPrec :: forall e. (Read e, Ord e) => ReadPrec [Conjunction e]
readListPrec :: ReadPrec [Conjunction e]
Read, Int -> Conjunction e -> ShowS
[Conjunction e] -> ShowS
Conjunction e -> String
(Int -> Conjunction e -> ShowS)
-> (Conjunction e -> String)
-> ([Conjunction e] -> ShowS)
-> Show (Conjunction e)
forall e. Show e => Int -> Conjunction e -> ShowS
forall e. Show e => [Conjunction e] -> ShowS
forall e. Show e => Conjunction e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> Conjunction e -> ShowS
showsPrec :: Int -> Conjunction e -> ShowS
$cshow :: forall e. Show e => Conjunction e -> String
show :: Conjunction e -> String
$cshowList :: forall e. Show e => [Conjunction e] -> ShowS
showList :: [Conjunction e] -> ShowS
Show) -- Primitive Constraint

> -- |The factor is required to appear in every string.
> -- Note that a conjunctive constraint of
> -- (@required (Substring x True True)@)
> -- restricts the stringset to at most one word.
> required :: Factor e -> Literal e
> required :: forall e. Factor e -> Literal e
required = Bool -> Factor e -> Literal e
forall e. Bool -> Factor e -> Literal e
Literal Bool
True

> -- | The factor is not allowed to appear in any word.
> forbidden :: Factor e -> Literal e
> forbidden :: forall e. Factor e -> Literal e
forbidden = Bool -> Factor e -> Literal e
forall e. Bool -> Factor e -> Literal e
Literal Bool
False

> buildFactor :: (Enum n, Ord n, Ord e) =>
>                Set e -> Factor e -> Bool -> FSA n e
> buildFactor :: forall n e.
(Enum n, Ord n, Ord e) =>
Set e -> Factor e -> Bool -> FSA n e
buildFactor Set e
alpha (Substring [Set e]
factor Bool
anchoredToHead Bool
anchoredToTail)
>     = (Bool -> [Set e] -> FSA n e) -> [Set e] -> Bool -> FSA n e
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> Set e -> [Set e] -> FSA n e
`f` Set e
alpha) [Set e]
factor
>     where f :: Bool -> Set e -> [Set e] -> FSA n e
f = case (Bool
anchoredToHead, Bool
anchoredToTail)
>               of (Bool
True,   Bool
True)   ->  Bool -> Set e -> [Set e] -> FSA n e
forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
word
>                  (Bool
True,   Bool
False)  ->  Bool -> Set e -> [Set e] -> FSA n e
forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
initialLocal
>                  (Bool
False,  Bool
True)   ->  Bool -> Set e -> [Set e] -> FSA n e
forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
finalLocal
>                  (Bool
False,  Bool
False)  ->  Bool -> Set e -> [Set e] -> FSA n e
forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
local
> buildFactor Set e
alpha (Subsequence [Set e]
factor)
>     =  \Bool
isPositive ->
>        FSA { sigma :: Set e
sigma        =  Set e
alpha
>            , transitions :: Set (Transition n e)
transitions  =  Set (Transition n e)
tran
>            , initials :: Set (State n)
initials     =  State n -> Set (State n)
forall c a. Container c a => a -> c
singleton (State n -> Set (State n)) -> (n -> State n) -> n -> Set (State n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> State n
forall n. n -> State n
State (n -> Set (State n)) -> n -> Set (State n)
forall a b. (a -> b) -> a -> b
$ Int -> n
forall a. Enum a => Int -> a
toEnum Int
0
>            , finals :: Set (State n)
finals       =  if Bool
isPositive then Set (State n)
fin else Set (State n)
fin'
>            , isDeterministic :: Bool
isDeterministic = Bool
True
>            }
>     where tagged :: [(Set e, n)]
tagged     =  [Set e] -> [n] -> [(Set e, n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Set e]
factor ([n] -> [(Set e, n)]) -> [n] -> [(Set e, n)]
forall a b. (a -> b) -> a -> b
$ (n -> n) -> n -> [n]
forall a. (a -> a) -> a -> [a]
iterate n -> n
forall a. Enum a => a -> a
succ (Int -> n
forall a. Enum a => Int -> a
toEnum Int
0)
>           trans' :: Set (Transition n e)
trans'     =  [Set (Transition n e)] -> Set (Transition n e)
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll
>                         ([Set (Transition n e)] -> Set (Transition n e))
-> [Set (Transition n e)] -> Set (Transition n e)
forall a b. (a -> b) -> a -> b
$ ((Set e, n) -> Set (Transition n e))
-> [(Set e, n)] -> [Set (Transition n e)]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                           (\(Set e
symset, n
st) ->
>                            (e -> Transition n e) -> Set e -> Set (Transition n e)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (n -> e -> Transition n e
forall n e. Enum n => n -> e -> Transition n e
succtrans n
st)
>                                 (Set e -> Set e -> Set e
forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set e
alpha Set e
symset)
>                            Set (Transition n e)
-> Set (Transition n e) -> Set (Transition n e)
forall c a. Container c a => c -> c -> c
`union`
>                            (e -> Transition n e) -> Set e -> Set (Transition n e)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (n -> e -> Transition n e
forall n e. Enum n => n -> e -> Transition n e
selftrans n
st)
>                                 (Set e -> Set e -> Set e
forall c a. (Container c a, Eq a) => c -> c -> c
difference Set e
alpha Set e
symset)
>                           )
>                         [(Set e, n)]
tagged
>           tran :: Set (Transition n e)
tran       =  (e -> Transition n e) -> Set e -> Set (Transition n e)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (n -> e -> Transition n e
forall n e. Enum n => n -> e -> Transition n e
selftrans n
nextState) Set e
alpha
>                         Set (Transition n e)
-> Set (Transition n e) -> Set (Transition n e)
forall c a. Container c a => c -> c -> c
`union` Set (Transition n e)
trans'
>           fin' :: Set (State n)
fin'       =  [State n] -> Set (State n)
forall a. Ord a => [a] -> Set a
Set.fromList ([State n] -> Set (State n)) -> [State n] -> Set (State n)
forall a b. (a -> b) -> a -> b
$ ((Set e, n) -> State n) -> [(Set e, n)] -> [State n]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (n -> State n
forall n. n -> State n
State (n -> State n) -> ((Set e, n) -> n) -> (Set e, n) -> State n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set e, n) -> n
forall a b. (a, b) -> b
snd) [(Set e, n)]
tagged
>           nextState :: n
nextState  =  n -> n
forall a. Enum a => a -> a
succ (n -> n) -> ([n] -> n) -> [n] -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [n] -> n
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([n] -> n) -> [n] -> n
forall a b. (a -> b) -> a -> b
$ ((Set e, n) -> n) -> [(Set e, n)] -> [n]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Set e, n) -> n
forall a b. (a, b) -> b
snd [(Set e, n)]
tagged
>           fin :: Set (State n)
fin        =  State n -> Set (State n)
forall c a. Container c a => a -> c
singleton (n -> State n
forall n. n -> State n
State n
nextState)

> -- |Build an t'FSA' representing a single constraint.
> buildLiteral :: (Enum n, Ord n, Ord e) => Set e -> Literal e -> FSA n e
> buildLiteral :: forall n e. (Enum n, Ord n, Ord e) => Set e -> Literal e -> FSA n e
buildLiteral Set e
alpha (Literal Bool
isPositive Factor e
factor)
>     = Set e -> Factor e -> Bool -> FSA n e
forall n e.
(Enum n, Ord n, Ord e) =>
Set e -> Factor e -> Bool -> FSA n e
buildFactor Set e
alpha Factor e
factor Bool
isPositive

> buildDisjunction :: (Enum n, NFData n, Ord n, NFData e, Ord e) =>
>                     Set e -> Disjunction e -> FSA n e
> buildDisjunction :: forall n e.
(Enum n, NFData n, Ord n, NFData e, Ord e) =>
Set e -> Disjunction e -> FSA n e
buildDisjunction Set e
alpha (Disjunction Set (Literal e)
literals)
>     = [FSA n e] -> FSA n e
forall n e.
(Enum n, Ord n, NFData n, Ord e, NFData e) =>
[FSA n e] -> FSA n e
flatUnion ([FSA n e] -> FSA n e)
-> ([Literal e] -> [FSA n e]) -> [Literal e] -> FSA n e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> [FSA n e] -> [FSA n e]
forall c a. Container c a => a -> c -> c
insert (Set e -> FSA n e
forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
emptyWithAlphabet Set e
alpha) ([FSA n e] -> [FSA n e])
-> ([Literal e] -> [FSA n e]) -> [Literal e] -> [FSA n e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       (Literal e -> FSA n e) -> [Literal e] -> [FSA n e]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Set e -> Literal e -> FSA n e
forall n e. (Enum n, Ord n, Ord e) => Set e -> Literal e -> FSA n e
buildLiteral Set e
alpha) ([Literal e] -> FSA n e) -> [Literal e] -> FSA n e
forall a b. (a -> b) -> a -> b
$ Set (Literal e) -> [Literal e]
forall a. Set a -> [a]
Set.toList Set (Literal e)
literals

> buildConjunction :: (Enum n, NFData n, Ord n, NFData e, Ord e) =>
>                     Set e -> Conjunction e -> FSA n e
> buildConjunction :: forall n e.
(Enum n, NFData n, Ord n, NFData e, Ord e) =>
Set e -> Conjunction e -> FSA n e
buildConjunction Set e
alpha (Conjunction Set (Disjunction e)
disjunctions)
>     = [FSA n e] -> FSA n e
forall n e.
(Enum n, Ord n, NFData n, Ord e, NFData e) =>
[FSA n e] -> FSA n e
flatIntersection ([FSA n e] -> FSA n e)
-> ([Disjunction e] -> [FSA n e]) -> [Disjunction e] -> FSA n e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> [FSA n e] -> [FSA n e]
forall c a. Container c a => a -> c -> c
insert (Set e -> FSA n e
forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
totalWithAlphabet Set e
alpha) ([FSA n e] -> [FSA n e])
-> ([Disjunction e] -> [FSA n e]) -> [Disjunction e] -> [FSA n e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       (Disjunction e -> FSA n e) -> [Disjunction e] -> [FSA n e]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Set e -> Disjunction e -> FSA n e
forall n e.
(Enum n, NFData n, Ord n, NFData e, Ord e) =>
Set e -> Disjunction e -> FSA n e
buildDisjunction Set e
alpha) ([Disjunction e] -> FSA n e) -> [Disjunction e] -> FSA n e
forall a b. (a -> b) -> a -> b
$ Set (Disjunction e) -> [Disjunction e]
forall a. Set a -> [a]
Set.toList Set (Disjunction e)
disjunctions

> -- |Build an t'FSA' representing the conjunction of a set of
> -- constraints provided in conjunctive normal form.
> build :: (Enum n, NFData n, Ord n, NFData e, Ord e) =>
>          Set e -> Set (Conjunction e) -> FSA n e
> build :: forall n e.
(Enum n, NFData n, Ord n, NFData e, Ord e) =>
Set e -> Set (Conjunction e) -> FSA n e
build Set e
alpha = [FSA n e] -> FSA n e
forall n e.
(Enum n, Ord n, NFData n, Ord e, NFData e) =>
[FSA n e] -> FSA n e
flatIntersection                  ([FSA n e] -> FSA n e)
-> (Set (Conjunction e) -> [FSA n e])
-> Set (Conjunction e)
-> FSA n e
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>               FSA n e -> [FSA n e] -> [FSA n e]
forall c a. Container c a => a -> c -> c
insert (Set e -> FSA n e
forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
totalWithAlphabet Set e
alpha)  ([FSA n e] -> [FSA n e])
-> (Set (Conjunction e) -> [FSA n e])
-> Set (Conjunction e)
-> [FSA n e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>               (Conjunction e -> FSA n e) -> [Conjunction e] -> [FSA n e]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Set e -> Conjunction e -> FSA n e
forall n e.
(Enum n, NFData n, Ord n, NFData e, Ord e) =>
Set e -> Conjunction e -> FSA n e
buildConjunction Set e
alpha) ([Conjunction e] -> [FSA n e])
-> (Set (Conjunction e) -> [Conjunction e])
-> Set (Conjunction e)
-> [FSA n e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Conjunction e) -> [Conjunction e]
forall a. Set a -> [a]
Set.toList

> -- |Combine inner lists by t'Disjunction',
> -- and form a t'Conjunction' of the results.
> makeConstraint :: (Ord e) => [[Literal e]] -> Conjunction e
> makeConstraint :: forall e. Ord e => [[Literal e]] -> Conjunction e
makeConstraint
>     = Set (Disjunction e) -> Conjunction e
forall e. Set (Disjunction e) -> Conjunction e
Conjunction (Set (Disjunction e) -> Conjunction e)
-> ([[Literal e]] -> Set (Disjunction e))
-> [[Literal e]]
-> Conjunction e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Disjunction e] -> Set (Disjunction e)
forall a. Ord a => [a] -> Set a
Set.fromList ([Disjunction e] -> Set (Disjunction e))
-> ([[Literal e]] -> [Disjunction e])
-> [[Literal e]]
-> Set (Disjunction e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Literal e] -> Disjunction e) -> [[Literal e]] -> [Disjunction e]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Set (Literal e) -> Disjunction e
forall e. Set (Literal e) -> Disjunction e
Disjunction (Set (Literal e) -> Disjunction e)
-> ([Literal e] -> Set (Literal e)) -> [Literal e] -> Disjunction e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Literal e] -> Set (Literal e)
forall a. Ord a => [a] -> Set a
Set.fromList)

> word :: (Enum a, Ord a, Ord b) =>
>              Bool -> Set b -> [Set b] -> FSA a b
> word :: forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
word Bool
True  Set b
alpha []  =  Set b -> [b] -> FSA a b
forall e n. (Ord e, Enum n, Ord n) => Set e -> [e] -> FSA n e
singletonWithAlphabet Set b
alpha []
> word Bool
False Set b
alpha []  =  FSA a b -> FSA a b
forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic (FSA a b -> FSA a b) -> FSA a b -> FSA a b
forall a b. (a -> b) -> a -> b
$
>                         Set b -> [b] -> FSA a b
forall e n. (Ord e, Enum n, Ord n) => Set e -> [e] -> FSA n e
singletonWithAlphabet Set b
alpha []
> word Bool
isPositive Set b
alpha [Set b]
symseq
>     = FSA (Set Integer) b -> FSA a b
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set Integer) b -> FSA a b)
-> (FSA Integer b -> FSA (Set Integer) b)
-> FSA Integer b
-> FSA a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       (if Bool
isPositive then FSA (Set Integer) b -> FSA (Set Integer) b
forall a. a -> a
id else FSA (Set Integer) b -> FSA (Set Integer) b
forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic) (FSA (Set Integer) b -> FSA (Set Integer) b)
-> (FSA Integer b -> FSA (Set Integer) b)
-> FSA Integer b
-> FSA (Set Integer) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       FSA Integer b -> FSA (Set Integer) b
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set n) e
determinize (FSA Integer b -> FSA a b) -> FSA Integer b -> FSA a b
forall a b. (a -> b) -> a -> b
$
>       FSA { sigma :: Set b
sigma            =  Set b
alpha
>           , transitions :: Set (Transition Integer b)
transitions      =  Set (Transition Integer b)
trans
>           , initials :: Set (State Integer)
initials         =  State Integer -> Set (State Integer)
forall c a. Container c a => a -> c
singleton (State Integer -> Set (State Integer))
-> State Integer -> Set (State Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> State Integer
forall n. n -> State n
State Integer
0
>           , finals :: Set (State Integer)
finals           =  State Integer -> Set (State Integer)
forall c a. Container c a => a -> c
singleton (State Integer -> Set (State Integer))
-> State Integer -> Set (State Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> State Integer
forall n. n -> State n
State Integer
nextState
>           , isDeterministic :: Bool
isDeterministic  =  Bool
False
>           }
>     where tagged :: [(Set b, Integer)]
tagged     =  [Set b] -> [Integer] -> [(Set b, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Set b]
symseq [Integer
0 :: Integer ..]
>           trans' :: Set (Transition Integer b)
trans'     =  [Set (Transition Integer b)] -> Set (Transition Integer b)
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll ([Set (Transition Integer b)] -> Set (Transition Integer b))
-> [Set (Transition Integer b)] -> Set (Transition Integer b)
forall a b. (a -> b) -> a -> b
$
>                         ((Set b, Integer) -> Set (Transition Integer b))
-> [(Set b, Integer)] -> [Set (Transition Integer b)]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                         (\(Set b
symset, Integer
st) ->
>                          (b -> Transition Integer b) -> Set b -> Set (Transition Integer b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Integer -> b -> Transition Integer b
forall n e. Enum n => n -> e -> Transition n e
succtrans Integer
st)
>                               (Set b -> Set b -> Set b
forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set b
alpha Set b
symset)
>                          Set (Transition Integer b)
-> Set (Transition Integer b) -> Set (Transition Integer b)
forall c a. Container c a => c -> c -> c
`union`
>                          (b -> Transition Integer b) -> Set b -> Set (Transition Integer b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Integer -> Integer -> b -> Transition Integer b
forall n e. n -> n -> e -> Transition n e
sinktrans Integer
sinkState Integer
st)
>                               (Set b -> Set b -> Set b
forall c a. (Container c a, Eq a) => c -> c -> c
difference Set b
alpha Set b
symset)
>                         )
>                         [(Set b, Integer)]
tagged
>           trans :: Set (Transition Integer b)
trans      =  (b -> Transition Integer b) -> Set b -> Set (Transition Integer b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Integer -> b -> Transition Integer b
forall n e. Enum n => n -> e -> Transition n e
succtrans Integer
nextState) Set b
alpha
>                         Set (Transition Integer b)
-> Set (Transition Integer b) -> Set (Transition Integer b)
forall c a. Container c a => c -> c -> c
`union` Set (Transition Integer b)
trans'
>           nextState :: Integer
nextState  =  Integer -> Integer
forall a. Enum a => a -> a
succ (Integer -> Integer)
-> ([Integer] -> Integer) -> [Integer] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ ((Set b, Integer) -> Integer) -> [(Set b, Integer)] -> [Integer]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Set b, Integer) -> Integer
forall a b. (a, b) -> b
snd [(Set b, Integer)]
tagged
>           sinkState :: Integer
sinkState  =  Integer -> Integer
forall a. Enum a => a -> a
succ Integer
nextState

> initialLocal :: (Enum a, Ord a, Ord b) =>
>                 Bool -> Set b -> [Set b] -> FSA a b
> initialLocal :: forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
initialLocal Bool
True  Set b
a [] = FSA a b -> FSA a b
forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic (FSA a b -> FSA a b) -> FSA a b -> FSA a b
forall a b. (a -> b) -> a -> b
$ Bool -> Set b -> [Set b] -> FSA a b
forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
initialLocal Bool
False Set b
a []
> initialLocal Bool
False Set b
a [] = Set b -> FSA a b
forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
emptyWithAlphabet Set b
a
> initialLocal Bool
isPositive Set b
alpha [Set b]
symseq
>     = FSA { sigma :: Set b
sigma            =  Set b
alpha
>           , transitions :: Set (Transition a b)
transitions      =  Set (Transition a b)
trans
>           , initials :: Set (State a)
initials         =  State a -> Set (State a)
forall c a. Container c a => a -> c
singleton (State a -> Set (State a)) -> (a -> State a) -> a -> Set (State a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> State a
forall n. n -> State n
State (a -> Set (State a)) -> a -> Set (State a)
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a. Enum a => Int -> a
toEnum Int
0
>           , finals :: Set (State a)
finals           =  if Bool
isPositive then Set (State a)
fin else Set (State a)
fin'
>           , isDeterministic :: Bool
isDeterministic  =  Bool
True
>           }
>     where tagged :: [(Set b, a)]
tagged     =  [Set b] -> [a] -> [(Set b, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Set b]
symseq ([a] -> [(Set b, a)]) -> [a] -> [(Set b, a)]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
forall a. Enum a => a -> a
succ (Int -> a
forall a. Enum a => Int -> a
toEnum Int
0)
>           trans' :: Set (Transition a b)
trans'     =  [Set (Transition a b)] -> Set (Transition a b)
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll ([Set (Transition a b)] -> Set (Transition a b))
-> [Set (Transition a b)] -> Set (Transition a b)
forall a b. (a -> b) -> a -> b
$
>                         ((Set b, a) -> Set (Transition a b))
-> [(Set b, a)] -> [Set (Transition a b)]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                         (\(Set b
symset, a
st) ->
>                          (b -> Transition a b) -> Set b -> Set (Transition a b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (a -> b -> Transition a b
forall n e. Enum n => n -> e -> Transition n e
succtrans a
st)
>                               (Set b -> Set b -> Set b
forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set b
alpha Set b
symset)
>                          Set (Transition a b)
-> Set (Transition a b) -> Set (Transition a b)
forall c a. Container c a => c -> c -> c
`union`
>                          (b -> Transition a b) -> Set b -> Set (Transition a b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (a -> a -> b -> Transition a b
forall n e. n -> n -> e -> Transition n e
sinktrans a
sinkState a
st)
>                               (Set b -> Set b -> Set b
forall c a. (Container c a, Eq a) => c -> c -> c
difference Set b
alpha Set b
symset)
>                         ) [(Set b, a)]
tagged
>           trans :: Set (Transition a b)
trans      =  [Set (Transition a b)] -> Set (Transition a b)
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll
>                         [ (b -> Transition a b) -> Set b -> Set (Transition a b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (a -> b -> Transition a b
forall n e. Enum n => n -> e -> Transition n e
selftrans a
nextState) Set b
alpha
>                         , (b -> Transition a b) -> Set b -> Set (Transition a b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (a -> b -> Transition a b
forall n e. Enum n => n -> e -> Transition n e
selftrans a
sinkState) Set b
alpha
>                         , Set (Transition a b)
trans'
>                         ]
>           nextState :: a
nextState  =  a -> a
forall a. Enum a => a -> a
succ (a -> a) -> ([a] -> a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ ((Set b, a) -> a) -> [(Set b, a)] -> [a]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Set b, a) -> a
forall a b. (a, b) -> b
snd [(Set b, a)]
tagged
>           sinkState :: a
sinkState  =  a -> a
forall a. Enum a => a -> a
succ a
nextState
>           fin' :: Set (State a)
fin'       =  State a -> Set (State a) -> Set (State a)
forall c a. Container c a => a -> c -> c
insert
>                         (a -> State a
forall n. n -> State n
State a
sinkState)
>                         ([State a] -> Set (State a)
forall a. Ord a => [a] -> Set a
Set.fromList ([State a] -> Set (State a)) -> [State a] -> Set (State a)
forall a b. (a -> b) -> a -> b
$ ((Set b, a) -> State a) -> [(Set b, a)] -> [State a]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (a -> State a
forall n. n -> State n
State (a -> State a) -> ((Set b, a) -> a) -> (Set b, a) -> State a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set b, a) -> a
forall a b. (a, b) -> b
snd) [(Set b, a)]
tagged)
>           fin :: Set (State a)
fin        =  State a -> Set (State a)
forall c a. Container c a => a -> c
singleton (a -> State a
forall n. n -> State n
State a
nextState)

For final and non-anchored factors, it would be nice to use KMP.
However, for that to work properly, I believe we would have to expand
the symbol-sets, then combine all the results with either union or
intersection (depending on whether the factor is to be positive or
negative).  Making these from NFAs is cheaper, it seems.

> finalLocal :: (Enum a, Ord a, Ord b) =>
>                 Bool -> Set b -> [Set b] -> FSA a b
> finalLocal :: forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
finalLocal Bool
True  Set b
a [] = FSA a b -> FSA a b
forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic (FSA a b -> FSA a b) -> FSA a b -> FSA a b
forall a b. (a -> b) -> a -> b
$ Bool -> Set b -> [Set b] -> FSA a b
forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
finalLocal Bool
False Set b
a []
> finalLocal Bool
False Set b
a [] = Set b -> FSA a b
forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
emptyWithAlphabet Set b
a
> finalLocal Bool
isPositive Set b
alpha [Set b]
symseq
>     = FSA (Set Integer) b -> FSA a b
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set Integer) b -> FSA a b)
-> (FSA Integer b -> FSA (Set Integer) b)
-> FSA Integer b
-> FSA a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isPositive then FSA (Set Integer) b -> FSA (Set Integer) b
forall a. a -> a
id else FSA (Set Integer) b -> FSA (Set Integer) b
forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic) (FSA (Set Integer) b -> FSA (Set Integer) b)
-> (FSA Integer b -> FSA (Set Integer) b)
-> FSA Integer b
-> FSA (Set Integer) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       FSA Integer b -> FSA (Set Integer) b
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set n) e
determinize (FSA Integer b -> FSA a b) -> FSA Integer b -> FSA a b
forall a b. (a -> b) -> a -> b
$ FSA { sigma :: Set b
sigma            =  Set b
alpha
>                         , transitions :: Set (Transition Integer b)
transitions      =  Set (Transition Integer b)
trans
>                         , initials :: Set (State Integer)
initials         =  State Integer -> Set (State Integer)
forall c a. Container c a => a -> c
singleton (State Integer -> Set (State Integer))
-> State Integer -> Set (State Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> State Integer
forall n. n -> State n
State Integer
0
>                         , finals :: Set (State Integer)
finals           =  State Integer -> Set (State Integer)
forall c a. Container c a => a -> c
singleton (State Integer -> Set (State Integer))
-> State Integer -> Set (State Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> State Integer
forall n. n -> State n
State Integer
nextState
>                         , isDeterministic :: Bool
isDeterministic  =  Bool
False
>                         }
>     where tagged :: [(Set b, Integer)]
tagged     =  [Set b] -> [Integer] -> [(Set b, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Set b]
symseq [Integer
0 :: Integer ..]
>           trans' :: Set (Transition Integer b)
trans'     =  [Set (Transition Integer b)] -> Set (Transition Integer b)
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll
>                         ([Set (Transition Integer b)] -> Set (Transition Integer b))
-> [Set (Transition Integer b)] -> Set (Transition Integer b)
forall a b. (a -> b) -> a -> b
$ ((Set b, Integer) -> Set (Transition Integer b))
-> [(Set b, Integer)] -> [Set (Transition Integer b)]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                           (\(Set b
symset, Integer
st) ->
>                            (b -> Transition Integer b) -> Set b -> Set (Transition Integer b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Integer -> b -> Transition Integer b
forall n e. Enum n => n -> e -> Transition n e
succtrans Integer
st)
>                            (Set b -> Set (Transition Integer b))
-> Set b -> Set (Transition Integer b)
forall a b. (a -> b) -> a -> b
$ Set b -> Set b -> Set b
forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set b
alpha Set b
symset
>                           ) [(Set b, Integer)]
tagged
>           trans :: Set (Transition Integer b)
trans      =  (b -> Transition Integer b) -> Set b -> Set (Transition Integer b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Integer -> b -> Transition Integer b
forall n e. Enum n => n -> e -> Transition n e
selftrans Integer
0) Set b
alpha Set (Transition Integer b)
-> Set (Transition Integer b) -> Set (Transition Integer b)
forall c a. Container c a => c -> c -> c
`union` Set (Transition Integer b)
trans'
>           nextState :: Integer
nextState  =  Integer -> Integer
forall a. Enum a => a -> a
succ (Integer -> Integer)
-> ([Integer] -> Integer) -> [Integer] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ ((Set b, Integer) -> Integer) -> [(Set b, Integer)] -> [Integer]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Set b, Integer) -> Integer
forall a b. (a, b) -> b
snd [(Set b, Integer)]
tagged

> local :: (Enum a, Ord a, Ord b) =>
>                 Bool -> Set b -> [Set b] -> FSA a b
> local :: forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
local Bool
True  Set b
alpha [] = FSA a b -> FSA a b
forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic (FSA a b -> FSA a b) -> FSA a b -> FSA a b
forall a b. (a -> b) -> a -> b
$ Bool -> Set b -> [Set b] -> FSA a b
forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
local Bool
False Set b
alpha []
> local Bool
False Set b
alpha [] = Set b -> FSA a b
forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
emptyWithAlphabet Set b
alpha
> local Bool
isPositive Set b
alpha [Set b]
symseq
>     = FSA (Set Integer) b -> FSA a b
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set Integer) b -> FSA a b)
-> (FSA Integer b -> FSA (Set Integer) b)
-> FSA Integer b
-> FSA a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       (if Bool
isPositive then FSA (Set Integer) b -> FSA (Set Integer) b
forall a. a -> a
id else FSA (Set Integer) b -> FSA (Set Integer) b
forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic) (FSA (Set Integer) b -> FSA (Set Integer) b)
-> (FSA Integer b -> FSA (Set Integer) b)
-> FSA Integer b
-> FSA (Set Integer) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       FSA Integer b -> FSA (Set Integer) b
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set n) e
determinize (FSA Integer b -> FSA a b) -> FSA Integer b -> FSA a b
forall a b. (a -> b) -> a -> b
$
>       FSA
>       { sigma :: Set b
sigma        =  Set b
alpha
>       , transitions :: Set (Transition Integer b)
transitions  =  Set (Transition Integer b)
trans
>       , initials :: Set (State Integer)
initials     =  State Integer -> Set (State Integer)
forall c a. Container c a => a -> c
singleton (State Integer -> Set (State Integer))
-> State Integer -> Set (State Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> State Integer
forall n. n -> State n
State Integer
0
>       , finals :: Set (State Integer)
finals       =  State Integer -> Set (State Integer)
forall c a. Container c a => a -> c
singleton (State Integer -> Set (State Integer))
-> State Integer -> Set (State Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> State Integer
forall n. n -> State n
State Integer
nextState
>       , isDeterministic :: Bool
isDeterministic = Bool
False
>       }
>     where tagged :: [(Set b, Integer)]
tagged  = [Set b] -> [Integer] -> [(Set b, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Set b]
symseq [Integer
0 :: Integer ..]
>           trans' :: Set (Transition Integer b)
trans'  = [Set (Transition Integer b)] -> Set (Transition Integer b)
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll ([Set (Transition Integer b)] -> Set (Transition Integer b))
-> [Set (Transition Integer b)] -> Set (Transition Integer b)
forall a b. (a -> b) -> a -> b
$
>                     ((Set b, Integer) -> Set (Transition Integer b))
-> [(Set b, Integer)] -> [Set (Transition Integer b)]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                     (\(Set b
symset, Integer
st) ->
>                      (b -> Transition Integer b) -> Set b -> Set (Transition Integer b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Integer -> b -> Transition Integer b
forall n e. Enum n => n -> e -> Transition n e
succtrans Integer
st) (Set b -> Set (Transition Integer b))
-> Set b -> Set (Transition Integer b)
forall a b. (a -> b) -> a -> b
$ Set b -> Set b -> Set b
forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set b
alpha Set b
symset
>                     )
>                     [(Set b, Integer)]
tagged
>           trans :: Set (Transition Integer b)
trans   = [Set (Transition Integer b)] -> Set (Transition Integer b)
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll
>                     [(b -> Transition Integer b) -> Set b -> Set (Transition Integer b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Integer -> b -> Transition Integer b
forall n e. Enum n => n -> e -> Transition n e
selftrans Integer
0) Set b
alpha
>                     , (b -> Transition Integer b) -> Set b -> Set (Transition Integer b)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Integer -> b -> Transition Integer b
forall n e. Enum n => n -> e -> Transition n e
selftrans Integer
nextState) Set b
alpha
>                     , Set (Transition Integer b)
trans'
>                     ]
>           nextState :: Integer
nextState = Integer -> Integer
forall a. Enum a => a -> a
succ (Integer -> Integer)
-> ([Integer] -> Integer) -> [Integer] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ ((Set b, Integer) -> Integer) -> [(Set b, Integer)] -> [Integer]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (Set b, Integer) -> Integer
forall a b. (a, b) -> b
snd [(Set b, Integer)]
tagged

> selftrans, succtrans :: (Enum n) => n -> e -> Transition n e
> selftrans :: forall n e. Enum n => n -> e -> Transition n e
selftrans  =  (n -> n) -> n -> e -> Transition n e
forall n e. (n -> n) -> n -> e -> Transition n e
transTo n -> n
forall a. a -> a
id
> succtrans :: forall n e. Enum n => n -> e -> Transition n e
succtrans  =  (n -> n) -> n -> e -> Transition n e
forall n e. (n -> n) -> n -> e -> Transition n e
transTo n -> n
forall a. Enum a => a -> a
succ

> sinktrans :: n -> n -> e -> Transition n e
> sinktrans :: forall n e. n -> n -> e -> Transition n e
sinktrans n
sinkState = (n -> n) -> n -> e -> Transition n e
forall n e. (n -> n) -> n -> e -> Transition n e
transTo (n -> n -> n
forall a b. a -> b -> a
const n
sinkState)

> transTo :: (n -> n) -> n -> e -> Transition n e
> transTo :: forall n e. (n -> n) -> n -> e -> Transition n e
transTo n -> n
f n
n e
x
>     = Transition
>       { edgeLabel :: Symbol e
edgeLabel = e -> Symbol e
forall e. e -> Symbol e
Symbol e
x
>       , source :: State n
source = n -> State n
forall n. n -> State n
State n
n
>       , destination :: State n
destination = n -> State n
forall n. n -> State n
State (n -> State n) -> n -> State n
forall a b. (a -> b) -> a -> b
$ n -> n
f n
n
>       }