{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module LLVM.IRBuilder.Monad where
import LLVM.Prelude
import Control.Monad.Cont
import Control.Monad.Except
import qualified Control.Monad.Fail as Fail
import Control.Monad.Identity
import qualified Control.Monad.Writer.Lazy as Lazy
import qualified Control.Monad.Writer.Strict as Strict
import Control.Monad.Writer (MonadWriter)
import Control.Monad.Reader
import qualified Control.Monad.RWS.Lazy as Lazy
import qualified Control.Monad.RWS.Strict as Strict
import qualified Control.Monad.State.Lazy as Lazy
import Control.Monad.State.Strict
import Control.Monad.Trans.Maybe
#if !(MIN_VERSION_mtl(2,2,2))
import Control.Monad.Trans.Identity
#endif
#if __GLASGOW_HASKELL__ < 808
import Control.Monad.Fail (MonadFail)
#endif
import Data.Bifunctor
import Data.Monoid (First(..))
import Data.String
import Data.Map.Strict(Map)
import qualified Data.Map.Strict as M
import GHC.Stack
import LLVM.AST
import LLVM.IRBuilder.Internal.SnocList
newtype IRBuilderT m a = IRBuilderT { forall (m :: * -> *) a. IRBuilderT m a -> StateT IRBuilderState m a
unIRBuilderT :: StateT IRBuilderState m a }
deriving
( (forall a b. (a -> b) -> IRBuilderT m a -> IRBuilderT m b)
-> (forall a b. a -> IRBuilderT m b -> IRBuilderT m a)
-> Functor (IRBuilderT m)
forall a b. a -> IRBuilderT m b -> IRBuilderT m a
forall a b. (a -> b) -> IRBuilderT m a -> IRBuilderT m b
forall (m :: * -> *) a b.
Functor m =>
a -> IRBuilderT m b -> IRBuilderT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> IRBuilderT m a -> IRBuilderT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> IRBuilderT m a -> IRBuilderT m b
fmap :: forall a b. (a -> b) -> IRBuilderT m a -> IRBuilderT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> IRBuilderT m b -> IRBuilderT m a
<$ :: forall a b. a -> IRBuilderT m b -> IRBuilderT m a
Functor, Applicative (IRBuilderT m)
Applicative (IRBuilderT m)
-> (forall a. IRBuilderT m a)
-> (forall a. IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a)
-> (forall a. IRBuilderT m a -> IRBuilderT m [a])
-> (forall a. IRBuilderT m a -> IRBuilderT m [a])
-> Alternative (IRBuilderT m)
forall a. IRBuilderT m a
forall a. IRBuilderT m a -> IRBuilderT m [a]
forall a. IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall {m :: * -> *}. MonadPlus m => Applicative (IRBuilderT m)
forall (m :: * -> *) a. MonadPlus m => IRBuilderT m a
forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m [a]
forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
$cempty :: forall (m :: * -> *) a. MonadPlus m => IRBuilderT m a
empty :: forall a. IRBuilderT m a
$c<|> :: forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
<|> :: forall a. IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
$csome :: forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m [a]
some :: forall a. IRBuilderT m a -> IRBuilderT m [a]
$cmany :: forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m [a]
many :: forall a. IRBuilderT m a -> IRBuilderT m [a]
Alternative, Functor (IRBuilderT m)
Functor (IRBuilderT m)
-> (forall a. a -> IRBuilderT m a)
-> (forall a b.
IRBuilderT m (a -> b) -> IRBuilderT m a -> IRBuilderT m b)
-> (forall a b c.
(a -> b -> c)
-> IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m c)
-> (forall a b. IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b)
-> (forall a b. IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m a)
-> Applicative (IRBuilderT m)
forall a. a -> IRBuilderT m a
forall a b. IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m a
forall a b. IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
forall a b.
IRBuilderT m (a -> b) -> IRBuilderT m a -> IRBuilderT m b
forall a b c.
(a -> b -> c) -> IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m c
forall {m :: * -> *}. Monad m => Functor (IRBuilderT m)
forall (m :: * -> *) a. Monad m => a -> IRBuilderT m a
forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m a
forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m (a -> b) -> IRBuilderT m a -> IRBuilderT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> IRBuilderT m a
pure :: forall a. a -> IRBuilderT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m (a -> b) -> IRBuilderT m a -> IRBuilderT m b
<*> :: forall a b.
IRBuilderT m (a -> b) -> IRBuilderT m a -> IRBuilderT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m c
liftA2 :: forall a b c.
(a -> b -> c) -> IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
*> :: forall a b. IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m a
<* :: forall a b. IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m a
Applicative, Applicative (IRBuilderT m)
Applicative (IRBuilderT m)
-> (forall a b.
IRBuilderT m a -> (a -> IRBuilderT m b) -> IRBuilderT m b)
-> (forall a b. IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b)
-> (forall a. a -> IRBuilderT m a)
-> Monad (IRBuilderT m)
forall a. a -> IRBuilderT m a
forall a b. IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
forall a b.
IRBuilderT m a -> (a -> IRBuilderT m b) -> IRBuilderT m b
forall (m :: * -> *). Monad m => Applicative (IRBuilderT m)
forall (m :: * -> *) a. Monad m => a -> IRBuilderT m a
forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> (a -> IRBuilderT m b) -> IRBuilderT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> (a -> IRBuilderT m b) -> IRBuilderT m b
>>= :: forall a b.
IRBuilderT m a -> (a -> IRBuilderT m b) -> IRBuilderT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
>> :: forall a b. IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> IRBuilderT m a
return :: forall a. a -> IRBuilderT m a
Monad, Monad (IRBuilderT m)
Monad (IRBuilderT m)
-> (forall a b.
((a -> IRBuilderT m b) -> IRBuilderT m a) -> IRBuilderT m a)
-> MonadCont (IRBuilderT m)
forall a b.
((a -> IRBuilderT m b) -> IRBuilderT m a) -> IRBuilderT m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall {m :: * -> *}. MonadCont m => Monad (IRBuilderT m)
forall (m :: * -> *) a b.
MonadCont m =>
((a -> IRBuilderT m b) -> IRBuilderT m a) -> IRBuilderT m a
$ccallCC :: forall (m :: * -> *) a b.
MonadCont m =>
((a -> IRBuilderT m b) -> IRBuilderT m a) -> IRBuilderT m a
callCC :: forall a b.
((a -> IRBuilderT m b) -> IRBuilderT m a) -> IRBuilderT m a
MonadCont, MonadError e
, Monad (IRBuilderT m)
Monad (IRBuilderT m)
-> (forall a. (a -> IRBuilderT m a) -> IRBuilderT m a)
-> MonadFix (IRBuilderT m)
forall a. (a -> IRBuilderT m a) -> IRBuilderT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (IRBuilderT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> IRBuilderT m a) -> IRBuilderT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> IRBuilderT m a) -> IRBuilderT m a
mfix :: forall a. (a -> IRBuilderT m a) -> IRBuilderT m a
MonadFix, Monad (IRBuilderT m)
Monad (IRBuilderT m)
-> (forall a. IO a -> IRBuilderT m a) -> MonadIO (IRBuilderT m)
forall a. IO a -> IRBuilderT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (IRBuilderT m)
forall (m :: * -> *) a. MonadIO m => IO a -> IRBuilderT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> IRBuilderT m a
liftIO :: forall a. IO a -> IRBuilderT m a
MonadIO, Monad (IRBuilderT m)
Alternative (IRBuilderT m)
Alternative (IRBuilderT m)
-> Monad (IRBuilderT m)
-> (forall a. IRBuilderT m a)
-> (forall a. IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a)
-> MonadPlus (IRBuilderT m)
forall a. IRBuilderT m a
forall a. IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
forall {m :: * -> *}. MonadPlus m => Monad (IRBuilderT m)
forall (m :: * -> *). MonadPlus m => Alternative (IRBuilderT m)
forall (m :: * -> *) a. MonadPlus m => IRBuilderT m a
forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
$cmzero :: forall (m :: * -> *) a. MonadPlus m => IRBuilderT m a
mzero :: forall a. IRBuilderT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
mplus :: forall a. IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
MonadPlus, MonadReader r, (forall (m :: * -> *) a. Monad m => m a -> IRBuilderT m a)
-> MonadTrans IRBuilderT
forall (m :: * -> *) a. Monad m => m a -> IRBuilderT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> IRBuilderT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> IRBuilderT m a
MonadTrans, MonadWriter w
)
instance MonadFail m => MonadFail (IRBuilderT m) where
fail :: forall a. String -> IRBuilderT m a
fail String
str = StateT IRBuilderState m a -> IRBuilderT m a
forall (m :: * -> *) a. StateT IRBuilderState m a -> IRBuilderT m a
IRBuilderT ((IRBuilderState -> m (a, IRBuilderState))
-> StateT IRBuilderState m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((IRBuilderState -> m (a, IRBuilderState))
-> StateT IRBuilderState m a)
-> (IRBuilderState -> m (a, IRBuilderState))
-> StateT IRBuilderState m a
forall a b. (a -> b) -> a -> b
$ \ IRBuilderState
_ -> String -> m (a, IRBuilderState)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
str)
type IRBuilder = IRBuilderT Identity
class Monad m => MonadIRBuilder m where
liftIRState :: State IRBuilderState a -> m a
default liftIRState
:: (MonadTrans t, MonadIRBuilder m1, m ~ t m1)
=> State IRBuilderState a
-> m a
liftIRState = m1 a -> m a
m1 a -> t m1 a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 a -> m a)
-> (State IRBuilderState a -> m1 a)
-> State IRBuilderState a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State IRBuilderState a -> m1 a
forall a. State IRBuilderState a -> m1 a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState
instance Monad m => MonadIRBuilder (IRBuilderT m) where
liftIRState :: forall a. State IRBuilderState a -> IRBuilderT m a
liftIRState (StateT IRBuilderState -> Identity (a, IRBuilderState)
s) = StateT IRBuilderState m a -> IRBuilderT m a
forall (m :: * -> *) a. StateT IRBuilderState m a -> IRBuilderT m a
IRBuilderT (StateT IRBuilderState m a -> IRBuilderT m a)
-> StateT IRBuilderState m a -> IRBuilderT m a
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> m (a, IRBuilderState))
-> StateT IRBuilderState m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((IRBuilderState -> m (a, IRBuilderState))
-> StateT IRBuilderState m a)
-> (IRBuilderState -> m (a, IRBuilderState))
-> StateT IRBuilderState m a
forall a b. (a -> b) -> a -> b
$ (a, IRBuilderState) -> m (a, IRBuilderState)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, IRBuilderState) -> m (a, IRBuilderState))
-> (IRBuilderState -> (a, IRBuilderState))
-> IRBuilderState
-> m (a, IRBuilderState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (a, IRBuilderState) -> (a, IRBuilderState)
forall a. Identity a -> a
runIdentity (Identity (a, IRBuilderState) -> (a, IRBuilderState))
-> (IRBuilderState -> Identity (a, IRBuilderState))
-> IRBuilderState
-> (a, IRBuilderState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRBuilderState -> Identity (a, IRBuilderState)
s
data PartialBlock = PartialBlock
{ PartialBlock -> Name
partialBlockName :: !Name
, PartialBlock -> SnocList (Named Instruction)
partialBlockInstrs :: SnocList (Named Instruction)
, PartialBlock -> First (Named Terminator)
partialBlockTerm :: First (Named Terminator)
}
emptyPartialBlock :: Name -> PartialBlock
emptyPartialBlock :: Name -> PartialBlock
emptyPartialBlock Name
nm = Name
-> SnocList (Named Instruction)
-> First (Named Terminator)
-> PartialBlock
PartialBlock Name
nm SnocList (Named Instruction)
forall a. Monoid a => a
mempty (Maybe (Named Terminator) -> First (Named Terminator)
forall a. Maybe a -> First a
First Maybe (Named Terminator)
forall a. Maybe a
Nothing)
data IRBuilderState = IRBuilderState
{ IRBuilderState -> Word
builderSupply :: !Word
, IRBuilderState -> Map ShortByteString Word
builderUsedNames :: !(Map ShortByteString Word)
, IRBuilderState -> Maybe ShortByteString
builderNameSuggestion :: !(Maybe ShortByteString)
, IRBuilderState -> SnocList BasicBlock
builderBlocks :: SnocList BasicBlock
, IRBuilderState -> Maybe PartialBlock
builderBlock :: !(Maybe PartialBlock)
}
emptyIRBuilder :: IRBuilderState
emptyIRBuilder :: IRBuilderState
emptyIRBuilder = IRBuilderState
{ builderSupply :: Word
builderSupply = Word
0
, builderUsedNames :: Map ShortByteString Word
builderUsedNames = Map ShortByteString Word
forall a. Monoid a => a
mempty
, builderNameSuggestion :: Maybe ShortByteString
builderNameSuggestion = Maybe ShortByteString
forall a. Maybe a
Nothing
, builderBlocks :: SnocList BasicBlock
builderBlocks = SnocList BasicBlock
forall a. Monoid a => a
mempty
, builderBlock :: Maybe PartialBlock
builderBlock = Maybe PartialBlock
forall a. Maybe a
Nothing
}
runIRBuilder :: IRBuilderState -> IRBuilder a -> (a, [BasicBlock])
runIRBuilder :: forall a. IRBuilderState -> IRBuilder a -> (a, [BasicBlock])
runIRBuilder IRBuilderState
s IRBuilder a
m = Identity (a, [BasicBlock]) -> (a, [BasicBlock])
forall a. Identity a -> a
runIdentity (Identity (a, [BasicBlock]) -> (a, [BasicBlock]))
-> Identity (a, [BasicBlock]) -> (a, [BasicBlock])
forall a b. (a -> b) -> a -> b
$ IRBuilderState -> IRBuilder a -> Identity (a, [BasicBlock])
forall (m :: * -> *) a.
Monad m =>
IRBuilderState -> IRBuilderT m a -> m (a, [BasicBlock])
runIRBuilderT IRBuilderState
s IRBuilder a
m
runIRBuilderT :: Monad m => IRBuilderState -> IRBuilderT m a -> m (a, [BasicBlock])
runIRBuilderT :: forall (m :: * -> *) a.
Monad m =>
IRBuilderState -> IRBuilderT m a -> m (a, [BasicBlock])
runIRBuilderT IRBuilderState
s IRBuilderT m a
m
= (IRBuilderState -> [BasicBlock])
-> (a, IRBuilderState) -> (a, [BasicBlock])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (SnocList BasicBlock -> [BasicBlock]
forall a. SnocList a -> [a]
getSnocList (SnocList BasicBlock -> [BasicBlock])
-> (IRBuilderState -> SnocList BasicBlock)
-> IRBuilderState
-> [BasicBlock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRBuilderState -> SnocList BasicBlock
builderBlocks)
((a, IRBuilderState) -> (a, [BasicBlock]))
-> m (a, IRBuilderState) -> m (a, [BasicBlock])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IRBuilderState m a
-> IRBuilderState -> m (a, IRBuilderState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (IRBuilderT m a -> StateT IRBuilderState m a
forall (m :: * -> *) a. IRBuilderT m a -> StateT IRBuilderState m a
unIRBuilderT (IRBuilderT m a -> StateT IRBuilderState m a)
-> IRBuilderT m a -> StateT IRBuilderState m a
forall a b. (a -> b) -> a -> b
$ IRBuilderT m a
m IRBuilderT m a -> IRBuilderT m Name -> IRBuilderT m a
forall a b. IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IRBuilderT m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
block) IRBuilderState
s
execIRBuilder :: IRBuilderState -> IRBuilder a -> [BasicBlock]
execIRBuilder :: forall a. IRBuilderState -> IRBuilder a -> [BasicBlock]
execIRBuilder IRBuilderState
s IRBuilder a
m = (a, [BasicBlock]) -> [BasicBlock]
forall a b. (a, b) -> b
snd ((a, [BasicBlock]) -> [BasicBlock])
-> (a, [BasicBlock]) -> [BasicBlock]
forall a b. (a -> b) -> a -> b
$ IRBuilderState -> IRBuilder a -> (a, [BasicBlock])
forall a. IRBuilderState -> IRBuilder a -> (a, [BasicBlock])
runIRBuilder IRBuilderState
s IRBuilder a
m
execIRBuilderT :: Monad m => IRBuilderState -> IRBuilderT m a -> m [BasicBlock]
execIRBuilderT :: forall (m :: * -> *) a.
Monad m =>
IRBuilderState -> IRBuilderT m a -> m [BasicBlock]
execIRBuilderT IRBuilderState
s IRBuilderT m a
m = (a, [BasicBlock]) -> [BasicBlock]
forall a b. (a, b) -> b
snd ((a, [BasicBlock]) -> [BasicBlock])
-> m (a, [BasicBlock]) -> m [BasicBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRBuilderState -> IRBuilderT m a -> m (a, [BasicBlock])
forall (m :: * -> *) a.
Monad m =>
IRBuilderState -> IRBuilderT m a -> m (a, [BasicBlock])
runIRBuilderT IRBuilderState
s IRBuilderT m a
m
ensureBlock :: MonadIRBuilder m => m ()
ensureBlock :: forall (m :: * -> *). MonadIRBuilder m => m ()
ensureBlock = do
Maybe PartialBlock
mbb <- State IRBuilderState (Maybe PartialBlock) -> m (Maybe PartialBlock)
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState (Maybe PartialBlock)
-> m (Maybe PartialBlock))
-> State IRBuilderState (Maybe PartialBlock)
-> m (Maybe PartialBlock)
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> Maybe PartialBlock)
-> State IRBuilderState (Maybe PartialBlock)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRBuilderState -> Maybe PartialBlock
builderBlock
case Maybe PartialBlock
mbb of
Maybe PartialBlock
Nothing -> do
Name
nm <- m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
freshUnName
State IRBuilderState () -> m ()
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState () -> m ())
-> State IRBuilderState () -> m ()
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRBuilderState -> IRBuilderState) -> State IRBuilderState ())
-> (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall a b. (a -> b) -> a -> b
$ \IRBuilderState
s -> IRBuilderState
s { builderBlock :: Maybe PartialBlock
builderBlock = PartialBlock -> Maybe PartialBlock
forall a. a -> Maybe a
Just (PartialBlock -> Maybe PartialBlock)
-> PartialBlock -> Maybe PartialBlock
forall a b. (a -> b) -> a -> b
$! Name -> PartialBlock
emptyPartialBlock Name
nm }
Just PartialBlock
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
modifyBlock
:: MonadIRBuilder m
=> (PartialBlock -> PartialBlock)
-> m ()
modifyBlock :: forall (m :: * -> *).
MonadIRBuilder m =>
(PartialBlock -> PartialBlock) -> m ()
modifyBlock PartialBlock -> PartialBlock
f = do
Maybe PartialBlock
mbb <- State IRBuilderState (Maybe PartialBlock) -> m (Maybe PartialBlock)
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState (Maybe PartialBlock)
-> m (Maybe PartialBlock))
-> State IRBuilderState (Maybe PartialBlock)
-> m (Maybe PartialBlock)
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> Maybe PartialBlock)
-> State IRBuilderState (Maybe PartialBlock)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRBuilderState -> Maybe PartialBlock
builderBlock
case Maybe PartialBlock
mbb of
Maybe PartialBlock
Nothing -> do
Name
nm <- m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
freshUnName
State IRBuilderState () -> m ()
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState () -> m ())
-> State IRBuilderState () -> m ()
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRBuilderState -> IRBuilderState) -> State IRBuilderState ())
-> (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall a b. (a -> b) -> a -> b
$ \IRBuilderState
s -> IRBuilderState
s { builderBlock :: Maybe PartialBlock
builderBlock = PartialBlock -> Maybe PartialBlock
forall a. a -> Maybe a
Just (PartialBlock -> Maybe PartialBlock)
-> PartialBlock -> Maybe PartialBlock
forall a b. (a -> b) -> a -> b
$! PartialBlock -> PartialBlock
f (PartialBlock -> PartialBlock) -> PartialBlock -> PartialBlock
forall a b. (a -> b) -> a -> b
$ Name -> PartialBlock
emptyPartialBlock Name
nm }
Just PartialBlock
bb ->
State IRBuilderState () -> m ()
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState () -> m ())
-> State IRBuilderState () -> m ()
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRBuilderState -> IRBuilderState) -> State IRBuilderState ())
-> (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall a b. (a -> b) -> a -> b
$ \IRBuilderState
s -> IRBuilderState
s { builderBlock :: Maybe PartialBlock
builderBlock = PartialBlock -> Maybe PartialBlock
forall a. a -> Maybe a
Just (PartialBlock -> Maybe PartialBlock)
-> PartialBlock -> Maybe PartialBlock
forall a b. (a -> b) -> a -> b
$! PartialBlock -> PartialBlock
f PartialBlock
bb }
fresh :: MonadIRBuilder m => m Name
fresh :: forall (m :: * -> *). MonadIRBuilder m => m Name
fresh = do
Maybe ShortByteString
msuggestion <- State IRBuilderState (Maybe ShortByteString)
-> m (Maybe ShortByteString)
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState (Maybe ShortByteString)
-> m (Maybe ShortByteString))
-> State IRBuilderState (Maybe ShortByteString)
-> m (Maybe ShortByteString)
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> Maybe ShortByteString)
-> State IRBuilderState (Maybe ShortByteString)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRBuilderState -> Maybe ShortByteString
builderNameSuggestion
m Name
-> (ShortByteString -> m Name) -> Maybe ShortByteString -> m Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
freshUnName ShortByteString -> m Name
forall (m :: * -> *). MonadIRBuilder m => ShortByteString -> m Name
freshName Maybe ShortByteString
msuggestion
freshName :: MonadIRBuilder m => ShortByteString -> m Name
freshName :: forall (m :: * -> *). MonadIRBuilder m => ShortByteString -> m Name
freshName ShortByteString
suggestion = do
Map ShortByteString Word
usedNames <- State IRBuilderState (Map ShortByteString Word)
-> m (Map ShortByteString Word)
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState (Map ShortByteString Word)
-> m (Map ShortByteString Word))
-> State IRBuilderState (Map ShortByteString Word)
-> m (Map ShortByteString Word)
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> Map ShortByteString Word)
-> State IRBuilderState (Map ShortByteString Word)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRBuilderState -> Map ShortByteString Word
builderUsedNames
let
nameCount :: Word
nameCount = Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe Word
0 (Maybe Word -> Word) -> Maybe Word -> Word
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Map ShortByteString Word -> Maybe Word
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ShortByteString
suggestion Map ShortByteString Word
usedNames
unusedName :: ShortByteString
unusedName = ShortByteString
suggestion ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
<> String -> ShortByteString
forall a. IsString a => String -> a
fromString (String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
nameCount)
updatedUsedNames :: Map ShortByteString Word
updatedUsedNames = ShortByteString
-> Word -> Map ShortByteString Word -> Map ShortByteString Word
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ShortByteString
suggestion (Word
nameCount Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) Map ShortByteString Word
usedNames
State IRBuilderState () -> m ()
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState () -> m ())
-> State IRBuilderState () -> m ()
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRBuilderState -> IRBuilderState) -> State IRBuilderState ())
-> (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall a b. (a -> b) -> a -> b
$ \IRBuilderState
s -> IRBuilderState
s { builderUsedNames :: Map ShortByteString Word
builderUsedNames = Map ShortByteString Word
updatedUsedNames }
Name -> m Name
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> m Name) -> Name -> m Name
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Name
Name ShortByteString
unusedName
freshUnName :: MonadIRBuilder m => m Name
freshUnName :: forall (m :: * -> *). MonadIRBuilder m => m Name
freshUnName = State IRBuilderState Name -> m Name
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState Name -> m Name)
-> State IRBuilderState Name -> m Name
forall a b. (a -> b) -> a -> b
$ do
Word
n <- (IRBuilderState -> Word) -> StateT IRBuilderState Identity Word
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRBuilderState -> Word
builderSupply
(IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRBuilderState -> IRBuilderState) -> State IRBuilderState ())
-> (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall a b. (a -> b) -> a -> b
$ \IRBuilderState
s -> IRBuilderState
s { builderSupply :: Word
builderSupply = Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
n }
Name -> State IRBuilderState Name
forall a. a -> StateT IRBuilderState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> State IRBuilderState Name)
-> Name -> State IRBuilderState Name
forall a b. (a -> b) -> a -> b
$ Word -> Name
UnName Word
n
emitInstr
:: MonadIRBuilder m
=> Type
-> Instruction
-> m Operand
emitInstr :: forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
retty Instruction
instr = do
m ()
forall (m :: * -> *). MonadIRBuilder m => m ()
ensureBlock
Name
nm <- m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
fresh
(PartialBlock -> PartialBlock) -> m ()
forall (m :: * -> *).
MonadIRBuilder m =>
(PartialBlock -> PartialBlock) -> m ()
modifyBlock ((PartialBlock -> PartialBlock) -> m ())
-> (PartialBlock -> PartialBlock) -> m ()
forall a b. (a -> b) -> a -> b
$ \PartialBlock
bb -> PartialBlock
bb
{ partialBlockInstrs :: SnocList (Named Instruction)
partialBlockInstrs = PartialBlock -> SnocList (Named Instruction)
partialBlockInstrs PartialBlock
bb SnocList (Named Instruction)
-> Named Instruction -> SnocList (Named Instruction)
forall a. SnocList a -> a -> SnocList a
`snoc` (Name
nm Name -> Instruction -> Named Instruction
forall a. Name -> a -> Named a
:= Instruction
instr)
}
Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Name -> Operand
LocalReference Type
retty Name
nm)
emitInstrVoid
:: MonadIRBuilder m
=> Instruction
-> m ()
emitInstrVoid :: forall (m :: * -> *). MonadIRBuilder m => Instruction -> m ()
emitInstrVoid Instruction
instr = do
(PartialBlock -> PartialBlock) -> m ()
forall (m :: * -> *).
MonadIRBuilder m =>
(PartialBlock -> PartialBlock) -> m ()
modifyBlock ((PartialBlock -> PartialBlock) -> m ())
-> (PartialBlock -> PartialBlock) -> m ()
forall a b. (a -> b) -> a -> b
$ \PartialBlock
bb -> PartialBlock
bb
{ partialBlockInstrs :: SnocList (Named Instruction)
partialBlockInstrs = PartialBlock -> SnocList (Named Instruction)
partialBlockInstrs PartialBlock
bb SnocList (Named Instruction)
-> Named Instruction -> SnocList (Named Instruction)
forall a. SnocList a -> a -> SnocList a
`snoc` (Instruction -> Named Instruction
forall a. a -> Named a
Do Instruction
instr)
}
() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
emitTerm
:: MonadIRBuilder m
=> Terminator
-> m ()
emitTerm :: forall (m :: * -> *). MonadIRBuilder m => Terminator -> m ()
emitTerm Terminator
term = (PartialBlock -> PartialBlock) -> m ()
forall (m :: * -> *).
MonadIRBuilder m =>
(PartialBlock -> PartialBlock) -> m ()
modifyBlock ((PartialBlock -> PartialBlock) -> m ())
-> (PartialBlock -> PartialBlock) -> m ()
forall a b. (a -> b) -> a -> b
$ \PartialBlock
bb -> PartialBlock
bb
{ partialBlockTerm :: First (Named Terminator)
partialBlockTerm = PartialBlock -> First (Named Terminator)
partialBlockTerm PartialBlock
bb First (Named Terminator)
-> First (Named Terminator) -> First (Named Terminator)
forall a. Semigroup a => a -> a -> a
<> Maybe (Named Terminator) -> First (Named Terminator)
forall a. Maybe a -> First a
First (Named Terminator -> Maybe (Named Terminator)
forall a. a -> Maybe a
Just (Terminator -> Named Terminator
forall a. a -> Named a
Do Terminator
term))
}
emitBlockStart
:: MonadIRBuilder m
=> Name
-> m ()
emitBlockStart :: forall (m :: * -> *). MonadIRBuilder m => Name -> m ()
emitBlockStart Name
nm = do
Maybe PartialBlock
mbb <- State IRBuilderState (Maybe PartialBlock) -> m (Maybe PartialBlock)
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState (Maybe PartialBlock)
-> m (Maybe PartialBlock))
-> State IRBuilderState (Maybe PartialBlock)
-> m (Maybe PartialBlock)
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> Maybe PartialBlock)
-> State IRBuilderState (Maybe PartialBlock)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRBuilderState -> Maybe PartialBlock
builderBlock
case Maybe PartialBlock
mbb of
Maybe PartialBlock
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just PartialBlock
bb -> do
let
instrs :: [Named Instruction]
instrs = SnocList (Named Instruction) -> [Named Instruction]
forall a. SnocList a -> [a]
getSnocList (SnocList (Named Instruction) -> [Named Instruction])
-> SnocList (Named Instruction) -> [Named Instruction]
forall a b. (a -> b) -> a -> b
$ PartialBlock -> SnocList (Named Instruction)
partialBlockInstrs PartialBlock
bb
newBb :: BasicBlock
newBb = case First (Named Terminator) -> Maybe (Named Terminator)
forall a. First a -> Maybe a
getFirst (PartialBlock -> First (Named Terminator)
partialBlockTerm PartialBlock
bb) of
Maybe (Named Terminator)
Nothing -> Name -> [Named Instruction] -> Named Terminator -> BasicBlock
BasicBlock (PartialBlock -> Name
partialBlockName PartialBlock
bb) [Named Instruction]
instrs (Terminator -> Named Terminator
forall a. a -> Named a
Do (Maybe Operand -> InstructionMetadata -> Terminator
Ret Maybe Operand
forall a. Maybe a
Nothing []))
Just Named Terminator
term -> Name -> [Named Instruction] -> Named Terminator -> BasicBlock
BasicBlock (PartialBlock -> Name
partialBlockName PartialBlock
bb) [Named Instruction]
instrs Named Terminator
term
State IRBuilderState () -> m ()
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState () -> m ())
-> State IRBuilderState () -> m ()
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRBuilderState -> IRBuilderState) -> State IRBuilderState ())
-> (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall a b. (a -> b) -> a -> b
$ \IRBuilderState
s -> IRBuilderState
s
{ builderBlocks :: SnocList BasicBlock
builderBlocks = IRBuilderState -> SnocList BasicBlock
builderBlocks IRBuilderState
s SnocList BasicBlock -> BasicBlock -> SnocList BasicBlock
forall a. SnocList a -> a -> SnocList a
`snoc` BasicBlock
newBb
}
State IRBuilderState () -> m ()
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState () -> m ())
-> State IRBuilderState () -> m ()
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRBuilderState -> IRBuilderState) -> State IRBuilderState ())
-> (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall a b. (a -> b) -> a -> b
$ \IRBuilderState
s -> IRBuilderState
s { builderBlock :: Maybe PartialBlock
builderBlock = PartialBlock -> Maybe PartialBlock
forall a. a -> Maybe a
Just (PartialBlock -> Maybe PartialBlock)
-> PartialBlock -> Maybe PartialBlock
forall a b. (a -> b) -> a -> b
$ Name -> PartialBlock
emptyPartialBlock Name
nm }
block
:: MonadIRBuilder m
=> m Name
block :: forall (m :: * -> *). MonadIRBuilder m => m Name
block = do
Name
nm <- m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
fresh
Name -> m ()
forall (m :: * -> *). MonadIRBuilder m => Name -> m ()
emitBlockStart Name
nm
Name -> m Name
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
nm
named
:: MonadIRBuilder m
=> m r
-> ShortByteString
-> m r
named :: forall (m :: * -> *) r.
MonadIRBuilder m =>
m r -> ShortByteString -> m r
named m r
ir ShortByteString
name = do
Maybe ShortByteString
before <- State IRBuilderState (Maybe ShortByteString)
-> m (Maybe ShortByteString)
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState (Maybe ShortByteString)
-> m (Maybe ShortByteString))
-> State IRBuilderState (Maybe ShortByteString)
-> m (Maybe ShortByteString)
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> Maybe ShortByteString)
-> State IRBuilderState (Maybe ShortByteString)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRBuilderState -> Maybe ShortByteString
builderNameSuggestion
State IRBuilderState () -> m ()
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState () -> m ())
-> State IRBuilderState () -> m ()
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRBuilderState -> IRBuilderState) -> State IRBuilderState ())
-> (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall a b. (a -> b) -> a -> b
$ \IRBuilderState
s -> IRBuilderState
s { builderNameSuggestion :: Maybe ShortByteString
builderNameSuggestion = ShortByteString -> Maybe ShortByteString
forall a. a -> Maybe a
Just ShortByteString
name }
r
result <- m r
ir
State IRBuilderState () -> m ()
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState () -> m ())
-> State IRBuilderState () -> m ()
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRBuilderState -> IRBuilderState) -> State IRBuilderState ())
-> (IRBuilderState -> IRBuilderState) -> State IRBuilderState ()
forall a b. (a -> b) -> a -> b
$ \IRBuilderState
s -> IRBuilderState
s { builderNameSuggestion :: Maybe ShortByteString
builderNameSuggestion = Maybe ShortByteString
before }
r -> m r
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return r
result
currentBlock :: HasCallStack => MonadIRBuilder m => m Name
currentBlock :: forall (m :: * -> *). (HasCallStack, MonadIRBuilder m) => m Name
currentBlock = State IRBuilderState Name -> m Name
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState Name -> m Name)
-> State IRBuilderState Name -> m Name
forall a b. (a -> b) -> a -> b
$ do
Maybe Name
name <- (IRBuilderState -> Maybe Name)
-> StateT IRBuilderState Identity (Maybe Name)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((PartialBlock -> Name) -> Maybe PartialBlock -> Maybe Name
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PartialBlock -> Name
partialBlockName (Maybe PartialBlock -> Maybe Name)
-> (IRBuilderState -> Maybe PartialBlock)
-> IRBuilderState
-> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRBuilderState -> Maybe PartialBlock
builderBlock)
case Maybe Name
name of
Just Name
n -> Name -> State IRBuilderState Name
forall a. a -> StateT IRBuilderState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n
Maybe Name
Nothing -> String -> State IRBuilderState Name
forall a. HasCallStack => String -> a
error String
"Called currentBlock when no block was active"
hasTerminator :: HasCallStack => MonadIRBuilder m => m Bool
hasTerminator :: forall (m :: * -> *). (HasCallStack, MonadIRBuilder m) => m Bool
hasTerminator = do
Maybe PartialBlock
current <- State IRBuilderState (Maybe PartialBlock) -> m (Maybe PartialBlock)
forall a. State IRBuilderState a -> m a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState (State IRBuilderState (Maybe PartialBlock)
-> m (Maybe PartialBlock))
-> State IRBuilderState (Maybe PartialBlock)
-> m (Maybe PartialBlock)
forall a b. (a -> b) -> a -> b
$ (IRBuilderState -> Maybe PartialBlock)
-> State IRBuilderState (Maybe PartialBlock)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRBuilderState -> Maybe PartialBlock
builderBlock
case Maybe PartialBlock
current of
Maybe PartialBlock
Nothing -> String -> m Bool
forall a. HasCallStack => String -> a
error String
"Called hasTerminator when no block was active"
Just PartialBlock
blk -> case First (Named Terminator) -> Maybe (Named Terminator)
forall a. First a -> Maybe a
getFirst (PartialBlock -> First (Named Terminator)
partialBlockTerm PartialBlock
blk) of
Maybe (Named Terminator)
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Named Terminator
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
instance MonadState s m => MonadState s (IRBuilderT m) where
state :: forall a. (s -> (a, s)) -> IRBuilderT m a
state = m a -> IRBuilderT m a
forall (m :: * -> *) a. Monad m => m a -> IRBuilderT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IRBuilderT m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> IRBuilderT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
instance MonadIRBuilder m => MonadIRBuilder (ContT r m)
instance MonadIRBuilder m => MonadIRBuilder (ExceptT e m)
instance MonadIRBuilder m => MonadIRBuilder (IdentityT m)
instance MonadIRBuilder m => MonadIRBuilder (MaybeT m)
instance MonadIRBuilder m => MonadIRBuilder (ReaderT r m)
instance (MonadIRBuilder m, Monoid w) => MonadIRBuilder (Strict.RWST r w s m)
instance (MonadIRBuilder m, Monoid w) => MonadIRBuilder (Lazy.RWST r w s m)
instance MonadIRBuilder m => MonadIRBuilder (StateT s m)
instance MonadIRBuilder m => MonadIRBuilder (Lazy.StateT s m)
instance (Monoid w, MonadIRBuilder m) => MonadIRBuilder (Strict.WriterT w m)
instance (Monoid w, MonadIRBuilder m) => MonadIRBuilder (Lazy.WriterT w m)