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