> {-# OPTIONS_HADDOCK show-extensions #-}
> {-# Language CPP #-}

#if !defined(MIN_VERSION_base)
# define MIN_VERSION_base(a,b,c) 0
#endif

> {-|
> Module:    LTK.Porters.Pleb
> Copyright: (c) 2018-2024 Dakotah Lambert
> License:   MIT

> The (P)iecewise / (L)ocal (E)xpression (B)uilder.
> This module defines a parser for a representation of
> logical formulae over subsequence- and adjacency-factors,
> as well as a mechanism for evaluating (creating an t'FSA' from)
> the resulting expression tree.

> There are two special variables:
> 
> * @it@ describes the most recent expression, and
> 
> * @universe@ collects all symbols used.
> -}
> module LTK.Porters.Pleb
>        ( Dictionary
>        , Parse(..)
>        , Env
>        , Expr
>        , SymSet
>        , Token
>        , compileEnv
>        , groundEnv
>        , insertExpr
>        , fromAutomaton
>        , fromSemanticAutomaton
>        , makeAutomaton
>        , makeAutomatonE
>        , doStatements
>        , doStatementsWithError
>        , parseExpr
>        , readPleb
>        , restoreUniverse
>        , restrictUniverse
>        , tokenize
>        ) where

#if !MIN_VERSION_base(4,8,0)
> import Data.Functor ((<$>))
> import Data.Monoid (mconcat)
> import Control.Applicative (Applicative, pure, (<*>))
#endif
> import Control.Applicative ( Alternative
>                            , empty, many, some, (<|>))
> import Data.Char (isLetter, isSpace)
> import Data.Foldable (asum)
> import Data.Functor.Classes (Read1(..),Show1(..))
> import Data.List (intersperse,foldl1')
> import Data.Map (Map)
> import Data.Set (Set)
> import qualified Data.Map as Map
> import qualified Data.Set as Set

> import LTK.FSA
> import LTK.Factors (Factor(..), buildLiteral, required)
> import LTK.Extract.SP (subsequenceClosure)

> -- |A syntactic unit.
> data Token = TSymbol Char
>            | TName String
>              deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq, Eq Token
Eq Token =>
(Token -> Token -> Ordering)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Token)
-> (Token -> Token -> Token)
-> Ord Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
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
$ccompare :: Token -> Token -> Ordering
compare :: Token -> Token -> Ordering
$c< :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
>= :: Token -> Token -> Bool
$cmax :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
min :: Token -> Token -> Token
Ord, ReadPrec [Token]
ReadPrec Token
Int -> ReadS Token
ReadS [Token]
(Int -> ReadS Token)
-> ReadS [Token]
-> ReadPrec Token
-> ReadPrec [Token]
-> Read Token
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Token
readsPrec :: Int -> ReadS Token
$creadList :: ReadS [Token]
readList :: ReadS [Token]
$creadPrec :: ReadPrec Token
readPrec :: ReadPrec Token
$creadListPrec :: ReadPrec [Token]
readListPrec :: ReadPrec [Token]
Read, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show)

> -- |Convert a string into a stream of tokens ready for parsing.
> tokenize  :: String -> [Token]
> tokenize :: String -> [Token]
tokenize String
"" = []
> tokenize (Char
x:String
xs)
>     | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#'    =  String -> [Token]
tokenize ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
xs)
>     | Char -> Bool
isSpace Char
x   =  String -> [Token]
tokenize ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
xs)
>     | Char -> Bool
isLetter Char
x  =  (Token -> [Token] -> [Token]) -> (Token, [Token]) -> [Token]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((Token, [Token]) -> [Token])
-> ((String, String) -> (Token, [Token]))
-> (String, String)
-> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Token) -> (String, [Token]) -> (Token, [Token])
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapfst String -> Token
TName ((String, [Token]) -> (Token, [Token]))
-> ((String, String) -> (String, [Token]))
-> (String, String)
-> (Token, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [Token]) -> (String, String) -> (String, [Token])
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> [Token]
tokenize ((String, String) -> [Token]) -> (String, String) -> [Token]
forall a b. (a -> b) -> a -> b
$
>                      (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\Char
s -> Char
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char -> Bool
isDelim Char
s Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
s) (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
>     | Bool
otherwise   =  Char -> Token
TSymbol Char
x Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: String -> [Token]
tokenize String
xs
>     where isDelim :: Char -> Bool
isDelim Char
c = Char -> Char
matchingDelimiter Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|'

> -- |The environment: defined sets of symbols and defined expressions.
> type Env = (Dictionary (Set String), Dictionary Expr)

> newtype Fix a = In { forall (a :: * -> *). Fix a -> a (Fix a)
out :: a (Fix a) }
> instance Read1 f => Read (Fix f) where
>     readsPrec :: Int -> ReadS (Fix f)
readsPrec Int
d = ((f (Fix f), String) -> (Fix f, String))
-> [(f (Fix f), String)] -> [(Fix f, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((f (Fix f) -> Fix f) -> (f (Fix f), String) -> (Fix f, String)
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapfst f (Fix f) -> Fix f
forall (a :: * -> *). a (Fix a) -> Fix a
In) ([(f (Fix f), String)] -> [(Fix f, String)])
-> (String -> [(f (Fix f), String)]) -> ReadS (Fix f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ReadS (Fix f))
-> ReadS [Fix f] -> Int -> String -> [(f (Fix f), String)]
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS (Fix f)
forall a. Read a => Int -> ReadS a
readsPrec ReadS [Fix f]
forall a. Read a => ReadS [a]
readList Int
d
> instance Show1 f => Show (Fix f) where
>     showsPrec :: Int -> Fix f -> ShowS
showsPrec Int
d = (Int -> Fix f -> ShowS)
-> ([Fix f] -> ShowS) -> Int -> f (Fix f) -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> Fix f -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [Fix f] -> ShowS
forall a. Show a => [a] -> ShowS
showList Int
d (f (Fix f) -> ShowS) -> (Fix f -> f (Fix f)) -> Fix f -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (a :: * -> *). Fix a -> a (Fix a)
out

> -- |An expression tree of arbitrary depth.
> type Expr = Fix ExprF
> -- |An expression, the root of an expression tree.
> data ExprF a
>     = Automaton (FSA Integer (Maybe String))
>     | Concatenation [a]
>     | Conjunction [a]
>     | Disjunction [a]
>     | Domination [a]
>     | DownClose a
>     | Factor PLFactor
>     | Infiltration [a]
>     | Iteration a
>     | Negation a
>     | Neutralize [SymSet] a
>     | Reversal a
>     | Shuffle [a]
>     | StrictOrder [a]
>     | Tierify [SymSet] a
>     | QuotientL [a]
>     | QuotientR [a]
>     | UpClose a
>     | Variable String
>       deriving (ExprF a -> ExprF a -> Bool
(ExprF a -> ExprF a -> Bool)
-> (ExprF a -> ExprF a -> Bool) -> Eq (ExprF a)
forall a. Eq a => ExprF a -> ExprF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ExprF a -> ExprF a -> Bool
== :: ExprF a -> ExprF a -> Bool
$c/= :: forall a. Eq a => ExprF a -> ExprF a -> Bool
/= :: ExprF a -> ExprF a -> Bool
Eq, ReadPrec [ExprF a]
ReadPrec (ExprF a)
Int -> ReadS (ExprF a)
ReadS [ExprF a]
(Int -> ReadS (ExprF a))
-> ReadS [ExprF a]
-> ReadPrec (ExprF a)
-> ReadPrec [ExprF a]
-> Read (ExprF a)
forall a. Read a => ReadPrec [ExprF a]
forall a. Read a => ReadPrec (ExprF a)
forall a. Read a => Int -> ReadS (ExprF a)
forall a. Read a => ReadS [ExprF a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (ExprF a)
readsPrec :: Int -> ReadS (ExprF a)
$creadList :: forall a. Read a => ReadS [ExprF a]
readList :: ReadS [ExprF a]
$creadPrec :: forall a. Read a => ReadPrec (ExprF a)
readPrec :: ReadPrec (ExprF a)
$creadListPrec :: forall a. Read a => ReadPrec [ExprF a]
readListPrec :: ReadPrec [ExprF a]
Read, Int -> ExprF a -> ShowS
[ExprF a] -> ShowS
ExprF a -> String
(Int -> ExprF a -> ShowS)
-> (ExprF a -> String) -> ([ExprF a] -> ShowS) -> Show (ExprF a)
forall a. Show a => Int -> ExprF a -> ShowS
forall a. Show a => [ExprF a] -> ShowS
forall a. Show a => ExprF a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ExprF a -> ShowS
showsPrec :: Int -> ExprF a -> ShowS
$cshow :: forall a. Show a => ExprF a -> String
show :: ExprF a -> String
$cshowList :: forall a. Show a => [ExprF a] -> ShowS
showList :: [ExprF a] -> ShowS
Show)
> instance Functor ExprF where
>    fmap :: forall a b. (a -> b) -> ExprF a -> ExprF b
fmap a -> b
_ (Automaton FSA Integer (Maybe String)
x)      = FSA Integer (Maybe String) -> ExprF b
forall a. FSA Integer (Maybe String) -> ExprF a
Automaton FSA Integer (Maybe String)
x
>    fmap a -> b
f (Concatenation [a]
xs) = [b] -> ExprF b
forall a. [a] -> ExprF a
Concatenation ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
>    fmap a -> b
f (Conjunction [a]
xs)   = [b] -> ExprF b
forall a. [a] -> ExprF a
Conjunction ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
>    fmap a -> b
f (Disjunction [a]
xs)   = [b] -> ExprF b
forall a. [a] -> ExprF a
Disjunction ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
>    fmap a -> b
f (Domination [a]
xs)    = [b] -> ExprF b
forall a. [a] -> ExprF a
Domination ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
>    fmap a -> b
f (DownClose a
x)      = b -> ExprF b
forall a. a -> ExprF a
DownClose (a -> b
f a
x)
>    fmap a -> b
_ (Factor PLFactor
x)         = PLFactor -> ExprF b
forall a. PLFactor -> ExprF a
Factor PLFactor
x
>    fmap a -> b
f (Infiltration [a]
xs)  = [b] -> ExprF b
forall a. [a] -> ExprF a
Infiltration ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
>    fmap a -> b
f (Iteration a
x)      = b -> ExprF b
forall a. a -> ExprF a
Iteration (a -> b
f a
x)
>    fmap a -> b
f (Negation a
x)       = b -> ExprF b
forall a. a -> ExprF a
Negation (a -> b
f a
x)
>    fmap a -> b
f (Neutralize [SymSet]
s a
x)   = [SymSet] -> b -> ExprF b
forall a. [SymSet] -> a -> ExprF a
Neutralize [SymSet]
s (a -> b
f a
x)
>    fmap a -> b
f (Reversal a
x)       = b -> ExprF b
forall a. a -> ExprF a
Reversal (a -> b
f a
x)
>    fmap a -> b
f (Shuffle [a]
xs)       = [b] -> ExprF b
forall a. [a] -> ExprF a
Shuffle ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
>    fmap a -> b
f (StrictOrder [a]
xs)   = [b] -> ExprF b
forall a. [a] -> ExprF a
StrictOrder ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
>    fmap a -> b
f (Tierify [SymSet]
s a
x)      = [SymSet] -> b -> ExprF b
forall a. [SymSet] -> a -> ExprF a
Tierify [SymSet]
s (a -> b
f a
x)
>    fmap a -> b
f (QuotientL [a]
xs)     = [b] -> ExprF b
forall a. [a] -> ExprF a
QuotientL ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
>    fmap a -> b
f (QuotientR [a]
xs)     = [b] -> ExprF b
forall a. [a] -> ExprF a
QuotientR ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
>    fmap a -> b
f (UpClose a
x)        = b -> ExprF b
forall a. a -> ExprF a
UpClose (a -> b
f a
x)
>    fmap a -> b
_ (Variable String
x)       = String -> ExprF b
forall a. String -> ExprF a
Variable String
x
> instance Foldable ExprF where
>    foldr :: forall a b. (a -> b -> b) -> b -> ExprF a -> b
foldr a -> b -> b
_ b
a (Automaton FSA Integer (Maybe String)
_)      = b
a
>    foldr a -> b -> b
f b
a (Concatenation [a]
xs) = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
a [a]
xs
>    foldr a -> b -> b
f b
a (Conjunction [a]
xs)   = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
a [a]
xs
>    foldr a -> b -> b
f b
a (Disjunction [a]
xs)   = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
a [a]
xs
>    foldr a -> b -> b
f b
a (Domination [a]
xs)    = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
a [a]
xs
>    foldr a -> b -> b
f b
a (DownClose a
x)      = a -> b -> b
f a
x b
a
>    foldr a -> b -> b
_ b
a (Factor PLFactor
_)         = b
a
>    foldr a -> b -> b
f b
a (Infiltration [a]
xs)  = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
a [a]
xs
>    foldr a -> b -> b
f b
a (Iteration a
x)      = a -> b -> b
f a
x b
a
>    foldr a -> b -> b
f b
a (Negation a
x)       = a -> b -> b
f a
x b
a
>    foldr a -> b -> b
f b
a (Neutralize [SymSet]
_ a
x)   = a -> b -> b
f a
x b
a
>    foldr a -> b -> b
f b
a (Reversal a
x)       = a -> b -> b
f a
x b
a
>    foldr a -> b -> b
f b
a (Shuffle [a]
xs)       = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
a [a]
xs
>    foldr a -> b -> b
f b
a (StrictOrder [a]
xs)   = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
a [a]
xs
>    foldr a -> b -> b
f b
a (Tierify [SymSet]
_ a
x)      = a -> b -> b
f a
x b
a
>    foldr a -> b -> b
f b
a (QuotientL [a]
xs)     = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
a [a]
xs
>    foldr a -> b -> b
f b
a (QuotientR [a]
xs)     = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
a [a]
xs
>    foldr a -> b -> b
f b
a (UpClose a
x)        = a -> b -> b
f a
x b
a
>    foldr a -> b -> b
_ b
a (Variable String
_)       = b
a
> instance Traversable ExprF where
>    sequenceA :: forall (f :: * -> *) a. Applicative f => ExprF (f a) -> f (ExprF a)
sequenceA (Automaton FSA Integer (Maybe String)
x)      = ExprF a -> f (ExprF a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExprF a -> f (ExprF a)) -> ExprF a -> f (ExprF a)
forall a b. (a -> b) -> a -> b
$ FSA Integer (Maybe String) -> ExprF a
forall a. FSA Integer (Maybe String) -> ExprF a
Automaton FSA Integer (Maybe String)
x
>    sequenceA (Concatenation [f a]
xs) = [a] -> ExprF a
forall a. [a] -> ExprF a
Concatenation ([a] -> ExprF a) -> f [a] -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f a]
xs
>    sequenceA (Conjunction [f a]
xs)   = [a] -> ExprF a
forall a. [a] -> ExprF a
Conjunction ([a] -> ExprF a) -> f [a] -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f a]
xs
>    sequenceA (Disjunction [f a]
xs)   = [a] -> ExprF a
forall a. [a] -> ExprF a
Disjunction ([a] -> ExprF a) -> f [a] -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f a]
xs
>    sequenceA (Domination [f a]
xs)    = [a] -> ExprF a
forall a. [a] -> ExprF a
Domination ([a] -> ExprF a) -> f [a] -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f a]
xs
>    sequenceA (DownClose f a
x)      = a -> ExprF a
forall a. a -> ExprF a
DownClose (a -> ExprF a) -> f a -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
>    sequenceA (Factor PLFactor
x)         = ExprF a -> f (ExprF a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExprF a -> f (ExprF a)) -> ExprF a -> f (ExprF a)
forall a b. (a -> b) -> a -> b
$ PLFactor -> ExprF a
forall a. PLFactor -> ExprF a
Factor PLFactor
x
>    sequenceA (Infiltration [f a]
xs)  = [a] -> ExprF a
forall a. [a] -> ExprF a
Infiltration ([a] -> ExprF a) -> f [a] -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f a]
xs
>    sequenceA (Iteration f a
x)      = a -> ExprF a
forall a. a -> ExprF a
Iteration (a -> ExprF a) -> f a -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
>    sequenceA (Negation f a
x)       = a -> ExprF a
forall a. a -> ExprF a
Negation (a -> ExprF a) -> f a -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
>    sequenceA (Neutralize [SymSet]
s f a
x)   = ([SymSet] -> a -> ExprF a
forall a. [SymSet] -> a -> ExprF a
Neutralize [SymSet]
s) (a -> ExprF a) -> f a -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
>    sequenceA (Reversal f a
x)       = a -> ExprF a
forall a. a -> ExprF a
Reversal (a -> ExprF a) -> f a -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
>    sequenceA (Shuffle [f a]
xs)       = [a] -> ExprF a
forall a. [a] -> ExprF a
Shuffle ([a] -> ExprF a) -> f [a] -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f a]
xs
>    sequenceA (StrictOrder [f a]
xs)   = [a] -> ExprF a
forall a. [a] -> ExprF a
StrictOrder ([a] -> ExprF a) -> f [a] -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f a]
xs
>    sequenceA (Tierify [SymSet]
s f a
x)      = ([SymSet] -> a -> ExprF a
forall a. [SymSet] -> a -> ExprF a
Tierify [SymSet]
s) (a -> ExprF a) -> f a -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
>    sequenceA (QuotientL [f a]
xs)     = [a] -> ExprF a
forall a. [a] -> ExprF a
QuotientL ([a] -> ExprF a) -> f [a] -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f a]
xs
>    sequenceA (QuotientR [f a]
xs)     = [a] -> ExprF a
forall a. [a] -> ExprF a
QuotientR ([a] -> ExprF a) -> f [a] -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [f a]
xs
>    sequenceA (UpClose f a
x)        = a -> ExprF a
forall a. a -> ExprF a
UpClose (a -> ExprF a) -> f a -> f (ExprF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
>    sequenceA (Variable String
x)       = ExprF a -> f (ExprF a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExprF a -> f (ExprF a)) -> ExprF a -> f (ExprF a)
forall a b. (a -> b) -> a -> b
$ String -> ExprF a
forall a. String -> ExprF a
Variable String
x

> -- |A subexpression representing a single Piecewise-Local factor.
> -- @Left s@ represents a variable name, while @Right x@ is a real set.
> data PLFactor
>     = PLFactor Bool Bool [[SymSet]]
>     | PLGap [PLFactor]
>     | PLCat [PLFactor]
>     | PLVariable String
>       deriving (PLFactor -> PLFactor -> Bool
(PLFactor -> PLFactor -> Bool)
-> (PLFactor -> PLFactor -> Bool) -> Eq PLFactor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PLFactor -> PLFactor -> Bool
== :: PLFactor -> PLFactor -> Bool
$c/= :: PLFactor -> PLFactor -> Bool
/= :: PLFactor -> PLFactor -> Bool
Eq, Eq PLFactor
Eq PLFactor =>
(PLFactor -> PLFactor -> Ordering)
-> (PLFactor -> PLFactor -> Bool)
-> (PLFactor -> PLFactor -> Bool)
-> (PLFactor -> PLFactor -> Bool)
-> (PLFactor -> PLFactor -> Bool)
-> (PLFactor -> PLFactor -> PLFactor)
-> (PLFactor -> PLFactor -> PLFactor)
-> Ord PLFactor
PLFactor -> PLFactor -> Bool
PLFactor -> PLFactor -> Ordering
PLFactor -> PLFactor -> PLFactor
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
$ccompare :: PLFactor -> PLFactor -> Ordering
compare :: PLFactor -> PLFactor -> Ordering
$c< :: PLFactor -> PLFactor -> Bool
< :: PLFactor -> PLFactor -> Bool
$c<= :: PLFactor -> PLFactor -> Bool
<= :: PLFactor -> PLFactor -> Bool
$c> :: PLFactor -> PLFactor -> Bool
> :: PLFactor -> PLFactor -> Bool
$c>= :: PLFactor -> PLFactor -> Bool
>= :: PLFactor -> PLFactor -> Bool
$cmax :: PLFactor -> PLFactor -> PLFactor
max :: PLFactor -> PLFactor -> PLFactor
$cmin :: PLFactor -> PLFactor -> PLFactor
min :: PLFactor -> PLFactor -> PLFactor
Ord, ReadPrec [PLFactor]
ReadPrec PLFactor
Int -> ReadS PLFactor
ReadS [PLFactor]
(Int -> ReadS PLFactor)
-> ReadS [PLFactor]
-> ReadPrec PLFactor
-> ReadPrec [PLFactor]
-> Read PLFactor
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PLFactor
readsPrec :: Int -> ReadS PLFactor
$creadList :: ReadS [PLFactor]
readList :: ReadS [PLFactor]
$creadPrec :: ReadPrec PLFactor
readPrec :: ReadPrec PLFactor
$creadListPrec :: ReadPrec [PLFactor]
readListPrec :: ReadPrec [PLFactor]
Read, Int -> PLFactor -> ShowS
[PLFactor] -> ShowS
PLFactor -> String
(Int -> PLFactor -> ShowS)
-> (PLFactor -> String) -> ([PLFactor] -> ShowS) -> Show PLFactor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PLFactor -> ShowS
showsPrec :: Int -> PLFactor -> ShowS
$cshow :: PLFactor -> String
show :: PLFactor -> String
$cshowList :: [PLFactor] -> ShowS
showList :: [PLFactor] -> ShowS
Show)

> -- |A particular action.
> data Statement
>     = EAssignment String Expr
>     | SAssignment String SymSet
>       --deriving (Eq, Ord, Read, Show)

> -- |A set of symbols.
> data SymSet = SSSet (Set String)
>             | SSUni [SymSet]
>             | SSInt [SymSet]
>             | SSVar String
>               deriving (SymSet -> SymSet -> Bool
(SymSet -> SymSet -> Bool)
-> (SymSet -> SymSet -> Bool) -> Eq SymSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SymSet -> SymSet -> Bool
== :: SymSet -> SymSet -> Bool
$c/= :: SymSet -> SymSet -> Bool
/= :: SymSet -> SymSet -> Bool
Eq, Eq SymSet
Eq SymSet =>
(SymSet -> SymSet -> Ordering)
-> (SymSet -> SymSet -> Bool)
-> (SymSet -> SymSet -> Bool)
-> (SymSet -> SymSet -> Bool)
-> (SymSet -> SymSet -> Bool)
-> (SymSet -> SymSet -> SymSet)
-> (SymSet -> SymSet -> SymSet)
-> Ord SymSet
SymSet -> SymSet -> Bool
SymSet -> SymSet -> Ordering
SymSet -> SymSet -> SymSet
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
$ccompare :: SymSet -> SymSet -> Ordering
compare :: SymSet -> SymSet -> Ordering
$c< :: SymSet -> SymSet -> Bool
< :: SymSet -> SymSet -> Bool
$c<= :: SymSet -> SymSet -> Bool
<= :: SymSet -> SymSet -> Bool
$c> :: SymSet -> SymSet -> Bool
> :: SymSet -> SymSet -> Bool
$c>= :: SymSet -> SymSet -> Bool
>= :: SymSet -> SymSet -> Bool
$cmax :: SymSet -> SymSet -> SymSet
max :: SymSet -> SymSet -> SymSet
$cmin :: SymSet -> SymSet -> SymSet
min :: SymSet -> SymSet -> SymSet
Ord, ReadPrec [SymSet]
ReadPrec SymSet
Int -> ReadS SymSet
ReadS [SymSet]
(Int -> ReadS SymSet)
-> ReadS [SymSet]
-> ReadPrec SymSet
-> ReadPrec [SymSet]
-> Read SymSet
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SymSet
readsPrec :: Int -> ReadS SymSet
$creadList :: ReadS [SymSet]
readList :: ReadS [SymSet]
$creadPrec :: ReadPrec SymSet
readPrec :: ReadPrec SymSet
$creadListPrec :: ReadPrec [SymSet]
readListPrec :: ReadPrec [SymSet]
Read, Int -> SymSet -> ShowS
[SymSet] -> ShowS
SymSet -> String
(Int -> SymSet -> ShowS)
-> (SymSet -> String) -> ([SymSet] -> ShowS) -> Show SymSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SymSet -> ShowS
showsPrec :: Int -> SymSet -> ShowS
$cshow :: SymSet -> String
show :: SymSet -> String
$cshowList :: [SymSet] -> ShowS
showList :: [SymSet] -> ShowS
Show)

> -- |Parse an input string and create a stringset-automaton
> -- from the result.
> readPleb :: String -> Either String (FSA Integer String)
> readPleb :: String -> Either String (FSA Integer String)
readPleb = (FSA Integer (Maybe String) -> FSA Integer String)
-> Either String (FSA Integer (Maybe String))
-> Either String (FSA Integer String)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FSA Integer (Maybe String) -> FSA Integer String
forall a b. (Ord a, Ord b) => FSA a (Maybe b) -> FSA a b
desemantify
>            (Either String (FSA Integer (Maybe String))
 -> Either String (FSA Integer String))
-> (String -> Either String (FSA Integer (Maybe String)))
-> String
-> Either String (FSA Integer String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> Either String (FSA Integer (Maybe String)))
-> Either String Env -> Either String (FSA Integer (Maybe String))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) ((Env -> Expr -> Either String (FSA Integer (Maybe String)))
-> Expr -> Env -> Either String (FSA Integer (Maybe String))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Env -> Expr -> Either String (FSA Integer (Maybe String))
makeAutomatonE (ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ExprF Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> ExprF Expr
forall a. String -> ExprF a
Variable String
"it"))
>            (Either String Env -> Either String (FSA Integer (Maybe String)))
-> (String -> Either String Env)
-> String
-> Either String (FSA Integer (Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Statement], [Token]) -> Either String Env)
-> Either String ([Statement], [Token]) -> Either String Env
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (Env -> [Statement] -> Either String Env
evaluateS (Map String (Set String)
forall k a. Map k a
Map.empty, Map String Expr
forall k a. Map k a
Map.empty) ([Statement] -> Either String Env)
-> (([Statement], [Token]) -> [Statement])
-> ([Statement], [Token])
-> Either String Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Statement], [Token]) -> [Statement]
forall a b. (a, b) -> a
fst)
>            (Either String ([Statement], [Token]) -> Either String Env)
-> (String -> Either String ([Statement], [Token]))
-> String
-> Either String Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse [Statement]
-> [Token] -> Either String ([Statement], [Token])
forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse Parse [Statement]
parseStatements
>            ([Token] -> Either String ([Statement], [Token]))
-> (String -> [Token])
-> String
-> Either String ([Statement], [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Token]
tokenize

> -- |Parse an input string and update the environment
> -- according to the result of the parse.
> doStatements :: Env -> String -> Env
> doStatements :: Env -> String -> Env
doStatements Env
d  =  (String -> Env) -> (Env -> Env) -> Either String Env -> Env
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Env -> String -> Env
forall a b. a -> b -> a
const Env
d) Env -> Env
forall a. a -> a
id (Either String Env -> Env)
-> (String -> Either String Env) -> String -> Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> String -> Either String Env
doStatementsWithError Env
d

> -- |Parse an input string and update the environment
> -- according to the result of the parse.  Pass along
> -- errors encountered.
> doStatementsWithError :: Env -> String -> Either String Env
> doStatementsWithError :: Env -> String -> Either String Env
doStatementsWithError Env
d String
str
>     = Env -> [Statement] -> Either String Env
evaluateS Env
d ([Statement] -> Either String Env)
-> Either String [Statement] -> Either String Env
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([Statement], [Token]) -> Either String [Statement]
forall {b} {a}. (b, [a]) -> Either String b
f (([Statement], [Token]) -> Either String [Statement])
-> Either String ([Statement], [Token])
-> Either String [Statement]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Parse [Statement]
-> [Token] -> Either String ([Statement], [Token])
forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse Parse [Statement]
parseStatements ([Token] -> Either String ([Statement], [Token]))
-> [Token] -> Either String ([Statement], [Token])
forall a b. (a -> b) -> a -> b
$ String -> [Token]
tokenize String
str)
>     where f :: (b, [a]) -> Either String b
f (b
x, []) = b -> Either String b
forall a b. b -> Either a b
Right b
x
>           f (b, [a])
_ = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"input not exhausted"]

> -- |Add a new expression to the environment, call it "@(it)@".
> insertExpr :: Env -> Expr -> Env
> insertExpr :: Env -> Expr -> Env
insertExpr Env
d Expr
e
>     = (String -> Env) -> (Env -> Env) -> Either String Env -> Env
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Env -> String -> Env
forall a b. a -> b -> a
const Env
d) Env -> Env
forall a. a -> a
id (Either String Env -> Env) -> Either String Env -> Env
forall a b. (a -> b) -> a -> b
$ Env -> Statement -> Either String Env
evaluate Env
d (String -> Expr -> Statement
EAssignment String
"it" Expr
e)

> -- |Act upon a statement, reporting any semantic errors
> -- (i.e. undefined variables)
> evaluate :: Env -> Statement -> Either String Env
> evaluate :: Env -> Statement -> Either String Env
evaluate d :: Env
d@(Map String (Set String)
dict,Map String Expr
subexprs) Statement
stmt
>     = case Statement
stmt of
>         EAssignment String
name Expr
e
>             -> (\Expr
x -> ( Set String -> Map String (Set String)
mkUniverse (Set String -> Map String (Set String))
-> Set String -> Map String (Set String)
forall a b. (a -> b) -> a -> b
$ Expr -> Set String
usedSymbols Expr
x
>                       , String -> Expr -> Map String Expr -> Map String Expr
forall a. String -> a -> Dictionary a -> Dictionary a
define String
name Expr
x Map String Expr
subexprs
>                       )
>                ) (Expr -> Env) -> Either String Expr -> Either String Env
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> Expr -> Either String Expr
fillVars Env
d Expr
e
>         SAssignment String
name SymSet
s
>             -> (\SymSet
x -> ( let x' :: Set String
x' = SymSet -> Set String
getSyms SymSet
x
>                         in String
-> Set String -> Map String (Set String) -> Map String (Set String)
forall a. String -> a -> Dictionary a -> Dictionary a
define String
name Set String
x' (Map String (Set String) -> Map String (Set String))
-> Map String (Set String) -> Map String (Set String)
forall a b. (a -> b) -> a -> b
$ Set String -> Map String (Set String)
mkUniverse Set String
x'
>                       , Map String Expr
subexprs
>                       )
>                ) (SymSet -> Env) -> Either String SymSet -> Either String Env
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> SymSet -> Either String SymSet
fillVarsS Env
d SymSet
s
>     where u :: Set String
u = (String -> Set String)
-> (Set String -> Set String)
-> Either String (Set String)
-> Set String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Set String -> String -> Set String
forall a b. a -> b -> a
const Set String
forall a. Set a
Set.empty) Set String -> Set String
forall a. a -> a
id (Either String (Set String) -> Set String)
-> Either String (Set String) -> Set String
forall a b. (a -> b) -> a -> b
$ String -> Map String (Set String) -> Either String (Set String)
forall a. String -> Dictionary a -> Either String a
definition String
"universe" Map String (Set String)
dict
>           mkUniverse :: Set String -> Map String (Set String)
mkUniverse Set String
s = String
-> Set String -> Map String (Set String) -> Map String (Set String)
forall a. String -> a -> Dictionary a -> Dictionary a
define String
"universe" (Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set String
s Set String
u) Map String (Set String)
dict
> -- |Act upon a sequence of statements.
> evaluateS :: Env -> [Statement] -> Either String Env
> evaluateS :: Env -> [Statement] -> Either String Env
evaluateS Env
d [] = Env -> Either String Env
forall a b. b -> Either a b
Right Env
d
> evaluateS Env
d (Statement
x:[Statement]
xs) = Env -> Statement -> Either String Env
evaluate Env
d Statement
x Either String Env
-> (Env -> Either String Env) -> Either String Env
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Env
d' -> Env -> [Statement] -> Either String Env
evaluateS Env
d' [Statement]
xs)

> -- |Instantiate variables in an expression.
> fillVars :: Env -> Expr -> Either String Expr
> fillVars :: Env -> Expr -> Either String Expr
fillVars Env
d = (ExprF (Either String Expr) -> Either String Expr)
-> Expr -> Either String Expr
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata (Env -> ExprF (Either String Expr) -> Either String Expr
fillVarsEF Env
d)
> fillVarsEF :: Env -> ExprF (Either String Expr) -> Either String Expr
> fillVarsEF :: Env -> ExprF (Either String Expr) -> Either String Expr
fillVarsEF d :: Env
d@(Map String (Set String)
_,Map String Expr
subexprs) ExprF (Either String Expr)
e
>     = case ExprF (Either String Expr)
e of
>         Factor PLFactor
x         ->  (ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr)
-> (PLFactor -> ExprF Expr) -> PLFactor -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PLFactor -> ExprF Expr
forall a. PLFactor -> ExprF a
Factor) (PLFactor -> Expr) -> Either String PLFactor -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> PLFactor -> Either String PLFactor
fillVarsF Env
d PLFactor
x
>         Neutralize [SymSet]
ts Either String Expr
x  ->  (([SymSet], Expr) -> Expr) -> [SymSet] -> Expr -> Expr
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr)
-> (([SymSet], Expr) -> ExprF Expr) -> ([SymSet], Expr) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymSet] -> Expr -> ExprF Expr) -> ([SymSet], Expr) -> ExprF Expr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [SymSet] -> Expr -> ExprF Expr
forall a. [SymSet] -> a -> ExprF a
Neutralize)
>                              ([SymSet] -> Expr -> Expr)
-> Either String [SymSet] -> Either String (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either String SymSet] -> Either String [SymSet]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ((SymSet -> Either String SymSet)
-> [SymSet] -> [Either String SymSet]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> SymSet -> Either String SymSet
fillVarsS Env
d) [SymSet]
ts)
>                              Either String (Expr -> Expr)
-> Either String Expr -> Either String Expr
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String Expr
x
>         Tierify [SymSet]
ts Either String Expr
x     ->  (([SymSet], Expr) -> Expr) -> [SymSet] -> Expr -> Expr
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr)
-> (([SymSet], Expr) -> ExprF Expr) -> ([SymSet], Expr) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymSet] -> Expr -> ExprF Expr) -> ([SymSet], Expr) -> ExprF Expr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [SymSet] -> Expr -> ExprF Expr
forall a. [SymSet] -> a -> ExprF a
Tierify)
>                              ([SymSet] -> Expr -> Expr)
-> Either String [SymSet] -> Either String (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either String SymSet] -> Either String [SymSet]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ((SymSet -> Either String SymSet)
-> [SymSet] -> [Either String SymSet]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> SymSet -> Either String SymSet
fillVarsS Env
d) [SymSet]
ts)
>                              Either String (Expr -> Expr)
-> Either String Expr -> Either String Expr
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String Expr
x
>         Variable String
v       ->  Env -> Expr -> Either String Expr
fillVars Env
d (Expr -> Either String Expr)
-> Either String Expr -> Either String Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Map String Expr -> Either String Expr
forall a. String -> Dictionary a -> Either String a
definition String
v Map String Expr
subexprs
>         ExprF (Either String Expr)
_                ->  ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr)
-> Either String (ExprF Expr) -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprF (Either String Expr) -> Either String (ExprF Expr)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => ExprF (f a) -> f (ExprF a)
sequenceA ExprF (Either String Expr)
e
> fillVarsF :: Env -> PLFactor -> Either String PLFactor
> fillVarsF :: Env -> PLFactor -> Either String PLFactor
fillVarsF Env
d (PLFactor Bool
h Bool
t [[SymSet]]
ps)
>     = ([[SymSet]] -> PLFactor)
-> Either String [[SymSet]] -> Either String PLFactor
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
h Bool
t)
>       (Either String [[SymSet]] -> Either String PLFactor)
-> ([Either String [SymSet]] -> Either String [[SymSet]])
-> [Either String [SymSet]]
-> Either String PLFactor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String [SymSet]] -> Either String [[SymSet]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either String [SymSet]] -> Either String PLFactor)
-> [Either String [SymSet]] -> Either String PLFactor
forall a b. (a -> b) -> a -> b
$ ([SymSet] -> Either String [SymSet])
-> [[SymSet]] -> [Either String [SymSet]]
forall a b. (a -> b) -> [a] -> [b]
map ([Either String SymSet] -> Either String [SymSet]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either String SymSet] -> Either String [SymSet])
-> ([SymSet] -> [Either String SymSet])
-> [SymSet]
-> Either String [SymSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymSet -> Either String SymSet)
-> [SymSet] -> [Either String SymSet]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> SymSet -> Either String SymSet
fillVarsS Env
d)) [[SymSet]]
ps
> fillVarsF Env
d (PLCat [PLFactor]
fs)
>           = ([PLFactor] -> PLFactor)
-> Either String [PLFactor] -> Either String PLFactor
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PLFactor] -> PLFactor
PLCat (Either String [PLFactor] -> Either String PLFactor)
-> ([Either String PLFactor] -> Either String [PLFactor])
-> [Either String PLFactor]
-> Either String PLFactor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String PLFactor] -> Either String [PLFactor]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either String PLFactor] -> Either String PLFactor)
-> [Either String PLFactor] -> Either String PLFactor
forall a b. (a -> b) -> a -> b
$ (PLFactor -> Either String PLFactor)
-> [PLFactor] -> [Either String PLFactor]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> PLFactor -> Either String PLFactor
fillVarsF Env
d) [PLFactor]
fs
> fillVarsF Env
d (PLGap [PLFactor]
fs)
>           = ([PLFactor] -> PLFactor)
-> Either String [PLFactor] -> Either String PLFactor
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PLFactor] -> PLFactor
PLGap (Either String [PLFactor] -> Either String PLFactor)
-> ([Either String PLFactor] -> Either String [PLFactor])
-> [Either String PLFactor]
-> Either String PLFactor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String PLFactor] -> Either String [PLFactor]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either String PLFactor] -> Either String PLFactor)
-> [Either String PLFactor] -> Either String PLFactor
forall a b. (a -> b) -> a -> b
$ (PLFactor -> Either String PLFactor)
-> [PLFactor] -> [Either String PLFactor]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> PLFactor -> Either String PLFactor
fillVarsF Env
d) [PLFactor]
fs
> fillVarsF d :: Env
d@(Map String (Set String)
_,Map String Expr
subexprs) (PLVariable String
s)
>     = case Expr -> ExprF Expr
forall (a :: * -> *). Fix a -> a (Fix a)
out (Expr -> ExprF Expr)
-> Either String Expr -> Either String (ExprF Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Map String Expr -> Either String Expr
forall a. String -> Dictionary a -> Either String a
definition String
s Map String Expr
subexprs of
>         Left String
msg -> String -> Either String PLFactor
forall a b. a -> Either a b
Left String
msg
>         Right (Variable String
v) -> Env -> PLFactor -> Either String PLFactor
fillVarsF Env
d (String -> PLFactor
PLVariable String
v)
>         Right (Factor PLFactor
p) -> Env -> PLFactor -> Either String PLFactor
fillVarsF Env
d PLFactor
p
>         Right ExprF Expr
_ -> String -> Either String PLFactor
forall a b. a -> Either a b
Left (String -> Either String PLFactor)
-> String -> Either String PLFactor
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
>                    [String
"attempted to use the non-factor "
>                     String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" as a factor"]
> fillVarsS :: Env -> SymSet -> Either String SymSet
> fillVarsS :: Env -> SymSet -> Either String SymSet
fillVarsS d :: Env
d@(Map String (Set String)
dict,Map String Expr
_) SymSet
s
>     = case SymSet
s of
>         SSSet Set String
xs -> SymSet -> Either String SymSet
forall a b. b -> Either a b
Right (SymSet -> Either String SymSet) -> SymSet -> Either String SymSet
forall a b. (a -> b) -> a -> b
$ Set String -> SymSet
SSSet Set String
xs
>         SSUni [SymSet]
xs -> ([SymSet] -> SymSet)
-> Either String [SymSet] -> Either String SymSet
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SymSet] -> SymSet
SSUni (Either String [SymSet] -> Either String SymSet)
-> ([Either String SymSet] -> Either String [SymSet])
-> [Either String SymSet]
-> Either String SymSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String SymSet] -> Either String [SymSet]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either String SymSet] -> Either String SymSet)
-> [Either String SymSet] -> Either String SymSet
forall a b. (a -> b) -> a -> b
$ (SymSet -> Either String SymSet)
-> [SymSet] -> [Either String SymSet]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> SymSet -> Either String SymSet
fillVarsS Env
d) [SymSet]
xs
>         SSInt [SymSet]
xs -> ([SymSet] -> SymSet)
-> Either String [SymSet] -> Either String SymSet
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SymSet] -> SymSet
SSInt (Either String [SymSet] -> Either String SymSet)
-> ([Either String SymSet] -> Either String [SymSet])
-> [Either String SymSet]
-> Either String SymSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String SymSet] -> Either String [SymSet]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either String SymSet] -> Either String SymSet)
-> [Either String SymSet] -> Either String SymSet
forall a b. (a -> b) -> a -> b
$ (SymSet -> Either String SymSet)
-> [SymSet] -> [Either String SymSet]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> SymSet -> Either String SymSet
fillVarsS Env
d) [SymSet]
xs
>         SSVar String
v  -> Set String -> SymSet
SSSet (Set String -> SymSet)
-> Either String (Set String) -> Either String SymSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Map String (Set String) -> Either String (Set String)
forall a. String -> Dictionary a -> Either String a
definition String
v Map String (Set String)
dict

> -- |Transform all saved expressions into automata to prevent reevaluation.
> compileEnv :: Env -> Env
> compileEnv :: Env -> Env
compileEnv (Map String (Set String)
dict, Map String Expr
subexprs) = (Map String (Set String)
dict, (Expr -> Expr) -> Map String Expr -> Map String Expr
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Expr -> Expr
f Map String Expr
subexprs)
>     where f :: Expr -> Expr
f = ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> (Expr -> ExprF Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String) -> ExprF Expr
forall a. FSA Integer (Maybe String) -> ExprF a
Automaton (FSA Integer (Maybe String) -> ExprF Expr)
-> (Expr -> FSA Integer (Maybe String)) -> Expr -> ExprF Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA (Set Integer) (Maybe String) -> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates
>               (FSA (Set Integer) (Maybe String) -> FSA Integer (Maybe String))
-> (Expr -> FSA (Set Integer) (Maybe String))
-> Expr
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String) -> FSA (Set Integer) (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set n) e
minimizeDeterministic (FSA Integer (Maybe String) -> FSA (Set Integer) (Maybe String))
-> (Expr -> FSA Integer (Maybe String))
-> Expr
-> FSA (Set Integer) (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> FSA Integer (Maybe String)
automatonFromExpr

> -- |Convert saved automata from descriptions of constraints to
> -- descriptions of stringsets.
> -- This action effectively removes metadata describing constraint types
> -- from the environment.
> groundEnv :: Env -> Env
> groundEnv :: Env -> Env
groundEnv (Map String (Set String)
dict, Map String Expr
subexprs) = (Map String (Set String)
dict, (Expr -> Expr) -> Map String Expr -> Map String Expr
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Expr -> Expr
f Map String Expr
subexprs)
>     where f :: Expr -> Expr
f = ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> (Expr -> ExprF Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String) -> ExprF Expr
forall a. FSA Integer (Maybe String) -> ExprF a
Automaton
>               (FSA Integer (Maybe String) -> ExprF Expr)
-> (Expr -> FSA Integer (Maybe String)) -> Expr -> ExprF Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String)
-> FSA Integer String -> FSA Integer (Maybe String)
forall e e1 n.
(Ord e, Ord e1, Ord n) =>
(e -> e1) -> FSA n e -> FSA n e1
renameSymbolsBy String -> Maybe String
forall a. a -> Maybe a
Just
>               (FSA Integer String -> FSA Integer (Maybe String))
-> (Expr -> FSA Integer String)
-> Expr
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA (Set Integer) String -> FSA Integer String
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set Integer) String -> FSA Integer String)
-> (Expr -> FSA (Set Integer) String) -> Expr -> FSA Integer String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer String -> FSA (Set Integer) String
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set n) e
minimizeDeterministic
>               (FSA Integer String -> FSA (Set Integer) String)
-> (Expr -> FSA Integer String) -> Expr -> FSA (Set Integer) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String) -> FSA Integer String
forall a b. (Ord a, Ord b) => FSA a (Maybe b) -> FSA a b
desemantify (FSA Integer (Maybe String) -> FSA Integer String)
-> (Expr -> FSA Integer (Maybe String))
-> Expr
-> FSA Integer String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set String
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b.
(Ord a, Ord b) =>
Set b -> FSA a (Maybe b) -> FSA a (Maybe b)
semanticallyExtendAlphabetTo Set String
universe
>               (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> (Expr -> FSA Integer (Maybe String))
-> Expr
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> FSA Integer (Maybe String)
automatonFromExpr
>           universe :: Set String
universe = (String -> Set String)
-> (Set String -> Set String)
-> Either String (Set String)
-> Set String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Set String -> String -> Set String
forall a b. a -> b -> a
const Set String
forall a. Set a
Set.empty) Set String -> Set String
forall a. a -> a
id
>                      (String -> Map String (Set String) -> Either String (Set String)
forall a. String -> Dictionary a -> Either String a
definition String
"universe" Map String (Set String)
dict)

> -- |Reset the "@universe@" to contain all and only other symbols used.
> --
> -- @since 1.2
> restoreUniverse :: Env -> Env
> restoreUniverse :: Env -> Env
restoreUniverse (Map String (Set String)
d, Map String Expr
s) = (String
-> Set String -> Map String (Set String) -> Map String (Set String)
forall a. String -> a -> Dictionary a -> Dictionary a
define String
"universe" Set String
syms Map String (Set String)
d, Map String Expr
s)
>     where syms :: Set String
syms = (Expr -> Set String -> Set String)
-> Set String -> Map String Expr -> Set String
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Set String -> Set String -> Set String)
-> (Expr -> Set String) -> Expr -> Set String -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Set String
usedSymbols)
>                  ([Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set String)
-> (Map String (Set String) -> [Set String])
-> Map String (Set String)
-> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String (Set String) -> [Set String]
forall k a. Map k a -> [a]
Map.elems (Map String (Set String) -> Set String)
-> Map String (Set String) -> Set String
forall a b. (a -> b) -> a -> b
$ (String -> Set String -> Bool)
-> Map String (Set String) -> Map String (Set String)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
>                   (\String
k Set String
_ -> String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"universe") Map String (Set String)
d) Map String Expr
s

=====
Note:
=====

@restrictUniverse@ previously deleted symbolsets bound to the empty set.
However, it is now possible to manually define the empty set: [/a,/b].
Therefore, this cleanup step has been removed.

> -- |Remove any symbols not present in @(universe)@ from the environment.
> restrictUniverse :: Env -> Env
> restrictUniverse :: Env -> Env
restrictUniverse (Map String (Set String)
dict, Map String Expr
subexprs)
>     = ( (Set String -> Set String)
-> Map String (Set String) -> Map String (Set String)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set String
universe) Map String (Set String)
dict
>       , (Expr -> Expr) -> Map String Expr -> Map String Expr
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Expr -> Expr
restrictUniverseE Map String Expr
subexprs
>       )
>     where universe :: Set String
universe = (String -> Set String)
-> (Set String -> Set String)
-> Either String (Set String)
-> Set String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Set String -> String -> Set String
forall a b. a -> b -> a
const Set String
forall a. Set a
Set.empty) Set String -> Set String
forall a. a -> a
id
>                      (Either String (Set String) -> Set String)
-> Either String (Set String) -> Set String
forall a b. (a -> b) -> a -> b
$ String -> Map String (Set String) -> Either String (Set String)
forall a. String -> Dictionary a -> Either String a
definition String
"universe" Map String (Set String)
dict
>           restrictUniverseS :: SymSet -> SymSet
restrictUniverseS SymSet
s
>               = case SymSet
s of
>                   SSSet Set String
x -> Set String -> SymSet
SSSet (Set String -> Set String -> Set String
forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set String
universe Set String
x)
>                   SSUni [SymSet]
x -> [SymSet] -> SymSet
SSUni ([SymSet] -> SymSet) -> [SymSet] -> SymSet
forall a b. (a -> b) -> a -> b
$ (SymSet -> SymSet) -> [SymSet] -> [SymSet]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> SymSet
restrictUniverseS [SymSet]
x
>                   SSInt [SymSet]
x -> [SymSet] -> SymSet
SSInt ([SymSet] -> SymSet) -> [SymSet] -> SymSet
forall a b. (a -> b) -> a -> b
$ (SymSet -> SymSet) -> [SymSet] -> [SymSet]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> SymSet
restrictUniverseS [SymSet]
x
>                   SSVar String
x -> String -> SymSet
SSVar String
x
>           restrictUniverseF :: PLFactor -> PLFactor
restrictUniverseF PLFactor
pf
>               = case PLFactor
pf of
>                   PLVariable String
x -> String -> PLFactor
PLVariable String
x
>                   PLGap [PLFactor]
ps -> [PLFactor] -> PLFactor
PLGap ([PLFactor] -> PLFactor) -> [PLFactor] -> PLFactor
forall a b. (a -> b) -> a -> b
$ (PLFactor -> PLFactor) -> [PLFactor] -> [PLFactor]
forall a b. (a -> b) -> [a] -> [b]
map PLFactor -> PLFactor
restrictUniverseF [PLFactor]
ps
>                   PLCat [PLFactor]
ps -> [PLFactor] -> PLFactor
PLCat ([PLFactor] -> PLFactor) -> [PLFactor] -> PLFactor
forall a b. (a -> b) -> a -> b
$ (PLFactor -> PLFactor) -> [PLFactor] -> [PLFactor]
forall a b. (a -> b) -> [a] -> [b]
map PLFactor -> PLFactor
restrictUniverseF [PLFactor]
ps
>                   PLFactor Bool
h Bool
t [[SymSet]]
ps
>                       -> Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
h Bool
t
>                          ([[SymSet]] -> PLFactor) -> [[SymSet]] -> PLFactor
forall a b. (a -> b) -> a -> b
$ ([SymSet] -> [SymSet]) -> [[SymSet]] -> [[SymSet]]
forall a b. (a -> b) -> [a] -> [b]
map ((SymSet -> SymSet) -> [SymSet] -> [SymSet]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> SymSet
restrictUniverseS) [[SymSet]]
ps
>           restrictUniverseE :: Expr -> Expr
restrictUniverseE = (ExprF Expr -> Expr) -> Expr -> Expr
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata (ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr)
-> (ExprF Expr -> ExprF Expr) -> ExprF Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprF Expr -> ExprF Expr
forall {a}. ExprF a -> ExprF a
restrictUniverseEF)
>           restrictUniverseEF :: ExprF a -> ExprF a
restrictUniverseEF ExprF a
e
>               = case ExprF a
e of
>                   Automaton FSA Integer (Maybe String)
x
>                       ->  FSA Integer (Maybe String) -> ExprF a
forall a. FSA Integer (Maybe String) -> ExprF a
Automaton (FSA Integer (Maybe String) -> ExprF a)
-> FSA Integer (Maybe String) -> ExprF a
forall a b. (a -> b) -> a -> b
$
>                           Set (Maybe String)
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (Ord a, Ord b) => Set b -> FSA a b -> FSA a b
contractAlphabetTo
>                           (Maybe String -> Set (Maybe String) -> Set (Maybe String)
forall c a. Container c a => a -> c -> c
insert Maybe String
forall a. Maybe a
Nothing ((String -> Maybe String) -> Set String -> Set (Maybe String)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap String -> Maybe String
forall a. a -> Maybe a
Just Set String
universe))
>                           FSA Integer (Maybe String)
x
>                   Factor PLFactor
pf
>                       ->  PLFactor -> ExprF a
forall a. PLFactor -> ExprF a
Factor (PLFactor -> ExprF a) -> PLFactor -> ExprF a
forall a b. (a -> b) -> a -> b
$ PLFactor -> PLFactor
restrictUniverseF PLFactor
pf
>                   Neutralize [SymSet]
ts a
ex
>                       ->  [SymSet] -> a -> ExprF a
forall a. [SymSet] -> a -> ExprF a
Neutralize ((SymSet -> SymSet) -> [SymSet] -> [SymSet]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap SymSet -> SymSet
restrictUniverseS [SymSet]
ts) a
ex
>                   Tierify [SymSet]
ts a
ex
>                       ->  [SymSet] -> a -> ExprF a
forall a. [SymSet] -> a -> ExprF a
Tierify ((SymSet -> SymSet) -> [SymSet] -> [SymSet]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap SymSet -> SymSet
restrictUniverseS [SymSet]
ts) a
ex
>                   ExprF a
_ -> ExprF a
e

> -- |Create an t'FSA' from an expression tree and environment,
> -- complete with metadata regarding the constraint(s) it represents.
> makeAutomaton :: Env -> Expr -> Maybe (FSA Integer (Maybe String))
> makeAutomaton :: Env -> Expr -> Maybe (FSA Integer (Maybe String))
makeAutomaton Env
e = (String -> Maybe (FSA Integer (Maybe String)))
-> (FSA Integer (Maybe String)
    -> Maybe (FSA Integer (Maybe String)))
-> Either String (FSA Integer (Maybe String))
-> Maybe (FSA Integer (Maybe String))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (FSA Integer (Maybe String))
-> String -> Maybe (FSA Integer (Maybe String))
forall a b. a -> b -> a
const Maybe (FSA Integer (Maybe String))
forall a. Maybe a
Nothing) FSA Integer (Maybe String) -> Maybe (FSA Integer (Maybe String))
forall a. a -> Maybe a
Just (Either String (FSA Integer (Maybe String))
 -> Maybe (FSA Integer (Maybe String)))
-> (Expr -> Either String (FSA Integer (Maybe String)))
-> Expr
-> Maybe (FSA Integer (Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Expr -> Either String (FSA Integer (Maybe String))
makeAutomatonE Env
e

> -- |Create an t'FSA' from an expression tree and environment,
> -- complete with metadata regarding the constraint(s) it represents.
> makeAutomatonE :: Env -> Expr
>                -> Either String (FSA Integer (Maybe String))
> makeAutomatonE :: Env -> Expr -> Either String (FSA Integer (Maybe String))
makeAutomatonE d :: Env
d@(Map String (Set String)
dict, Map String Expr
_) Expr
e
>     = FSA (Set Integer) (Maybe String) -> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set Integer) (Maybe String) -> FSA Integer (Maybe String))
-> (Expr -> FSA (Set Integer) (Maybe String))
-> Expr
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String) -> FSA (Set Integer) (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set n) e
minimizeDeterministic
>       (FSA Integer (Maybe String) -> FSA (Set Integer) (Maybe String))
-> (Expr -> FSA Integer (Maybe String))
-> Expr
-> FSA (Set Integer) (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set String
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b.
(Ord a, Ord b) =>
Set b -> FSA a (Maybe b) -> FSA a (Maybe b)
semanticallyExtendAlphabetTo Set String
symsets
>       (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> (Expr -> FSA Integer (Maybe String))
-> Expr
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> FSA Integer (Maybe String)
automatonFromExpr (Expr -> FSA Integer (Maybe String))
-> Either String Expr -> Either String (FSA Integer (Maybe String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> Expr -> Either String Expr
fillVars Env
d Expr
e
>     where symsets :: Set String
symsets = (String -> Set String)
-> (Set String -> Set String)
-> Either String (Set String)
-> Set String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Set String -> String -> Set String
forall a b. a -> b -> a
const Set String
forall a. Set a
Set.empty) Set String -> Set String
forall a. a -> a
id
>                     (Either String (Set String) -> Set String)
-> Either String (Set String) -> Set String
forall a b. (a -> b) -> a -> b
$ String -> Map String (Set String) -> Either String (Set String)
forall a. String -> Dictionary a -> Either String a
definition String
"universe" Map String (Set String)
dict

The properties of semantic automata are used here to prevent having to
pass alphabet information to the individual constructors, which in turn
prevents having to descend through the tree to find this information.

> -- |Create an t'FSA' from an expression tree,
> -- complete with metadata regarding the constraint(s) it represents.
> automatonFromExpr :: Expr -> FSA Integer (Maybe String)
> automatonFromExpr :: Expr -> FSA Integer (Maybe String)
automatonFromExpr = (ExprF (FSA Integer (Maybe String)) -> FSA Integer (Maybe String))
-> Expr -> FSA Integer (Maybe String)
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata ExprF (FSA Integer (Maybe String)) -> FSA Integer (Maybe String)
automatonFromEF
> automatonFromEF :: ExprF (FSA Integer (Maybe String))
>                 -> FSA Integer (Maybe String)
> automatonFromEF :: ExprF (FSA Integer (Maybe String)) -> FSA Integer (Maybe String)
automatonFromEF ExprF (FSA Integer (Maybe String))
e
>     = case ExprF (FSA Integer (Maybe String))
e of
>         Automaton FSA Integer (Maybe String)
x      -> FSA Integer (Maybe String)
x
>         Concatenation [FSA Integer (Maybe String)]
xs -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall {e} {n} {n1}.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n1 e
-> ([FSA Integer (Maybe String)] -> FSA n e)
-> [FSA Integer (Maybe String)]
-> FSA n1 e
f FSA Integer (Maybe String)
emptyStr [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall a. Monoid a => [a] -> a
mconcat [FSA Integer (Maybe String)]
xs
>         Conjunction [FSA Integer (Maybe String)]
xs   -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall {e} {n} {n1}.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n1 e
-> ([FSA Integer (Maybe String)] -> FSA n e)
-> [FSA Integer (Maybe String)]
-> FSA n1 e
f FSA Integer (Maybe String)
univLang [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall n e.
(Enum n, Ord n, NFData n, Ord e, NFData e) =>
[FSA n e] -> FSA n e
flatIntersection [FSA Integer (Maybe String)]
xs
>         Disjunction [FSA Integer (Maybe String)]
xs   -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall {e} {n} {n1}.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n1 e
-> ([FSA Integer (Maybe String)] -> FSA n e)
-> [FSA Integer (Maybe String)]
-> FSA n1 e
f FSA Integer (Maybe String)
forall e n. (Ord e, Ord n, Enum n) => FSA n e
emptyLanguage [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall n e.
(Enum n, Ord n, NFData n, Ord e, NFData e) =>
[FSA n e] -> FSA n e
flatUnion [FSA Integer (Maybe String)]
xs
>         Domination [FSA Integer (Maybe String)]
xs    -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall {e} {n} {n1}.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n1 e
-> ([FSA Integer (Maybe String)] -> FSA n e)
-> [FSA Integer (Maybe String)]
-> FSA n1 e
f FSA Integer (Maybe String)
emptyStr [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall a. Monoid a => [a] -> a
mconcat ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ FSA Integer (Maybe String)
-> [FSA Integer (Maybe String)] -> [FSA Integer (Maybe String)]
forall a. a -> [a] -> [a]
intersperse FSA Integer (Maybe String)
univLang [FSA Integer (Maybe String)]
xs
>         DownClose FSA Integer (Maybe String)
x      -> FSA (Set (Set Integer)) (Maybe String)
-> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set (Set Integer)) (Maybe String)
 -> FSA Integer (Maybe String))
-> (FSA Integer (Maybe String)
    -> FSA (Set (Set Integer)) (Maybe String))
-> FSA Integer (Maybe String)
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String)
-> FSA (Set (Set Integer)) (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall n e. (Ord n, Ord e) => FSA n e -> FSA n e
subsequenceClosure FSA Integer (Maybe String)
x
>         Factor PLFactor
x         -> (Bool, Bool, [[SymSet]]) -> FSA Integer (Maybe String)
automatonFromPLFactor (PLFactor -> (Bool, Bool, [[SymSet]])
simplifyPL PLFactor
x)
>         Infiltration [FSA Integer (Maybe String)]
xs  -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall {e} {n} {n1}.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n1 e
-> ([FSA Integer (Maybe String)] -> FSA n e)
-> [FSA Integer (Maybe String)]
-> FSA n1 e
f FSA Integer (Maybe String)
emptyStr [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall n e.
(Enum n, Ord n, NFData n, Ord e, NFData e) =>
[FSA n e] -> FSA n e
flatInfiltration [FSA Integer (Maybe String)]
xs
>         Iteration FSA Integer (Maybe String)
x      -> FSA (Set (Set (Either Integer Bool))) (Maybe String)
-> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set (Set (Either Integer Bool))) (Maybe String)
 -> FSA Integer (Maybe String))
-> (FSA (Either Integer Bool) (Maybe String)
    -> FSA (Set (Set (Either Integer Bool))) (Maybe String))
-> FSA (Either Integer Bool) (Maybe String)
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA (Either Integer Bool) (Maybe String)
-> FSA (Set (Set (Either Integer Bool))) (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize (FSA (Either Integer Bool) (Maybe String)
 -> FSA Integer (Maybe String))
-> FSA (Either Integer Bool) (Maybe String)
-> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ FSA Integer (Maybe String)
-> FSA (Either Integer Bool) (Maybe String)
forall n e. (Ord n, Ord e) => FSA n e -> FSA (Either n Bool) e
kleeneClosure FSA Integer (Maybe String)
x
>         Negation FSA Integer (Maybe String)
x       -> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic FSA Integer (Maybe String)
x
>         Neutralize [SymSet]
ts FSA Integer (Maybe String)
x
>             -> FSA (Set (Set Integer)) (Maybe String)
-> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set (Set Integer)) (Maybe String)
 -> FSA Integer (Maybe String))
-> (FSA Integer (Maybe String)
    -> FSA (Set (Set Integer)) (Maybe String))
-> FSA Integer (Maybe String)
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String)
-> FSA (Set (Set Integer)) (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize
>                (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ Set (Maybe String)
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (Ord a, Ord b) => Set b -> FSA a b -> FSA a b
neutralize
>                  ((String -> Maybe String) -> Set String -> Set (Maybe String)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic String -> Maybe String
forall a. a -> Maybe a
Just (Set String -> Set (Maybe String))
-> ([Set String] -> Set String)
-> [Set String]
-> Set (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set String] -> Set String
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll ([Set String] -> Set (Maybe String))
-> [Set String] -> Set (Maybe String)
forall a b. (a -> b) -> a -> b
$ (SymSet -> Set String) -> [SymSet] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> Set String
getSyms [SymSet]
ts) FSA Integer (Maybe String)
x
>         QuotientL [FSA Integer (Maybe String)]
xs     -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall {e} {n} {n1}.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n1 e
-> ([FSA Integer (Maybe String)] -> FSA n e)
-> [FSA Integer (Maybe String)]
-> FSA n1 e
f FSA Integer (Maybe String)
emptyStr [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall {n2} {a}.
(Enum n2, Ord a, Ord n2) =>
[FSA n2 (Maybe a)] -> FSA n2 (Maybe a)
ql [FSA Integer (Maybe String)]
xs
>         QuotientR [FSA Integer (Maybe String)]
xs     -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall {e} {n} {n1}.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n1 e
-> ([FSA Integer (Maybe String)] -> FSA n e)
-> [FSA Integer (Maybe String)]
-> FSA n1 e
f FSA Integer (Maybe String)
emptyStr [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall {t :: * -> *} {n2} {a}.
(Foldable t, Enum n2, Ord a, Ord n2) =>
t (FSA n2 (Maybe a)) -> FSA n2 (Maybe a)
qr [FSA Integer (Maybe String)]
xs
>         Reversal FSA Integer (Maybe String)
x       -> FSA (Set (Set Integer)) (Maybe String)
-> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set (Set Integer)) (Maybe String)
 -> FSA Integer (Maybe String))
-> (FSA Integer (Maybe String)
    -> FSA (Set (Set Integer)) (Maybe String))
-> FSA Integer (Maybe String)
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String)
-> FSA (Set (Set Integer)) (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
LTK.FSA.reverse FSA Integer (Maybe String)
x
>         Shuffle [FSA Integer (Maybe String)]
xs       -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall {e} {n} {n1}.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n1 e
-> ([FSA Integer (Maybe String)] -> FSA n e)
-> [FSA Integer (Maybe String)]
-> FSA n1 e
f FSA Integer (Maybe String)
emptyStr [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall n e.
(Enum n, Ord n, NFData n, Ord e, NFData e) =>
[FSA n e] -> FSA n e
flatShuffle [FSA Integer (Maybe String)]
xs
>         StrictOrder [FSA Integer (Maybe String)]
xs
>             -> (FSA Integer (Maybe String)
 -> FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String)
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\FSA Integer (Maybe String)
x FSA Integer (Maybe String)
y -> FSA
  (Set (Set (Maybe (Either (Maybe Integer) Integer, Maybe Integer))))
  (Maybe String)
-> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA
   (Set (Set (Maybe (Either (Maybe Integer) Integer, Maybe Integer))))
   (Maybe String)
 -> FSA Integer (Maybe String))
-> (FSA
      (Maybe (Either (Maybe Integer) Integer, Maybe Integer))
      (Maybe String)
    -> FSA
         (Set (Set (Maybe (Either (Maybe Integer) Integer, Maybe Integer))))
         (Maybe String))
-> FSA
     (Maybe (Either (Maybe Integer) Integer, Maybe Integer))
     (Maybe String)
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA
  (Maybe (Either (Maybe Integer) Integer, Maybe Integer))
  (Maybe String)
-> FSA
     (Set (Set (Maybe (Either (Maybe Integer) Integer, Maybe Integer))))
     (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize
>                               (FSA
   (Maybe (Either (Maybe Integer) Integer, Maybe Integer))
   (Maybe String)
 -> FSA Integer (Maybe String))
-> FSA
     (Maybe (Either (Maybe Integer) Integer, Maybe Integer))
     (Maybe String)
-> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ FSA Integer (Maybe String)
-> FSA Integer (Maybe String)
-> FSA
     (Maybe (Either (Maybe Integer) Integer, Maybe Integer))
     (Maybe String)
forall n1 n2 e.
(Ord n1, Ord n2, Ord e) =>
FSA n1 e
-> FSA n2 e -> FSA (Maybe (Either (Maybe n1) n2, Maybe n1)) e
autStrictOrderOverlay FSA Integer (Maybe String)
x FSA Integer (Maybe String)
y)
>                      FSA Integer (Maybe String)
emptyStr ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ [FSA Integer (Maybe String)] -> [FSA Integer (Maybe String)]
ext [FSA Integer (Maybe String)]
xs
>         Tierify [SymSet]
ts FSA Integer (Maybe String)
x
>             -> FSA (Set (Set Integer)) (Maybe String)
-> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set (Set Integer)) (Maybe String)
 -> FSA Integer (Maybe String))
-> (FSA Integer (Maybe String)
    -> FSA (Set (Set Integer)) (Maybe String))
-> FSA Integer (Maybe String)
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String)
-> FSA (Set (Set Integer)) (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize
>                (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ Set String
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b.
(Ord a, Ord b) =>
Set b -> FSA a (Maybe b) -> FSA a (Maybe b)
tierify ([Set String] -> Set String
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll ([Set String] -> Set String) -> [Set String] -> Set String
forall a b. (a -> b) -> a -> b
$ (SymSet -> Set String) -> [SymSet] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> Set String
getSyms [SymSet]
ts) FSA Integer (Maybe String)
x
>         UpClose FSA Integer (Maybe String)
x        -> FSA (Set (Set Integer)) (Maybe String)
-> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set (Set Integer)) (Maybe String)
 -> FSA Integer (Maybe String))
-> (FSA Integer (Maybe String)
    -> FSA (Set (Set Integer)) (Maybe String))
-> FSA Integer (Maybe String)
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String)
-> FSA (Set (Set Integer)) (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall n e. (Ord n, Ord e) => FSA n e -> FSA n e
loopify FSA Integer (Maybe String)
x
>         Variable String
_       -> String -> FSA Integer (Maybe String)
forall a. HasCallStack => String -> a
error String
"free variable in expression"
>     where f :: FSA n1 e
-> ([FSA Integer (Maybe String)] -> FSA n e)
-> [FSA Integer (Maybe String)]
-> FSA n1 e
f FSA n1 e
z [FSA Integer (Maybe String)] -> FSA n e
_ [] = FSA n1 e
z
>           f FSA n1 e
_ [FSA Integer (Maybe String)] -> FSA n e
tl [FSA Integer (Maybe String)]
xs = FSA (Set (Set n)) e -> FSA n1 e
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set (Set n)) e -> FSA n1 e)
-> ([FSA Integer (Maybe String)] -> FSA (Set (Set n)) e)
-> [FSA Integer (Maybe String)]
-> FSA n1 e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> FSA (Set (Set n)) e
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize (FSA n e -> FSA (Set (Set n)) e)
-> ([FSA Integer (Maybe String)] -> FSA n e)
-> [FSA Integer (Maybe String)]
-> FSA (Set (Set n)) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FSA Integer (Maybe String)] -> FSA n e
tl ([FSA Integer (Maybe String)] -> FSA n1 e)
-> [FSA Integer (Maybe String)] -> FSA n1 e
forall a b. (a -> b) -> a -> b
$ [FSA Integer (Maybe String)] -> [FSA Integer (Maybe String)]
ext [FSA Integer (Maybe String)]
xs
>           ext :: [FSA Integer (Maybe String)] -> [FSA Integer (Maybe String)]
ext [FSA Integer (Maybe String)]
xs = let as :: Set String
as = [FSA Integer (Maybe String)] -> Set String
bigAlpha [FSA Integer (Maybe String)]
xs
>                    in (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)] -> [FSA Integer (Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map (Set String
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b.
(Ord a, Ord b) =>
Set b -> FSA a (Maybe b) -> FSA a (Maybe b)
semanticallyExtendAlphabetTo Set String
as) [FSA Integer (Maybe String)]
xs
>           bigAlpha :: [FSA Integer (Maybe String)] -> Set String
bigAlpha = (Maybe String -> Set String -> Set String)
-> Set String -> Set (Maybe String) -> Set String
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse ((Set String -> Set String)
-> (String -> Set String -> Set String)
-> Maybe String
-> Set String
-> Set String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set String -> Set String
forall a. a -> a
id String -> Set String -> Set String
forall c a. Container c a => a -> c -> c
insert) Set String
forall a. Set a
Set.empty (Set (Maybe String) -> Set String)
-> ([FSA Integer (Maybe String)] -> Set (Maybe String))
-> [FSA Integer (Maybe String)]
-> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                      (FSA Integer (Maybe String)
 -> Set (Maybe String) -> Set (Maybe String))
-> Set (Maybe String)
-> [FSA Integer (Maybe String)]
-> Set (Maybe String)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Set (Maybe String) -> Set (Maybe String) -> Set (Maybe String)
forall c a. Container c a => c -> c -> c
union (Set (Maybe String) -> Set (Maybe String) -> Set (Maybe String))
-> (FSA Integer (Maybe String) -> Set (Maybe String))
-> FSA Integer (Maybe String)
-> Set (Maybe String)
-> Set (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String) -> Set (Maybe String)
forall e. FSA Integer e -> Set e
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet) Set (Maybe String)
forall a. Set a
Set.empty
>           univLang :: FSA Integer (Maybe String)
univLang = Set (Maybe String) -> FSA Integer (Maybe String)
forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
totalWithAlphabet (Maybe String -> Set (Maybe String)
forall a. a -> Set a
Set.singleton Maybe String
forall a. Maybe a
Nothing)
>           emptyStr :: FSA Integer (Maybe String)
emptyStr = Set (Maybe String) -> FSA Integer (Maybe String)
forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
totalWithAlphabet Set (Maybe String)
forall a. Set a
Set.empty
>           ql :: [FSA n2 (Maybe a)] -> FSA n2 (Maybe a)
ql [FSA n2 (Maybe a)]
xs = if [FSA n2 (Maybe a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FSA n2 (Maybe a)]
xs
>                   then Set (Maybe a) -> FSA n2 (Maybe a)
forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
emptyWithAlphabet (Maybe a -> Set (Maybe a)
forall a. a -> Set a
Set.singleton Maybe a
forall a. Maybe a
Nothing)
>                   else (FSA n2 (Maybe a) -> FSA n2 (Maybe a) -> FSA n2 (Maybe a))
-> [FSA n2 (Maybe a)] -> FSA n2 (Maybe a)
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' (\FSA n2 (Maybe a)
a FSA n2 (Maybe a)
b -> FSA (Maybe (Either n2 ()), Maybe n2) (Maybe a) -> FSA n2 (Maybe a)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Maybe (Either n2 ()), Maybe n2) (Maybe a)
 -> FSA n2 (Maybe a))
-> FSA (Maybe (Either n2 ()), Maybe n2) (Maybe a)
-> FSA n2 (Maybe a)
forall a b. (a -> b) -> a -> b
$ FSA n2 (Maybe a)
-> FSA n2 (Maybe a)
-> FSA (Maybe (Either n2 ()), Maybe n2) (Maybe a)
forall e n1 n2.
(Ord e, Ord n1, Ord n2) =>
FSA n1 e -> FSA n2 e -> FSA (Maybe (Either n1 ()), Maybe n2) e
quotLeft FSA n2 (Maybe a)
a FSA n2 (Maybe a)
b) [FSA n2 (Maybe a)]
xs
>           qr :: t (FSA n2 (Maybe a)) -> FSA n2 (Maybe a)
qr t (FSA n2 (Maybe a))
xs = if t (FSA n2 (Maybe a)) -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t (FSA n2 (Maybe a))
xs
>                   then Set (Maybe a) -> FSA n2 (Maybe a)
forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
emptyWithAlphabet (Maybe a -> Set (Maybe a)
forall a. a -> Set a
Set.singleton Maybe a
forall a. Maybe a
Nothing)
>                   else (FSA n2 (Maybe a) -> FSA n2 (Maybe a) -> FSA n2 (Maybe a))
-> t (FSA n2 (Maybe a)) -> FSA n2 (Maybe a)
forall a. (a -> a -> a) -> t a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\FSA n2 (Maybe a)
a FSA n2 (Maybe a)
b -> FSA Integer (Maybe a) -> FSA n2 (Maybe a)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA Integer (Maybe a) -> FSA n2 (Maybe a))
-> FSA Integer (Maybe a) -> FSA n2 (Maybe a)
forall a b. (a -> b) -> a -> b
$ FSA n2 (Maybe a) -> FSA n2 (Maybe a) -> FSA Integer (Maybe a)
forall e n1 n2.
(Ord e, Ord n1, Ord n2) =>
FSA n1 e -> FSA n2 e -> FSA Integer e
quotRight FSA n2 (Maybe a)
a FSA n2 (Maybe a)
b) t (FSA n2 (Maybe a))
xs

> automatonFromPLFactor :: (Bool, Bool, [[SymSet]])
>                       -> FSA Integer (Maybe String)
> automatonFromPLFactor :: (Bool, Bool, [[SymSet]]) -> FSA Integer (Maybe String)
automatonFromPLFactor (Bool
h, Bool
t, [[SymSet]]
pieces')
>     = case ([Set String] -> [Set (Maybe String)])
-> [[Set String]] -> [[Set (Maybe String)]]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap ((Set String -> Set (Maybe String))
-> [Set String] -> [Set (Maybe String)]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap ((String -> Maybe String) -> Set String -> Set (Maybe String)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap String -> Maybe String
forall a. a -> Maybe a
Just)) [[Set String]]
pieces of
>         []      ->  Factor (Maybe String) -> FSA Integer (Maybe String)
bl ([Set (Maybe String)] -> Bool -> Bool -> Factor (Maybe String)
forall e. [Set e] -> Bool -> Bool -> Factor e
Substring [] Bool
h Bool
t)
>         [[Set (Maybe String)]
p]     ->  Factor (Maybe String) -> FSA Integer (Maybe String)
bl ([Set (Maybe String)] -> Bool -> Bool -> Factor (Maybe String)
forall e. [Set e] -> Bool -> Bool -> Factor e
Substring [Set (Maybe String)]
p  Bool
h Bool
t)
>         ([Set (Maybe String)]
p:[[Set (Maybe String)]]
ps)  ->  if Bool
isPF
>                     then Factor (Maybe String) -> FSA Integer (Maybe String)
bl (Factor (Maybe String) -> FSA Integer (Maybe String))
-> ([Set (Maybe String)] -> Factor (Maybe String))
-> [Set (Maybe String)]
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set (Maybe String)] -> Factor (Maybe String)
forall e. [Set e] -> Factor e
Subsequence ([Set (Maybe String)] -> FSA Integer (Maybe String))
-> [Set (Maybe String)] -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ [[Set (Maybe String)]] -> [Set (Maybe String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Set (Maybe String)]
p[Set (Maybe String)]
-> [[Set (Maybe String)]] -> [[Set (Maybe String)]]
forall a. a -> [a] -> [a]
:[[Set (Maybe String)]]
ps)
>                     else FSA (Set (Set Integer)) (Maybe String)
-> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set (Set Integer)) (Maybe String)
 -> FSA Integer (Maybe String))
-> ([FSA Integer (Maybe String)]
    -> FSA (Set (Set Integer)) (Maybe String))
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String)
-> FSA (Set (Set Integer)) (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize (FSA Integer (Maybe String)
 -> FSA (Set (Set Integer)) (Maybe String))
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)]
-> FSA (Set (Set Integer)) (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall a. Monoid a => [a] -> a
mconcat
>                          ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ (Factor (Maybe String) -> FSA Integer (Maybe String))
-> [Factor (Maybe String)] -> [FSA Integer (Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map Factor (Maybe String) -> FSA Integer (Maybe String)
bl [Factor (Maybe String)]
lfs
>                         where lfs :: [Factor (Maybe String)]
lfs  =  [Set (Maybe String)] -> Bool -> Bool -> Factor (Maybe String)
forall e. [Set e] -> Bool -> Bool -> Factor e
Substring [Set (Maybe String)]
p Bool
h Bool
False Factor (Maybe String)
-> [Factor (Maybe String)] -> [Factor (Maybe String)]
forall a. a -> [a] -> [a]
: [[Set (Maybe String)]] -> [Factor (Maybe String)]
forall {e}. [[Set e]] -> [Factor e]
lfs' [[Set (Maybe String)]]
ps
>     where as :: Set (Maybe String)
as           =  Maybe String -> Set (Maybe String) -> Set (Maybe String)
forall c a. Container c a => a -> c -> c
insert Maybe String
forall a. Maybe a
Nothing (Set (Maybe String) -> Set (Maybe String))
-> ([Set String] -> Set (Maybe String))
-> [Set String]
-> Set (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String) -> Set String -> Set (Maybe String)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap String -> Maybe String
forall a. a -> Maybe a
Just
>                           (Set String -> Set (Maybe String))
-> ([Set String] -> Set String)
-> [Set String]
-> Set (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set (Maybe String))
-> [Set String] -> Set (Maybe String)
forall a b. (a -> b) -> a -> b
$ [[Set String]] -> [Set String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Set String]]
pieces
>           bl :: Factor (Maybe String) -> FSA Integer (Maybe String)
bl           =  Set (Maybe String)
-> Literal (Maybe String) -> FSA Integer (Maybe String)
forall n e. (Enum n, Ord n, Ord e) => Set e -> Literal e -> FSA n e
buildLiteral Set (Maybe String)
as (Literal (Maybe String) -> FSA Integer (Maybe String))
-> (Factor (Maybe String) -> Literal (Maybe String))
-> Factor (Maybe String)
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Factor (Maybe String) -> Literal (Maybe String)
forall e. Factor e -> Literal e
required
>           isPF :: Bool
isPF         =  Bool -> Bool
not Bool
h Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
t Bool -> Bool -> Bool
&&
>                           ([Set String] -> Bool) -> [[Set String]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([()] -> [()] -> Bool
forall a. Eq a => a -> a -> Bool
(==) [()] ([()] -> Bool) -> ([Set String] -> [()]) -> [Set String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set String -> ()) -> [Set String] -> [()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> Set String -> ()
forall a b. a -> b -> a
const ())) [[Set String]]
pieces
>           lfs' :: [[Set e]] -> [Factor e]
lfs' [[Set e]
x]     =  [Set e] -> Bool -> Bool -> Factor e
forall e. [Set e] -> Bool -> Bool -> Factor e
Substring [Set e]
x Bool
False Bool
t Factor e -> [Factor e] -> [Factor e]
forall a. a -> [a] -> [a]
: [[Set e]] -> [Factor e]
lfs' []
>           lfs' ([Set e]
x:[[Set e]]
xs)  =  [Set e] -> Bool -> Bool -> Factor e
forall e. [Set e] -> Bool -> Bool -> Factor e
Substring [Set e]
x Bool
False Bool
False Factor e -> [Factor e] -> [Factor e]
forall a. a -> [a] -> [a]
: [[Set e]] -> [Factor e]
lfs' [[Set e]]
xs
>           lfs' [[Set e]]
_       =  []
>           pieces :: [[Set String]]
pieces       =  ([SymSet] -> [Set String]) -> [[SymSet]] -> [[Set String]]
forall a b. (a -> b) -> [a] -> [b]
map ((SymSet -> Set String) -> [SymSet] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map (SymSet -> Set String
getSyms)) [[SymSet]]
pieces'

> getSyms :: SymSet -> Set String
> getSyms :: SymSet -> Set String
getSyms (SSSet Set String
ts) = Set String
ts
> getSyms (SSUni [SymSet]
xs) = [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set String) -> [Set String] -> Set String
forall a b. (a -> b) -> a -> b
$ (SymSet -> Set String) -> [SymSet] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> Set String
getSyms [SymSet]
xs
> getSyms (SSInt []) = String -> Set String
forall a. HasCallStack => String -> a
error String
"unreplaced void intersection"
> getSyms (SSInt (SymSet
x:[SymSet]
xs))
>     = (Set String -> Set String -> Set String)
-> Set String -> [Set String] -> Set String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection) (SymSet -> Set String
getSyms SymSet
x) ((SymSet -> Set String) -> [SymSet] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> Set String
getSyms [SymSet]
xs)
> getSyms (SSVar String
_) = String -> Set String
forall a. HasCallStack => String -> a
error String
"free variable in symset"

> usedSymbols :: Expr -> Set String
> usedSymbols :: Expr -> Set String
usedSymbols = (ExprF (Set String) -> Set String) -> Expr -> Set String
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata ExprF (Set String) -> Set String
usedSymbolsE
> usedSymbolsE :: ExprF (Set String) -> Set String
> usedSymbolsE :: ExprF (Set String) -> Set String
usedSymbolsE ExprF (Set String)
e = case ExprF (Set String)
e of
>     Automaton FSA Integer (Maybe String)
a     -> (Maybe String -> Set String -> Set String)
-> Set String -> Set (Maybe String) -> Set String
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse ((Set String -> Set String)
-> (String -> Set String -> Set String)
-> Maybe String
-> Set String
-> Set String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set String -> Set String
forall a. a -> a
id String -> Set String -> Set String
forall c a. Container c a => a -> c -> c
insert) Set String
forall a. Set a
Set.empty (Set (Maybe String) -> Set String)
-> Set (Maybe String) -> Set String
forall a b. (a -> b) -> a -> b
$ FSA Integer (Maybe String) -> Set (Maybe String)
forall e. FSA Integer e -> Set e
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet FSA Integer (Maybe String)
a
>     Factor PLFactor
f        -> PLFactor -> Set String
usedSymbolsF PLFactor
f
>     Neutralize [SymSet]
ts Set String
x -> [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (Set String
x Set String -> [Set String] -> [Set String]
forall a. a -> [a] -> [a]
: (SymSet -> Set String) -> [SymSet] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> Set String
usedSymsInSet [SymSet]
ts)
>     Tierify [SymSet]
ts Set String
x    -> [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (Set String
x Set String -> [Set String] -> [Set String]
forall a. a -> [a] -> [a]
: (SymSet -> Set String) -> [SymSet] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> Set String
usedSymsInSet [SymSet]
ts)
>     ExprF (Set String)
_               -> (Set String -> Set String -> Set String)
-> Set String -> ExprF (Set String) -> Set String
forall a b. (a -> b -> b) -> b -> ExprF a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set String
forall a. Set a
Set.empty ExprF (Set String)
e
>     where usedSymbolsF :: PLFactor -> Set String
usedSymbolsF (PLFactor Bool
_ Bool
_ [[SymSet]]
ps)
>               = [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set String)
-> ([SymSet] -> [Set String]) -> [SymSet] -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymSet -> Set String) -> [SymSet] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> Set String
usedSymsInSet ([SymSet] -> Set String) -> [SymSet] -> Set String
forall a b. (a -> b) -> a -> b
$ [[SymSet]] -> [SymSet]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[SymSet]]
ps
>           usedSymbolsF (PLCat [PLFactor]
xs)
>               = [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set String) -> [Set String] -> Set String
forall a b. (a -> b) -> a -> b
$ (PLFactor -> Set String) -> [PLFactor] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map PLFactor -> Set String
usedSymbolsF [PLFactor]
xs
>           usedSymbolsF (PLGap [PLFactor]
xs)
>               = [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set String) -> [Set String] -> Set String
forall a b. (a -> b) -> a -> b
$ (PLFactor -> Set String) -> [PLFactor] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map PLFactor -> Set String
usedSymbolsF [PLFactor]
xs
>           usedSymbolsF (PLVariable String
_) = Set String
forall a. Set a
Set.empty

> usedSymsInSet :: SymSet -> Set String
> usedSymsInSet :: SymSet -> Set String
usedSymsInSet (SSSet Set String
ts) = Set String
ts
> usedSymsInSet (SSUni [SymSet]
sets) = [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set String) -> [Set String] -> Set String
forall a b. (a -> b) -> a -> b
$ (SymSet -> Set String) -> [SymSet] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> Set String
usedSymsInSet [SymSet]
sets
> usedSymsInSet (SSInt [SymSet]
sets) = [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set String) -> [Set String] -> Set String
forall a b. (a -> b) -> a -> b
$ (SymSet -> Set String) -> [SymSet] -> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map SymSet -> Set String
usedSymsInSet [SymSet]
sets
> usedSymsInSet (SSVar String
_) = Set String
forall a. Set a
Set.empty

> parseStatements :: Parse [Statement]
> parseStatements :: Parse [Statement]
parseStatements
>     = [Parse [Statement]] -> Parse [Statement]
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
>       [ (:)
>         (Statement -> [Statement] -> [Statement])
-> Parse Statement -> Parse ([Statement] -> [Statement])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Expr -> Statement
EAssignment (String -> Expr -> Statement)
-> Parse String -> Parse (Expr -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parse [Any]
forall {a}. Parse [a]
start Parse [Any] -> Parse String -> Parse String
forall a b. Parse a -> Parse b -> Parse b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parse String
getName) Parse (Expr -> Statement) -> Parse Expr -> Parse Statement
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse Expr
parseExpr)
>         Parse ([Statement] -> [Statement])
-> Parse [Statement] -> Parse [Statement]
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse [Statement]
parseStatements
>       , (:)
>         (Statement -> [Statement] -> [Statement])
-> Parse Statement -> Parse ([Statement] -> [Statement])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> SymSet -> Statement
SAssignment (String -> SymSet -> Statement)
-> Parse String -> Parse (SymSet -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parse [Any]
forall {a}. Parse [a]
start Parse [Any] -> Parse String -> Parse String
forall a b. Parse a -> Parse b -> Parse b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parse String
getName) Parse (SymSet -> Statement) -> Parse SymSet -> Parse Statement
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse SymSet
parseSymExpr)
>         Parse ([Statement] -> [Statement])
-> Parse [Statement] -> Parse [Statement]
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse [Statement]
parseStatements
>       , (:) (Statement -> [Statement] -> [Statement])
-> Parse Statement -> Parse ([Statement] -> [Statement])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Expr -> Statement
EAssignment String
"it" (Expr -> Statement) -> Parse Expr -> Parse Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Expr
parseExpr) Parse ([Statement] -> [Statement])
-> Parse [Statement] -> Parse [Statement]
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse [Statement]
parseStatements
>       , ([Token] -> Either String ([Statement], [Token]))
-> Parse [Statement]
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String ([Statement], [Token]))
 -> Parse [Statement])
-> ([Token] -> Either String ([Statement], [Token]))
-> Parse [Statement]
forall a b. (a -> b) -> a -> b
$ \[Token]
ts ->
>         case [Token]
ts
>         of []  ->  ([Statement], [Token]) -> Either String ([Statement], [Token])
forall a b. b -> Either a b
Right ([], [])
>            [Token]
_   ->  String -> Either String ([Statement], [Token])
forall a b. a -> Either a b
Left (String -> Either String ([Statement], [Token]))
-> String -> Either String ([Statement], [Token])
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"not finished"]
>       ]
>    where getName :: Parse String
getName
>              = ([Token] -> Either String (String, [Token])) -> Parse String
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String (String, [Token])) -> Parse String)
-> ([Token] -> Either String (String, [Token])) -> Parse String
forall a b. (a -> b) -> a -> b
$ \[Token]
ts ->
>                case [Token]
ts
>                of (TName String
n : [Token]
ts') -> (String, [Token]) -> Either String (String, [Token])
forall a b. b -> Either a b
Right (String
n, [Token]
ts')
>                   (Token
x : [Token]
_)
>                       -> String -> Either String (String, [Token])
forall a b. a -> Either a b
Left (String -> Either String (String, [Token]))
-> ShowS -> String -> Either String (String, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (String, [Token]))
-> String -> Either String (String, [Token])
forall a b. (a -> b) -> a -> b
$
>                          String
"could not find name at " String -> ShowS
forall a. [a] -> [a] -> [a]
++
>                          Bool -> ShowS -> ShowS
showParen Bool
True (Token -> ShowS
forall a. Show a => a -> ShowS
shows Token
x) String
""
>                   [Token]
_ -> String -> Either String (String, [Token])
forall a b. a -> Either a b
Left (String -> Either String (String, [Token]))
-> ShowS -> String -> Either String (String, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
>                        (String -> Either String (String, [Token]))
-> String -> Either String (String, [Token])
forall a b. (a -> b) -> a -> b
$ String
"end of input looking for name"
>          start :: Parse [a]
start = String -> [a] -> Parse [a]
forall a. String -> a -> Parse a
eat String
"≝" [] Parse [a] -> Parse [a] -> Parse [a]
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> [a] -> Parse [a]
forall a. String -> a -> Parse a
eat String
"=" []

> -- |Parse an expression from a 'Token' stream.
> parseExpr :: Parse Expr
> parseExpr :: Parse Expr
parseExpr = [Parse Expr] -> Parse Expr
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
>             [ ([Token] -> Either String (Expr, [Token])) -> Parse Expr
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse [Token] -> Either String (Expr, [Token])
var
>             , Parse Expr
parseNAryExpr
>             , Parse Expr
parseUnaryExpr
>             , ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr)
-> (PLFactor -> ExprF Expr) -> PLFactor -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PLFactor -> ExprF Expr
forall a. PLFactor -> ExprF a
Factor (PLFactor -> Expr) -> Parse PLFactor -> Parse Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse PLFactor
parsePLFactor
>             ]
>     where var :: [Token] -> Either String (Expr, [Token])
var (TName String
n : [Token]
ts) = (Expr, [Token]) -> Either String (Expr, [Token])
forall a b. b -> Either a b
Right (ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ExprF Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> ExprF Expr
forall a. String -> ExprF a
Variable String
n, [Token]
ts)
>           var (Token
x : [Token]
_) = String -> Either String (Expr, [Token])
forall a b. a -> Either a b
Left (String -> Either String (Expr, [Token]))
-> ShowS -> String -> Either String (Expr, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (Expr, [Token]))
-> String -> Either String (Expr, [Token])
forall a b. (a -> b) -> a -> b
$
>                         String
"not a variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
>                         Bool -> ShowS -> ShowS
showParen Bool
False (Token -> ShowS
forall a. Show a => a -> ShowS
shows Token
x) String
""
>           var [Token]
_ = String -> Either String (Expr, [Token])
forall a b. a -> Either a b
Left (String -> Either String (Expr, [Token]))
-> String -> Either String (Expr, [Token])
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"not a variable"]

> parseNAryExpr :: Parse Expr
> parseNAryExpr :: Parse Expr
parseNAryExpr
>     = [([String], [Expr] -> Expr)] -> Parse ([Expr] -> Expr)
forall a. [([String], a)] -> Parse a
makeLifter
>       [ ([String
"⋀", String
"⋂", String
"∧", String
"∩", String
"/\\"],  ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ([Expr] -> ExprF Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> ExprF Expr
forall a. [a] -> ExprF a
Conjunction)
>       , ([String
"⋁", String
"⋃", String
"∨", String
"∪", String
"\\/"],  ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ([Expr] -> ExprF Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> ExprF Expr
forall a. [a] -> ExprF a
Disjunction)
>       , ([String
"\\\\"],                     ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ([Expr] -> ExprF Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> ExprF Expr
forall a. [a] -> ExprF a
QuotientL)
>       , ([String
"//"],                       ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ([Expr] -> ExprF Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> ExprF Expr
forall a. [a] -> ExprF a
QuotientR)
>       , ([String
".∙.", String
".@."],               ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ([Expr] -> ExprF Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> ExprF Expr
forall a. [a] -> ExprF a
StrictOrder)
>       , ([String
"∙∙", String
"@@"],                 ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ([Expr] -> ExprF Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> ExprF Expr
forall a. [a] -> ExprF a
Domination)
>       , ([String
"∙" , String
"@" ],                 ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ([Expr] -> ExprF Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> ExprF Expr
forall a. [a] -> ExprF a
Concatenation)
>       , ([String
"⧢", String
"|_|_|"],               ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ([Expr] -> ExprF Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> ExprF Expr
forall a. [a] -> ExprF a
Shuffle)
>       , ([String
"⇑", String
".^."],                 ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ([Expr] -> ExprF Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> ExprF Expr
forall a. [a] -> ExprF a
Infiltration)
>       ] Parse ([Expr] -> Expr) -> Parse [Expr] -> Parse Expr
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse [Expr]
pd
>     where pd :: Parse [Expr]
pd = Parse [Expr]
forall {a}. Parse [a]
parseEmpty
>                Parse [Expr] -> Parse [Expr] -> Parse [Expr]
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parse [Expr] -> Parse [Expr]
forall a. String -> Parse [a] -> Parse [a]
parseDelimited [Char
'(', Char
'{']
>                    (String -> Parse Expr -> Parse [Expr]
forall a. String -> Parse a -> Parse [a]
parseSeparated String
"," (Parse Expr -> Parse [Expr]) -> Parse Expr -> Parse [Expr]
forall a b. (a -> b) -> a -> b
$ Parse Expr
parseExpr)
>           parseEmpty :: Parse [a]
parseEmpty = ([Token] -> Either String ([a], [Token])) -> Parse [a]
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String ([a], [Token])) -> Parse [a])
-> ([Token] -> Either String ([a], [Token])) -> Parse [a]
forall a b. (a -> b) -> a -> b
$ \[Token]
xs ->
>                        case [Token]
xs of
>                          (TSymbol Char
'(':TSymbol Char
')':[Token]
ts) -> ([a], [Token]) -> Either String ([a], [Token])
forall a b. b -> Either a b
Right ([], [Token]
ts)
>                          (TSymbol Char
'{':TSymbol Char
'}':[Token]
ts) -> ([a], [Token]) -> Either String ([a], [Token])
forall a b. b -> Either a b
Right ([], [Token]
ts)
>                          [Token]
_ -> String -> Either String ([a], [Token])
forall a b. a -> Either a b
Left (String -> Either String ([a], [Token]))
-> String -> Either String ([a], [Token])
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"not an empty expr"]

> parseUnaryExpr :: Parse Expr
> parseUnaryExpr :: Parse Expr
parseUnaryExpr
>     = ([([String], Expr -> Expr)] -> Parse (Expr -> Expr)
forall a. [([String], a)] -> Parse a
makeLifter
>        [ ([String
"↓", String
"$"],       ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> (Expr -> ExprF Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> ExprF Expr
forall a. a -> ExprF a
DownClose)
>        , ([String
"↑", String
"^"],       ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> (Expr -> ExprF Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> ExprF Expr
forall a. a -> ExprF a
UpClose)
>        , ([String
"*", String
"∗"],       ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> (Expr -> ExprF Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> ExprF Expr
forall a. a -> ExprF a
Iteration)
>        , ([String
"+"],            ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> (Expr -> ExprF Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> ExprF Expr
plus)
>        , ([String
"¬", String
"~", String
"!"],  ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> (Expr -> ExprF Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> ExprF Expr
forall a. a -> ExprF a
Negation)
>        , ([String
"⇄", String
"-"],       ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> (Expr -> ExprF Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> ExprF Expr
forall a. a -> ExprF a
Reversal)
>        ] Parse (Expr -> Expr) -> Parse Expr -> Parse Expr
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse Expr
parseExpr
>       ) Parse Expr -> Parse Expr -> Parse Expr
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((([SymSet], Expr) -> Expr) -> [SymSet] -> Expr -> Expr
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr)
-> (([SymSet], Expr) -> ExprF Expr) -> ([SymSet], Expr) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymSet] -> Expr -> ExprF Expr) -> ([SymSet], Expr) -> ExprF Expr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [SymSet] -> Expr -> ExprF Expr
forall a. [SymSet] -> a -> ExprF a
Tierify) ([SymSet] -> Expr -> Expr)
-> Parse [SymSet] -> Parse (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse [SymSet]
pt Parse (Expr -> Expr) -> Parse Expr -> Parse Expr
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse Expr
parseExpr)
>         Parse Expr -> Parse Expr -> Parse Expr
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((([SymSet], Expr) -> Expr) -> [SymSet] -> Expr -> Expr
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr)
-> (([SymSet], Expr) -> ExprF Expr) -> ([SymSet], Expr) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymSet] -> Expr -> ExprF Expr) -> ([SymSet], Expr) -> ExprF Expr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [SymSet] -> Expr -> ExprF Expr
forall a. [SymSet] -> a -> ExprF a
Neutralize) ([SymSet] -> Expr -> Expr)
-> Parse [SymSet] -> Parse (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse [SymSet]
pn Parse (Expr -> Expr) -> Parse Expr -> Parse Expr
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse Expr
parseExpr)
>     where pt :: Parse [SymSet]
pt = String -> Parse [SymSet] -> Parse [SymSet]
forall a. String -> Parse [a] -> Parse [a]
parseDelimited [Char
'['] (String -> Parse SymSet -> Parse [SymSet]
forall a. String -> Parse a -> Parse [a]
parseSeparated String
"," Parse SymSet
parseSymExpr)
>           pn :: Parse [SymSet]
pn = String -> Parse [SymSet] -> Parse [SymSet]
forall a. String -> Parse [a] -> Parse [a]
parseDelimited [Char
'|'] (String -> Parse SymSet -> Parse [SymSet]
forall a. String -> Parse a -> Parse [a]
parseSeparated String
"," Parse SymSet
parseSymExpr)
>           plus :: Expr -> ExprF Expr
plus Expr
e = [Expr] -> ExprF Expr
forall a. [a] -> ExprF a
Concatenation [Expr
e, ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr) -> ExprF Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> ExprF Expr
forall a. a -> ExprF a
Iteration Expr
e]
 
> parsePLFactor :: Parse PLFactor
> parsePLFactor :: Parse PLFactor
parsePLFactor = String -> ([PLFactor] -> PLFactor) -> Parse PLFactor
forall {b}. String -> ([PLFactor] -> b) -> Parse b
combine String
".." [PLFactor] -> PLFactor
PLGap Parse PLFactor -> Parse PLFactor -> Parse PLFactor
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ([PLFactor] -> PLFactor) -> Parse PLFactor
forall {b}. String -> ([PLFactor] -> b) -> Parse b
combine String
"‥" [PLFactor] -> PLFactor
PLGap
>                 Parse PLFactor -> Parse PLFactor -> Parse PLFactor
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ([PLFactor] -> PLFactor) -> Parse PLFactor
forall {b}. String -> ([PLFactor] -> b) -> Parse b
combine String
"." [PLFactor] -> PLFactor
PLCat
>                 Parse PLFactor -> Parse PLFactor -> Parse PLFactor
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse PLFactor
pplf
>     where combine :: String -> ([PLFactor] -> b) -> Parse b
combine String
s [PLFactor] -> b
f = String -> ([PLFactor] -> b) -> Parse ([PLFactor] -> b)
forall a. String -> a -> Parse a
eat String
s [PLFactor] -> b
f Parse ([PLFactor] -> b) -> Parse [PLFactor] -> Parse b
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
>                         String -> Parse [PLFactor] -> Parse [PLFactor]
forall a. String -> Parse [a] -> Parse [a]
parseDelimited [Char
'<', Char
'⟨']
>                         (String -> Parse PLFactor -> Parse [PLFactor]
forall a. String -> Parse a -> Parse [a]
parseSeparated String
"," Parse PLFactor
pplf)
>           pplf :: Parse PLFactor
pplf = Parse PLFactor
parseBasicPLFactor Parse PLFactor -> Parse PLFactor -> Parse PLFactor
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Token] -> Either String (PLFactor, [Token])) -> Parse PLFactor
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse [Token] -> Either String (PLFactor, [Token])
var
>           var :: [Token] -> Either String (PLFactor, [Token])
var (TName String
n : [Token]
ts) = (PLFactor, [Token]) -> Either String (PLFactor, [Token])
forall a b. b -> Either a b
Right (String -> PLFactor
PLVariable String
n, [Token]
ts)
>           var (Token
x : [Token]
_) = String -> Either String (PLFactor, [Token])
forall a b. a -> Either a b
Left (String -> Either String (PLFactor, [Token]))
-> ShowS -> String -> Either String (PLFactor, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (PLFactor, [Token]))
-> String -> Either String (PLFactor, [Token])
forall a b. (a -> b) -> a -> b
$
>                         String
"not a variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
>                         Bool -> ShowS -> ShowS
showParen Bool
False (Token -> ShowS
forall a. Show a => a -> ShowS
shows Token
x) String
""
>           var [Token]
_ = String -> Either String (PLFactor, [Token])
forall a b. a -> Either a b
Left (String -> Either String (PLFactor, [Token]))
-> String -> Either String (PLFactor, [Token])
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"not a variable"]

> parseBasicPLFactor :: Parse PLFactor
> parseBasicPLFactor :: Parse PLFactor
parseBasicPLFactor
>     = [([String], [[SymSet]] -> PLFactor)]
-> Parse ([[SymSet]] -> PLFactor)
forall a. [([String], a)] -> Parse a
makeLifter
>       [ ([String
"⋊⋉", String
"%||%"], Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
True Bool
True)
>       , ([String
"⋊", String
"%|"], Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
True Bool
False)
>       , ([String
"⋉", String
"|%"], Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
False Bool
True)
>       , ([String
""], Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
False Bool
False)
>       ]
>       Parse ([[SymSet]] -> PLFactor)
-> Parse [[SymSet]] -> Parse PLFactor
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parse [[SymSet]] -> Parse [[SymSet]]
forall a. String -> Parse [a] -> Parse [a]
parseDelimited [Char
'<', Char
'⟨']
>           (String -> Parse [SymSet] -> Parse [[SymSet]]
forall a. String -> Parse a -> Parse [a]
parseSeparated String
"," (Parse [SymSet] -> Parse [[SymSet]])
-> Parse [SymSet] -> Parse [[SymSet]]
forall a b. (a -> b) -> a -> b
$ Parse SymSet -> Parse [SymSet]
forall a. Parse a -> Parse [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parse SymSet
parseSymExpr
>            Parse [SymSet] -> Parse [SymSet] -> Parse [SymSet]
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Token] -> Either String ([SymSet], [Token])) -> Parse [SymSet]
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (\[Token]
ts -> ([SymSet], [Token]) -> Either String ([SymSet], [Token])
forall a b. b -> Either a b
Right ([], [Token]
ts)))

> parseSymExpr :: Parse SymSet
> parseSymExpr :: Parse SymSet
parseSymExpr
>     = (([SymSet] -> SymSet) -> Parse [SymSet] -> Parse SymSet
forall a b. (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SymSet] -> SymSet
SSUni
>        (Parse [SymSet] -> Parse SymSet)
-> (Parse [SymSet] -> Parse [SymSet])
-> Parse [SymSet]
-> Parse SymSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parse [SymSet] -> Parse [SymSet]
forall a. String -> Parse [a] -> Parse [a]
parseDelimited [Char
'{', Char
'(']
>        (Parse [SymSet] -> Parse SymSet) -> Parse [SymSet] -> Parse SymSet
forall a b. (a -> b) -> a -> b
$ String -> Parse SymSet -> Parse [SymSet]
forall a. String -> Parse a -> Parse [a]
parseSeparated String
"," Parse SymSet
parseSymExpr)
>       Parse SymSet -> Parse SymSet -> Parse SymSet
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( ([SymSet] -> SymSet) -> Parse [SymSet] -> Parse SymSet
forall a b. (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SymSet] -> SymSet
SSInt
>           (Parse [SymSet] -> Parse SymSet)
-> (Parse [SymSet] -> Parse [SymSet])
-> Parse [SymSet]
-> Parse SymSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parse [SymSet] -> Parse [SymSet]
forall a. String -> Parse [a] -> Parse [a]
parseDelimited [Char
'[']
>           (Parse [SymSet] -> Parse SymSet) -> Parse [SymSet] -> Parse SymSet
forall a b. (a -> b) -> a -> b
$ String -> Parse SymSet -> Parse [SymSet]
forall a. String -> Parse a -> Parse [a]
parseSeparated String
"," Parse SymSet
parseSymExpr)
>       Parse SymSet -> Parse SymSet -> Parse SymSet
forall a. Parse a -> Parse a -> Parse a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse SymSet
parseSymSet

> parseSymSet :: Parse SymSet
> parseSymSet :: Parse SymSet
parseSymSet
>     = ([Token] -> Either String (SymSet, [Token])) -> Parse SymSet
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String (SymSet, [Token])) -> Parse SymSet)
-> ([Token] -> Either String (SymSet, [Token])) -> Parse SymSet
forall a b. (a -> b) -> a -> b
$ \[Token]
xs ->
>       case [Token]
xs
>       of (TName String
n : [Token]
ts)
>              -> (SymSet, [Token]) -> Either String (SymSet, [Token])
forall a b. b -> Either a b
Right ((String -> SymSet
SSVar String
n), [Token]
ts)
>          (TSymbol Char
'/' : TName String
n : [Token]
ts)
>              -> (SymSet, [Token]) -> Either String (SymSet, [Token])
forall a b. b -> Either a b
Right ((Set String -> SymSet
SSSet (Set String -> SymSet) -> Set String -> SymSet
forall a b. (a -> b) -> a -> b
$ String -> Set String
forall a. a -> Set a
Set.singleton String
n), [Token]
ts)
>          (Token
a:[Token]
_)
>              -> String -> Either String (SymSet, [Token])
forall a b. a -> Either a b
Left (String -> Either String (SymSet, [Token]))
-> ShowS -> String -> Either String (SymSet, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (SymSet, [Token]))
-> String -> Either String (SymSet, [Token])
forall a b. (a -> b) -> a -> b
$
>                 String
"cannot start a SymSet with " String -> ShowS
forall a. [a] -> [a] -> [a]
++
>                 Bool -> ShowS -> ShowS
showParen Bool
True (Token -> ShowS
forall a. Show a => a -> ShowS
shows Token
a) String
""
>          [Token]
_ -> String -> Either String (SymSet, [Token])
forall a b. a -> Either a b
Left (String -> Either String (SymSet, [Token]))
-> String -> Either String (SymSet, [Token])
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"unexpected end of input in SymSet"]

> makeLifter :: [([String], a)] -> Parse a
> makeLifter :: forall a. [([String], a)] -> Parse a
makeLifter = [Parse a] -> Parse a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parse a] -> Parse a)
-> ([([String], a)] -> [Parse a]) -> [([String], a)] -> Parse a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], a) -> [Parse a]) -> [([String], a)] -> [Parse a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((String, a) -> Parse a) -> [(String, a)] -> [Parse a]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> a -> Parse a) -> (String, a) -> Parse a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> a -> Parse a
forall a. String -> a -> Parse a
eat) ([(String, a)] -> [Parse a])
-> (([String], a) -> [(String, a)]) -> ([String], a) -> [Parse a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], a) -> [(String, a)]
forall {a} {b}. ([a], b) -> [(a, b)]
f)
>     where f :: ([a], b) -> [(a, b)]
f ([], b
_)    =  []
>           f (a
x:[a]
xs, b
g)  =  (a
x, b
g) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: ([a], b) -> [(a, b)]
f ([a]
xs, b
g)

> eat :: String -> a -> Parse a
> eat :: forall a. String -> a -> Parse a
eat String
str a
f = ([Token] -> Either String (a, [Token])) -> Parse a
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String (a, [Token])) -> Parse a)
-> ([Token] -> Either String (a, [Token])) -> Parse a
forall a b. (a -> b) -> a -> b
$ \[Token]
ts ->
>             if [Token] -> [Token] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Token]
ts ((Char -> Token) -> String -> [Token]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap Char -> Token
TSymbol String
str)
>             then (a, [Token]) -> Either String (a, [Token])
forall a b. b -> Either a b
Right (a
f, Int -> [Token] -> [Token]
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) [Token]
ts)
>             else String -> Either String (a, [Token])
forall a b. a -> Either a b
Left String
""

> parseDelimited :: [Char] -> Parse [a] -> Parse [a]
> parseDelimited :: forall a. String -> Parse [a] -> Parse [a]
parseDelimited String
ds Parse [a]
pl = String -> Parse Char
parseOpeningDelimiter String
ds Parse Char -> (Char -> Parse [a]) -> Parse [a]
forall a b. Parse a -> (a -> Parse b) -> Parse b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Parse [a]
f
>     where f :: Char -> Parse [a]
f Char
d = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a] -> [a] -> [a]) -> Parse [a] -> Parse ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse [a]
pl Parse ([a] -> [a]) -> Parse [a] -> Parse [a]
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parse [a]
forall a. Char -> Parse [a]
parseClosingDelimiter Char
d

> parseOpeningDelimiter :: [Char] -> Parse Char
> parseOpeningDelimiter :: String -> Parse Char
parseOpeningDelimiter String
ds = ([Token] -> Either String (Char, [Token])) -> Parse Char
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse [Token] -> Either String (Char, [Token])
openingDelimiter
>     where openingDelimiter :: [Token] -> Either String (Char, [Token])
openingDelimiter (TSymbol Char
x : [Token]
ts)
>               | String -> Char -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn String
ds Char
x  =  (Char, [Token]) -> Either String (Char, [Token])
forall a b. b -> Either a b
Right (Char
x, [Token]
ts)
>               | Bool
otherwise  =  String -> Either String (Char, [Token])
forall a b. a -> Either a b
Left (String -> Either String (Char, [Token]))
-> ShowS -> String -> Either String (Char, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (Char, [Token]))
-> String -> Either String (Char, [Token])
forall a b. (a -> b) -> a -> b
$
>                               String
"sought " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
sought String
ds String -> ShowS
forall a. [a] -> [a] -> [a]
++
>                               String
" but instead found " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
x
>           openingDelimiter [Token]
_
>               = String -> Either String (Char, [Token])
forall a b. a -> Either a b
Left (String -> Either String (Char, [Token]))
-> ShowS -> String -> Either String (Char, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (Char, [Token]))
-> String -> Either String (Char, [Token])
forall a b. (a -> b) -> a -> b
$
>                 String
"unexpected end of input looking for "
>                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
sought String
ds
>           sought :: ShowS
sought (Char
x:[]) = Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
"'"
>           sought (Char
x:String
xs) = Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
',' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
sought String
xs
>           sought String
_ = String
"nothing"

> parseClosingDelimiter :: Char -> Parse [a]
> parseClosingDelimiter :: forall a. Char -> Parse [a]
parseClosingDelimiter = (String -> [a] -> Parse [a]) -> [a] -> String -> Parse [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [a] -> Parse [a]
forall a. String -> a -> Parse a
eat [] (String -> Parse [a]) -> (Char -> String) -> Char -> Parse [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall c a. Container c a => a -> c
singleton (Char -> String) -> (Char -> Char) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
matchingDelimiter

> parseSeparated :: String -> Parse a -> Parse [a]
> parseSeparated :: forall a. String -> Parse a -> Parse [a]
parseSeparated String
string Parse a
p = (:) (a -> [a] -> [a]) -> Parse a -> Parse ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse a
p Parse ([a] -> [a]) -> Parse [a] -> Parse [a]
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse a -> Parse [a]
forall a. Parse a -> Parse [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> [Any] -> Parse [Any]
forall a. String -> a -> Parse a
eat String
string [] Parse [Any] -> Parse a -> Parse a
forall a b. Parse a -> Parse b -> Parse b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parse a
p)



> simplifyPL :: PLFactor -> (Bool, Bool, [[SymSet]])
> simplifyPL :: PLFactor -> (Bool, Bool, [[SymSet]])
simplifyPL PLFactor
p
>     = case PLFactor
p of
>         PLVariable String
_ -> String -> (Bool, Bool, [[SymSet]])
forall a. HasCallStack => String -> a
error String
"free variable in PLFactor"
>         PLFactor Bool
h Bool
t [[SymSet]]
ps -> (Bool
h, Bool
t, [[SymSet]]
ps)
>         PLCat [] -> (Bool
False, Bool
False, [])
>         PLCat (PLFactor
x:[PLFactor]
xs) -> let (Bool
h, Bool
_, [[SymSet]]
a) = PLFactor -> (Bool, Bool, [[SymSet]])
simplifyPL PLFactor
x
>                             (Bool
_, Bool
t, [[SymSet]]
b) = PLFactor -> (Bool, Bool, [[SymSet]])
simplifyPL ([PLFactor] -> PLFactor
PLCat [PLFactor]
xs)
>                         in (Bool
h, Bool
t, [[SymSet]] -> [[SymSet]] -> [[SymSet]]
forall {a}. [[a]] -> [[a]] -> [[a]]
pc [[SymSet]]
a [[SymSet]]
b)
>         PLGap [] -> (Bool
False, Bool
False, [])
>         PLGap (PLFactor
x:[PLFactor]
xs) -> let (Bool
h, Bool
_, [[SymSet]]
a) = PLFactor -> (Bool, Bool, [[SymSet]])
simplifyPL PLFactor
x
>                             (Bool
_, Bool
t, [[SymSet]]
b) = PLFactor -> (Bool, Bool, [[SymSet]])
simplifyPL ([PLFactor] -> PLFactor
PLGap [PLFactor]
xs)
>                         in (Bool
h, Bool
t, [[SymSet]]
a [[SymSet]] -> [[SymSet]] -> [[SymSet]]
forall a. [a] -> [a] -> [a]
++ [[SymSet]]
b)
>     where pc :: [[a]] -> [[a]] -> [[a]]
pc [] [[a]]
bs       =  [[a]]
bs
>           pc [[a]
a] []      =  [[a]
a]
>           pc [[a]
a] ([a]
b:[[a]]
bs)  = ([a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
b) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
bs
>           pc ([a]
a:[[a]]
as) [[a]]
bs   =  [a]
a [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]] -> [[a]]
pc [[a]]
as [[a]]
bs



> -- |An association between names and values.
> type Dictionary a = Map String a

> define :: String -> a -> Dictionary a -> Dictionary a
> define :: forall a. String -> a -> Dictionary a -> Dictionary a
define String
name a
value = String -> a -> Map String a -> Map String a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name a
value

> definition :: String -> Dictionary a -> Either String a
> definition :: forall a. String -> Dictionary a -> Either String a
definition String
a = Either String a
-> (a -> Either String a) -> Maybe a -> Either String a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String a
forall a b. a -> Either a b
Left String
undef) a -> Either String a
forall a b. b -> Either a b
Right (Maybe a -> Either String a)
-> (Dictionary a -> Maybe a) -> Dictionary a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dictionary a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
a
>     where undef :: String
undef = [String] -> String
unlines [String
"undefined variable \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""]

> -- |The base type for a combinatorial parser.
> newtype Parse a = Parse
>     {forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse :: [Token] -> Either String (a, [Token])}

> instance Functor Parse
>     where fmap :: forall a b. (a -> b) -> Parse a -> Parse b
fmap a -> b
g (Parse [Token] -> Either String (a, [Token])
f) = ([Token] -> Either String (b, [Token])) -> Parse b
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (((a, [Token]) -> (b, [Token]))
-> Either String (a, [Token]) -> Either String (b, [Token])
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, [Token]) -> (b, [Token])
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapfst a -> b
g) (Either String (a, [Token]) -> Either String (b, [Token]))
-> ([Token] -> Either String (a, [Token]))
-> [Token]
-> Either String (b, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> Either String (a, [Token])
f)

> instance Applicative Parse
>     where pure :: forall a. a -> Parse a
pure     =  ([Token] -> Either String (a, [Token])) -> Parse a
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String (a, [Token])) -> Parse a)
-> (a -> [Token] -> Either String (a, [Token])) -> a -> Parse a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, [Token]) -> Either String (a, [Token]))
-> ([Token] -> (a, [Token]))
-> [Token]
-> Either String (a, [Token])
forall a b. (a -> b) -> ([Token] -> a) -> [Token] -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [Token]) -> Either String (a, [Token])
forall a b. b -> Either a b
Right (([Token] -> (a, [Token]))
 -> [Token] -> Either String (a, [Token]))
-> (a -> [Token] -> (a, [Token]))
-> a
-> [Token]
-> Either String (a, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,)
>           Parse (a -> b)
f <*> :: forall a b. Parse (a -> b) -> Parse a -> Parse b
<*> Parse a
x  =  ([Token] -> Either String (b, [Token])) -> Parse b
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String (b, [Token])) -> Parse b)
-> ([Token] -> Either String (b, [Token])) -> Parse b
forall a b. (a -> b) -> a -> b
$ \[Token]
s0 ->
>                       let h :: (a -> b, [Token]) -> Either String (b, [Token])
h (a -> b
g, [Token]
s1) = (a -> b) -> (a, [Token]) -> (b, [Token])
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapfst a -> b
g ((a, [Token]) -> (b, [Token]))
-> Either String (a, [Token]) -> Either String (b, [Token])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse a -> [Token] -> Either String (a, [Token])
forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse Parse a
x [Token]
s1
>                       in (a -> b, [Token]) -> Either String (b, [Token])
forall {b}. (a -> b, [Token]) -> Either String (b, [Token])
h ((a -> b, [Token]) -> Either String (b, [Token]))
-> Either String (a -> b, [Token]) -> Either String (b, [Token])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parse (a -> b) -> [Token] -> Either String (a -> b, [Token])
forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse Parse (a -> b)
f [Token]
s0

> instance Alternative Parse
>     where empty :: forall a. Parse a
empty    =  ([Token] -> Either String (a, [Token])) -> Parse a
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String (a, [Token])) -> Parse a)
-> (Either String (a, [Token])
    -> [Token] -> Either String (a, [Token]))
-> Either String (a, [Token])
-> Parse a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String (a, [Token]) -> [Token] -> Either String (a, [Token])
forall a b. a -> b -> a
const (Either String (a, [Token]) -> Parse a)
-> Either String (a, [Token]) -> Parse a
forall a b. (a -> b) -> a -> b
$ String -> Either String (a, [Token])
forall a b. a -> Either a b
Left String
""
>           Parse a
p <|> :: forall a. Parse a -> Parse a -> Parse a
<|> Parse a
q  =  ([Token] -> Either String (a, [Token])) -> Parse a
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String (a, [Token])) -> Parse a)
-> ([Token] -> Either String (a, [Token])) -> Parse a
forall a b. (a -> b) -> a -> b
$ \[Token]
ts ->
>                       let f :: String -> ShowS
f String
s1 String
s2
>                             = [String] -> String
unlines
>                               ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines)
>                               [String
s1, String
s2]
>                           h :: String -> Either String (a, [Token])
h String
s = (String -> Either String (a, [Token]))
-> ((a, [Token]) -> Either String (a, [Token]))
-> Either String (a, [Token])
-> Either String (a, [Token])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String (a, [Token])
forall a b. a -> Either a b
Left (String -> Either String (a, [Token]))
-> ShowS -> String -> Either String (a, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
f String
s) (a, [Token]) -> Either String (a, [Token])
forall a b. b -> Either a b
Right (Either String (a, [Token]) -> Either String (a, [Token]))
-> Either String (a, [Token]) -> Either String (a, [Token])
forall a b. (a -> b) -> a -> b
$ Parse a -> [Token] -> Either String (a, [Token])
forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse Parse a
q [Token]
ts
>                       in (String -> Either String (a, [Token]))
-> ((a, [Token]) -> Either String (a, [Token]))
-> Either String (a, [Token])
-> Either String (a, [Token])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String (a, [Token])
h (a, [Token]) -> Either String (a, [Token])
forall a b. b -> Either a b
Right (Either String (a, [Token]) -> Either String (a, [Token]))
-> Either String (a, [Token]) -> Either String (a, [Token])
forall a b. (a -> b) -> a -> b
$ Parse a -> [Token] -> Either String (a, [Token])
forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse Parse a
p [Token]
ts

> instance Monad Parse
>     where Parse a
p >>= :: forall a b. Parse a -> (a -> Parse b) -> Parse b
>>= a -> Parse b
f   =  ([Token] -> Either String (b, [Token])) -> Parse b
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String (b, [Token])) -> Parse b)
-> ([Token] -> Either String (b, [Token])) -> Parse b
forall a b. (a -> b) -> a -> b
$ \[Token]
s0 ->
>                        let h :: (a, [Token]) -> Either String (b, [Token])
h (a
a, [Token]
s1) = Parse b -> [Token] -> Either String (b, [Token])
forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse (a -> Parse b
f a
a) [Token]
s1
>                        in (a, [Token]) -> Either String (b, [Token])
h ((a, [Token]) -> Either String (b, [Token]))
-> Either String (a, [Token]) -> Either String (b, [Token])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parse a -> [Token] -> Either String (a, [Token])
forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse Parse a
p [Token]
s0
#if !MIN_VERSION_base(4,8,0)
>           return    =  pure
#endif



> -- |Generate an expression (sub)tree from an t'FSA' that
> -- contains metadata regarding the constraint(s) it represents.
> fromSemanticAutomaton :: FSA Integer (Maybe String) -> Expr
> fromSemanticAutomaton :: FSA Integer (Maybe String) -> Expr
fromSemanticAutomaton = ExprF Expr -> Expr
forall (a :: * -> *). a (Fix a) -> Fix a
In (ExprF Expr -> Expr)
-> (FSA Integer (Maybe String) -> ExprF Expr)
-> FSA Integer (Maybe String)
-> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String) -> ExprF Expr
forall a. FSA Integer (Maybe String) -> ExprF a
Automaton (FSA Integer (Maybe String) -> ExprF Expr)
-> (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String)
-> ExprF Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA (Set (Set Integer)) (Maybe String)
-> FSA Integer (Maybe String)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Set (Set Integer)) (Maybe String)
 -> FSA Integer (Maybe String))
-> (FSA Integer (Maybe String)
    -> FSA (Set (Set Integer)) (Maybe String))
-> FSA Integer (Maybe String)
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer (Maybe String)
-> FSA (Set (Set Integer)) (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize

> -- |Generate an expression (sub)tree from an t'FSA'.
> fromAutomaton :: FSA Integer String -> Expr
> fromAutomaton :: FSA Integer String -> Expr
fromAutomaton = FSA Integer (Maybe String) -> Expr
fromSemanticAutomaton (FSA Integer (Maybe String) -> Expr)
-> (FSA Integer String -> FSA Integer (Maybe String))
-> FSA Integer String
-> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String)
-> FSA Integer String -> FSA Integer (Maybe String)
forall e e1 n.
(Ord e, Ord e1, Ord n) =>
(e -> e1) -> FSA n e -> FSA n e1
renameSymbolsBy String -> Maybe String
forall a. a -> Maybe a
Just



> isPrefixOf :: Eq a => [a] -> [a] -> Bool
> isPrefixOf :: forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
_ []  =  Bool
True
> isPrefixOf [] [a]
_  =  Bool
False
> isPrefixOf (a
a:[a]
as) (a
b:[a]
bs)
>     | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b     =  [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
as [a]
bs
>     | Bool
otherwise  =  Bool
False

> mapfst :: (a -> b) -> (a, c) -> (b, c)
> mapfst :: forall a b c. (a -> b) -> (a, c) -> (b, c)
mapfst a -> b
f (a
a, c
c) = (a -> b
f a
a, c
c)

> matchingDelimiter :: Char -> Char
> matchingDelimiter :: Char -> Char
matchingDelimiter Char
x = ((Char, Char) -> Char -> Char) -> Char -> [(Char, Char)] -> Char
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Char, Char) -> Char -> Char
f Char
x [(Char, Char)]
delimiters
>     where f :: (Char, Char) -> Char -> Char
f (Char
a, Char
b) Char
u
>               | Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x     =  Char
b
>               | Char
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x     =  Char
a
>               | Bool
otherwise  =  Char
u
>           delimiters :: [(Char, Char)]
delimiters
>               = [ (Char
'<', Char
'>')
>                 , (Char
'⟨', Char
'⟩')
>                 , (Char
'(', Char
')')
>                 , (Char
'[', Char
']')
>                 , (Char
'{', Char
'}')
>                 , (Char
'|', Char
'|')
>                 ]

Traversals

> cata :: Functor f => (f a -> a) -> Fix f -> a
> cata :: forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata f a -> a
f = f a -> a
f (f a -> a) -> (Fix f -> f a) -> Fix f -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix f -> a) -> f (Fix f) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> a) -> Fix f -> a
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata f a -> a
f) (f (Fix f) -> f a) -> (Fix f -> f (Fix f)) -> Fix f -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (a :: * -> *). Fix a -> a (Fix a)
out

Read1 and Show1 for ExprF, in order to allow derived Read/Show on Expr

> instance Read1 ExprF where
>     liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExprF a)
liftReadsPrec Int -> ReadS a
rP ReadS [a]
rL Int
d
>         = Bool -> ReadS (ExprF a) -> ReadS (ExprF a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>           (\String
r ->
>            case ReadS String
lex String
r of
>              [(String
"Automaton",String
s)]
>                  -> [ (FSA Integer (Maybe String) -> ExprF a
forall a. FSA Integer (Maybe String) -> ExprF a
Automaton FSA Integer (Maybe String)
x, String
t)
>                     | (FSA Integer (Maybe String)
x,String
t) <- Int -> ReadS (FSA Integer (Maybe String))
forall a. Read a => Int -> ReadS a
readsPrec (Int
app_prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
s]
>              [(String
"Concatenation",String
s)] -> ([a] -> ExprF a) -> ReadS (ExprF a)
forall {a}. ([a] -> a) -> String -> [(a, String)]
goN [a] -> ExprF a
forall a. [a] -> ExprF a
Concatenation String
s
>              [(String
"Conjunction",String
s)]   -> ([a] -> ExprF a) -> ReadS (ExprF a)
forall {a}. ([a] -> a) -> String -> [(a, String)]
goN [a] -> ExprF a
forall a. [a] -> ExprF a
Conjunction String
s
>              [(String
"Disjunction",String
s)]   -> ([a] -> ExprF a) -> ReadS (ExprF a)
forall {a}. ([a] -> a) -> String -> [(a, String)]
goN [a] -> ExprF a
forall a. [a] -> ExprF a
Conjunction String
s
>              [(String
"Domination",String
s)]    -> ([a] -> ExprF a) -> ReadS (ExprF a)
forall {a}. ([a] -> a) -> String -> [(a, String)]
goN [a] -> ExprF a
forall a. [a] -> ExprF a
Domination String
s
>              [(String
"DownClose",String
s)]     -> (a -> ExprF a) -> ReadS (ExprF a)
forall {a}. (a -> a) -> String -> [(a, String)]
goU a -> ExprF a
forall a. a -> ExprF a
DownClose String
s
>              [(String
"Factor",String
s)]
>                  -> [ (PLFactor -> ExprF a
forall a. PLFactor -> ExprF a
Factor PLFactor
x, String
t)
>                     | (PLFactor
x,String
t) <- Int -> ReadS PLFactor
forall a. Read a => Int -> ReadS a
readsPrec (Int
app_prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
s]
>              [(String
"Infiltration",String
s)]  -> ([a] -> ExprF a) -> ReadS (ExprF a)
forall {a}. ([a] -> a) -> String -> [(a, String)]
goN [a] -> ExprF a
forall a. [a] -> ExprF a
Infiltration String
s
>              [(String
"Iteration",String
s)]     -> (a -> ExprF a) -> ReadS (ExprF a)
forall {a}. (a -> a) -> String -> [(a, String)]
goU a -> ExprF a
forall a. a -> ExprF a
Iteration String
s
>              [(String
"Negation",String
s)]      -> (a -> ExprF a) -> ReadS (ExprF a)
forall {a}. (a -> a) -> String -> [(a, String)]
goU a -> ExprF a
forall a. a -> ExprF a
Negation String
s
>              [(String
"Neutralize",String
s)]
>                  -> [ ([SymSet] -> a -> ExprF a
forall a. [SymSet] -> a -> ExprF a
Neutralize [SymSet]
x a
y, String
u)
>                     | ([SymSet]
x, String
t) <- Int -> ReadS [SymSet]
forall a. Read a => Int -> ReadS a
readsPrec (Int
app_prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
s
>                     , (a
y, String
u) <- Int -> ReadS a
rP (Int
app_prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
t]
>              [(String
"Reversal",String
s)]      -> (a -> ExprF a) -> ReadS (ExprF a)
forall {a}. (a -> a) -> String -> [(a, String)]
goU a -> ExprF a
forall a. a -> ExprF a
Reversal String
s
>              [(String
"Shuffle",String
s)]       -> ([a] -> ExprF a) -> ReadS (ExprF a)
forall {a}. ([a] -> a) -> String -> [(a, String)]
goN [a] -> ExprF a
forall a. [a] -> ExprF a
Shuffle String
s
>              [(String
"StrictOrder",String
s)]   -> ([a] -> ExprF a) -> ReadS (ExprF a)
forall {a}. ([a] -> a) -> String -> [(a, String)]
goN [a] -> ExprF a
forall a. [a] -> ExprF a
StrictOrder String
s
>              [(String
"Tierify",String
s)]
>                  -> [ ([SymSet] -> a -> ExprF a
forall a. [SymSet] -> a -> ExprF a
Tierify [SymSet]
x a
y, String
u)
>                     | ([SymSet]
x, String
t) <- Int -> ReadS [SymSet]
forall a. Read a => Int -> ReadS a
readsPrec (Int
app_prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
s
>                     , (a
y, String
u) <- Int -> ReadS a
rP (Int
app_prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
t]
>              [(String
"QuotientL",String
s)]     -> ([a] -> ExprF a) -> ReadS (ExprF a)
forall {a}. ([a] -> a) -> String -> [(a, String)]
goN [a] -> ExprF a
forall a. [a] -> ExprF a
QuotientL String
s
>              [(String
"QuotientR",String
s)]     -> ([a] -> ExprF a) -> ReadS (ExprF a)
forall {a}. ([a] -> a) -> String -> [(a, String)]
goN [a] -> ExprF a
forall a. [a] -> ExprF a
QuotientR String
s
>              [(String
"UpClose",String
s)]       -> (a -> ExprF a) -> ReadS (ExprF a)
forall {a}. (a -> a) -> String -> [(a, String)]
goU a -> ExprF a
forall a. a -> ExprF a
UpClose String
s
>              [(String
"Variable",String
s)]
>                  -> [ (String -> ExprF a
forall a. String -> ExprF a
Variable String
x, String
t)
>                     | (String
x,String
t) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec (Int
app_prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
s]
>              [(String, String)]
_                     -> []
>           )
>         where app_prec :: Int
app_prec = Int
10
>               goN :: ([a] -> a) -> String -> [(a, String)]
goN [a] -> a
f String
s = [([a] -> a
f [a]
xs, String
t) | ([a]
xs, String
t) <- ReadS [a]
rL String
s]
>               goU :: (a -> a) -> String -> [(a, String)]
goU a -> a
f String
s = [(a -> a
f a
x,  String
t) | (a
x,  String
t) <- Int -> ReadS a
rP (Int
app_prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
s]

> instance Show1 ExprF where
>     liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> ExprF a -> ShowS
liftShowsPrec Int -> a -> ShowS
showP [a] -> ShowS
showL Int
d ExprF a
e
>         = case ExprF a
e of
>             Automaton FSA Integer (Maybe String)
x
>                 -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>                    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Automaton " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FSA Integer (Maybe String) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) FSA Integer (Maybe String)
x
>             Concatenation [a]
xs -> String -> [a] -> ShowS
goL String
"Concatenation " [a]
xs
>             Conjunction [a]
xs   -> String -> [a] -> ShowS
goL String
"Conjunction " [a]
xs
>             Disjunction [a]
xs   -> String -> [a] -> ShowS
goL String
"Disjunction " [a]
xs
>             Domination [a]
xs    -> String -> [a] -> ShowS
goL String
"Domination " [a]
xs
>             DownClose a
x      -> String -> a -> ShowS
go1 String
"DownClose " a
x
>             Factor PLFactor
x
>                 -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>                    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Factor " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PLFactor -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) PLFactor
x
>             Infiltration [a]
xs  -> String -> [a] -> ShowS
goL String
"Infiltration " [a]
xs
>             Iteration a
x      -> String -> a -> ShowS
go1 String
"Iteration " a
x
>             Negation a
x       -> String -> a -> ShowS
go1 String
"Negation " a
x
>             Neutralize [SymSet]
s a
x
>                 -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>                    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Neutralize "
>                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [SymSet] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [SymSet]
s
>                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
>                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showP (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x
>             Reversal a
x       -> String -> a -> ShowS
go1 String
"Reversal " a
x
>             Shuffle [a]
xs       -> String -> [a] -> ShowS
goL String
"Shuffle " [a]
xs
>             StrictOrder [a]
xs   -> String -> [a] -> ShowS
goL String
"StrictOrder " [a]
xs
>             Tierify [SymSet]
s a
x
>                 -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>                    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Neutralize "
>                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [SymSet] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [SymSet]
s
>                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
>                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showP (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x
>             QuotientL [a]
xs     -> String -> [a] -> ShowS
goL String
"QuotientL " [a]
xs
>             QuotientR [a]
xs     -> String -> [a] -> ShowS
goL String
"QuotientR " [a]
xs
>             UpClose a
x        -> String -> a -> ShowS
go1 String
"UpClose " a
x
>             Variable String
x
>                 -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>                    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Variable " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
x
>         where app_prec :: Int
app_prec = Int
10
>               goL :: String -> [a] -> ShowS
goL String
s [a]
xs = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>                          (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
showL [a]
xs
>               go1 :: String -> a -> ShowS
go1 String
s a
x  = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>                          (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showP (Int
app_prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x