{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}
module LLVM.IRBuilder.Monad where
import LLVM.Prelude
import Control.Monad.Cont
import Control.Monad.Except
import Control.Monad.Fail
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.List
import Control.Monad.Trans.Maybe
#if !(MIN_VERSION_mtl(2,2,2))
import Control.Monad.Trans.Identity
#endif
import Data.Bifunctor
import Data.String
import Data.Map.Strict(Map)
import qualified Data.Map.Strict as M
import LLVM.AST
import LLVM.IRBuilder.Internal.SnocList
newtype IRBuilderT m a = IRBuilderT { IRBuilderT m a -> StateT IRBuilderState m a
unIRBuilderT :: StateT IRBuilderState m a }
deriving
( a -> IRBuilderT m b -> IRBuilderT m a
(a -> b) -> IRBuilderT m a -> IRBuilderT m b
(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
<$ :: a -> IRBuilderT m b -> IRBuilderT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> IRBuilderT m b -> IRBuilderT m a
fmap :: (a -> b) -> IRBuilderT m a -> IRBuilderT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> IRBuilderT m a -> IRBuilderT m b
Functor, Applicative (IRBuilderT m)
IRBuilderT m a
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)
IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
IRBuilderT m a -> IRBuilderT m [a]
IRBuilderT m a -> IRBuilderT m [a]
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
many :: IRBuilderT m a -> IRBuilderT m [a]
$cmany :: forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m [a]
some :: IRBuilderT m a -> IRBuilderT m [a]
$csome :: forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m [a]
<|> :: IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
$c<|> :: forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
empty :: IRBuilderT m a
$cempty :: forall (m :: * -> *) a. MonadPlus m => IRBuilderT m a
$cp1Alternative :: forall (m :: * -> *). MonadPlus m => Applicative (IRBuilderT m)
Alternative, Functor (IRBuilderT m)
a -> IRBuilderT m a
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)
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m a
IRBuilderT m (a -> b) -> IRBuilderT m a -> IRBuilderT m b
(a -> b -> c) -> IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m c
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
<* :: IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m a
*> :: IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
liftA2 :: (a -> b -> c) -> IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m c
<*> :: IRBuilderT m (a -> b) -> IRBuilderT m a -> IRBuilderT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m (a -> b) -> IRBuilderT m a -> IRBuilderT m b
pure :: a -> IRBuilderT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> IRBuilderT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (IRBuilderT m)
Applicative, Applicative (IRBuilderT m)
a -> IRBuilderT m a
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)
IRBuilderT m a -> (a -> IRBuilderT m b) -> IRBuilderT m b
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
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
return :: a -> IRBuilderT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> IRBuilderT m a
>> :: IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> IRBuilderT m b -> IRBuilderT m b
>>= :: IRBuilderT m a -> (a -> IRBuilderT m b) -> IRBuilderT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
IRBuilderT m a -> (a -> IRBuilderT m b) -> IRBuilderT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (IRBuilderT m)
Monad, Monad (IRBuilderT m)
Monad (IRBuilderT m) =>
(forall a b.
((a -> IRBuilderT m b) -> IRBuilderT m a) -> IRBuilderT m a)
-> MonadCont (IRBuilderT m)
((a -> IRBuilderT m b) -> IRBuilderT m a) -> IRBuilderT m a
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
callCC :: ((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
$cp1MonadCont :: forall (m :: * -> *). MonadCont m => Monad (IRBuilderT m)
MonadCont, MonadError e
, Monad (IRBuilderT m)
Monad (IRBuilderT m) =>
(forall a. (a -> IRBuilderT m a) -> IRBuilderT m a)
-> MonadFix (IRBuilderT m)
(a -> IRBuilderT m a) -> IRBuilderT m a
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
mfix :: (a -> IRBuilderT m a) -> IRBuilderT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> IRBuilderT m a) -> IRBuilderT m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (IRBuilderT m)
MonadFix, Monad (IRBuilderT m)
Monad (IRBuilderT m) =>
(forall a. IO a -> IRBuilderT m a) -> MonadIO (IRBuilderT m)
IO a -> IRBuilderT m a
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
liftIO :: IO a -> IRBuilderT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> IRBuilderT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (IRBuilderT m)
MonadIO, Monad (IRBuilderT m)
Alternative (IRBuilderT m)
IRBuilderT m a
(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)
IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
forall a. IRBuilderT m a
forall a. 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
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
mplus :: IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
IRBuilderT m a -> IRBuilderT m a -> IRBuilderT m a
mzero :: IRBuilderT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => IRBuilderT m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (IRBuilderT m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (IRBuilderT m)
MonadPlus, MonadReader r, m a -> IRBuilderT m a
(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
lift :: m a -> IRBuilderT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> IRBuilderT m a
MonadTrans, MonadWriter w
)
instance MonadFail m => MonadFail (IRBuilderT m) where
fail :: String -> IRBuilderT m a
fail str :: 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
$ \ _ -> String -> m (a, IRBuilderState)
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 -> t m1 a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 a -> t m1 a)
-> (State IRBuilderState a -> m1 a)
-> State IRBuilderState a
-> t m1 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State IRBuilderState a -> m1 a
forall (m :: * -> *) a.
MonadIRBuilder m =>
State IRBuilderState a -> m a
liftIRState
instance Monad m => MonadIRBuilder (IRBuilderT m) where
liftIRState :: State IRBuilderState a -> IRBuilderT m a
liftIRState (StateT s :: 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 (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 -> Maybe (Named Terminator)
partialBlockTerm :: Maybe (Named Terminator)
}
emptyPartialBlock :: Name -> PartialBlock
emptyPartialBlock :: Name -> PartialBlock
emptyPartialBlock nm :: Name
nm = Name
-> SnocList (Named Instruction)
-> Maybe (Named Terminator)
-> PartialBlock
PartialBlock Name
nm SnocList (Named Instruction)
forall a. Monoid a => a
mempty 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 = $WIRBuilderState :: Word
-> Map ShortByteString Word
-> Maybe ShortByteString
-> SnocList BasicBlock
-> Maybe PartialBlock
-> IRBuilderState
IRBuilderState
{ builderSupply :: Word
builderSupply = 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 :: IRBuilderState -> IRBuilder a -> (a, [BasicBlock])
runIRBuilder s :: IRBuilderState
s m :: 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 :: IRBuilderState -> IRBuilderT m a -> m (a, [BasicBlock])
runIRBuilderT s :: IRBuilderState
s m :: IRBuilderT m a
m
= (IRBuilderState -> [BasicBlock])
-> (a, IRBuilderState) -> (a, [BasicBlock])
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 (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 :: IRBuilderState -> IRBuilder a -> [BasicBlock]
execIRBuilder s :: IRBuilderState
s m :: 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 :: IRBuilderState -> IRBuilderT m a -> m [BasicBlock]
execIRBuilderT s :: IRBuilderState
s m :: 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 :: m ()
ensureBlock = do
Maybe PartialBlock
mbb <- State IRBuilderState (Maybe PartialBlock) -> m (Maybe PartialBlock)
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
Nothing -> do
Name
nm <- m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
freshUnName
State IRBuilderState () -> m ()
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
$ \s :: 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 _ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
modifyBlock
:: MonadIRBuilder m
=> (PartialBlock -> PartialBlock)
-> m ()
modifyBlock :: (PartialBlock -> PartialBlock) -> m ()
modifyBlock f :: PartialBlock -> PartialBlock
f = do
Maybe PartialBlock
mbb <- State IRBuilderState (Maybe PartialBlock) -> m (Maybe PartialBlock)
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
Nothing -> do
Name
nm <- m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
freshUnName
State IRBuilderState () -> m ()
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
$ \s :: 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 bb :: PartialBlock
bb ->
State IRBuilderState () -> m ()
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
$ \s :: 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 :: m Name
fresh = do
Maybe ShortByteString
msuggestion <- State IRBuilderState (Maybe ShortByteString)
-> m (Maybe ShortByteString)
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 :: ShortByteString -> m Name
freshName suggestion :: ShortByteString
suggestion = do
Map ShortByteString Word
usedNames <- State IRBuilderState (Map ShortByteString Word)
-> m (Map ShortByteString Word)
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 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
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
+ 1) Map ShortByteString Word
usedNames
State IRBuilderState () -> m ()
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
$ \s :: IRBuilderState
s -> IRBuilderState
s { builderUsedNames :: Map ShortByteString Word
builderUsedNames = Map ShortByteString Word
updatedUsedNames }
Name -> m Name
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 :: m Name
freshUnName = State IRBuilderState Name -> m Name
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
$ \s :: IRBuilderState
s -> IRBuilderState
s { builderSupply :: Word
builderSupply = 1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
n }
Name -> State IRBuilderState Name
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 :: Type -> Instruction -> m Operand
emitInstr retty :: Type
retty instr :: 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
$ \bb :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Name -> Operand
LocalReference Type
retty Name
nm)
emitInstrVoid
:: MonadIRBuilder m
=> Instruction
-> m ()
emitInstrVoid :: Instruction -> m ()
emitInstrVoid instr :: 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
$ \bb :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
emitTerm
:: MonadIRBuilder m
=> Terminator
-> m ()
emitTerm :: Terminator -> m ()
emitTerm term :: 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
$ \bb :: PartialBlock
bb -> PartialBlock
bb
{ partialBlockTerm :: Maybe (Named Terminator)
partialBlockTerm = 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 :: Name -> m ()
emitBlockStart nm :: Name
nm = do
Maybe PartialBlock
mbb <- State IRBuilderState (Maybe PartialBlock) -> m (Maybe PartialBlock)
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
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just bb :: 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 PartialBlock -> Maybe (Named Terminator)
partialBlockTerm PartialBlock
bb of
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 term :: 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 (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
$ \s :: 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 (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
$ \s :: 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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return Name
nm
named
:: MonadIRBuilder m
=> m r
-> ShortByteString
-> m r
named :: m r -> ShortByteString -> m r
named ir :: m r
ir name :: ShortByteString
name = do
Maybe ShortByteString
before <- State IRBuilderState (Maybe ShortByteString)
-> m (Maybe ShortByteString)
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 (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
$ \s :: 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 (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
$ \s :: IRBuilderState
s -> IRBuilderState
s { builderNameSuggestion :: Maybe ShortByteString
builderNameSuggestion = Maybe ShortByteString
before }
r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
result
currentBlock :: MonadIRBuilder m => m Name
currentBlock :: m Name
currentBlock = State IRBuilderState Name -> m Name
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 (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 n :: Name
n -> Name -> State IRBuilderState Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n
Nothing -> String -> State IRBuilderState Name
forall a. HasCallStack => String -> a
error "Called currentBlock when no block was active"
hasTerminator :: MonadIRBuilder m => m Bool
hasTerminator :: m Bool
hasTerminator = do
Maybe PartialBlock
current <- State IRBuilderState (Maybe PartialBlock) -> m (Maybe PartialBlock)
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
Nothing -> String -> m Bool
forall a. HasCallStack => String -> a
error "Called hasTerminator when no block was active"
Just blk :: PartialBlock
blk -> case PartialBlock -> Maybe (Named Terminator)
partialBlockTerm PartialBlock
blk of
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just _ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
instance MonadState s m => MonadState s (IRBuilderT m) where
state :: (s -> (a, s)) -> IRBuilderT m a
state = 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 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 (ListT 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)