{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-} -- For MonadState s (ModuleBuilderT m) instance
{-# 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

-- | This provides a uniform API for creating instructions and inserting them
-- into a basic block: either at the end of a BasicBlock, or at a specific
-- location in a block.
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

-- | A partially constructed block as a sequence of instructions
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

-- | Builder monad state
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
  }

-- | Evaluate IRBuilder to a result and a list of basic blocks
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

-- | Evaluate IRBuilderT to a result and a list of basic blocks
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

-- | Evaluate IRBuilder to a list of basic blocks
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

-- | Evaluate IRBuilderT to a list of basic blocks
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

-------------------------------------------------------------------------------
-- * Low-level functionality
-------------------------------------------------------------------------------

-- | If no partial block exists, create a new block with a fresh label.
--
-- This is useful if you want to ensure that the label for the block
-- is assigned before another label which is not possible with
-- `modifyBlock`.
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 }

-- | Generate a fresh name. The resulting name is numbered or
-- based on the name suggested with 'named' if that's used.
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

-- | Generate a fresh name from a name suggestion
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

-- | Generate a fresh numbered name
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

-- | Emit instruction
emitInstr
  :: MonadIRBuilder m
  => Type -- ^ Return type
  -> Instruction
  -> m Operand
emitInstr :: Type -> Instruction -> m Operand
emitInstr retty :: Type
retty instr :: Instruction
instr = do
  -- Ensure that the fresh identifier for the block is assigned before the identifier for the instruction.
  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)

-- | Emit instruction that returns void
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 ()

-- | Emit terminator
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)
  }

-- | Starts a new block labelled using the given name and ends the previous
-- one. The name is assumed to be fresh.
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 }

-------------------------------------------------------------------------------
-- * High-level functionality
-------------------------------------------------------------------------------

-- | Starts a new block and ends the previous one
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

-- | @ir `named` name@ executes the 'IRBuilder' @ir@ using @name@ as the base
-- name whenever a fresh local name is generated. Collisions are avoided by
-- appending numbers (first @"name"@, then @"name1"@, @"name2"@, and so on).
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

-- | Get the name of the currently active block.
--
-- This function will throw an error if there is no active block. The
-- only situation in which this can occur is if it is called before
-- any call to `block` and before emitting any instructions.
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"

-- | Find out if the currently active block has a terminator.
--
-- This function will fail under the same condition as @currentBlock@
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

-------------------------------------------------------------------------------
-- mtl instances
-------------------------------------------------------------------------------

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)