> {-# 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-2021 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 '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
>        , doStatements
>        , parseExpr
>        , readPleb
>        , 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.Set (Set)
> 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
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: 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
min :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmax :: Token -> Token -> Token
>= :: Token -> Token -> Bool
$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
compare :: Token -> Token -> Ordering
$ccompare :: Token -> Token -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [Token]
$creadListPrec :: ReadPrec [Token]
readPrec :: ReadPrec Token
$creadPrec :: ReadPrec Token
readList :: ReadS [Token]
$creadList :: ReadS [Token]
readsPrec :: Int -> ReadS Token
$creadsPrec :: Int -> ReadS 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
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> 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 (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

> -- |The environment: defined sets of symbols, defined expressions, and
> -- possibly a value for the special variable @(it)@.
> type Env = (Dictionary SymSet, Dictionary Expr, Maybe Expr)

> -- |An expression, the root of an expression tree.
> data Expr
>     = NAry NAryExpr
>     | Unary UnaryExpr
>     | Factor PLFactor
>     | Automaton (FSA Integer (Maybe String))
>       deriving (Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: 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
min :: Expr -> Expr -> Expr
$cmin :: Expr -> Expr -> Expr
max :: Expr -> Expr -> Expr
$cmax :: Expr -> Expr -> Expr
>= :: Expr -> Expr -> Bool
$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
compare :: Expr -> Expr -> Ordering
$ccompare :: Expr -> Expr -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [Expr]
$creadListPrec :: ReadPrec [Expr]
readPrec :: ReadPrec Expr
$creadPrec :: ReadPrec Expr
readList :: ReadS [Expr]
$creadList :: ReadS [Expr]
readsPrec :: Int -> ReadS Expr
$creadsPrec :: Int -> ReadS 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
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show)

> -- |A subexpression that consists of an n-ary operator and its operands.
> data NAryExpr
>     = Concatenation [Expr]
>     | Conjunction   [Expr]
>     | Disjunction   [Expr]
>     | Domination    [Expr]
>     | QuotientL     [Expr] -- ^@since 1.0
>     | QuotientR     [Expr] -- ^@since 1.0
>       deriving (NAryExpr -> NAryExpr -> Bool
(NAryExpr -> NAryExpr -> Bool)
-> (NAryExpr -> NAryExpr -> Bool) -> Eq NAryExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NAryExpr -> NAryExpr -> Bool
$c/= :: NAryExpr -> NAryExpr -> Bool
== :: NAryExpr -> NAryExpr -> Bool
$c== :: NAryExpr -> NAryExpr -> Bool
Eq, Eq NAryExpr
Eq NAryExpr
-> (NAryExpr -> NAryExpr -> Ordering)
-> (NAryExpr -> NAryExpr -> Bool)
-> (NAryExpr -> NAryExpr -> Bool)
-> (NAryExpr -> NAryExpr -> Bool)
-> (NAryExpr -> NAryExpr -> Bool)
-> (NAryExpr -> NAryExpr -> NAryExpr)
-> (NAryExpr -> NAryExpr -> NAryExpr)
-> Ord NAryExpr
NAryExpr -> NAryExpr -> Bool
NAryExpr -> NAryExpr -> Ordering
NAryExpr -> NAryExpr -> NAryExpr
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
min :: NAryExpr -> NAryExpr -> NAryExpr
$cmin :: NAryExpr -> NAryExpr -> NAryExpr
max :: NAryExpr -> NAryExpr -> NAryExpr
$cmax :: NAryExpr -> NAryExpr -> NAryExpr
>= :: NAryExpr -> NAryExpr -> Bool
$c>= :: NAryExpr -> NAryExpr -> Bool
> :: NAryExpr -> NAryExpr -> Bool
$c> :: NAryExpr -> NAryExpr -> Bool
<= :: NAryExpr -> NAryExpr -> Bool
$c<= :: NAryExpr -> NAryExpr -> Bool
< :: NAryExpr -> NAryExpr -> Bool
$c< :: NAryExpr -> NAryExpr -> Bool
compare :: NAryExpr -> NAryExpr -> Ordering
$ccompare :: NAryExpr -> NAryExpr -> Ordering
$cp1Ord :: Eq NAryExpr
Ord, ReadPrec [NAryExpr]
ReadPrec NAryExpr
Int -> ReadS NAryExpr
ReadS [NAryExpr]
(Int -> ReadS NAryExpr)
-> ReadS [NAryExpr]
-> ReadPrec NAryExpr
-> ReadPrec [NAryExpr]
-> Read NAryExpr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NAryExpr]
$creadListPrec :: ReadPrec [NAryExpr]
readPrec :: ReadPrec NAryExpr
$creadPrec :: ReadPrec NAryExpr
readList :: ReadS [NAryExpr]
$creadList :: ReadS [NAryExpr]
readsPrec :: Int -> ReadS NAryExpr
$creadsPrec :: Int -> ReadS NAryExpr
Read, Int -> NAryExpr -> ShowS
[NAryExpr] -> ShowS
NAryExpr -> String
(Int -> NAryExpr -> ShowS)
-> (NAryExpr -> String) -> ([NAryExpr] -> ShowS) -> Show NAryExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NAryExpr] -> ShowS
$cshowList :: [NAryExpr] -> ShowS
show :: NAryExpr -> String
$cshow :: NAryExpr -> String
showsPrec :: Int -> NAryExpr -> ShowS
$cshowsPrec :: Int -> NAryExpr -> ShowS
Show)

> -- |A subexpression that consists of a unary operator and its operand.
> data UnaryExpr
>     = DownClose Expr -- ^@since 1.0
>     | Iteration Expr
>     | Negation Expr
>     | Tierify [SymSet] Expr
>       deriving (UnaryExpr -> UnaryExpr -> Bool
(UnaryExpr -> UnaryExpr -> Bool)
-> (UnaryExpr -> UnaryExpr -> Bool) -> Eq UnaryExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnaryExpr -> UnaryExpr -> Bool
$c/= :: UnaryExpr -> UnaryExpr -> Bool
== :: UnaryExpr -> UnaryExpr -> Bool
$c== :: UnaryExpr -> UnaryExpr -> Bool
Eq, Eq UnaryExpr
Eq UnaryExpr
-> (UnaryExpr -> UnaryExpr -> Ordering)
-> (UnaryExpr -> UnaryExpr -> Bool)
-> (UnaryExpr -> UnaryExpr -> Bool)
-> (UnaryExpr -> UnaryExpr -> Bool)
-> (UnaryExpr -> UnaryExpr -> Bool)
-> (UnaryExpr -> UnaryExpr -> UnaryExpr)
-> (UnaryExpr -> UnaryExpr -> UnaryExpr)
-> Ord UnaryExpr
UnaryExpr -> UnaryExpr -> Bool
UnaryExpr -> UnaryExpr -> Ordering
UnaryExpr -> UnaryExpr -> UnaryExpr
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
min :: UnaryExpr -> UnaryExpr -> UnaryExpr
$cmin :: UnaryExpr -> UnaryExpr -> UnaryExpr
max :: UnaryExpr -> UnaryExpr -> UnaryExpr
$cmax :: UnaryExpr -> UnaryExpr -> UnaryExpr
>= :: UnaryExpr -> UnaryExpr -> Bool
$c>= :: UnaryExpr -> UnaryExpr -> Bool
> :: UnaryExpr -> UnaryExpr -> Bool
$c> :: UnaryExpr -> UnaryExpr -> Bool
<= :: UnaryExpr -> UnaryExpr -> Bool
$c<= :: UnaryExpr -> UnaryExpr -> Bool
< :: UnaryExpr -> UnaryExpr -> Bool
$c< :: UnaryExpr -> UnaryExpr -> Bool
compare :: UnaryExpr -> UnaryExpr -> Ordering
$ccompare :: UnaryExpr -> UnaryExpr -> Ordering
$cp1Ord :: Eq UnaryExpr
Ord, ReadPrec [UnaryExpr]
ReadPrec UnaryExpr
Int -> ReadS UnaryExpr
ReadS [UnaryExpr]
(Int -> ReadS UnaryExpr)
-> ReadS [UnaryExpr]
-> ReadPrec UnaryExpr
-> ReadPrec [UnaryExpr]
-> Read UnaryExpr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnaryExpr]
$creadListPrec :: ReadPrec [UnaryExpr]
readPrec :: ReadPrec UnaryExpr
$creadPrec :: ReadPrec UnaryExpr
readList :: ReadS [UnaryExpr]
$creadList :: ReadS [UnaryExpr]
readsPrec :: Int -> ReadS UnaryExpr
$creadsPrec :: Int -> ReadS UnaryExpr
Read, Int -> UnaryExpr -> ShowS
[UnaryExpr] -> ShowS
UnaryExpr -> String
(Int -> UnaryExpr -> ShowS)
-> (UnaryExpr -> String)
-> ([UnaryExpr] -> ShowS)
-> Show UnaryExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnaryExpr] -> ShowS
$cshowList :: [UnaryExpr] -> ShowS
show :: UnaryExpr -> String
$cshow :: UnaryExpr -> String
showsPrec :: Int -> UnaryExpr -> ShowS
$cshowsPrec :: Int -> UnaryExpr -> ShowS
Show)

> -- |A subexpression representing a single Piecewise-Local factor.
> data PLFactor
>     = PLFactor Bool Bool [[SymSet]]
>       deriving (PLFactor -> PLFactor -> Bool
(PLFactor -> PLFactor -> Bool)
-> (PLFactor -> PLFactor -> Bool) -> Eq PLFactor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLFactor -> PLFactor -> Bool
$c/= :: PLFactor -> PLFactor -> Bool
== :: PLFactor -> PLFactor -> Bool
$c== :: 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
min :: PLFactor -> PLFactor -> PLFactor
$cmin :: PLFactor -> PLFactor -> PLFactor
max :: PLFactor -> PLFactor -> PLFactor
$cmax :: PLFactor -> PLFactor -> PLFactor
>= :: PLFactor -> PLFactor -> Bool
$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
compare :: PLFactor -> PLFactor -> Ordering
$ccompare :: PLFactor -> PLFactor -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [PLFactor]
$creadListPrec :: ReadPrec [PLFactor]
readPrec :: ReadPrec PLFactor
$creadPrec :: ReadPrec PLFactor
readList :: ReadS [PLFactor]
$creadList :: ReadS [PLFactor]
readsPrec :: Int -> ReadS PLFactor
$creadsPrec :: Int -> ReadS 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
showList :: [PLFactor] -> ShowS
$cshowList :: [PLFactor] -> ShowS
show :: PLFactor -> String
$cshow :: PLFactor -> String
showsPrec :: Int -> PLFactor -> ShowS
$cshowsPrec :: Int -> PLFactor -> ShowS
Show)

> -- |A set of symbols.
> type SymSet = Set String

> -- |Parse an input string and create a stringset-automaton from the result.
> -- If there is an error while parsing, the result is the string "no parse".
> readPleb :: String -> Either String (FSA Integer String)
> readPleb :: String -> Either String (FSA Integer String)
readPleb = Either String (FSA Integer String)
-> (FSA Integer (Maybe String)
    -> Either String (FSA Integer String))
-> Maybe (FSA Integer (Maybe String))
-> Either String (FSA Integer String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (FSA Integer String)
forall a b. a -> Either a b
Left String
"no parse") (FSA Integer String -> Either String (FSA Integer String)
forall a b. b -> Either a b
Right (FSA Integer String -> Either String (FSA Integer String))
-> (FSA Integer (Maybe String) -> FSA Integer String)
-> FSA Integer (Maybe String)
-> Either String (FSA 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) (Maybe (FSA Integer (Maybe String))
 -> Either String (FSA Integer String))
-> (String -> Maybe (FSA Integer (Maybe String)))
-> String
-> Either String (FSA Integer String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>            (String -> Maybe (FSA Integer (Maybe String)))
-> ((Env, [Token]) -> Maybe (FSA Integer (Maybe String)))
-> Either String (Env, [Token])
-> 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) (Env -> Maybe (FSA Integer (Maybe String))
makeAutomaton (Env -> Maybe (FSA Integer (Maybe String)))
-> ((Env, [Token]) -> Env)
-> (Env, [Token])
-> Maybe (FSA Integer (Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env, [Token]) -> Env
forall a b. (a, b) -> a
fst) (Either String (Env, [Token])
 -> Maybe (FSA Integer (Maybe String)))
-> (String -> Either String (Env, [Token]))
-> String
-> Maybe (FSA Integer (Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>            Parse Env -> [Token] -> Either String (Env, [Token])
forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse (Env -> Parse Env
parseStatements (Set (String, SymSet)
forall a. Set a
Set.empty, Set (String, Expr)
forall a. Set a
Set.empty, Maybe Expr
forall a. Maybe a
Nothing)) ([Token] -> Either String (Env, [Token]))
-> (String -> [Token]) -> String -> Either String (Env, [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
str  =  (String -> Env)
-> ((Env, [Token]) -> Env) -> Either String (Env, [Token]) -> 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, [Token]) -> Env
forall a. (Env, [a]) -> Env
f (Either String (Env, [Token]) -> Env)
-> ([Token] -> Either String (Env, [Token])) -> [Token] -> Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                        Parse Env -> [Token] -> Either String (Env, [Token])
forall a. Parse a -> [Token] -> Either String (a, [Token])
doParse (Env -> Parse Env
parseStatements Env
d) ([Token] -> Env) -> [Token] -> Env
forall a b. (a -> b) -> a -> b
$
>                        String -> [Token]
tokenize String
str
>     where f :: (Env, [a]) -> Env
f (Env
x, [])  =  Env
x
>           f (Env, [a])
_        =  Env
d

> -- |Add a new expression to the environment, call it "@(it)@".
> insertExpr :: Env -> Expr -> Env
> insertExpr :: Env -> Expr -> Env
insertExpr (Set (String, SymSet)
dict, Set (String, Expr)
subexprs, Maybe Expr
_) Expr
e
>     = Env -> String -> Env
doStatements (Set (String, SymSet)
dict, String -> Expr -> Set (String, Expr) -> Set (String, Expr)
forall a. Ord a => String -> a -> Dictionary a -> Dictionary a
define String
"it" Expr
e Set (String, Expr)
subexprs, Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e) String
"= it it"

> -- |Transform all saved expressions into automata to prevent reevaluation.
> compileEnv :: Env -> Env
> compileEnv :: Env -> Env
compileEnv (Set (String, SymSet)
dict, Set (String, Expr)
subexprs, Maybe Expr
e) = (Set (String, SymSet)
dict, ((String, Expr) -> (String, Expr))
-> Set (String, Expr) -> Set (String, Expr)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap ((Expr -> Expr) -> (String, Expr) -> (String, Expr)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapsnd Expr -> Expr
f) Set (String, Expr)
subexprs, Expr -> Expr
f (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
e)
>     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 (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))
-> (Expr -> FSA (Set (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 (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))
-> (Expr -> FSA Integer (Maybe String))
-> Expr
-> FSA (Set (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 (Set (String, SymSet)
dict, Set (String, Expr)
subexprs, Maybe Expr
e) = (Set (String, SymSet)
dict, ((String, Expr) -> (String, Expr))
-> Set (String, Expr) -> Set (String, Expr)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap ((Expr -> Expr) -> (String, Expr) -> (String, Expr)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapsnd Expr -> Expr
f) Set (String, Expr)
subexprs, Expr -> Expr
f (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
e)
>     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 (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 (Set Integer)) String -> FSA Integer String)
-> (Expr -> FSA (Set (Set Integer)) String)
-> Expr
-> FSA Integer String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer String -> FSA (Set (Set Integer)) String
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize (FSA Integer String -> FSA (Set (Set Integer)) String)
-> (Expr -> FSA Integer String)
-> Expr
-> FSA (Set (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
. SymSet -> 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 SymSet
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 :: SymSet
universe = (String -> SymSet)
-> (SymSet -> SymSet) -> Either String SymSet -> SymSet
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SymSet -> String -> SymSet
forall a b. a -> b -> a
const SymSet
forall a. Set a
Set.empty) SymSet -> SymSet
forall a. a -> a
id (String -> Set (String, SymSet) -> Either String SymSet
forall a. Ord a => String -> Dictionary a -> Either String a
definition String
"universe" Set (String, SymSet)
dict)

=====
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 (Set (String, SymSet)
dict, Set (String, Expr)
subexprs, Maybe Expr
v)
>     = ( ((String, SymSet) -> (String, SymSet))
-> Set (String, SymSet) -> Set (String, SymSet)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap ((SymSet -> SymSet) -> (String, SymSet) -> (String, SymSet)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapsnd SymSet -> SymSet
restrictUniverseS) Set (String, SymSet)
dict
>       , ((String, Expr) -> (String, Expr))
-> Set (String, Expr) -> Set (String, Expr)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap ((Expr -> Expr) -> (String, Expr) -> (String, Expr)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapsnd Expr -> Expr
restrictUniverseE) Set (String, Expr)
subexprs
>       , Expr -> Expr
restrictUniverseE (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
v
>       )
>     where universe :: SymSet
universe           =  (String -> SymSet)
-> (SymSet -> SymSet) -> Either String SymSet -> SymSet
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SymSet -> String -> SymSet
forall a b. a -> b -> a
const SymSet
forall a. Set a
Set.empty) SymSet -> SymSet
forall a. a -> a
id (Either String SymSet -> SymSet) -> Either String SymSet -> SymSet
forall a b. (a -> b) -> a -> b
$
>                                 String -> Set (String, SymSet) -> Either String SymSet
forall a. Ord a => String -> Dictionary a -> Either String a
definition String
"universe" Set (String, SymSet)
dict
>           restrictUniverseS :: SymSet -> SymSet
restrictUniverseS  =  SymSet -> SymSet -> SymSet
forall c a. (Container c a, Eq a) => c -> c -> c
intersection SymSet
universe
>           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) -> SymSet -> 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 SymSet
universe))
>                            FSA Integer (Maybe String)
x
>                    Factor (PLFactor Bool
h Bool
t [[SymSet]]
ps)
>                        -> Bool -> Bool -> [[SymSet]] -> Expr
fixFactor Bool
h Bool
t ([[SymSet]] -> Expr) -> [[SymSet]] -> Expr
forall a b. (a -> b) -> a -> b
$ ([SymSet] -> [SymSet]) -> [[SymSet]] -> [[SymSet]]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap ((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]]
ps
>                    NAry (Concatenation [Expr]
es)  ->  ([Expr] -> NAryExpr) -> [Expr] -> Expr
f [Expr] -> NAryExpr
Concatenation [Expr]
es
>                    NAry (Conjunction [Expr]
es)    ->  ([Expr] -> NAryExpr) -> [Expr] -> Expr
f [Expr] -> NAryExpr
Conjunction [Expr]
es
>                    NAry (Disjunction [Expr]
es)    ->  ([Expr] -> NAryExpr) -> [Expr] -> Expr
f [Expr] -> NAryExpr
Disjunction [Expr]
es
>                    NAry (Domination [Expr]
es)     ->  ([Expr] -> NAryExpr) -> [Expr] -> Expr
f [Expr] -> NAryExpr
Domination [Expr]
es
>                    NAry (QuotientL [Expr]
es)      ->  ([Expr] -> NAryExpr) -> [Expr] -> Expr
f [Expr] -> NAryExpr
QuotientL [Expr]
es
>                    NAry (QuotientR [Expr]
es)      ->  ([Expr] -> NAryExpr) -> [Expr] -> Expr
f [Expr] -> NAryExpr
QuotientR [Expr]
es
>                    Unary (DownClose Expr
ex)     ->  (Expr -> UnaryExpr) -> Expr -> Expr
g Expr -> UnaryExpr
DownClose Expr
ex
>                    Unary (Iteration Expr
ex)     ->  (Expr -> UnaryExpr) -> Expr -> Expr
g Expr -> UnaryExpr
Iteration Expr
ex
>                    Unary (Negation Expr
ex)      ->  (Expr -> UnaryExpr) -> Expr -> Expr
g Expr -> UnaryExpr
Negation Expr
ex
>                    Unary (Tierify [SymSet]
ts Expr
ex)
>                        -> (Expr -> UnaryExpr) -> Expr -> Expr
g ([SymSet] -> Expr -> UnaryExpr
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
>           f :: ([Expr] -> NAryExpr) -> [Expr] -> Expr
f [Expr] -> NAryExpr
t [Expr]
es = NAryExpr -> Expr
NAry ([Expr] -> NAryExpr
t ([Expr] -> NAryExpr) -> [Expr] -> NAryExpr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr) -> [Expr] -> [Expr]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap Expr -> Expr
restrictUniverseE [Expr]
es)
>           g :: (Expr -> UnaryExpr) -> Expr -> Expr
g Expr -> UnaryExpr
t Expr
e  = UnaryExpr -> Expr
Unary (Expr -> UnaryExpr
t (Expr -> UnaryExpr) -> Expr -> UnaryExpr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
restrictUniverseE Expr
e)
>           fixFactor :: Bool -> Bool -> [[SymSet]] -> Expr
fixFactor Bool
h Bool
t [[SymSet]]
ps
>               | ([SymSet] -> Bool) -> [[SymSet]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((SymSet -> Bool) -> [SymSet] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SymSet -> Bool
forall c a. Container c a => c -> Bool
isEmpty) [[SymSet]]
ps
>                   = UnaryExpr -> Expr
Unary (Expr -> UnaryExpr
Negation (PLFactor -> Expr
Factor (Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
False Bool
False [])))
>                     -- <> and ~<> are essentially True and False
>               | Bool
otherwise = PLFactor -> Expr
Factor (Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
h Bool
t [[SymSet]]
ps)

> -- |Create an 'FSA' from an expression tree and environment,
> -- complete with metadata regarding the constraint(s) it represents.
> makeAutomaton :: Env -> Maybe (FSA Integer (Maybe String))
> makeAutomaton :: Env -> Maybe (FSA Integer (Maybe String))
makeAutomaton (Set (String, SymSet)
dict, Set (String, Expr)
_, Maybe Expr
e) = FSA Integer (Maybe String) -> FSA Integer (Maybe String)
forall e n. (Ord e, Ord n) => FSA n e -> FSA Integer e
normalize (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
>                              SymSet -> 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 SymSet
symsets (FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> (Expr -> FSA Integer (Maybe String))
-> Expr
-> FSA Integer (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
>                              Expr -> FSA Integer (Maybe String)
automatonFromExpr (Expr -> FSA Integer (Maybe String))
-> Maybe Expr -> Maybe (FSA Integer (Maybe String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expr
e
>     where symsets :: SymSet
symsets = (String -> SymSet)
-> (SymSet -> SymSet) -> Either String SymSet -> SymSet
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SymSet -> String -> SymSet
forall a b. a -> b -> a
const SymSet
forall a. Set a
Set.empty) SymSet -> SymSet
forall a. a -> a
id (Either String SymSet -> SymSet) -> Either String SymSet -> SymSet
forall a b. (a -> b) -> a -> b
$
>                     String -> Set (String, SymSet) -> Either String SymSet
forall a. Ord a => String -> Dictionary a -> Either String a
definition String
"universe" Set (String, SymSet)
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 '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
>          Factor PLFactor
x                -> PLFactor -> FSA Integer (Maybe String)
automatonFromPLFactor PLFactor
x
>          NAry (Concatenation [Expr]
es) -> ([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 Integer (Maybe String)] -> FSA n e) -> [Expr] -> FSA n1 e
f [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall a. Monoid a => [a] -> a
mconcat [Expr]
es
>          NAry (Conjunction [Expr]
es)   -> ([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 Integer (Maybe String)] -> FSA n e) -> [Expr] -> FSA n1 e
f [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
>          NAry (Disjunction [Expr]
es)   -> ([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 Integer (Maybe String)] -> FSA n e) -> [Expr] -> FSA n1 e
f [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
>          NAry (Domination [Expr]
es)
>              -> ([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 Integer (Maybe String)] -> FSA n e) -> [Expr] -> FSA n1 e
f ([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)])
-> [FSA Integer (Maybe String)]
-> FSA Integer (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                    FSA Integer (Maybe String)
-> [FSA Integer (Maybe String)] -> [FSA Integer (Maybe String)]
forall a. a -> [a] -> [a]
intersperse (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 c a. Container c a => a -> c
singleton Maybe String
forall a. Maybe a
Nothing))
>                   ) [Expr]
es
>          NAry (QuotientL [Expr]
es)     -> ([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 Integer (Maybe String)] -> FSA n e) -> [Expr] -> FSA n1 e
f [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall n a.
(Enum n, Ord a, Ord n) =>
[FSA n (Maybe a)] -> FSA n (Maybe a)
ql [Expr]
es
>          NAry (QuotientR [Expr]
es)     -> ([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 Integer (Maybe String)] -> FSA n e) -> [Expr] -> FSA n1 e
f [FSA Integer (Maybe String)] -> FSA Integer (Maybe String)
forall (t :: * -> *) n a.
(Foldable t, Enum n, Ord a, Ord n) =>
t (FSA n (Maybe a)) -> FSA n (Maybe a)
qr [Expr]
es
>          Unary (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
>          Unary (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
>          Unary (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
>          Unary (Tierify [SymSet]
ts Expr
ex)
>              -> SymSet -> 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 ([SymSet] -> SymSet
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll [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
>     where f :: ([FSA Integer (Maybe String)] -> FSA n e) -> [Expr] -> FSA n1 e
f [FSA Integer (Maybe String)] -> FSA n e
tl = 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)
-> ([Expr] -> FSA (Set (Set n)) e) -> [Expr] -> FSA n1 e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> FSA (Set (Set n)) e
forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set (Set n)) e
minimize (FSA n e -> FSA (Set (Set n)) e)
-> ([Expr] -> FSA n e) -> [Expr] -> FSA (Set (Set n)) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FSA Integer (Maybe String)] -> FSA n e
tl ([FSA Integer (Maybe String)] -> FSA n e)
-> ([Expr] -> [FSA Integer (Maybe String)]) -> [Expr] -> FSA n e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> [FSA Integer (Maybe String)]
automata
>           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 (SymSet -> 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 (SymSet
 -> FSA Integer (Maybe String) -> FSA Integer (Maybe String))
-> SymSet
-> FSA Integer (Maybe String)
-> FSA Integer (Maybe String)
forall a b. (a -> b) -> a -> b
$ [FSA Integer (Maybe String)] -> SymSet
bigAlpha [FSA Integer (Maybe String)]
as) [FSA Integer (Maybe String)]
as
>           bigAlpha :: [FSA Integer (Maybe String)] -> SymSet
bigAlpha = (Maybe String -> SymSet -> SymSet)
-> SymSet -> Set (Maybe String) -> SymSet
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse ((SymSet -> SymSet)
-> (String -> SymSet -> SymSet) -> Maybe String -> SymSet -> SymSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SymSet -> SymSet
forall a. a -> a
id String -> SymSet -> SymSet
forall c a. Container c a => a -> c -> c
insert) SymSet
forall a. Set a
Set.empty (Set (Maybe String) -> SymSet)
-> ([FSA Integer (Maybe String)] -> Set (Maybe String))
-> [FSA Integer (Maybe String)]
-> SymSet
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 (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 (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet) Set (Maybe String)
forall a. Set a
Set.empty
>           ql :: [FSA n (Maybe a)] -> FSA n (Maybe a)
ql [FSA n (Maybe a)]
xs = if [FSA n (Maybe a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FSA n (Maybe a)]
xs
>                   then Set (Maybe a) -> FSA n (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 n (Maybe a) -> FSA n (Maybe a) -> FSA n (Maybe a))
-> [FSA n (Maybe a)] -> FSA n (Maybe a)
forall a. (a -> a -> a) -> [a] -> a
foldl1' (\FSA n (Maybe a)
a FSA n (Maybe a)
b -> FSA (Maybe (Either n ()), Maybe n) (Maybe a) -> FSA n (Maybe a)
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA (Maybe (Either n ()), Maybe n) (Maybe a) -> FSA n (Maybe a))
-> FSA (Maybe (Either n ()), Maybe n) (Maybe a) -> FSA n (Maybe a)
forall a b. (a -> b) -> a -> b
$ FSA n (Maybe a)
-> FSA n (Maybe a) -> FSA (Maybe (Either n ()), Maybe n) (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 n (Maybe a)
a FSA n (Maybe a)
b) [FSA n (Maybe a)]
xs
>           qr :: t (FSA n (Maybe a)) -> FSA n (Maybe a)
qr t (FSA n (Maybe a))
xs = if t (FSA n (Maybe a)) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t (FSA n (Maybe a))
xs
>                   then Set (Maybe a) -> FSA n (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 n (Maybe a) -> FSA n (Maybe a) -> FSA n (Maybe a))
-> t (FSA n (Maybe a)) -> FSA n (Maybe a)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\FSA n (Maybe a)
a FSA n (Maybe a)
b -> FSA Integer (Maybe a) -> FSA n (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 n (Maybe a))
-> FSA Integer (Maybe a) -> FSA n (Maybe a)
forall a b. (a -> b) -> a -> b
$ FSA n (Maybe a) -> FSA n (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 n (Maybe a)
a FSA n (Maybe a)
b) t (FSA n (Maybe a))
xs

> automatonFromPLFactor :: PLFactor -> FSA Integer (Maybe String)
> automatonFromPLFactor :: PLFactor -> FSA Integer (Maybe String)
automatonFromPLFactor (PLFactor Bool
h Bool
t [[SymSet]]
pieces)
>     | [[SymSet]] -> Bool
forall c a. Container c a => c -> Bool
isEmpty [[SymSet]]
pieces  =  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)]] -> Bool
forall c a. Container c a => c -> Bool
isEmpty [[Set (Maybe String)]]
ps      =  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)
>     | Bool
isPF            =  Factor (Maybe String) -> FSA Integer (Maybe String)
bl ([Set (Maybe String)] -> Factor (Maybe String)
forall e. [Set e] -> Factor e
Subsequence ([[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)))
>     | Bool
otherwise       =  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 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))
-> (SymSet -> Set (Maybe String)) -> SymSet -> Set (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String) -> SymSet -> 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 (SymSet -> Set (Maybe String)) -> SymSet -> Set (Maybe String)
forall a b. (a -> b) -> a -> b
$
>                           [SymSet] -> SymSet
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll ([[SymSet]] -> [SymSet]
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll [[SymSet]]
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
>           ([Set (Maybe String)]
p:[[Set (Maybe String)]]
ps)       =  ([SymSet] -> [Set (Maybe String)])
-> [[SymSet]] -> [[Set (Maybe String)]]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap ((SymSet -> Set (Maybe String)) -> [SymSet] -> [Set (Maybe String)]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap ((String -> Maybe String) -> SymSet -> 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)) [[SymSet]]
pieces
>           isPF :: Bool
isPF         =  Bool -> Bool
not Bool
h Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
t Bool -> Bool -> Bool
&&
>                           ([SymSet] -> Bool) -> [[SymSet]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([()] -> [()] -> Bool
forall a. Eq a => a -> a -> Bool
(==) [()] ([()] -> Bool) -> ([SymSet] -> [()]) -> [SymSet] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymSet -> ()) -> [SymSet] -> [()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> SymSet -> ()
forall a b. a -> b -> a
const ())) [[SymSet]]
pieces
>           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
>           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]]
_       =  []

> usedSymbols :: Expr -> SymSet
> usedSymbols :: Expr -> SymSet
usedSymbols Expr
e = case Expr
e
>                 of Automaton FSA Integer (Maybe String)
a  ->  (Maybe String -> SymSet -> SymSet)
-> SymSet -> Set (Maybe String) -> SymSet
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse ((SymSet -> SymSet)
-> (String -> SymSet -> SymSet) -> Maybe String -> SymSet -> SymSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SymSet -> SymSet
forall a. a -> a
id String -> SymSet -> SymSet
forall c a. Container c a => a -> c -> c
insert) SymSet
forall a. Set a
Set.empty (Set (Maybe String) -> SymSet) -> Set (Maybe String) -> SymSet
forall a b. (a -> b) -> a -> b
$
>                                     FSA Integer (Maybe String) -> Set (Maybe String)
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet FSA Integer (Maybe String)
a
>                    Factor PLFactor
f     ->  PLFactor -> SymSet
usedSymbolsF PLFactor
f
>                    NAry NAryExpr
n       ->  NAryExpr -> SymSet
usedSymbolsN NAryExpr
n
>                    Unary UnaryExpr
u      ->  UnaryExpr -> SymSet
usedSymbolsU UnaryExpr
u
>     where us :: c Expr -> SymSet
us c Expr
es = (Expr -> SymSet -> SymSet) -> SymSet -> c Expr -> SymSet
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (SymSet -> SymSet -> SymSet
forall c a. Container c a => c -> c -> c
union (SymSet -> SymSet -> SymSet)
-> (Expr -> SymSet) -> Expr -> SymSet -> SymSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> SymSet
usedSymbols) SymSet
forall a. Set a
Set.empty (c Expr -> SymSet) -> c Expr -> SymSet
forall a b. (a -> b) -> a -> b
$ c Expr
es
>           usedSymbolsN :: NAryExpr -> SymSet
usedSymbolsN (Concatenation [Expr]
es)  =  [Expr] -> SymSet
forall (c :: * -> *). Collapsible c => c Expr -> SymSet
us [Expr]
es
>           usedSymbolsN (Conjunction [Expr]
es)    =  [Expr] -> SymSet
forall (c :: * -> *). Collapsible c => c Expr -> SymSet
us [Expr]
es
>           usedSymbolsN (Disjunction [Expr]
es)    =  [Expr] -> SymSet
forall (c :: * -> *). Collapsible c => c Expr -> SymSet
us [Expr]
es
>           usedSymbolsN (Domination [Expr]
es)     =  [Expr] -> SymSet
forall (c :: * -> *). Collapsible c => c Expr -> SymSet
us [Expr]
es
>           usedSymbolsN (QuotientL [Expr]
es)      =  [Expr] -> SymSet
forall (c :: * -> *). Collapsible c => c Expr -> SymSet
us [Expr]
es
>           usedSymbolsN (QuotientR [Expr]
es)      =  [Expr] -> SymSet
forall (c :: * -> *). Collapsible c => c Expr -> SymSet
us [Expr]
es
>           usedSymbolsU :: UnaryExpr -> SymSet
usedSymbolsU (DownClose Expr
ex)      =  Expr -> SymSet
usedSymbols Expr
ex
>           usedSymbolsU (Iteration Expr
ex)      =  Expr -> SymSet
usedSymbols Expr
ex
>           usedSymbolsU (Negation Expr
ex)       =  Expr -> SymSet
usedSymbols Expr
ex
>           usedSymbolsU (Tierify [SymSet]
ts Expr
_)      =  [SymSet] -> SymSet
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll [SymSet]
ts
>           usedSymbolsF :: PLFactor -> SymSet
usedSymbolsF (PLFactor Bool
_ Bool
_ [[SymSet]]
ps)   =  [SymSet] -> SymSet
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll ([SymSet] -> SymSet) -> [SymSet] -> SymSet
forall a b. (a -> b) -> a -> b
$ [[SymSet]] -> [SymSet]
forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll [[SymSet]]
ps

> parseStatements :: Env -> Parse Env
> parseStatements :: Env -> Parse Env
parseStatements (Set (String, SymSet)
dict, Set (String, Expr)
subexprs, Maybe Expr
prev)
>     = [Parse Env] -> Parse Env
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parse Env] -> Parse Env) -> [Parse Env] -> Parse Env
forall a b. (a -> b) -> a -> b
$
>       [ Parse [Any]
forall a. Parse [a]
start Parse [Any] -> Parse Env -> Parse Env
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
>         (Bool -> String -> Maybe Expr -> Env
f Bool
False (String -> Maybe Expr -> Env)
-> Parse String -> Parse (Maybe Expr -> Env)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse String
getName Parse (Maybe Expr -> Env) -> Parse (Maybe Expr) -> Parse Env
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Parse Expr -> Parse (Maybe Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (String, SymSet) -> Set (String, Expr) -> Parse Expr
parseExpr Set (String, SymSet)
dict Set (String, Expr)
subexprs)) Parse Env -> (Env -> Parse Env) -> Parse Env
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
>         Env -> Parse Env
parseStatements
>       , Parse [Any]
forall a. Parse [a]
start Parse [Any] -> Parse Env -> Parse Env
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Set (String, SymSet) -> Env
forall a. a -> (a, Set (String, Expr), Maybe Expr)
putFst (Set (String, SymSet) -> Env)
-> Parse (Set (String, SymSet)) -> Parse Env
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
>         (String -> SymSet -> Set (String, SymSet) -> Set (String, SymSet)
mkSyms (String -> SymSet -> Set (String, SymSet) -> Set (String, SymSet))
-> Parse String
-> Parse (SymSet -> Set (String, SymSet) -> Set (String, SymSet))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse String
getName Parse (SymSet -> Set (String, SymSet) -> Set (String, SymSet))
-> Parse SymSet
-> Parse (Set (String, SymSet) -> Set (String, SymSet))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set (String, SymSet) -> Parse SymSet
parseSymExpr Set (String, SymSet)
dict Parse (Set (String, SymSet) -> Set (String, SymSet))
-> Parse (Set (String, SymSet)) -> Parse (Set (String, SymSet))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
>          Set (String, SymSet) -> Parse (Set (String, SymSet))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (String, SymSet)
dict
>         ) Parse Env -> (Env -> Parse Env) -> Parse Env
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
>         Env -> Parse Env
parseStatements
>       , Bool -> String -> Maybe Expr -> Env
f Bool
True String
"it" (Maybe Expr -> Env) -> (Expr -> Maybe Expr) -> Expr -> Env
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Env) -> Parse Expr -> Parse Env
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (String, SymSet) -> Set (String, Expr) -> Parse Expr
parseExpr Set (String, SymSet)
dict Set (String, Expr)
subexprs
>       , ([Token] -> Either String (Env, [Token])) -> Parse Env
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse (([Token] -> Either String (Env, [Token])) -> Parse Env)
-> ([Token] -> Either String (Env, [Token])) -> Parse Env
forall a b. (a -> b) -> a -> b
$ \[Token]
ts ->
>         case [Token]
ts
>         of []  ->  (Env, [Token]) -> Either String (Env, [Token])
forall a b. b -> Either a b
Right ((Set (String, SymSet)
dict, Set (String, Expr)
subexprs, Maybe Expr
prev), [])
>            [Token]
_   ->  String -> Either String (Env, [Token])
forall a b. a -> Either a b
Left 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]))
-> 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
"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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> [a] -> Parse [a]
forall a. String -> a -> Parse a
eat String
"=" []
>          putFst :: a -> (a, Set (String, Expr), Maybe Expr)
putFst a
a = (a
a, Set (String, Expr)
subexprs, Maybe Expr
prev)
>          universe :: SymSet
universe = (String -> SymSet)
-> (SymSet -> SymSet) -> Either String SymSet -> SymSet
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SymSet -> String -> SymSet
forall a b. a -> b -> a
const SymSet
forall a. Set a
Set.empty) SymSet -> SymSet
forall a. a -> a
id (Either String SymSet -> SymSet) -> Either String SymSet -> SymSet
forall a b. (a -> b) -> a -> b
$
>                     String -> Set (String, SymSet) -> Either String SymSet
forall a. Ord a => String -> Dictionary a -> Either String a
definition String
"universe" Set (String, SymSet)
dict
>          mkSyms :: String -> SymSet -> Set (String, SymSet) -> Set (String, SymSet)
mkSyms String
name SymSet
value
>              = String -> SymSet -> Set (String, SymSet) -> Set (String, SymSet)
forall a. Ord a => String -> a -> Dictionary a -> Dictionary a
define String
"universe"
>                (if String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"universe"
>                 then SymSet -> SymSet -> SymSet
forall c a. Container c a => c -> c -> c
union SymSet
universe SymSet
value
>                 else SymSet
value
>                ) (Set (String, SymSet) -> Set (String, SymSet))
-> (Set (String, SymSet) -> Set (String, SymSet))
-> Set (String, SymSet)
-> Set (String, SymSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SymSet -> Set (String, SymSet) -> Set (String, SymSet)
forall a. Ord a => String -> a -> Dictionary a -> Dictionary a
define String
name SymSet
value
>          f :: Bool -> String -> Maybe Expr -> Env
f Bool
isL String
name Maybe Expr
me
>              = let nd :: Set (String, SymSet)
nd = Set (String, SymSet)
-> (Expr -> Set (String, SymSet))
-> Maybe Expr
-> Set (String, SymSet)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
>                         Set (String, SymSet)
dict
>                         ((SymSet -> Set (String, SymSet) -> Set (String, SymSet))
-> Set (String, SymSet) -> SymSet -> Set (String, SymSet)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> SymSet -> Set (String, SymSet) -> Set (String, SymSet)
forall a. Ord a => String -> a -> Dictionary a -> Dictionary a
define String
"universe") Set (String, SymSet)
dict (SymSet -> Set (String, SymSet))
-> (Expr -> SymSet) -> Expr -> Set (String, SymSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                          SymSet -> SymSet -> SymSet
forall c a. Container c a => c -> c -> c
union SymSet
universe (SymSet -> SymSet) -> (Expr -> SymSet) -> Expr -> SymSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                          Expr -> SymSet
usedSymbols
>                         )
>                         Maybe Expr
me
>                in ( Set (String, SymSet)
nd
>                   , Set (String, Expr)
-> (Expr -> Set (String, Expr)) -> Maybe Expr -> Set (String, Expr)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set (String, Expr)
subexprs ((Expr -> Set (String, Expr) -> Set (String, Expr))
-> Set (String, Expr) -> Expr -> Set (String, Expr)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Expr -> Set (String, Expr) -> Set (String, Expr)
forall a. Ord a => String -> a -> Dictionary a -> Dictionary a
define String
name) Set (String, Expr)
subexprs) Maybe Expr
me
>                   , if Bool
isL then Maybe Expr
me else Maybe Expr
prev)

> -- |Parse an expression from a 'Token' stream.
> parseExpr :: Dictionary SymSet -> Dictionary Expr -> Parse Expr
> parseExpr :: Set (String, SymSet) -> Set (String, Expr) -> Parse Expr
parseExpr Set (String, SymSet)
dict Set (String, Expr)
subexprs = [Parse Expr] -> Parse Expr
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
>                           [ NAryExpr -> Expr
NAry    (NAryExpr -> Expr) -> Parse NAryExpr -> Parse Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Set (String, SymSet) -> Set (String, Expr) -> Parse NAryExpr
parseNAryExpr Set (String, SymSet)
dict Set (String, Expr)
subexprs
>                           , UnaryExpr -> Expr
Unary   (UnaryExpr -> Expr) -> Parse UnaryExpr -> Parse Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Set (String, SymSet) -> Set (String, Expr) -> Parse UnaryExpr
parseUnaryExpr Set (String, SymSet)
dict Set (String, Expr)
subexprs
>                           , PLFactor -> Expr
Factor  (PLFactor -> Expr) -> Parse PLFactor -> Parse Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Set (String, SymSet) -> Set (String, Expr) -> Parse PLFactor
parsePLFactor Set (String, SymSet)
dict Set (String, Expr)
subexprs
>                           , ([Token] -> Either String (Expr, [Token])) -> Parse Expr
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse [Token] -> Either String (Expr, [Token])
expandVar
>                           ]
>     where expandVar :: [Token] -> Either String (Expr, [Token])
expandVar (TName String
n : [Token]
ts)
>               = (Expr -> (Expr, [Token]))
-> Either String Expr -> Either String (Expr, [Token])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr -> [Token] -> (Expr, [Token]))
-> [Token] -> Expr -> (Expr, [Token])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [Token]
ts) (Either String Expr -> Either String (Expr, [Token]))
-> Either String Expr -> Either String (Expr, [Token])
forall a b. (a -> b) -> a -> b
$ String -> Set (String, Expr) -> Either String Expr
forall a. Ord a => String -> Dictionary a -> Either String a
definition String
n Set (String, Expr)
subexprs
>           expandVar [Token]
_ = String -> Either String (Expr, [Token])
forall a b. a -> Either a b
Left String
"not a variable"

> parseNAryExpr :: Dictionary SymSet -> Dictionary Expr -> Parse NAryExpr
> parseNAryExpr :: Set (String, SymSet) -> Set (String, Expr) -> Parse NAryExpr
parseNAryExpr Set (String, SymSet)
dict Set (String, Expr)
subexprs
>     = [([String], [Expr] -> NAryExpr)] -> Parse ([Expr] -> NAryExpr)
forall a. [([String], a)] -> Parse a
makeLifter
>       [ ([String
"⋀", String
"⋂", String
"∧", String
"∩", String
"/\\"],  [Expr] -> NAryExpr
Conjunction)
>       , ([String
"⋁", String
"⋃", String
"∨", String
"∪", String
"\\/"],  [Expr] -> NAryExpr
Disjunction)
>       , ([String
"\\\\"], [Expr] -> NAryExpr
QuotientL)
>       , ([String
"//"], [Expr] -> NAryExpr
QuotientR)
>       , ([String
"∙∙", String
"@@"],       [Expr] -> NAryExpr
Domination)
>       , ([String
"∙" , String
"@" ],       [Expr] -> NAryExpr
Concatenation)
>       ] Parse ([Expr] -> NAryExpr) -> Parse [Expr] -> Parse NAryExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
>       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
"," (Set (String, SymSet) -> Set (String, Expr) -> Parse Expr
parseExpr Set (String, SymSet)
dict Set (String, Expr)
subexprs))

> parseUnaryExpr :: Dictionary SymSet -> Dictionary Expr -> Parse UnaryExpr
> parseUnaryExpr :: Set (String, SymSet) -> Set (String, Expr) -> Parse UnaryExpr
parseUnaryExpr Set (String, SymSet)
dict Set (String, Expr)
subexprs
>     = ([([String], Expr -> UnaryExpr)] -> Parse (Expr -> UnaryExpr)
forall a. [([String], a)] -> Parse a
makeLifter
>        [ ([String
"↓", String
"$"],       Expr -> UnaryExpr
DownClose)
>        , ([String
"*", String
"∗"],       Expr -> UnaryExpr
Iteration)
>        , ([String
"¬", String
"~", String
"!"],  Expr -> UnaryExpr
Negation)
>        ] Parse (Expr -> UnaryExpr) -> Parse Expr -> Parse UnaryExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set (String, SymSet) -> Set (String, Expr) -> Parse Expr
parseExpr Set (String, SymSet)
dict Set (String, Expr)
subexprs
>       ) Parse UnaryExpr -> Parse UnaryExpr -> Parse UnaryExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([SymSet] -> Expr -> UnaryExpr
Tierify ([SymSet] -> Expr -> UnaryExpr)
-> Parse [SymSet] -> Parse (Expr -> UnaryExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse [SymSet]
pt Parse (Expr -> UnaryExpr) -> Parse Expr -> Parse UnaryExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set (String, SymSet) -> Set (String, Expr) -> Parse Expr
parseExpr Set (String, SymSet)
dict Set (String, Expr)
subexprs)
>     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
"," (Set (String, SymSet) -> Parse SymSet
parseSymExpr Set (String, SymSet)
dict))

> parsePLFactor :: Dictionary SymSet -> Dictionary Expr -> Parse PLFactor
> parsePLFactor :: Set (String, SymSet) -> Set (String, Expr) -> Parse PLFactor
parsePLFactor Set (String, SymSet)
dict Set (String, Expr)
subexprs
>     = String -> (PLFactor -> PLFactor -> PLFactor) -> Parse PLFactor
combine String
".." PLFactor -> PLFactor -> PLFactor
plGap Parse PLFactor -> Parse PLFactor -> Parse PLFactor
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
>       String -> (PLFactor -> PLFactor -> PLFactor) -> Parse PLFactor
combine String
"‥" PLFactor -> PLFactor -> PLFactor
plGap Parse PLFactor -> Parse PLFactor -> Parse PLFactor
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
>       String -> (PLFactor -> PLFactor -> PLFactor) -> Parse PLFactor
combine String
"." PLFactor -> PLFactor -> PLFactor
plCatenate Parse PLFactor -> Parse PLFactor -> Parse PLFactor
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
>       Parse PLFactor
pplf
>     where combine :: String -> (PLFactor -> PLFactor -> PLFactor) -> Parse PLFactor
combine String
s PLFactor -> PLFactor -> PLFactor
f = String
-> ([PLFactor] -> PLFactor) -> Parse ([PLFactor] -> PLFactor)
forall a. String -> a -> Parse a
eat String
s ((PLFactor -> PLFactor -> PLFactor) -> [PLFactor] -> PLFactor
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 PLFactor -> PLFactor -> PLFactor
f) Parse ([PLFactor] -> PLFactor)
-> Parse [PLFactor] -> Parse PLFactor
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 = Set (String, SymSet) -> Parse PLFactor
parseBasicPLFactor Set (String, SymSet)
dict Parse PLFactor -> Parse PLFactor -> Parse PLFactor
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])
expandVar)
>           expandVar :: [Token] -> Either String (PLFactor, [Token])
expandVar (TName String
n : [Token]
ts)
>               = case Either String Expr
v
>                 of Right (Factor PLFactor
x) -> (PLFactor, [Token]) -> Either String (PLFactor, [Token])
forall a b. b -> Either a b
Right (PLFactor
x, [Token]
ts)
>                    Either String Expr
_ -> String -> Either String (PLFactor, [Token])
forall a b. a -> Either a b
Left String
"expression does not represent a factor"
>               where v :: Either String Expr
v = String -> Set (String, Expr) -> Either String Expr
forall a. Ord a => String -> Dictionary a -> Either String a
definition String
n Set (String, Expr)
subexprs
>           expandVar [Token]
_ = String -> Either String (PLFactor, [Token])
forall a b. a -> Either a b
Left String
"not a variable"

> parseBasicPLFactor :: Dictionary SymSet -> Parse PLFactor
> parseBasicPLFactor :: Set (String, SymSet) -> Parse PLFactor
parseBasicPLFactor Set (String, SymSet)
dict
>     = [([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 (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]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Set (String, SymSet) -> Parse SymSet
parseSymExpr Set (String, SymSet)
dict)) Parse [[SymSet]] -> Parse [[SymSet]] -> Parse [[SymSet]]
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 :: Dictionary SymSet -> Parse SymSet
> parseSymExpr :: Set (String, SymSet) -> Parse SymSet
parseSymExpr Set (String, SymSet)
dict
>     = ((([SymSet] -> SymSet) -> Parse [SymSet] -> Parse SymSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SymSet] -> SymSet
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
>        (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
"," (Set (String, SymSet) -> Parse SymSet
parseSymExpr Set (String, SymSet)
dict))
>       Parse SymSet -> Parse SymSet -> Parse SymSet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
>        (([SymSet] -> SymSet) -> Parse [SymSet] -> Parse SymSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SymSet -> SymSet -> SymSet) -> [SymSet] -> SymSet
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 SymSet -> SymSet -> SymSet
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection)
>        (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
"," (Set (String, SymSet) -> Parse SymSet
parseSymExpr Set (String, SymSet)
dict))
>       Parse SymSet -> Parse SymSet -> Parse SymSet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
>        Set (String, SymSet) -> Parse SymSet
parseSymSet Set (String, SymSet)
dict)

> parseSymSet :: Dictionary SymSet -> Parse SymSet
> parseSymSet :: Set (String, SymSet) -> Parse SymSet
parseSymSet Set (String, SymSet)
dict
>     = ([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 -> (SymSet, [Token]))
-> Either String SymSet -> Either String (SymSet, [Token])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SymSet -> [Token] -> (SymSet, [Token]))
-> [Token] -> SymSet -> (SymSet, [Token])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [Token]
ts) (String -> Set (String, SymSet) -> Either String SymSet
forall a. Ord a => String -> Dictionary a -> Either String a
definition String
n Set (String, SymSet)
dict)
>          (TSymbol Char
'/' : TName String
n : [Token]
ts)
>              -> (SymSet, [Token]) -> Either String (SymSet, [Token])
forall a b. b -> Either a b
Right ((SymSet, [Token]) -> Either String (SymSet, [Token]))
-> (SymSet -> (SymSet, [Token]))
-> SymSet
-> Either String (SymSet, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymSet -> [Token] -> (SymSet, [Token]))
-> [Token] -> SymSet -> (SymSet, [Token])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [Token]
ts (SymSet -> Either String (SymSet, [Token]))
-> SymSet -> Either String (SymSet, [Token])
forall a b. (a -> b) -> a -> b
$ String -> SymSet
forall c a. Container c a => a -> c
singleton String
n
>          (Token
a:[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
"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
"unexpected end of input in SymSet"

> makeLifter :: [([String], a)] -> Parse a
> makeLifter :: [([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 :: 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 (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 -> Either String (a, [Token]))
-> String -> Either String (a, [Token])
forall a b. (a -> b) -> a -> b
$ String
""

> parseDelimited :: [Char] -> Parse [a] -> Parse [a]
> parseDelimited :: 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 (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 (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]))
-> String -> Either String (Char, [Token])
forall a b. (a -> b) -> a -> b
$
>                               String
"invalid opening delimiter: " 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
"unexpected end of input looking for opening delimiter"

> parseClosingDelimiter :: Char -> Parse [a]
> parseClosingDelimiter :: 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 :: 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parse a
p)



> plCatenate :: PLFactor -> PLFactor -> PLFactor
> plCatenate :: PLFactor -> PLFactor -> PLFactor
plCatenate (PLFactor Bool
h Bool
_ [[SymSet]]
xs) (PLFactor Bool
_ Bool
t [[SymSet]]
ys) = Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
h Bool
t ([[SymSet]] -> [[SymSet]] -> [[SymSet]]
forall a. [[a]] -> [[a]] -> [[a]]
pc [[SymSet]]
xs [[SymSet]]
ys)
>     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

> plGap :: PLFactor -> PLFactor -> PLFactor
> plGap :: PLFactor -> PLFactor -> PLFactor
plGap (PLFactor Bool
h Bool
_ [[SymSet]]
xs) (PLFactor Bool
_ Bool
t [[SymSet]]
ys) = Bool -> Bool -> [[SymSet]] -> PLFactor
PLFactor Bool
h Bool
t ([[SymSet]]
xs [[SymSet]] -> [[SymSet]] -> [[SymSet]]
forall a. [a] -> [a] -> [a]
++ [[SymSet]]
ys)



> -- |An association between names and values.
> type Dictionary a = Set (String, a)

> define :: (Ord a) => String -> a -> Dictionary a -> Dictionary a
> define :: String -> a -> Dictionary a -> Dictionary a
define String
name a
value = (String, a) -> Dictionary a -> Dictionary a
forall c a. Container c a => a -> c -> c
insert (String
name, a
value) (Dictionary a -> Dictionary a)
-> (Dictionary a -> Dictionary a) -> Dictionary a -> Dictionary a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, a) -> Bool) -> Dictionary a -> Dictionary a
forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
name) (String -> Bool) -> ((String, a) -> String) -> (String, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, a) -> String
forall a b. (a, b) -> a
fst)

> definition :: (Ord a) => String -> Dictionary a -> Either String a
> definition :: 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 -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"undefined variable \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"")
>                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
.
>                Set a -> Maybe a
forall a. Eq a => Set a -> Maybe a
lookupMin (Set a -> Maybe a)
-> (Dictionary a -> Set a) -> Dictionary a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, a) -> a) -> Dictionary a -> Set a
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (String, a) -> a
forall a b. (a, b) -> b
snd (Dictionary a -> Set a)
-> (Dictionary a -> Dictionary a) -> Dictionary a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, a) -> Bool) -> Dictionary a -> Dictionary a
forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
a) (String -> Bool) -> ((String, a) -> String) -> (String, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, a) -> String
forall a b. (a, b) -> a
fst)
>     where lookupMin :: Set a -> Maybe a
lookupMin Set a
xs
>               | Set a
xs Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== Set a
forall a. Set a
Set.empty = Maybe a
forall a. Maybe a
Nothing
>               | Bool
otherwise       = a -> Maybe a
forall a. a -> Maybe a
Just (Set a -> a
forall a. Set a -> a
Set.findMin Set a
xs)

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

> instance Functor Parse
>     where fmap :: (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 (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 :: a -> Parse a
pure a
x   =  ([Token] -> Either String (a, [Token])) -> Parse a
forall a. ([Token] -> Either String (a, [Token])) -> Parse a
Parse ((a, [Token]) -> Either String (a, [Token])
forall a b. b -> Either a b
Right ((a, [Token]) -> Either String (a, [Token]))
-> ([Token] -> (a, [Token]))
-> [Token]
-> Either String (a, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
x ([Token] -> (a, [Token]))
-> ([Token] -> [Token]) -> [Token] -> (a, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> [Token]
forall a. a -> a
id)
>           Parse (a -> b)
f <*> :: 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, [Token]) -> (b, [Token]))
-> Either String (a, [Token]) -> Either String (b, [Token])
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]))
-> Either String (a, [Token]) -> Either String (b, [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
x [Token]
s1
>                       in (String -> Either String (b, [Token]))
-> ((a -> b, [Token]) -> Either String (b, [Token]))
-> Either String (a -> b, [Token])
-> Either String (b, [Token])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String (b, [Token])
forall a b. a -> Either a b
Left (a -> b, [Token]) -> Either String (b, [Token])
forall b. (a -> b, [Token]) -> Either String (b, [Token])
h (Either String (a -> b, [Token]) -> Either String (b, [Token]))
-> Either String (a -> b, [Token]) -> Either String (b, [Token])
forall a b. (a -> b) -> a -> 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 :: 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 <|> :: 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 return :: a -> Parse a
return a
x  =  ([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
$ (a, [Token]) -> Either String (a, [Token])
forall a b. b -> Either a b
Right ((a, [Token]) -> Either String (a, [Token]))
-> ([Token] -> (a, [Token]))
-> [Token]
-> Either String (a, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
x ([Token] -> (a, [Token]))
-> ([Token] -> [Token]) -> [Token] -> (a, [Token])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> [Token]
forall a. a -> a
id
>           Parse a
p >>= :: 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 (String -> Either String (b, [Token]))
-> ((a, [Token]) -> Either String (b, [Token]))
-> Either String (a, [Token])
-> Either String (b, [Token])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String (b, [Token])
forall a b. a -> Either a b
Left (a, [Token]) -> Either String (b, [Token])
h (Either String (a, [Token]) -> Either String (b, [Token]))
-> Either String (a, [Token]) -> Either String (b, [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]
s0



> -- |Generate an expression (sub)tree from an '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

> -- |Generate an expression (sub)tree from an '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 :: [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 :: (a -> b) -> (a, c) -> (b, c)
mapfst a -> b
f (a
a, c
c) = (a -> b
f a
a, c
c)

> mapsnd :: (b -> c) -> (a, b) -> (a, c)
> mapsnd :: (b -> c) -> (a, b) -> (a, c)
mapsnd b -> c
f (a
a, b
b) = (a
a, b -> c
f b
b)

> matchingDelimiter :: Char -> Char
> matchingDelimiter :: Char -> Char
matchingDelimiter Char
x = ((Char, Char) -> Char -> Char) -> Char -> [(Char, Char)] -> Char
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
'}')
>                 ]