module Data.LLVM.BitCode.Match where
import Data.LLVM.BitCode.Bitstream
import Data.LLVM.BitCode.Parse
import Control.Monad (MonadPlus(..),guard)
type Match i a = i -> Maybe a
match :: Match i a -> i -> Parse a
match :: forall i a. Match i a -> i -> Parse a
match Match i a
p i
i =
case Match i a
p i
i of
Just a
a -> a -> Parse a
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Maybe a
Nothing -> String -> Parse a
forall a. String -> Parse a
failWithContext String
"match failed"
keep :: Match i i
keep :: forall i. Match i i
keep = i -> Maybe i
forall i. Match i i
forall (m :: * -> *) a. Monad m => a -> m a
return
skip :: Match i a
skip :: forall i a. Match i a
skip i
_ = Maybe a
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
infixr 8 |||
(|||) :: Match a b -> Match a b -> Match a b
||| :: forall a b. Match a b -> Match a b -> Match a b
(|||) Match a b
l Match a b
r a
a = Match a b
l a
a Maybe b -> Maybe b -> Maybe b
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Match a b
r a
a
tryMatch :: Match a b -> Match a (Maybe b)
tryMatch :: forall a b. Match a b -> Match a (Maybe b)
tryMatch Match a b
m = (b -> Maybe b) -> Maybe b -> Maybe (Maybe b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall i. Match i i
Just (Maybe b -> Maybe (Maybe b)) -> Match a b -> a -> Maybe (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match a b
m (a -> Maybe (Maybe b))
-> (a -> Maybe (Maybe b)) -> a -> Maybe (Maybe b)
forall a b. Match a b -> Match a b -> Match a b
||| Maybe (Maybe b) -> a -> Maybe (Maybe b)
forall a b. a -> b -> a
const (Maybe b -> Maybe (Maybe b)
forall i. Match i i
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing)
oneChild :: Match [a] a
oneChild :: forall a. Match [a] a
oneChild [a
a] = Match a a
forall i. Match i i
keep a
a
oneChild [a]
_ = Maybe a
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
findMatch :: Match a b -> Match [a] (Maybe b)
findMatch :: forall a b. Match a b -> Match [a] (Maybe b)
findMatch Match a b
p (a
a:[a]
as) = (b -> Maybe b
forall i. Match i i
Just (b -> Maybe b) -> Maybe b -> Maybe (Maybe b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Match a b
p a
a) Maybe (Maybe b) -> Maybe (Maybe b) -> Maybe (Maybe b)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Match a b -> Match [a] (Maybe b)
forall a b. Match a b -> Match [a] (Maybe b)
findMatch Match a b
p [a]
as
findMatch Match a b
_ [] = Maybe b -> Maybe (Maybe b)
forall i. Match i i
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
index :: Int -> Match [a] a
index :: forall a. RecordId -> Match [a] a
index RecordId
n [a]
as = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RecordId
n RecordId -> RecordId -> Bool
forall a. Ord a => a -> a -> Bool
>= RecordId
0 Bool -> Bool -> Bool
&& RecordId
n RecordId -> RecordId -> Bool
forall a. Ord a => a -> a -> Bool
< [a] -> RecordId
forall a. [a] -> RecordId
forall (t :: * -> *) a. Foldable t => t a -> RecordId
length [a]
as)
a -> Maybe a
forall i. Match i i
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
as [a] -> RecordId -> a
forall a. HasCallStack => [a] -> RecordId -> a
!! RecordId
n)
dropUntil :: Match a b -> Match [a] (b,[a])
dropUntil :: forall a b. Match a b -> Match [a] (b, [a])
dropUntil Match a b
p (a
a:[a]
as) = Maybe (b, [a])
success Maybe (b, [a]) -> Maybe (b, [a]) -> Maybe (b, [a])
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Match a b -> Match [a] (b, [a])
forall a b. Match a b -> Match [a] (b, [a])
dropUntil Match a b
p [a]
as
where
success :: Maybe (b, [a])
success = do
b
b <- Match a b
p a
a
(b, [a]) -> Maybe (b, [a])
forall i. Match i i
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b,[a]
as)
dropUntil Match a b
_ [] = Maybe (b, [a])
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
block :: Match Entry Block
block :: Match Entry Block
block (EntryBlock Block
b) = Match Block Block
forall i. Match i i
keep Block
b
block Entry
_ = Maybe Block
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
unabbrev :: Match Entry UnabbrevRecord
unabbrev :: Match Entry UnabbrevRecord
unabbrev (EntryUnabbrevRecord UnabbrevRecord
r) = Match UnabbrevRecord UnabbrevRecord
forall i. Match i i
keep UnabbrevRecord
r
unabbrev Entry
_ = Maybe UnabbrevRecord
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
abbrev :: Match Entry AbbrevRecord
abbrev :: Match Entry AbbrevRecord
abbrev (EntryAbbrevRecord AbbrevRecord
r) = Match AbbrevRecord AbbrevRecord
forall i. Match i i
keep AbbrevRecord
r
abbrev Entry
_ = Maybe AbbrevRecord
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
abbrevDef :: Match Entry DefineAbbrev
abbrevDef :: Match Entry DefineAbbrev
abbrevDef (EntryDefineAbbrev DefineAbbrev
d) = Match DefineAbbrev DefineAbbrev
forall i. Match i i
keep DefineAbbrev
d
abbrevDef Entry
_ = Maybe DefineAbbrev
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
hasBlockId :: BlockId -> Match Block Block
hasBlockId :: BlockId -> Match Block Block
hasBlockId BlockId
bid Block
b | Block -> BlockId
blockId Block
b BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== BlockId
bid = Match Block Block
forall i. Match i i
keep Block
b
| Bool
otherwise = Maybe Block
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
hasUnabbrevCode :: RecordId -> Match UnabbrevRecord UnabbrevRecord
hasUnabbrevCode :: RecordId -> Match UnabbrevRecord UnabbrevRecord
hasUnabbrevCode RecordId
rid UnabbrevRecord
r | UnabbrevRecord -> RecordId
unabbrevCode UnabbrevRecord
r RecordId -> RecordId -> Bool
forall a. Eq a => a -> a -> Bool
== RecordId
rid = Match UnabbrevRecord UnabbrevRecord
forall i. Match i i
keep UnabbrevRecord
r
| Bool
otherwise = Maybe UnabbrevRecord
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero