{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wall -Werror #-}
module Data.SBV.RegExp (
RegExp(..)
, RegExpMatchable(..)
, everything, nothing, anyChar
, exactly
, oneOf
, newline, whiteSpaceNoNewLine, whiteSpace
, tab, punctuation
, asciiLetter, asciiLower, asciiUpper
, digit, octDigit, hexDigit
, decimal, octal, hexadecimal, floating
, identifier
) where
import Prelude hiding (length, take, elem, notElem, head)
import qualified Prelude as P
import qualified Data.List as L
import Data.SBV.Core.Data
import Data.SBV.Core.Model ()
import Data.SBV.String
import qualified Data.Char as C
import Data.Proxy
import Data.SBV.Char
class RegExpMatchable a where
match :: a -> RegExp -> SBool
instance RegExpMatchable SChar where
match :: SChar -> RegExp -> SBool
match = forall a. RegExpMatchable a => a -> RegExp -> SBool
match forall b c a. (b -> c) -> (a -> b) -> a -> c
. SChar -> SString
singleton
instance RegExpMatchable SString where
match :: SString -> RegExp -> SBool
match SString
input RegExp
regExp = forall a b.
(SymVal a, SymVal b) =>
StrOp -> Maybe (a -> b) -> SBV a -> SBV b
lift1 (RegExp -> StrOp
StrInRe RegExp
regExp) (forall a. a -> Maybe a
Just (RegExp -> (String -> Bool) -> String -> Bool
go RegExp
regExp forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null)) SString
input
where
go :: RegExp -> (String -> Bool) -> String -> Bool
go :: RegExp -> (String -> Bool) -> String -> Bool
go (Literal String
l) String -> Bool
k String
s = String
l forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
s Bool -> Bool -> Bool
&& String -> Bool
k (forall a. Int -> [a] -> [a]
P.drop (forall (t :: * -> *) a. Foldable t => t a -> Int
P.length String
l) String
s)
go RegExp
All String -> Bool
_ String
_ = Bool
True
go RegExp
AllChar String -> Bool
k String
s = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null String
s) Bool -> Bool -> Bool
&& String -> Bool
k (forall a. Int -> [a] -> [a]
P.drop Int
1 String
s)
go RegExp
None String -> Bool
_ String
_ = Bool
False
go (Range Char
_ Char
_) String -> Bool
_ [] = Bool
False
go (Range Char
a Char
b) String -> Bool
k (Char
c:String
cs) = Char
a forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
b Bool -> Bool -> Bool
&& String -> Bool
k String
cs
go (Conc []) String -> Bool
k String
s = String -> Bool
k String
s
go (Conc (RegExp
r:[RegExp]
rs)) String -> Bool
k String
s = RegExp -> (String -> Bool) -> String -> Bool
go RegExp
r (RegExp -> (String -> Bool) -> String -> Bool
go ([RegExp] -> RegExp
Conc [RegExp]
rs) String -> Bool
k) String
s
go (KStar RegExp
r) String -> Bool
k String
s = String -> Bool
k String
s Bool -> Bool -> Bool
|| RegExp -> (String -> Bool) -> String -> Bool
go RegExp
r (forall {t :: * -> *} {a}.
Foldable t =>
Int -> (t a -> Bool) -> t a -> Bool
smaller (forall (t :: * -> *) a. Foldable t => t a -> Int
P.length String
s) (RegExp -> (String -> Bool) -> String -> Bool
go (RegExp -> RegExp
KStar RegExp
r) String -> Bool
k)) String
s
go (KPlus RegExp
r) String -> Bool
k String
s = RegExp -> (String -> Bool) -> String -> Bool
go ([RegExp] -> RegExp
Conc [RegExp
r, RegExp -> RegExp
KStar RegExp
r]) String -> Bool
k String
s
go (Opt RegExp
r) String -> Bool
k String
s = String -> Bool
k String
s Bool -> Bool -> Bool
|| RegExp -> (String -> Bool) -> String -> Bool
go RegExp
r String -> Bool
k String
s
go (Comp RegExp
r) String -> Bool
k String
s = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ RegExp -> (String -> Bool) -> String -> Bool
go RegExp
r String -> Bool
k String
s
go (Diff RegExp
r1 RegExp
r2) String -> Bool
k String
s = RegExp -> (String -> Bool) -> String -> Bool
go RegExp
r1 String -> Bool
k String
s Bool -> Bool -> Bool
&& Bool -> Bool
not (RegExp -> (String -> Bool) -> String -> Bool
go RegExp
r2 String -> Bool
k String
s)
go (Loop Int
i Int
j RegExp
r) String -> Bool
k String
s = RegExp -> (String -> Bool) -> String -> Bool
go ([RegExp] -> RegExp
Conc (forall a. Int -> a -> [a]
replicate Int
i RegExp
r forall a. [a] -> [a] -> [a]
P.++ forall a. Int -> a -> [a]
replicate (Int
j forall a. Num a => a -> a -> a
- Int
i) (RegExp -> RegExp
Opt RegExp
r))) String -> Bool
k String
s
go (Power Int
n RegExp
r) String -> Bool
k String
s = RegExp -> (String -> Bool) -> String -> Bool
go (Int -> Int -> RegExp -> RegExp
Loop Int
n Int
n RegExp
r) String -> Bool
k String
s
go (Union []) String -> Bool
_ String
_ = Bool
False
go (Union [RegExp
x]) String -> Bool
k String
s = RegExp -> (String -> Bool) -> String -> Bool
go RegExp
x String -> Bool
k String
s
go (Union (RegExp
x:[RegExp]
xs)) String -> Bool
k String
s = RegExp -> (String -> Bool) -> String -> Bool
go RegExp
x String -> Bool
k String
s Bool -> Bool -> Bool
|| RegExp -> (String -> Bool) -> String -> Bool
go ([RegExp] -> RegExp
Union [RegExp]
xs) String -> Bool
k String
s
go (Inter RegExp
a RegExp
b) String -> Bool
k String
s = RegExp -> (String -> Bool) -> String -> Bool
go RegExp
a String -> Bool
k String
s Bool -> Bool -> Bool
&& RegExp -> (String -> Bool) -> String -> Bool
go RegExp
b String -> Bool
k String
s
smaller :: Int -> (t a -> Bool) -> t a -> Bool
smaller Int
orig t a -> Bool
k t a
inp = forall (t :: * -> *) a. Foldable t => t a -> Int
P.length t a
inp forall a. Ord a => a -> a -> Bool
< Int
orig Bool -> Bool -> Bool
&& t a -> Bool
k t a
inp
everything :: RegExp
everything :: RegExp
everything = RegExp
All
nothing :: RegExp
nothing :: RegExp
nothing = RegExp
None
anyChar :: RegExp
anyChar :: RegExp
anyChar = RegExp
AllChar
exactly :: String -> RegExp
exactly :: String -> RegExp
exactly = String -> RegExp
Literal
oneOf :: String -> RegExp
oneOf :: String -> RegExp
oneOf String
xs = [RegExp] -> RegExp
Union [String -> RegExp
exactly [Char
x] | Char
x <- String
xs]
newline :: RegExp
newline :: RegExp
newline = String -> RegExp
oneOf String
"\n\r\f"
tab :: RegExp
tab :: RegExp
tab = String -> RegExp
oneOf String
"\t"
liftPredL1 :: (Char -> Bool) -> RegExp
liftPredL1 :: (Char -> Bool) -> RegExp
liftPredL1 Char -> Bool
predicate = String -> RegExp
oneOf forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
predicate (forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
C.chr [Int
0 .. Int
255])
whiteSpaceNoNewLine :: RegExp
whiteSpaceNoNewLine :: RegExp
whiteSpaceNoNewLine = (Char -> Bool) -> RegExp
liftPredL1 (\Char
c -> Char -> Bool
C.isSpace Char
c Bool -> Bool -> Bool
&& Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.notElem` (String
"\n" :: String))
whiteSpace :: RegExp
whiteSpace :: RegExp
whiteSpace = (Char -> Bool) -> RegExp
liftPredL1 Char -> Bool
C.isSpace
punctuation :: RegExp
punctuation :: RegExp
punctuation = (Char -> Bool) -> RegExp
liftPredL1 Char -> Bool
C.isPunctuation
asciiLetter :: RegExp
asciiLetter :: RegExp
asciiLetter = RegExp
asciiLower forall a. Num a => a -> a -> a
+ RegExp
asciiUpper
asciiLower :: RegExp
asciiLower :: RegExp
asciiLower = Char -> Char -> RegExp
Range Char
'a' Char
'z'
asciiUpper :: RegExp
asciiUpper :: RegExp
asciiUpper = Char -> Char -> RegExp
Range Char
'A' Char
'Z'
digit :: RegExp
digit :: RegExp
digit = Char -> Char -> RegExp
Range Char
'0' Char
'9'
octDigit :: RegExp
octDigit :: RegExp
octDigit = Char -> Char -> RegExp
Range Char
'0' Char
'7'
hexDigit :: RegExp
hexDigit :: RegExp
hexDigit = RegExp
digit forall a. Num a => a -> a -> a
+ Char -> Char -> RegExp
Range Char
'a' Char
'f' forall a. Num a => a -> a -> a
+ Char -> Char -> RegExp
Range Char
'A' Char
'F'
decimal :: RegExp
decimal :: RegExp
decimal = RegExp -> RegExp
KPlus RegExp
digit
octal :: RegExp
octal :: RegExp
octal = (RegExp
"0o" forall a. Num a => a -> a -> a
+ RegExp
"0O") forall a. Num a => a -> a -> a
* RegExp -> RegExp
KPlus RegExp
octDigit
hexadecimal :: RegExp
hexadecimal :: RegExp
hexadecimal = (RegExp
"0x" forall a. Num a => a -> a -> a
+ RegExp
"0X") forall a. Num a => a -> a -> a
* RegExp -> RegExp
KPlus RegExp
hexDigit
floating :: RegExp
floating :: RegExp
floating = RegExp
withFraction forall a. Num a => a -> a -> a
+ RegExp
withoutFraction
where withFraction :: RegExp
withFraction = RegExp
decimal forall a. Num a => a -> a -> a
* RegExp
"." forall a. Num a => a -> a -> a
* RegExp
decimal forall a. Num a => a -> a -> a
* RegExp -> RegExp
Opt RegExp
expt
withoutFraction :: RegExp
withoutFraction = RegExp
decimal forall a. Num a => a -> a -> a
* RegExp
expt
expt :: RegExp
expt = (RegExp
"e" forall a. Num a => a -> a -> a
+ RegExp
"E") forall a. Num a => a -> a -> a
* RegExp -> RegExp
Opt (String -> RegExp
oneOf String
"+-") forall a. Num a => a -> a -> a
* RegExp
decimal
identifier :: RegExp
identifier :: RegExp
identifier = RegExp
asciiLower forall a. Num a => a -> a -> a
* RegExp -> RegExp
KStar (RegExp
asciiLetter forall a. Num a => a -> a -> a
+ RegExp
digit forall a. Num a => a -> a -> a
+ RegExp
"_" forall a. Num a => a -> a -> a
+ RegExp
"'")
lift1 :: forall a b. (SymVal a, SymVal b) => StrOp -> Maybe (a -> b) -> SBV a -> SBV b
lift1 :: forall a b.
(SymVal a, SymVal b) =>
StrOp -> Maybe (a -> b) -> SBV a -> SBV b
lift1 StrOp
w Maybe (a -> b)
mbOp SBV a
a
| Just SBV b
cv <- forall a b.
(SymVal a, SymVal b) =>
Maybe (a -> b) -> SBV a -> Maybe (SBV b)
concEval1 Maybe (a -> b)
mbOp SBV a
a
= SBV b
cv
| Bool
True
= forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @b)
r :: State -> IO SV
r State
st = do SV
sva <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
a
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp (StrOp -> Op
StrOp StrOp
w) [SV
sva])
concEval1 :: (SymVal a, SymVal b) => Maybe (a -> b) -> SBV a -> Maybe (SBV b)
concEval1 :: forall a b.
(SymVal a, SymVal b) =>
Maybe (a -> b) -> SBV a -> Maybe (SBV b)
concEval1 Maybe (a -> b)
mbOp SBV a
a = forall a. SymVal a => a -> SBV a
literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (a -> b)
mbOp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
a)
__unused :: a
__unused :: forall a. a
__unused = forall a. HasCallStack => a
undefined SChar -> SBool
isSpaceL1 SString -> SInteger
length SInteger -> SString -> SString
take SChar -> SString -> SBool
elem SChar -> SString -> SBool
notElem SString -> SChar
head