> {-# 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.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)

> -- |An expression, the root of an expression tree.
> data Expr
>     = Automaton (FSA Integer (Maybe String))
>     | Concatenation [Expr]
>     | Conjunction [Expr]
>     | Disjunction [Expr]
>     | Domination [Expr]
>     | DownClose Expr            -- ^@since 1.0
>     | Factor PLFactor
>     | Infiltration [Expr]       -- ^@since 1.1
>     | Iteration Expr
>     | Negation Expr
>     | Neutralize [SymSet] Expr  -- ^@since 1.1
>     | Reversal Expr             -- ^@since 1.1
>     | Shuffle [Expr]            -- ^@since 1.1
>     | StrictOrder [Expr]
>     | Tierify [SymSet] Expr
>     | QuotientL [Expr]          -- ^@since 1.0
>     | QuotientR [Expr]          -- ^@since 1.0
>     | UpClose Expr              -- ^@since 1.1
>     | Variable String
>       deriving (Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
/= :: Expr -> Expr -> Bool
Eq, Eq Expr
Eq Expr =>
(Expr -> Expr -> Ordering)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> Ord Expr
Expr -> Expr -> Bool
Expr -> Expr -> Ordering
Expr -> Expr -> Expr
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 :: Expr -> Expr -> Ordering
compare :: Expr -> Expr -> Ordering
$c< :: Expr -> Expr -> Bool
< :: Expr -> Expr -> Bool
$c<= :: Expr -> Expr -> Bool
<= :: Expr -> Expr -> Bool
$c> :: Expr -> Expr -> Bool
> :: Expr -> Expr -> Bool
$c>= :: Expr -> Expr -> Bool
>= :: Expr -> Expr -> Bool
$cmax :: Expr -> Expr -> Expr
max :: Expr -> Expr -> Expr
$cmin :: Expr -> Expr -> Expr
min :: Expr -> Expr -> Expr
Ord, ReadPrec [Expr]
ReadPrec Expr
Int -> ReadS Expr
ReadS [Expr]
(Int -> ReadS Expr)
-> ReadS [Expr] -> ReadPrec Expr -> ReadPrec [Expr] -> Read Expr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Expr
readsPrec :: Int -> ReadS Expr
$creadList :: ReadS [Expr]
readList :: ReadS [Expr]
$creadPrec :: ReadPrec Expr
readPrec :: ReadPrec Expr
$creadListPrec :: ReadPrec [Expr]
readListPrec :: ReadPrec [Expr]
Read, Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Expr -> ShowS
showsPrec :: Int -> Expr -> ShowS
$cshow :: Expr -> String
show :: Expr -> String
$cshowList :: [Expr] -> ShowS
showList :: [Expr] -> ShowS
Show)

> -- |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 (Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
/= :: Statement -> Statement -> Bool
Eq, Eq Statement
Eq Statement =>
(Statement -> Statement -> Ordering)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool)
-> (Statement -> Statement -> Statement)
-> (Statement -> Statement -> Statement)
-> Ord Statement
Statement -> Statement -> Bool
Statement -> Statement -> Ordering
Statement -> Statement -> Statement
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 :: Statement -> Statement -> Ordering
compare :: Statement -> Statement -> Ordering
$c< :: Statement -> Statement -> Bool
< :: Statement -> Statement -> Bool
$c<= :: Statement -> Statement -> Bool
<= :: Statement -> Statement -> Bool
$c> :: Statement -> Statement -> Bool
> :: Statement -> Statement -> Bool
$c>= :: Statement -> Statement -> Bool
>= :: Statement -> Statement -> Bool
$cmax :: Statement -> Statement -> Statement
max :: Statement -> Statement -> Statement
$cmin :: Statement -> Statement -> Statement
min :: Statement -> Statement -> Statement
Ord, ReadPrec [Statement]
ReadPrec Statement
Int -> ReadS Statement
ReadS [Statement]
(Int -> ReadS Statement)
-> ReadS [Statement]
-> ReadPrec Statement
-> ReadPrec [Statement]
-> Read Statement
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Statement
readsPrec :: Int -> ReadS Statement
$creadList :: ReadS [Statement]
readList :: ReadS [Statement]
$creadPrec :: ReadPrec Statement
readPrec :: ReadPrec Statement
$creadListPrec :: ReadPrec [Statement]
readListPrec :: ReadPrec [Statement]
Read, Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
(Int -> Statement -> ShowS)
-> (Statement -> String)
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Statement -> ShowS
showsPrec :: Int -> Statement -> ShowS
$cshow :: Statement -> String
show :: Statement -> String
$cshowList :: [Statement] -> ShowS
showList :: [Statement] -> ShowS
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 (String -> Expr
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. Ord 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. Ord 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. Ord 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. Ord 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 d :: Env
d@(Map String (Set String)
_,Map String Expr
subexprs) Expr
e
>     = case Expr
e of
>         Automaton FSA Integer (Maybe String)
x       ->  Expr -> Either String Expr
forall a b. b -> Either a b
Right (Expr -> Either String Expr) -> Expr -> Either String Expr
forall a b. (a -> b) -> a -> b
$ FSA Integer (Maybe String) -> Expr
Automaton FSA Integer (Maybe String)
x
>         Concatenation [Expr]
xs  ->  [Expr] -> Expr
Concatenation ([Expr] -> Expr) -> Either String [Expr] -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Either String [Expr]
f [Expr]
xs
>         Conjunction [Expr]
xs    ->  [Expr] -> Expr
Conjunction ([Expr] -> Expr) -> Either String [Expr] -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Either String [Expr]
f [Expr]
xs
>         Disjunction [Expr]
xs    ->  [Expr] -> Expr
Disjunction ([Expr] -> Expr) -> Either String [Expr] -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Either String [Expr]
f [Expr]
xs
>         Domination [Expr]
xs     ->  [Expr] -> Expr
Domination  ([Expr] -> Expr) -> Either String [Expr] -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Either String [Expr]
f [Expr]
xs
>         DownClose Expr
x       ->  Expr -> Expr
DownClose (Expr -> Expr) -> Either String Expr -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> Expr -> Either String Expr
fillVars Env
d Expr
x
>         Factor PLFactor
x          ->  PLFactor -> Expr
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)
>         Infiltration [Expr]
xs   ->  [Expr] -> Expr
Infiltration ([Expr] -> Expr) -> Either String [Expr] -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Either String [Expr]
f [Expr]
xs
>         Iteration Expr
x       ->  Expr -> Expr
Iteration (Expr -> Expr) -> Either String Expr -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> Expr -> Either String Expr
fillVars Env
d Expr
x
>         Negation Expr
x        ->  Expr -> Expr
Negation (Expr -> Expr) -> Either String Expr -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> Expr -> Either String Expr
fillVars Env
d Expr
x
>         Neutralize [SymSet]
ts Expr
x
>             -> [SymSet] -> Expr -> Expr
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 :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ((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
<*> Env -> Expr -> Either String Expr
fillVars Env
d Expr
x
>         QuotientL [Expr]
xs      ->  [Expr] -> Expr
QuotientL ([Expr] -> Expr) -> Either String [Expr] -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Either String [Expr]
f [Expr]
xs
>         QuotientR [Expr]
xs      ->  [Expr] -> Expr
QuotientR ([Expr] -> Expr) -> Either String [Expr] -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Either String [Expr]
f [Expr]
xs
>         Reversal Expr
x        ->  Expr -> Expr
Reversal (Expr -> Expr) -> Either String Expr -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> Expr -> Either String Expr
fillVars Env
d Expr
x
>         Shuffle [Expr]
xs        ->  [Expr] -> Expr
Shuffle ([Expr] -> Expr) -> Either String [Expr] -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Either String [Expr]
f [Expr]
xs
>         StrictOrder [Expr]
xs    ->  [Expr] -> Expr
StrictOrder ([Expr] -> Expr) -> Either String [Expr] -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Either String [Expr]
f [Expr]
xs
>         Tierify [SymSet]
ts Expr
x
>             -> [SymSet] -> Expr -> Expr
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 :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ((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
<*> Env -> Expr -> Either String Expr
fillVars Env
d Expr
x
>         UpClose Expr
x         ->  Expr -> Expr
UpClose (Expr -> Expr) -> Either String Expr -> Either String Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> Expr -> Either String Expr
fillVars Env
d 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. Ord a => String -> Dictionary a -> Either String a
definition String
v Map String Expr
subexprs
>     where f :: [Expr] -> Either String [Expr]
f [Expr]
es = [Either String Expr] -> Either String [Expr]
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 Expr] -> Either String [Expr])
-> [Either String Expr] -> Either String [Expr]
forall a b. (a -> b) -> a -> b
$ (Expr -> Either String Expr) -> [Expr] -> [Either String Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> Expr -> Either String Expr
fillVars Env
d) [Expr]
es
> 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 String -> Map String Expr -> Either String Expr
forall a. Ord 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 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. Ord 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 = FSA Integer (Maybe String) -> Expr
Automaton (FSA Integer (Maybe String) -> Expr)
-> (Expr -> FSA Integer (Maybe String)) -> Expr -> 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 = FSA Integer (Maybe String) -> Expr
Automaton
>               (FSA Integer (Maybe String) -> Expr)
-> (Expr -> FSA Integer (Maybe String)) -> Expr -> 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. Ord 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. Ord 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. Ord 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 Expr
e
>               = case Expr
e of
>                   Automaton FSA Integer (Maybe String)
x
>                       ->  FSA Integer (Maybe String) -> Expr
Automaton (FSA Integer (Maybe String) -> Expr)
-> FSA Integer (Maybe String) -> Expr
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
>                   Concatenation [Expr]
es  ->  ([Expr] -> Expr) -> [Expr] -> Expr
f [Expr] -> Expr
Concatenation [Expr]
es
>                   Conjunction [Expr]
es    ->  ([Expr] -> Expr) -> [Expr] -> Expr
f [Expr] -> Expr
Conjunction [Expr]
es
>                   Disjunction [Expr]
es    ->  ([Expr] -> Expr) -> [Expr] -> Expr
f [Expr] -> Expr
Disjunction [Expr]
es
>                   Domination [Expr]
es     ->  ([Expr] -> Expr) -> [Expr] -> Expr
f [Expr] -> Expr
Domination [Expr]
es
>                   DownClose Expr
ex      ->  (Expr -> Expr) -> Expr -> Expr
g Expr -> Expr
DownClose Expr
ex
>                   Factor PLFactor
pf
>                       ->  PLFactor -> Expr
Factor (PLFactor -> Expr) -> PLFactor -> Expr
forall a b. (a -> b) -> a -> b
$ PLFactor -> PLFactor
restrictUniverseF PLFactor
pf
>                   Infiltration [Expr]
es   ->  ([Expr] -> Expr) -> [Expr] -> Expr
f [Expr] -> Expr
Infiltration [Expr]
es
>                   Iteration Expr
ex      ->  (Expr -> Expr) -> Expr -> Expr
g Expr -> Expr
Iteration Expr
ex
>                   Negation Expr
ex       ->  (Expr -> Expr) -> Expr -> Expr
g Expr -> Expr
Negation Expr
ex
>                   Neutralize [SymSet]
ts Expr
ex
>                       -> (Expr -> Expr) -> Expr -> Expr
g ([SymSet] -> Expr -> Expr
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)) Expr
ex
>                   QuotientL [Expr]
es      ->  ([Expr] -> Expr) -> [Expr] -> Expr
f [Expr] -> Expr
QuotientL [Expr]
es
>                   QuotientR [Expr]
es      ->  ([Expr] -> Expr) -> [Expr] -> Expr
f [Expr] -> Expr
QuotientR [Expr]
es
>                   Reversal Expr
ex       ->  (Expr -> Expr) -> Expr -> Expr
g Expr -> Expr
Reversal Expr
ex
>                   Shuffle [Expr]
es        ->  ([Expr] -> Expr) -> [Expr] -> Expr
f [Expr] -> Expr
Shuffle [Expr]
es
>                   StrictOrder [Expr]
es    ->  ([Expr] -> Expr) -> [Expr] -> Expr
f [Expr] -> Expr
StrictOrder [Expr]
es
>                   Tierify [SymSet]
ts Expr
ex
>                       -> (Expr -> Expr) -> Expr -> Expr
g ([SymSet] -> Expr -> Expr
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)) Expr
ex
>                   UpClose Expr
ex        ->  (Expr -> Expr) -> Expr -> Expr
g Expr -> Expr
UpClose Expr
ex
>                   Variable String
x        ->  String -> Expr
Variable String
x
>           f :: ([Expr] -> Expr) -> [Expr] -> Expr
f [Expr] -> Expr
t [Expr]
es = [Expr] -> Expr
t ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr) -> [Expr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
restrictUniverseE [Expr]
es
>           g :: (Expr -> Expr) -> Expr -> Expr
g Expr -> Expr
t Expr
e  = Expr -> Expr
t (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
restrictUniverseE Expr
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. Ord 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 Expr
e
>     = case Expr
e
>       of Automaton FSA Integer (Maybe String)
x             -> FSA Integer (Maybe String)
x
>          Concatenation [Expr]
es -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [Expr]
-> 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) -> [Expr] -> FSA n1 e
f FSA Integer (Maybe String)
emptyStr [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall a. Monoid a => [a] -> a
mconcat [Expr]
es
>          Conjunction [Expr]
es   -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [Expr]
-> 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) -> [Expr] -> 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 [Expr]
es
>          Disjunction [Expr]
es   -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [Expr]
-> 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) -> [Expr] -> 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 [Expr]
es
>          Domination [Expr]
es
>              -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [Expr]
-> 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) -> [Expr] -> FSA n1 e
f FSA Integer (Maybe String)
emptyStr [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall a. Monoid a => [a] -> a
mconcat
>                 ([Expr] -> FSA Integer (Maybe String))
-> [Expr] -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
intersperse (PLFactor -> Expr
Factor (PLFactor -> Expr) -> PLFactor -> Expr
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
False Bool
False []) [Expr]
es
>          DownClose Expr
ex
>              -> 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 n e. (Ord n, Ord e) => FSA n e -> FSA n e
subsequenceClosure (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$
>                 Expr -> FSA Integer (Maybe String)
automatonFromExpr Expr
ex
>          Factor PLFactor
x
>              -> (Bool, Bool, [[SymSet]]) -> FSA Integer (Maybe String)
automatonFromPLFactor (PLFactor -> (Bool, Bool, [[SymSet]])
simplifyPL PLFactor
x)
>          Infiltration [Expr]
es  -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [Expr]
-> 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) -> [Expr] -> 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 [Expr]
es
>          Iteration Expr
ex
>              -> 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 Integer (Maybe String)
    -> FSA (Set (Set (Either Integer Bool))) (Maybe String))
-> FSA Integer (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 (Set (Set (Either Integer Bool))) (Maybe String))
-> (FSA Integer (Maybe String)
    -> FSA (Either Integer Bool) (Maybe String))
-> FSA Integer (Maybe String)
-> FSA (Set (Set (Either Integer Bool))) (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$
>                 Expr -> FSA Integer (Maybe String)
automatonFromExpr Expr
ex
>          Negation Expr
ex
>              -> 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) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ Expr -> FSA Integer (Maybe String)
automatonFromExpr Expr
ex
>          Neutralize [SymSet]
ts Expr
ex
>              -> 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
. 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) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ Expr -> FSA Integer (Maybe String)
automatonFromExpr Expr
ex
>          QuotientL [Expr]
es     -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [Expr]
-> 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) -> [Expr] -> 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 [Expr]
es
>          QuotientR [Expr]
es     -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [Expr]
-> 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) -> [Expr] -> 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 [Expr]
es
>          Reversal Expr
ex
>              -> 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 e n. (Ord e, Ord n) => FSA n e -> FSA n e
LTK.FSA.reverse
>                 (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ Expr -> FSA Integer (Maybe String)
automatonFromExpr Expr
ex
>          Shuffle [Expr]
es       -> FSA Integer (Maybe String)
-> ([FSA Integer (Maybe String)] -> FSA Integer (Maybe String))
-> [Expr]
-> 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) -> [Expr] -> 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 [Expr]
es
>          StrictOrder [Expr]
es   -> (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
$ [Expr] -> [FSA Integer (Maybe String)]
automata [Expr]
es
>          Tierify [SymSet]
ts Expr
ex
>              -> 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
. 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) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ Expr -> FSA Integer (Maybe String)
automatonFromExpr Expr
ex
>          UpClose Expr
ex
>              -> 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 n e. (Ord n, Ord e) => FSA n e -> FSA n e
loopify (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$
>                 Expr -> FSA Integer (Maybe String)
automatonFromExpr Expr
ex
>          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) -> [Expr] -> FSA n1 e
f FSA n1 e
z [FSA Integer (Maybe String)] -> FSA n e
tl [Expr]
xs = case [Expr] -> [FSA Integer (Maybe String)]
automata [Expr]
xs
>                       of [] -> FSA n1 e
z
>                          [FSA Integer (Maybe String)]
a -> 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 n e -> FSA (Set (Set n)) e) -> FSA n e -> 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 n1 e) -> FSA n e -> FSA n1 e
forall a b. (a -> b) -> a -> b
$ [FSA Integer (Maybe String)] -> FSA n e
tl [FSA Integer (Maybe String)]
a
>           automata :: [Expr] -> [FSA Integer (Maybe String)]
automata [Expr]
es
>               =  let as :: [FSA Integer (Maybe String)]
as = (Expr -> FSA Integer (Maybe String))
-> [Expr] -> [FSA Integer (Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> FSA Integer (Maybe String)
automatonFromExpr [Expr]
es
>                  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
 -> FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> Set String
-> FSA Integer (Maybe String)
-> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ [FSA Integer (Maybe String)] -> Set String
bigAlpha [FSA Integer (Maybe String)]
as) [FSA Integer (Maybe String)]
as
>           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
>           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
>           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 Expr
e
>     = case Expr
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
>         Concatenation [Expr]
es  ->  [Expr] -> Set String
us [Expr]
es
>         Conjunction [Expr]
es    ->  [Expr] -> Set String
us [Expr]
es
>         Disjunction [Expr]
es    ->  [Expr] -> Set String
us [Expr]
es
>         Domination [Expr]
es     ->  [Expr] -> Set String
us [Expr]
es
>         DownClose Expr
ex      ->  Expr -> Set String
usedSymbols Expr
ex
>         Factor PLFactor
f          ->  PLFactor -> Set String
usedSymbolsF PLFactor
f
>         Infiltration [Expr]
es   ->  [Expr] -> Set String
us [Expr]
es
>         Iteration Expr
ex      ->  Expr -> Set String
usedSymbols Expr
ex
>         Negation Expr
ex       ->  Expr -> Set String
usedSymbols Expr
ex
>         Neutralize [SymSet]
ts Expr
ex
>             -> [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (Expr -> Set String
usedSymbols Expr
ex 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)
>         Reversal Expr
ex       ->  Expr -> Set String
usedSymbols Expr
ex
>         Shuffle [Expr]
es        ->  [Expr] -> Set String
us [Expr]
es
>         StrictOrder [Expr]
es    ->  [Expr] -> Set String
us [Expr]
es
>         Tierify [SymSet]
ts Expr
_
>             -> [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]
ts
>         QuotientL [Expr]
es      ->  [Expr] -> Set String
us [Expr]
es
>         QuotientR [Expr]
es      ->  [Expr] -> Set String
us [Expr]
es
>         UpClose Expr
ex        ->  Expr -> Set String
usedSymbols Expr
ex
>         Variable String
_        ->  Set String
forall a. Set a
Set.empty
>     where us :: [Expr] -> Set String
us = (Expr -> Set String -> Set String)
-> Set String -> [Expr] -> Set 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 String -> Set String -> Set String
forall c a. Container c a => c -> c -> c
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
forall a. Set a
Set.empty
>           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
>             , PLFactor -> Expr
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 (String -> Expr
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
"/\\"],  [Expr] -> Expr
Conjunction)
>       , ([String
"⋁", String
"⋃", String
"∨", String
"∪", String
"\\/"],  [Expr] -> Expr
Disjunction)
>       , ([String
"\\\\"],                     [Expr] -> Expr
QuotientL)
>       , ([String
"//"],                       [Expr] -> Expr
QuotientR)
>       , ([String
".∙.", String
".@."],               [Expr] -> Expr
StrictOrder)
>       , ([String
"∙∙", String
"@@"],                 [Expr] -> Expr
Domination)
>       , ([String
"∙" , String
"@" ],                 [Expr] -> Expr
Concatenation)
>       , ([String
"⧢", String
"|_|_|"],               [Expr] -> Expr
Shuffle)
>       , ([String
"⇑", String
".^."],                 [Expr] -> Expr
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
"$"],       Expr -> Expr
DownClose)
>        , ([String
"↑", String
"^"],       Expr -> Expr
UpClose)
>        , ([String
"*", String
"∗"],       Expr -> Expr
Iteration)
>        , ([String
"+"],            Expr -> Expr
plus)
>        , ([String
"¬", String
"~", String
"!"],  Expr -> Expr
Negation)
>        , ([String
"⇄", String
"-"],       Expr -> Expr
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
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
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 -> Expr
plus Expr
e = [Expr] -> Expr
Concatenation [Expr
e, Expr -> Expr
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 :: (Ord a) => String -> a -> Dictionary a -> Dictionary a
> define :: forall a. Ord 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 :: (Ord a) => String -> Dictionary a -> Either String a
> definition :: forall a. Ord 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 = FSA Integer (Maybe String) -> Expr
Automaton (FSA Integer (Maybe String) -> Expr)
-> (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> FSA Integer (Maybe String)
-> 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
'|')
>                 ]