{-# LANGUAGE FlexibleContexts #-}
-- | 
-- Module: RegExp
-- Description: Regular expression library
-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc.
--
-- A regular expression library.
--
-- For examples, see @Examples/RegExpExamples.hs@ in the
-- <https://github.com/leepike/Copilot/tree/master/Examples Copilot repository>.

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

-- The symbols in a regular expression, "Any" is any value of type t
-- (matches any symbol, the "point" character in a regular expression).
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 )

-- A symbol's value can occur multiple times in a regular expression,
-- e.g. "t(tfft)*". A running number "symbolNum" is used to make all
-- symbols in a regular expression unique.
type NumT     = Int
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 )

-- The regular expression data type. For our use
-- regular expressions describing a language with
-- no word is not supported since empty languages
-- would not match anything and just yield a
-- copilot stream of constant false values.
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


-- Parsers for single characters.
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

-- A "followedBy" combinator for parsing, parses
-- p, then p' and returns the result of p.
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


-- Parsing a string p' with prefix p, returning
-- both in order
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'

-- Parsing a string p' with the character p as an
-- optional prefix, return the result with the
-- optional prefix.
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'

-- The ci function ("case insensitive") takes one argument of
-- type string, parses for the string in a case insensitive
-- manner and yields the parsed string (preserving its case).
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 )


-- the parser for regular expressions
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

-- Parses the "." - point character used to match any symbol.
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
_               = []


-- assign each symbol in the regular expression a
-- unique number, counting up from 0
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