{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
module Copilot.Library.RegExp ( copilotRegexp, copilotRegexpB ) where
import Text.ParserCombinators.Parsec
( optional, (<|>), string, char, between, GenParser, many, choice, CharParser
, optionMaybe, chainr1, chainr, many1, digit, letter, eof, parse
, SourceName )
import Data.Int
import Data.Word
import Data.List
import Data.Char
import Data.Maybe
import Control.Monad.State ( evalState, get, modify )
import qualified Copilot.Language as C
data Sym t = Any | Sym t
deriving ( Sym t -> Sym t -> Bool
(Sym t -> Sym t -> Bool) -> (Sym t -> Sym t -> Bool) -> Eq (Sym t)
forall t. Eq t => Sym t -> Sym t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sym t -> Sym t -> Bool
$c/= :: forall t. Eq t => Sym t -> Sym t -> Bool
== :: Sym t -> Sym t -> Bool
$c== :: forall t. Eq t => Sym t -> Sym t -> Bool
Eq, Eq (Sym t)
Eq (Sym t)
-> (Sym t -> Sym t -> Ordering)
-> (Sym t -> Sym t -> Bool)
-> (Sym t -> Sym t -> Bool)
-> (Sym t -> Sym t -> Bool)
-> (Sym t -> Sym t -> Bool)
-> (Sym t -> Sym t -> Sym t)
-> (Sym t -> Sym t -> Sym t)
-> Ord (Sym t)
Sym t -> Sym t -> Bool
Sym t -> Sym t -> Ordering
Sym t -> Sym t -> Sym t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Ord t => Eq (Sym t)
forall t. Ord t => Sym t -> Sym t -> Bool
forall t. Ord t => Sym t -> Sym t -> Ordering
forall t. Ord t => Sym t -> Sym t -> Sym t
min :: Sym t -> Sym t -> Sym t
$cmin :: forall t. Ord t => Sym t -> Sym t -> Sym t
max :: Sym t -> Sym t -> Sym t
$cmax :: forall t. Ord t => Sym t -> Sym t -> Sym t
>= :: Sym t -> Sym t -> Bool
$c>= :: forall t. Ord t => Sym t -> Sym t -> Bool
> :: Sym t -> Sym t -> Bool
$c> :: forall t. Ord t => Sym t -> Sym t -> Bool
<= :: Sym t -> Sym t -> Bool
$c<= :: forall t. Ord t => Sym t -> Sym t -> Bool
< :: Sym t -> Sym t -> Bool
$c< :: forall t. Ord t => Sym t -> Sym t -> Bool
compare :: Sym t -> Sym t -> Ordering
$ccompare :: forall t. Ord t => Sym t -> Sym t -> Ordering
$cp1Ord :: forall t. Ord t => Eq (Sym t)
Ord, Int -> Sym t -> ShowS
[Sym t] -> ShowS
Sym t -> String
(Int -> Sym t -> ShowS)
-> (Sym t -> String) -> ([Sym t] -> ShowS) -> Show (Sym t)
forall t. Show t => Int -> Sym t -> ShowS
forall t. Show t => [Sym t] -> ShowS
forall t. Show t => Sym t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sym t] -> ShowS
$cshowList :: forall t. Show t => [Sym t] -> ShowS
show :: Sym t -> String
$cshow :: forall t. Show t => Sym t -> String
showsPrec :: Int -> Sym t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Sym t -> ShowS
Show )
data NumSym t = NumSym { NumSym t -> Maybe Int
symbolNum :: Maybe NumT
, NumSym t -> Sym t
symbol :: Sym t
} deriving ( NumSym t -> NumSym t -> Bool
(NumSym t -> NumSym t -> Bool)
-> (NumSym t -> NumSym t -> Bool) -> Eq (NumSym t)
forall t. Eq t => NumSym t -> NumSym t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumSym t -> NumSym t -> Bool
$c/= :: forall t. Eq t => NumSym t -> NumSym t -> Bool
== :: NumSym t -> NumSym t -> Bool
$c== :: forall t. Eq t => NumSym t -> NumSym t -> Bool
Eq, Int -> NumSym t -> ShowS
[NumSym t] -> ShowS
NumSym t -> String
(Int -> NumSym t -> ShowS)
-> (NumSym t -> String) -> ([NumSym t] -> ShowS) -> Show (NumSym t)
forall t. Show t => Int -> NumSym t -> ShowS
forall t. Show t => [NumSym t] -> ShowS
forall t. Show t => NumSym t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumSym t] -> ShowS
$cshowList :: forall t. Show t => [NumSym t] -> ShowS
show :: NumSym t -> String
$cshow :: forall t. Show t => NumSym t -> String
showsPrec :: Int -> NumSym t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> NumSym t -> ShowS
Show )
type NumT = Int
data RegExp t = REpsilon
| RSymbol ( NumSym t )
| ROr ( RegExp t ) ( RegExp t )
| RConcat ( RegExp t ) ( RegExp t )
| RStar ( RegExp t )
deriving Int -> RegExp t -> ShowS
[RegExp t] -> ShowS
RegExp t -> String
(Int -> RegExp t -> ShowS)
-> (RegExp t -> String) -> ([RegExp t] -> ShowS) -> Show (RegExp t)
forall t. Show t => Int -> RegExp t -> ShowS
forall t. Show t => [RegExp t] -> ShowS
forall t. Show t => RegExp t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegExp t] -> ShowS
$cshowList :: forall t. Show t => [RegExp t] -> ShowS
show :: RegExp t -> String
$cshow :: forall t. Show t => RegExp t -> String
showsPrec :: Int -> RegExp t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> RegExp t -> ShowS
Show
lquote, rquote, lparen, rparen,
star, plus, qmark, point, minus,
nondigit :: CharParser () Char
lquote :: CharParser () Char
lquote = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
rquote :: CharParser () Char
rquote = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
lparen :: CharParser () Char
lparen = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
rparen :: CharParser () Char
rparen = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
star :: CharParser () Char
star = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
plus :: CharParser () Char
plus = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
qmark :: CharParser () Char
qmark = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?'
point :: CharParser () Char
point = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
minus :: CharParser () Char
minus = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
nondigit :: CharParser () Char
nondigit = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_' CharParser () Char -> CharParser () Char -> CharParser () Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser () Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
followedBy :: GenParser tok () a
-> GenParser tok () b
-> GenParser tok () a
followedBy :: GenParser tok () a -> GenParser tok () b -> GenParser tok () a
followedBy GenParser tok () a
p GenParser tok () b
p' = GenParser tok () a
p GenParser tok () a
-> (a -> GenParser tok () a) -> GenParser tok () a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ a
r -> GenParser tok () b
p' GenParser tok () b -> GenParser tok () a -> GenParser tok () a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> GenParser tok () a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
cPrefix, optCPrefix :: GenParser tok () Char
-> GenParser tok () String
-> GenParser tok () String
cPrefix :: GenParser tok () Char
-> GenParser tok () String -> GenParser tok () String
cPrefix GenParser tok () Char
p GenParser tok () String
p' = GenParser tok () Char
p GenParser tok () Char
-> (Char -> GenParser tok () String) -> GenParser tok () String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Char
c -> ShowS -> GenParser tok () String -> GenParser tok () String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ) GenParser tok () String
p'
optCPrefix :: GenParser tok () Char
-> GenParser tok () String -> GenParser tok () String
optCPrefix GenParser tok () Char
p GenParser tok () String
p' = GenParser tok () Char -> ParsecT [tok] () Identity (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe GenParser tok () Char
p
ParsecT [tok] () Identity (Maybe Char)
-> (Maybe Char -> GenParser tok () String)
-> GenParser tok () String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe Char
r -> case Maybe Char
r of
Maybe Char
Nothing -> GenParser tok () String
p'
Just Char
c -> ShowS -> GenParser tok () String -> GenParser tok () String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ) GenParser tok () String
p'
ci :: String -> GenParser Char () String
ci :: String -> GenParser Char () String
ci = (Char -> CharParser () Char) -> String -> GenParser Char () String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ( \ Char
c -> ( Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> CharParser () Char)
-> (Char -> Char) -> Char -> CharParser () Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower ) Char
c CharParser () Char -> CharParser () Char -> CharParser () Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> CharParser () Char)
-> (Char -> Char) -> Char -> CharParser () Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper ) Char
c )
regexp :: ( SymbolParser t ) => GenParser Char () ( RegExp t )
regexp :: GenParser Char () (RegExp t)
regexp = GenParser Char () (RegExp t)
-> ParsecT String () Identity (RegExp t -> RegExp t -> RegExp t)
-> GenParser Char () (RegExp t)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainr1 GenParser Char () (RegExp t)
forall t. SymbolParser t => GenParser Char () (RegExp t)
term ParsecT String () Identity (RegExp t -> RegExp t -> RegExp t)
forall t. GenParser Char () (RegExp t -> RegExp t -> RegExp t)
opOr
term :: ( SymbolParser t ) => GenParser Char () ( RegExp t )
term :: GenParser Char () (RegExp t)
term = GenParser Char () (RegExp t)
-> ParsecT String () Identity (RegExp t -> RegExp t -> RegExp t)
-> RegExp t
-> GenParser Char () (RegExp t)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a
-> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
chainr GenParser Char () (RegExp t)
forall t. SymbolParser t => GenParser Char () (RegExp t)
factor ParsecT String () Identity (RegExp t -> RegExp t -> RegExp t)
forall t. GenParser Char () (RegExp t -> RegExp t -> RegExp t)
opConcat RegExp t
forall t. RegExp t
REpsilon
factor :: ( SymbolParser t ) => GenParser Char () ( RegExp t )
factor :: GenParser Char () (RegExp t)
factor = GenParser Char () (RegExp t) -> GenParser Char () (RegExp t)
forall t.
GenParser Char () (RegExp t) -> GenParser Char () (RegExp t)
opSuffix GenParser Char () (RegExp t)
forall t. SymbolParser t => GenParser Char () (RegExp t)
factor'
factor' :: ( SymbolParser t ) => GenParser Char () ( RegExp t )
factor' :: GenParser Char () (RegExp t)
factor' = CharParser () Char
-> CharParser () Char
-> GenParser Char () (RegExp t)
-> GenParser Char () (RegExp t)
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between CharParser () Char
lparen CharParser () Char
rparen GenParser Char () (RegExp t)
forall t. SymbolParser t => GenParser Char () (RegExp t)
regexp
GenParser Char () (RegExp t)
-> GenParser Char () (RegExp t) -> GenParser Char () (RegExp t)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () (RegExp t)
forall t. SymbolParser t => GenParser Char () (RegExp t)
anySym
GenParser Char () (RegExp t)
-> GenParser Char () (RegExp t) -> GenParser Char () (RegExp t)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char () (RegExp t)
forall t. SymbolParser t => GenParser Char () (RegExp t)
parseSym
anySym :: ( SymbolParser t ) => GenParser Char () ( RegExp t )
anySym :: GenParser Char () (RegExp t)
anySym = CharParser () Char
point CharParser () Char
-> GenParser Char () (RegExp t) -> GenParser Char () (RegExp t)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ( RegExp t -> GenParser Char () (RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return (RegExp t -> GenParser Char () (RegExp t))
-> (NumSym t -> RegExp t)
-> NumSym t
-> GenParser Char () (RegExp t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSym t -> RegExp t
forall t. NumSym t -> RegExp t
RSymbol ) ( Maybe Int -> Sym t -> NumSym t
forall t. Maybe Int -> Sym t -> NumSym t
NumSym Maybe Int
forall a. Maybe a
Nothing Sym t
forall t. Sym t
Any )
class SymbolParser t where
parseSym :: GenParser Char () ( RegExp t )
instance SymbolParser Bool where
parseSym :: GenParser Char () (RegExp Bool)
parseSym = do { Bool
truth <- ( String -> GenParser Char () String
ci String
"t" GenParser Char () String
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () String -> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ( String -> GenParser Char () String
ci String
"rue" )
ParsecT String () Identity ()
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( String -> GenParser Char () String
ci String
"f" GenParser Char () String
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char () String -> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ( String -> GenParser Char () String
ci String
"alse" )
ParsecT String () Identity ()
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False )
ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( String -> GenParser Char () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"1" GenParser Char () String
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( String -> GenParser Char () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0" GenParser Char () String
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False )
; RegExp Bool -> GenParser Char () (RegExp Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (RegExp Bool -> GenParser Char () (RegExp Bool))
-> RegExp Bool -> GenParser Char () (RegExp Bool)
forall a b. (a -> b) -> a -> b
$ NumSym Bool -> RegExp Bool
forall t. NumSym t -> RegExp t
RSymbol ( Maybe Int -> Sym Bool -> NumSym Bool
forall t. Maybe Int -> Sym t -> NumSym t
NumSym Maybe Int
forall a. Maybe a
Nothing (Sym Bool -> NumSym Bool) -> Sym Bool -> NumSym Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Sym Bool
forall t. t -> Sym t
Sym Bool
truth )
}
parseWordSym :: ( Integral t )
=> GenParser Char () ( RegExp t )
parseWordSym :: GenParser Char () (RegExp t)
parseWordSym = do { String
num <- CharParser () Char
-> CharParser () Char
-> GenParser Char () String
-> GenParser Char () String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between CharParser () Char
lquote CharParser () Char
rquote (GenParser Char () String -> GenParser Char () String)
-> GenParser Char () String -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ CharParser () Char -> GenParser Char () String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 CharParser () Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
; RegExp t -> GenParser Char () (RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return (RegExp t -> GenParser Char () (RegExp t))
-> (t -> RegExp t) -> t -> GenParser Char () (RegExp t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSym t -> RegExp t
forall t. NumSym t -> RegExp t
RSymbol (NumSym t -> RegExp t) -> (t -> NumSym t) -> t -> RegExp t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Sym t -> NumSym t
forall t. Maybe Int -> Sym t -> NumSym t
NumSym Maybe Int
forall a. Maybe a
Nothing (Sym t -> NumSym t) -> (t -> Sym t) -> t -> NumSym t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Sym t
forall t. t -> Sym t
Sym
(t -> GenParser Char () (RegExp t))
-> t -> GenParser Char () (RegExp t)
forall a b. (a -> b) -> a -> b
$ Integer -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral ( String -> Integer
forall a. Read a => String -> a
read String
num :: Integer )
}
parseIntSym :: ( Integral t )
=> GenParser Char () ( RegExp t )
parseIntSym :: GenParser Char () (RegExp t)
parseIntSym = do { String
num <- CharParser () Char
-> CharParser () Char
-> GenParser Char () String
-> GenParser Char () String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between CharParser () Char
lquote CharParser () Char
rquote (GenParser Char () String -> GenParser Char () String)
-> GenParser Char () String -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$
CharParser () Char
-> GenParser Char () String -> GenParser Char () String
forall tok.
GenParser tok () Char
-> GenParser tok () String -> GenParser tok () String
optCPrefix CharParser () Char
minus ( CharParser () Char -> GenParser Char () String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 CharParser () Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit )
; RegExp t -> GenParser Char () (RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return (RegExp t -> GenParser Char () (RegExp t))
-> (t -> RegExp t) -> t -> GenParser Char () (RegExp t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSym t -> RegExp t
forall t. NumSym t -> RegExp t
RSymbol (NumSym t -> RegExp t) -> (t -> NumSym t) -> t -> RegExp t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Sym t -> NumSym t
forall t. Maybe Int -> Sym t -> NumSym t
NumSym Maybe Int
forall a. Maybe a
Nothing (Sym t -> NumSym t) -> (t -> Sym t) -> t -> NumSym t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Sym t
forall t. t -> Sym t
Sym
(t -> GenParser Char () (RegExp t))
-> t -> GenParser Char () (RegExp t)
forall a b. (a -> b) -> a -> b
$ Integer -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral ( String -> Integer
forall a. Read a => String -> a
read String
num :: Integer )
}
type StreamName = String
newtype P = P { P -> String
getName :: StreamName }
deriving P -> P -> Bool
(P -> P -> Bool) -> (P -> P -> Bool) -> Eq P
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: P -> P -> Bool
$c/= :: P -> P -> Bool
== :: P -> P -> Bool
$c== :: P -> P -> Bool
Eq
parsePSym :: GenParser Char () ( RegExp P )
parsePSym :: GenParser Char () (RegExp P)
parsePSym = do { String
pStream <- CharParser () Char
-> CharParser () Char
-> GenParser Char () String
-> GenParser Char () String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between CharParser () Char
lquote CharParser () Char
rquote (GenParser Char () String -> GenParser Char () String)
-> GenParser Char () String -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$
CharParser () Char
-> GenParser Char () String -> GenParser Char () String
forall tok.
GenParser tok () Char
-> GenParser tok () String -> GenParser tok () String
cPrefix CharParser () Char
nondigit ( CharParser () Char -> GenParser Char () String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (CharParser () Char -> GenParser Char () String)
-> CharParser () Char -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ CharParser () Char
nondigit CharParser () Char -> CharParser () Char -> CharParser () Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser () Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit )
; RegExp P -> GenParser Char () (RegExp P)
forall (m :: * -> *) a. Monad m => a -> m a
return (RegExp P -> GenParser Char () (RegExp P))
-> (P -> RegExp P) -> P -> GenParser Char () (RegExp P)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSym P -> RegExp P
forall t. NumSym t -> RegExp t
RSymbol (NumSym P -> RegExp P) -> (P -> NumSym P) -> P -> RegExp P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Sym P -> NumSym P
forall t. Maybe Int -> Sym t -> NumSym t
NumSym Maybe Int
forall a. Maybe a
Nothing (Sym P -> NumSym P) -> (P -> Sym P) -> P -> NumSym P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P -> Sym P
forall t. t -> Sym t
Sym
(P -> GenParser Char () (RegExp P))
-> P -> GenParser Char () (RegExp P)
forall a b. (a -> b) -> a -> b
$ String -> P
P String
pStream
}
instance SymbolParser Word8 where
parseSym :: GenParser Char () (RegExp Word8)
parseSym = GenParser Char () (RegExp Word8)
forall t. Integral t => GenParser Char () (RegExp t)
parseWordSym
instance SymbolParser Word16 where
parseSym :: GenParser Char () (RegExp Word16)
parseSym = GenParser Char () (RegExp Word16)
forall t. Integral t => GenParser Char () (RegExp t)
parseWordSym
instance SymbolParser Word32 where
parseSym :: GenParser Char () (RegExp Word32)
parseSym = GenParser Char () (RegExp Word32)
forall t. Integral t => GenParser Char () (RegExp t)
parseWordSym
instance SymbolParser Word64 where
parseSym :: GenParser Char () (RegExp Word64)
parseSym = GenParser Char () (RegExp Word64)
forall t. Integral t => GenParser Char () (RegExp t)
parseWordSym
instance SymbolParser Int8 where
parseSym :: GenParser Char () (RegExp Int8)
parseSym = GenParser Char () (RegExp Int8)
forall t. Integral t => GenParser Char () (RegExp t)
parseIntSym
instance SymbolParser Int16 where
parseSym :: GenParser Char () (RegExp Int16)
parseSym = GenParser Char () (RegExp Int16)
forall t. Integral t => GenParser Char () (RegExp t)
parseIntSym
instance SymbolParser Int32 where
parseSym :: GenParser Char () (RegExp Int32)
parseSym = GenParser Char () (RegExp Int32)
forall t. Integral t => GenParser Char () (RegExp t)
parseIntSym
instance SymbolParser Int64 where
parseSym :: GenParser Char () (RegExp Int64)
parseSym = GenParser Char () (RegExp Int64)
forall t. Integral t => GenParser Char () (RegExp t)
parseIntSym
instance SymbolParser P where
parseSym :: GenParser Char () (RegExp P)
parseSym = GenParser Char () (RegExp P)
parsePSym
opOr :: GenParser Char () ( RegExp t -> RegExp t -> RegExp t )
opOr :: GenParser Char () (RegExp t -> RegExp t -> RegExp t)
opOr = Char -> CharParser () Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' CharParser () Char
-> GenParser Char () (RegExp t -> RegExp t -> RegExp t)
-> GenParser Char () (RegExp t -> RegExp t -> RegExp t)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RegExp t -> RegExp t -> RegExp t)
-> GenParser Char () (RegExp t -> RegExp t -> RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return RegExp t -> RegExp t -> RegExp t
forall t. RegExp t -> RegExp t -> RegExp t
ROr
opConcat :: GenParser Char () ( RegExp t -> RegExp t -> RegExp t )
opConcat :: GenParser Char () (RegExp t -> RegExp t -> RegExp t)
opConcat = (RegExp t -> RegExp t -> RegExp t)
-> GenParser Char () (RegExp t -> RegExp t -> RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return RegExp t -> RegExp t -> RegExp t
forall t. RegExp t -> RegExp t -> RegExp t
RConcat
opSuffix :: GenParser Char () ( RegExp t )
-> GenParser Char () ( RegExp t )
opSuffix :: GenParser Char () (RegExp t) -> GenParser Char () (RegExp t)
opSuffix GenParser Char () (RegExp t)
r = do
RegExp t
subexp <- GenParser Char () (RegExp t)
r
String
suffixes <- CharParser () Char -> GenParser Char () String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (CharParser () Char -> GenParser Char () String)
-> CharParser () Char -> GenParser Char () String
forall a b. (a -> b) -> a -> b
$ [CharParser () Char] -> CharParser () Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ CharParser () Char
star, CharParser () Char
plus, CharParser () Char
qmark ]
let transform :: RegExp t -> Char -> RegExp t
transform RegExp t
rexp Char
suffix =
case Char
suffix of
Char
'*' -> RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
RStar RegExp t
rexp
Char
'+' -> RegExp t -> RegExp t -> RegExp t
forall t. RegExp t -> RegExp t -> RegExp t
RConcat RegExp t
rexp ( RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
RStar RegExp t
rexp )
Char
'?' -> RegExp t -> RegExp t -> RegExp t
forall t. RegExp t -> RegExp t -> RegExp t
ROr RegExp t
rexp RegExp t
forall t. RegExp t
REpsilon
Char
other -> String -> RegExp t
forall a. String -> a
C.badUsage (String
"in Regular Expression library: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"unhandled operator: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
other)
RegExp t -> GenParser Char () (RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return (RegExp t -> GenParser Char () (RegExp t))
-> RegExp t -> GenParser Char () (RegExp t)
forall a b. (a -> b) -> a -> b
$ (RegExp t -> Char -> RegExp t) -> RegExp t -> String -> RegExp t
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl RegExp t -> Char -> RegExp t
forall t. RegExp t -> Char -> RegExp t
transform RegExp t
subexp String
suffixes
parser :: ( SymbolParser t )
=> GenParser Char () ( RegExp t )
parser :: GenParser Char () (RegExp t)
parser = GenParser Char () (RegExp t)
forall t. SymbolParser t => GenParser Char () (RegExp t)
regexp GenParser Char () (RegExp t)
-> ParsecT String () Identity () -> GenParser Char () (RegExp t)
forall tok a b.
GenParser tok () a -> GenParser tok () b -> GenParser tok () a
`followedBy` ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
hasEpsilon :: RegExp t -> Bool
hasEpsilon :: RegExp t -> Bool
hasEpsilon RegExp t
REpsilon = Bool
True
hasEpsilon ( RSymbol NumSym t
_ ) = Bool
False
hasEpsilon ( ROr RegExp t
r1 RegExp t
r2 ) = RegExp t -> Bool
forall t. RegExp t -> Bool
hasEpsilon RegExp t
r1 Bool -> Bool -> Bool
|| RegExp t -> Bool
forall t. RegExp t -> Bool
hasEpsilon RegExp t
r2
hasEpsilon ( RConcat RegExp t
r1 RegExp t
r2 ) = RegExp t -> Bool
forall t. RegExp t -> Bool
hasEpsilon RegExp t
r1 Bool -> Bool -> Bool
&& RegExp t -> Bool
forall t. RegExp t -> Bool
hasEpsilon RegExp t
r2
hasEpsilon ( RStar RegExp t
_ ) = Bool
True
first :: RegExp t -> [ NumSym t ]
first :: RegExp t -> [NumSym t]
first RegExp t
REpsilon = []
first ( RSymbol NumSym t
s ) = [ NumSym t
s ]
first ( ROr RegExp t
r1 RegExp t
r2 ) = RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
first RegExp t
r1 [NumSym t] -> [NumSym t] -> [NumSym t]
forall a. [a] -> [a] -> [a]
++ RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
first RegExp t
r2
first ( RConcat RegExp t
r1 RegExp t
r2 ) = RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
first RegExp t
r1 [NumSym t] -> [NumSym t] -> [NumSym t]
forall a. [a] -> [a] -> [a]
++ if RegExp t -> Bool
forall t. RegExp t -> Bool
hasEpsilon RegExp t
r1 then
RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
first RegExp t
r2 else []
first ( RStar RegExp t
r ) = RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
first RegExp t
r
reverse' :: RegExp t -> RegExp t
reverse' :: RegExp t -> RegExp t
reverse' ( ROr RegExp t
r1 RegExp t
r2 ) = RegExp t -> RegExp t -> RegExp t
forall t. RegExp t -> RegExp t -> RegExp t
ROr ( RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
reverse' RegExp t
r1 ) ( RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
reverse' RegExp t
r2 )
reverse' ( RConcat RegExp t
r1 RegExp t
r2 ) = RegExp t -> RegExp t -> RegExp t
forall t. RegExp t -> RegExp t -> RegExp t
RConcat ( RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
reverse' RegExp t
r2 ) ( RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
reverse' RegExp t
r1 )
reverse' ( RStar RegExp t
r ) = RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
RStar ( RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
reverse' RegExp t
r )
reverse' RegExp t
e = RegExp t
e
last' :: RegExp t -> [ NumSym t ]
last' :: RegExp t -> [NumSym t]
last' = RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
first (RegExp t -> [NumSym t])
-> (RegExp t -> RegExp t) -> RegExp t -> [NumSym t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
reverse'
follow :: ( Eq t ) =>
RegExp t -> NumSym t -> [ NumSym t ]
follow :: RegExp t -> NumSym t -> [NumSym t]
follow RegExp t
REpsilon NumSym t
_ = []
follow ( RSymbol NumSym t
_ ) NumSym t
_ = []
follow ( ROr RegExp t
r1 RegExp t
r2 ) NumSym t
sNr = RegExp t -> NumSym t -> [NumSym t]
forall t. Eq t => RegExp t -> NumSym t -> [NumSym t]
follow RegExp t
r1 NumSym t
sNr [NumSym t] -> [NumSym t] -> [NumSym t]
forall a. [a] -> [a] -> [a]
++ RegExp t -> NumSym t -> [NumSym t]
forall t. Eq t => RegExp t -> NumSym t -> [NumSym t]
follow RegExp t
r2 NumSym t
sNr
follow ( RConcat RegExp t
r1 RegExp t
r2 ) NumSym t
sNr = RegExp t -> NumSym t -> [NumSym t]
forall t. Eq t => RegExp t -> NumSym t -> [NumSym t]
follow RegExp t
r1 NumSym t
sNr [NumSym t] -> [NumSym t] -> [NumSym t]
forall a. [a] -> [a] -> [a]
++ RegExp t -> NumSym t -> [NumSym t]
forall t. Eq t => RegExp t -> NumSym t -> [NumSym t]
follow RegExp t
r2 NumSym t
sNr
[NumSym t] -> [NumSym t] -> [NumSym t]
forall a. [a] -> [a] -> [a]
++ if NumSym t
sNr NumSym t -> [NumSym t] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
last' RegExp t
r1 then
RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
first RegExp t
r2 else []
follow ( RStar RegExp t
r ) NumSym t
sNr = RegExp t -> NumSym t -> [NumSym t]
forall t. Eq t => RegExp t -> NumSym t -> [NumSym t]
follow RegExp t
r NumSym t
sNr
[NumSym t] -> [NumSym t] -> [NumSym t]
forall a. Eq a => [a] -> [a] -> [a]
`union` if NumSym t
sNr NumSym t -> [NumSym t] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
last' RegExp t
r then
RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
first RegExp t
r else []
preceding :: ( Eq t ) => RegExp t -> NumSym t -> [ NumSym t ]
preceding :: RegExp t -> NumSym t -> [NumSym t]
preceding = RegExp t -> NumSym t -> [NumSym t]
forall t. Eq t => RegExp t -> NumSym t -> [NumSym t]
follow (RegExp t -> NumSym t -> [NumSym t])
-> (RegExp t -> RegExp t) -> RegExp t -> NumSym t -> [NumSym t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
reverse'
hasFinitePath :: RegExp t -> Bool
hasFinitePath :: RegExp t -> Bool
hasFinitePath ( ROr RegExp t
r1 RegExp t
r2 ) = RegExp t -> Bool
forall t. RegExp t -> Bool
hasFinitePath RegExp t
r1 Bool -> Bool -> Bool
|| RegExp t -> Bool
forall t. RegExp t -> Bool
hasFinitePath RegExp t
r2
hasFinitePath ( RConcat RegExp t
_ RegExp t
r2 ) = RegExp t -> Bool
forall t. RegExp t -> Bool
hasFinitePath RegExp t
r2
hasFinitePath ( RStar RegExp t
_ ) = Bool
False
hasFinitePath RegExp t
_ = Bool
True
getSymbols :: RegExp t -> [ NumSym t ]
getSymbols :: RegExp t -> [NumSym t]
getSymbols ( RSymbol NumSym t
s ) = [ NumSym t
s ]
getSymbols ( ROr RegExp t
r1 RegExp t
r2 ) = RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
getSymbols RegExp t
r1 [NumSym t] -> [NumSym t] -> [NumSym t]
forall a. [a] -> [a] -> [a]
++ RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
getSymbols RegExp t
r2
getSymbols ( RConcat RegExp t
r1 RegExp t
r2 ) = RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
getSymbols RegExp t
r1 [NumSym t] -> [NumSym t] -> [NumSym t]
forall a. [a] -> [a] -> [a]
++ RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
getSymbols RegExp t
r2
getSymbols ( RStar RegExp t
r ) = RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
getSymbols RegExp t
r
getSymbols RegExp t
_ = []
enumSyms :: RegExp t -> RegExp t
enumSyms :: RegExp t -> RegExp t
enumSyms RegExp t
rexp = State Int (RegExp t) -> Int -> RegExp t
forall s a. State s a -> s -> a
evalState ( RegExp t -> State Int (RegExp t)
forall (m :: * -> *) t.
MonadState Int m =>
RegExp t -> m (RegExp t)
enumSyms' RegExp t
rexp ) Int
0
where
enumSyms' :: RegExp t -> m (RegExp t)
enumSyms' ( RSymbol NumSym t
s ) = do
Int
num <- m Int
forall s (m :: * -> *). MonadState s m => m s
get
(Int -> Int) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ( Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 )
RegExp t -> m (RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return (RegExp t -> m (RegExp t)) -> RegExp t -> m (RegExp t)
forall a b. (a -> b) -> a -> b
$ NumSym t -> RegExp t
forall t. NumSym t -> RegExp t
RSymbol NumSym t
s { symbolNum :: Maybe Int
symbolNum = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
num }
enumSyms' ( ROr RegExp t
r1 RegExp t
r2 ) = do
RegExp t
r1' <- RegExp t -> m (RegExp t)
enumSyms' RegExp t
r1
RegExp t
r2' <- RegExp t -> m (RegExp t)
enumSyms' RegExp t
r2
RegExp t -> m (RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return (RegExp t -> m (RegExp t)) -> RegExp t -> m (RegExp t)
forall a b. (a -> b) -> a -> b
$ RegExp t -> RegExp t -> RegExp t
forall t. RegExp t -> RegExp t -> RegExp t
ROr RegExp t
r1' RegExp t
r2'
enumSyms' ( RConcat RegExp t
r1 RegExp t
r2 ) = do
RegExp t
r1' <- RegExp t -> m (RegExp t)
enumSyms' RegExp t
r1
RegExp t
r2' <- RegExp t -> m (RegExp t)
enumSyms' RegExp t
r2
RegExp t -> m (RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return (RegExp t -> m (RegExp t)) -> RegExp t -> m (RegExp t)
forall a b. (a -> b) -> a -> b
$ RegExp t -> RegExp t -> RegExp t
forall t. RegExp t -> RegExp t -> RegExp t
RConcat RegExp t
r1' RegExp t
r2'
enumSyms' ( RStar RegExp t
r ) = do
RegExp t
r' <- RegExp t -> m (RegExp t)
enumSyms' RegExp t
r
RegExp t -> m (RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return (RegExp t -> m (RegExp t)) -> RegExp t -> m (RegExp t)
forall a b. (a -> b) -> a -> b
$ RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
RStar RegExp t
r'
enumSyms' RegExp t
other =
RegExp t -> m (RegExp t)
forall (m :: * -> *) a. Monad m => a -> m a
return RegExp t
other
regexp2CopilotNFA :: ( C.Typed t, Eq t )
=> C.Stream t -> RegExp t -> C.Stream Bool -> C.Stream Bool
regexp2CopilotNFA :: Stream t -> RegExp t -> Stream Bool -> Stream Bool
regexp2CopilotNFA Stream t
inStream RegExp t
rexp Stream Bool
reset =
let symbols :: [NumSym t]
symbols = RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
getSymbols RegExp t
rexp
first' :: [NumSym t]
first' = RegExp t -> [NumSym t]
forall t. RegExp t -> [NumSym t]
first RegExp t
rexp
start :: Stream Bool
start = [ Bool
True ] [Bool] -> Stream Bool -> Stream Bool
forall a. Typed a => [a] -> Stream a -> Stream a
C.++ Stream Bool
C.false
preceding' :: NumSym t -> [Stream Bool]
preceding' NumSym t
numSym = let ps :: [NumSym t]
ps = RegExp t -> NumSym t -> [NumSym t]
forall t. Eq t => RegExp t -> NumSym t -> [NumSym t]
preceding RegExp t
rexp NumSym t
numSym
s :: [Stream Bool]
s = if NumSym t
numSym NumSym t -> [NumSym t] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [NumSym t]
first' then
[ Stream Bool
start ] else []
in [Stream Bool]
s [Stream Bool] -> [Stream Bool] -> [Stream Bool]
forall a. [a] -> [a] -> [a]
++ [ [Stream Bool]
streams [Stream Bool] -> Int -> Stream Bool
forall a. [a] -> Int -> a
!! Int
i
| Int
i <- (NumSym t -> Int) -> [NumSym t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ( Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> (NumSym t -> Maybe Int) -> NumSym t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSym t -> Maybe Int
forall t. NumSym t -> Maybe Int
symbolNum ) [NumSym t]
ps ]
matchesInput :: NumSym t -> Stream Bool
matchesInput NumSym t
numSym = case NumSym t -> Sym t
forall t. NumSym t -> Sym t
symbol NumSym t
numSym of
Sym t
Any -> Stream Bool
C.true
Sym t
t -> Stream t
inStream Stream t -> Stream t -> Stream Bool
forall a. (Eq a, Typed a) => Stream a -> Stream a -> Stream Bool
C.== t -> Stream t
forall a. Typed a => a -> Stream a
C.constant t
t
transitions :: NumSym t -> t (Stream Bool) -> Stream Bool
transitions NumSym t
numSym t (Stream Bool)
ps = NumSym t -> Stream Bool
matchesInput NumSym t
numSym
Stream Bool -> Stream Bool -> Stream Bool
C.&& ( (Stream Bool -> Stream Bool -> Stream Bool)
-> Stream Bool -> t (Stream Bool) -> Stream Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ( C.|| ) Stream Bool
C.false t (Stream Bool)
ps )
stream :: NumSym t -> Stream Bool
stream NumSym t
numSym = let ps :: [Stream Bool]
ps = NumSym t -> [Stream Bool]
preceding' NumSym t
numSym
init_ :: Stream Bool
init_ = Bool -> Stream Bool
forall a. Typed a => a -> Stream a
C.constant (Bool -> Stream Bool) -> Bool -> Stream Bool
forall a b. (a -> b) -> a -> b
$ NumSym t
numSym NumSym t -> [NumSym t] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [NumSym t]
first'
in Stream Bool -> Stream Bool -> Stream Bool -> Stream Bool
forall a.
Typed a =>
Stream Bool -> Stream a -> Stream a -> Stream a
C.mux Stream Bool
reset
( [ Bool
False ] [Bool] -> Stream Bool -> Stream Bool
forall a. Typed a => [a] -> Stream a -> Stream a
C.++ NumSym t -> Stream Bool
matchesInput NumSym t
numSym Stream Bool -> Stream Bool -> Stream Bool
C.&& Stream Bool
init_ )
( [ Bool
False ] [Bool] -> Stream Bool -> Stream Bool
forall a. Typed a => [a] -> Stream a -> Stream a
C.++ NumSym t -> [Stream Bool] -> Stream Bool
forall (t :: * -> *).
Foldable t =>
NumSym t -> t (Stream Bool) -> Stream Bool
transitions NumSym t
numSym [Stream Bool]
ps )
streams :: [Stream Bool]
streams = (NumSym t -> Stream Bool) -> [NumSym t] -> [Stream Bool]
forall a b. (a -> b) -> [a] -> [b]
map NumSym t -> Stream Bool
stream [NumSym t]
symbols
outStream :: Stream Bool
outStream = (Stream Bool -> Stream Bool -> Stream Bool)
-> Stream Bool -> [Stream Bool] -> Stream Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ( C.|| ) Stream Bool
start [Stream Bool]
streams
in Stream Bool
outStream
copilotRegexp :: ( C.Typed t, SymbolParser t, Eq t )
=> C.Stream t
-> SourceName
-> C.Stream Bool
-> C.Stream Bool
copilotRegexp :: Stream t -> String -> Stream Bool -> Stream Bool
copilotRegexp Stream t
inStream String
rexp Stream Bool
reset =
case Parsec String () (RegExp t)
-> String -> String -> Either ParseError (RegExp t)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () (RegExp t)
forall t. SymbolParser t => GenParser Char () (RegExp t)
parser String
rexp String
rexp of
Left ParseError
err -> String -> Stream Bool
forall a. String -> a
C.badUsage (String
"parsing regular exp: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
err)
Right RegExp t
rexp' -> let nrexp :: RegExp t
nrexp = RegExp t -> RegExp t
forall t. RegExp t -> RegExp t
enumSyms RegExp t
rexp' in
if RegExp t -> Bool
forall t. RegExp t -> Bool
hasFinitePath RegExp t
nrexp then
String -> Stream Bool
forall a. String -> a
C.badUsage (String -> Stream Bool) -> String -> Stream Bool
forall a b. (a -> b) -> a -> b
$
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"The regular expression contains a finite path "
, String
"which is something that will fail to match "
, String
"since we do not have a distinct end-of-input "
, String
"symbol on infinite streams." ]
else if RegExp t -> Bool
forall t. RegExp t -> Bool
hasEpsilon RegExp t
nrexp then
String -> Stream Bool
forall a. String -> a
C.badUsage (String -> Stream Bool) -> String -> Stream Bool
forall a b. (a -> b) -> a -> b
$
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"The regular expression matches a language "
, String
"that contains epsilon. This cannot be handled "
, String
"on infinite streams, since we do not have "
, String
"a distinct end-of-input symbol." ]
else Stream t -> RegExp t -> Stream Bool -> Stream Bool
forall t.
(Typed t, Eq t) =>
Stream t -> RegExp t -> Stream Bool -> Stream Bool
regexp2CopilotNFA Stream t
inStream RegExp t
nrexp Stream Bool
reset
regexp2CopilotNFAB :: RegExp P -> [ ( StreamName, C.Stream Bool ) ]
-> C.Stream Bool -> C.Stream Bool
regexp2CopilotNFAB :: RegExp P -> [(String, Stream Bool)] -> Stream Bool -> Stream Bool
regexp2CopilotNFAB RegExp P
rexp [(String, Stream Bool)]
propositions Stream Bool
reset =
let symbols :: [NumSym P]
symbols = RegExp P -> [NumSym P]
forall t. RegExp t -> [NumSym t]
getSymbols RegExp P
rexp
first' :: [NumSym P]
first' = RegExp P -> [NumSym P]
forall t. RegExp t -> [NumSym t]
first RegExp P
rexp
start :: Stream Bool
start = [ Bool
True ] [Bool] -> Stream Bool -> Stream Bool
forall a. Typed a => [a] -> Stream a -> Stream a
C.++ Stream Bool
C.false
preceding' :: NumSym P -> [Stream Bool]
preceding' NumSym P
numSym = let ps :: [NumSym P]
ps = RegExp P -> NumSym P -> [NumSym P]
forall t. Eq t => RegExp t -> NumSym t -> [NumSym t]
preceding RegExp P
rexp NumSym P
numSym
s :: [Stream Bool]
s = if NumSym P
numSym NumSym P -> [NumSym P] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [NumSym P]
first' then
[ Stream Bool
start ] else []
in [Stream Bool]
s [Stream Bool] -> [Stream Bool] -> [Stream Bool]
forall a. [a] -> [a] -> [a]
++ [ [Stream Bool]
streams [Stream Bool] -> Int -> Stream Bool
forall a. [a] -> Int -> a
!! Int
i
| Int
i <- (NumSym P -> Int) -> [NumSym P] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ( Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> (NumSym P -> Maybe Int) -> NumSym P -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumSym P -> Maybe Int
forall t. NumSym t -> Maybe Int
symbolNum ) [NumSym P]
ps ]
lookup' :: String -> [(String, p)] -> p
lookup' String
a [(String, p)]
l = case String -> [(String, p)] -> Maybe p
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a [(String, p)]
l of
Maybe p
Nothing -> String -> p
forall a. String -> a
C.badUsage (String
"boolean stream "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not defined")
Just p
s -> p
s
matchesInput :: NumSym P -> Stream Bool
matchesInput NumSym P
numSym = case NumSym P -> Sym P
forall t. NumSym t -> Sym t
symbol NumSym P
numSym of
Sym P
Any -> Stream Bool
C.true
Sym P
t -> String -> [(String, Stream Bool)] -> Stream Bool
forall p. String -> [(String, p)] -> p
lookup' ( P -> String
getName P
t ) [(String, Stream Bool)]
propositions
transitions :: NumSym P -> t (Stream Bool) -> Stream Bool
transitions NumSym P
numSym t (Stream Bool)
ps = NumSym P -> Stream Bool
matchesInput NumSym P
numSym
Stream Bool -> Stream Bool -> Stream Bool
C.&& ( (Stream Bool -> Stream Bool -> Stream Bool)
-> Stream Bool -> t (Stream Bool) -> Stream Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ( C.|| ) Stream Bool
C.false t (Stream Bool)
ps )
stream :: NumSym P -> Stream Bool
stream NumSym P
numSym = let ps :: [Stream Bool]
ps = NumSym P -> [Stream Bool]
preceding' NumSym P
numSym
init_ :: Stream Bool
init_ = Bool -> Stream Bool
forall a. Typed a => a -> Stream a
C.constant (Bool -> Stream Bool) -> Bool -> Stream Bool
forall a b. (a -> b) -> a -> b
$ NumSym P
numSym NumSym P -> [NumSym P] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [NumSym P]
first'
in Stream Bool -> Stream Bool -> Stream Bool -> Stream Bool
forall a.
Typed a =>
Stream Bool -> Stream a -> Stream a -> Stream a
C.mux Stream Bool
reset
( [ Bool
False ] [Bool] -> Stream Bool -> Stream Bool
forall a. Typed a => [a] -> Stream a -> Stream a
C.++ NumSym P -> Stream Bool
matchesInput NumSym P
numSym Stream Bool -> Stream Bool -> Stream Bool
C.&& Stream Bool
init_ )
( [ Bool
False ] [Bool] -> Stream Bool -> Stream Bool
forall a. Typed a => [a] -> Stream a -> Stream a
C.++ NumSym P -> [Stream Bool] -> Stream Bool
forall (t :: * -> *).
Foldable t =>
NumSym P -> t (Stream Bool) -> Stream Bool
transitions NumSym P
numSym [Stream Bool]
ps )
streams :: [Stream Bool]
streams = (NumSym P -> Stream Bool) -> [NumSym P] -> [Stream Bool]
forall a b. (a -> b) -> [a] -> [b]
map NumSym P -> Stream Bool
stream [NumSym P]
symbols
outStream :: Stream Bool
outStream = (Stream Bool -> Stream Bool -> Stream Bool)
-> Stream Bool -> [Stream Bool] -> Stream Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ( C.|| ) Stream Bool
start [Stream Bool]
streams
in Stream Bool
outStream
copilotRegexpB :: SourceName
-> [ ( StreamName, C.Stream Bool ) ]
-> C.Stream Bool
-> C.Stream Bool
copilotRegexpB :: String -> [(String, Stream Bool)] -> Stream Bool -> Stream Bool
copilotRegexpB String
rexp [(String, Stream Bool)]
propositions Stream Bool
reset =
case GenParser Char () (RegExp P)
-> String -> String -> Either ParseError (RegExp P)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse GenParser Char () (RegExp P)
forall t. SymbolParser t => GenParser Char () (RegExp t)
parser String
rexp String
rexp of
Left ParseError
err -> String -> Stream Bool
forall a. String -> a
C.badUsage (String
"parsing regular exp: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
err)
Right RegExp P
rexp' -> let nrexp :: RegExp P
nrexp = RegExp P -> RegExp P
forall t. RegExp t -> RegExp t
enumSyms RegExp P
rexp' in
if RegExp P -> Bool
forall t. RegExp t -> Bool
hasFinitePath RegExp P
nrexp then
String -> Stream Bool
forall a. String -> a
C.badUsage (String -> Stream Bool) -> String -> Stream Bool
forall a b. (a -> b) -> a -> b
$
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"The regular expression contains a finite path "
, String
"which is something that will fail to match "
, String
"since we do not have a distinct end-of-input "
, String
"symbol on infinite streams." ]
else if RegExp P -> Bool
forall t. RegExp t -> Bool
hasEpsilon RegExp P
nrexp then
String -> Stream Bool
forall a. String -> a
C.badUsage (String -> Stream Bool) -> String -> Stream Bool
forall a b. (a -> b) -> a -> b
$
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"The regular expression matches a language "
, String
"that contains epsilon. This cannot be handled "
, String
"on infinite streams, since we do not have "
, String
"a distinct end-of-input symbol." ]
else RegExp P -> [(String, Stream Bool)] -> Stream Bool -> Stream Bool
regexp2CopilotNFAB RegExp P
nrexp [(String, Stream Bool)]
propositions Stream Bool
reset