{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE UndecidableInstances       #-} -- For MonadState s (IRBuilderT m) instance

module LLVM.IRBuilder.Module where

import Prelude hiding (and, or)

import Control.Applicative
import Control.Monad.Cont
import Control.Monad.Except
import qualified Control.Monad.Fail as Fail
import Control.Monad.Identity
import Control.Monad.Writer.Lazy as Lazy
import Control.Monad.Writer.Strict as Strict
import Control.Monad.Reader
import Control.Monad.RWS.Lazy as Lazy
import Control.Monad.RWS.Strict as Strict
import qualified Control.Monad.State.Strict as Strict
import Control.Monad.State.Lazy
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 qualified Data.ByteString.Short as BS
import Data.ByteString.Short(ShortByteString)
import Data.Char
import Data.Data
import Data.Foldable
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import Data.String

import GHC.Generics(Generic)

import LLVM.AST hiding (function)
import LLVM.AST.Global
import LLVM.AST.Linkage
import LLVM.AST.Type (ptr)
import qualified LLVM.AST.Constant as C

import LLVM.IRBuilder.Internal.SnocList
import LLVM.IRBuilder.Monad

newtype ModuleBuilderT m a = ModuleBuilderT { forall (m :: * -> *) a.
ModuleBuilderT m a -> StateT ModuleBuilderState m a
unModuleBuilderT :: StateT ModuleBuilderState m a }
  deriving
    ( (forall a b. (a -> b) -> ModuleBuilderT m a -> ModuleBuilderT m b)
-> (forall a b. a -> ModuleBuilderT m b -> ModuleBuilderT m a)
-> Functor (ModuleBuilderT m)
forall a b. a -> ModuleBuilderT m b -> ModuleBuilderT m a
forall a b. (a -> b) -> ModuleBuilderT m a -> ModuleBuilderT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ModuleBuilderT m b -> ModuleBuilderT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ModuleBuilderT m a -> ModuleBuilderT 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) -> ModuleBuilderT m a -> ModuleBuilderT m b
fmap :: forall a b. (a -> b) -> ModuleBuilderT m a -> ModuleBuilderT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ModuleBuilderT m b -> ModuleBuilderT m a
<$ :: forall a b. a -> ModuleBuilderT m b -> ModuleBuilderT m a
Functor, Applicative (ModuleBuilderT m)
Applicative (ModuleBuilderT m)
-> (forall a. ModuleBuilderT m a)
-> (forall a.
    ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a)
-> (forall a. ModuleBuilderT m a -> ModuleBuilderT m [a])
-> (forall a. ModuleBuilderT m a -> ModuleBuilderT m [a])
-> Alternative (ModuleBuilderT m)
forall a. ModuleBuilderT m a
forall a. ModuleBuilderT m a -> ModuleBuilderT m [a]
forall a.
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT 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 (ModuleBuilderT m)
forall (m :: * -> *) a. MonadPlus m => ModuleBuilderT m a
forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m [a]
forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
$cempty :: forall (m :: * -> *) a. MonadPlus m => ModuleBuilderT m a
empty :: forall a. ModuleBuilderT m a
$c<|> :: forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
<|> :: forall a.
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
$csome :: forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m [a]
some :: forall a. ModuleBuilderT m a -> ModuleBuilderT m [a]
$cmany :: forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m [a]
many :: forall a. ModuleBuilderT m a -> ModuleBuilderT m [a]
Alternative, Functor (ModuleBuilderT m)
Functor (ModuleBuilderT m)
-> (forall a. a -> ModuleBuilderT m a)
-> (forall a b.
    ModuleBuilderT m (a -> b)
    -> ModuleBuilderT m a -> ModuleBuilderT m b)
-> (forall a b c.
    (a -> b -> c)
    -> ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m c)
-> (forall a b.
    ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b)
-> (forall a b.
    ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m a)
-> Applicative (ModuleBuilderT m)
forall a. a -> ModuleBuilderT m a
forall a b.
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m a
forall a b.
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
forall a b.
ModuleBuilderT m (a -> b)
-> ModuleBuilderT m a -> ModuleBuilderT m b
forall a b c.
(a -> b -> c)
-> ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m c
forall {m :: * -> *}. Monad m => Functor (ModuleBuilderT m)
forall (m :: * -> *) a. Monad m => a -> ModuleBuilderT m a
forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m a
forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m (a -> b)
-> ModuleBuilderT m a -> ModuleBuilderT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT 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 -> ModuleBuilderT m a
pure :: forall a. a -> ModuleBuilderT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m (a -> b)
-> ModuleBuilderT m a -> ModuleBuilderT m b
<*> :: forall a b.
ModuleBuilderT m (a -> b)
-> ModuleBuilderT m a -> ModuleBuilderT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m c
liftA2 :: forall a b c.
(a -> b -> c)
-> ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
*> :: forall a b.
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m a
<* :: forall a b.
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m a
Applicative, Applicative (ModuleBuilderT m)
Applicative (ModuleBuilderT m)
-> (forall a b.
    ModuleBuilderT m a
    -> (a -> ModuleBuilderT m b) -> ModuleBuilderT m b)
-> (forall a b.
    ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b)
-> (forall a. a -> ModuleBuilderT m a)
-> Monad (ModuleBuilderT m)
forall a. a -> ModuleBuilderT m a
forall a b.
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
forall a b.
ModuleBuilderT m a
-> (a -> ModuleBuilderT m b) -> ModuleBuilderT m b
forall (m :: * -> *). Monad m => Applicative (ModuleBuilderT m)
forall (m :: * -> *) a. Monad m => a -> ModuleBuilderT m a
forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a
-> (a -> ModuleBuilderT m b) -> ModuleBuilderT 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 =>
ModuleBuilderT m a
-> (a -> ModuleBuilderT m b) -> ModuleBuilderT m b
>>= :: forall a b.
ModuleBuilderT m a
-> (a -> ModuleBuilderT m b) -> ModuleBuilderT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
>> :: forall a b.
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> ModuleBuilderT m a
return :: forall a. a -> ModuleBuilderT m a
Monad, Monad (ModuleBuilderT m)
Monad (ModuleBuilderT m)
-> (forall a b.
    ((a -> ModuleBuilderT m b) -> ModuleBuilderT m a)
    -> ModuleBuilderT m a)
-> MonadCont (ModuleBuilderT m)
forall a b.
((a -> ModuleBuilderT m b) -> ModuleBuilderT m a)
-> ModuleBuilderT m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall {m :: * -> *}. MonadCont m => Monad (ModuleBuilderT m)
forall (m :: * -> *) a b.
MonadCont m =>
((a -> ModuleBuilderT m b) -> ModuleBuilderT m a)
-> ModuleBuilderT m a
$ccallCC :: forall (m :: * -> *) a b.
MonadCont m =>
((a -> ModuleBuilderT m b) -> ModuleBuilderT m a)
-> ModuleBuilderT m a
callCC :: forall a b.
((a -> ModuleBuilderT m b) -> ModuleBuilderT m a)
-> ModuleBuilderT m a
MonadCont, MonadError e
    , Monad (ModuleBuilderT m)
Monad (ModuleBuilderT m)
-> (forall a. (a -> ModuleBuilderT m a) -> ModuleBuilderT m a)
-> MonadFix (ModuleBuilderT m)
forall a. (a -> ModuleBuilderT m a) -> ModuleBuilderT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (ModuleBuilderT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> ModuleBuilderT m a) -> ModuleBuilderT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> ModuleBuilderT m a) -> ModuleBuilderT m a
mfix :: forall a. (a -> ModuleBuilderT m a) -> ModuleBuilderT m a
MonadFix, Monad (ModuleBuilderT m)
Monad (ModuleBuilderT m)
-> (forall a. IO a -> ModuleBuilderT m a)
-> MonadIO (ModuleBuilderT m)
forall a. IO a -> ModuleBuilderT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (ModuleBuilderT m)
forall (m :: * -> *) a. MonadIO m => IO a -> ModuleBuilderT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ModuleBuilderT m a
liftIO :: forall a. IO a -> ModuleBuilderT m a
MonadIO, Monad (ModuleBuilderT m)
Alternative (ModuleBuilderT m)
Alternative (ModuleBuilderT m)
-> Monad (ModuleBuilderT m)
-> (forall a. ModuleBuilderT m a)
-> (forall a.
    ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a)
-> MonadPlus (ModuleBuilderT m)
forall a. ModuleBuilderT m a
forall a.
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
forall {m :: * -> *}. MonadPlus m => Monad (ModuleBuilderT m)
forall (m :: * -> *). MonadPlus m => Alternative (ModuleBuilderT m)
forall (m :: * -> *) a. MonadPlus m => ModuleBuilderT m a
forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT 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 => ModuleBuilderT m a
mzero :: forall a. ModuleBuilderT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
mplus :: forall a.
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
MonadPlus, MonadReader r, (forall (m :: * -> *) a. Monad m => m a -> ModuleBuilderT m a)
-> MonadTrans ModuleBuilderT
forall (m :: * -> *) a. Monad m => m a -> ModuleBuilderT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> ModuleBuilderT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> ModuleBuilderT m a
MonadTrans, MonadWriter w
    )

instance MonadFail m => MonadFail (ModuleBuilderT m) where
  fail :: forall a. String -> ModuleBuilderT m a
fail String
str = StateT ModuleBuilderState m a -> ModuleBuilderT m a
forall (m :: * -> *) a.
StateT ModuleBuilderState m a -> ModuleBuilderT m a
ModuleBuilderT ((ModuleBuilderState -> m (a, ModuleBuilderState))
-> StateT ModuleBuilderState m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((ModuleBuilderState -> m (a, ModuleBuilderState))
 -> StateT ModuleBuilderState m a)
-> (ModuleBuilderState -> m (a, ModuleBuilderState))
-> StateT ModuleBuilderState m a
forall a b. (a -> b) -> a -> b
$ \ModuleBuilderState
_ -> String -> m (a, ModuleBuilderState)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
str)

data ModuleBuilderState = ModuleBuilderState
  { ModuleBuilderState -> SnocList Definition
builderDefs :: SnocList Definition
  , ModuleBuilderState -> Map Name Type
builderTypeDefs :: Map Name Type
  }

emptyModuleBuilder :: ModuleBuilderState
emptyModuleBuilder :: ModuleBuilderState
emptyModuleBuilder = ModuleBuilderState
  { builderDefs :: SnocList Definition
builderDefs = SnocList Definition
forall a. Monoid a => a
mempty
  , builderTypeDefs :: Map Name Type
builderTypeDefs = Map Name Type
forall a. Monoid a => a
mempty
  }

type ModuleBuilder = ModuleBuilderT Identity

class Monad m => MonadModuleBuilder m where
  liftModuleState :: State ModuleBuilderState a -> m a

  default liftModuleState
    :: (MonadTrans t, MonadModuleBuilder m1, m ~ t m1)
    => State ModuleBuilderState a
    -> m a
  liftModuleState = 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 ModuleBuilderState a -> m1 a)
-> State ModuleBuilderState a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ModuleBuilderState a -> m1 a
forall a. State ModuleBuilderState a -> m1 a
forall (m :: * -> *) a.
MonadModuleBuilder m =>
State ModuleBuilderState a -> m a
liftModuleState

instance Monad m => MonadModuleBuilder (ModuleBuilderT m) where
  liftModuleState :: forall a. State ModuleBuilderState a -> ModuleBuilderT m a
liftModuleState (StateT ModuleBuilderState -> Identity (a, ModuleBuilderState)
s) = StateT ModuleBuilderState m a -> ModuleBuilderT m a
forall (m :: * -> *) a.
StateT ModuleBuilderState m a -> ModuleBuilderT m a
ModuleBuilderT (StateT ModuleBuilderState m a -> ModuleBuilderT m a)
-> StateT ModuleBuilderState m a -> ModuleBuilderT m a
forall a b. (a -> b) -> a -> b
$ (ModuleBuilderState -> m (a, ModuleBuilderState))
-> StateT ModuleBuilderState m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((ModuleBuilderState -> m (a, ModuleBuilderState))
 -> StateT ModuleBuilderState m a)
-> (ModuleBuilderState -> m (a, ModuleBuilderState))
-> StateT ModuleBuilderState m a
forall a b. (a -> b) -> a -> b
$ (a, ModuleBuilderState) -> m (a, ModuleBuilderState)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, ModuleBuilderState) -> m (a, ModuleBuilderState))
-> (ModuleBuilderState -> (a, ModuleBuilderState))
-> ModuleBuilderState
-> m (a, ModuleBuilderState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (a, ModuleBuilderState) -> (a, ModuleBuilderState)
forall a. Identity a -> a
runIdentity (Identity (a, ModuleBuilderState) -> (a, ModuleBuilderState))
-> (ModuleBuilderState -> Identity (a, ModuleBuilderState))
-> ModuleBuilderState
-> (a, ModuleBuilderState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleBuilderState -> Identity (a, ModuleBuilderState)
s



-- | Evaluate 'ModuleBuilder' to a result and a list of definitions
runModuleBuilder :: ModuleBuilderState -> ModuleBuilder a -> (a, [Definition])
runModuleBuilder :: forall a.
ModuleBuilderState -> ModuleBuilder a -> (a, [Definition])
runModuleBuilder ModuleBuilderState
s ModuleBuilder a
m = Identity (a, [Definition]) -> (a, [Definition])
forall a. Identity a -> a
runIdentity (Identity (a, [Definition]) -> (a, [Definition]))
-> Identity (a, [Definition]) -> (a, [Definition])
forall a b. (a -> b) -> a -> b
$ ModuleBuilderState -> ModuleBuilder a -> Identity (a, [Definition])
forall (m :: * -> *) a.
Monad m =>
ModuleBuilderState -> ModuleBuilderT m a -> m (a, [Definition])
runModuleBuilderT ModuleBuilderState
s ModuleBuilder a
m

-- | Evaluate 'ModuleBuilderT' to a result and a list of definitions
runModuleBuilderT :: Monad m => ModuleBuilderState -> ModuleBuilderT m a -> m (a, [Definition])
runModuleBuilderT :: forall (m :: * -> *) a.
Monad m =>
ModuleBuilderState -> ModuleBuilderT m a -> m (a, [Definition])
runModuleBuilderT ModuleBuilderState
s (ModuleBuilderT StateT ModuleBuilderState m a
m)
  = (ModuleBuilderState -> [Definition])
-> (a, ModuleBuilderState) -> (a, [Definition])
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 Definition -> [Definition]
forall a. SnocList a -> [a]
getSnocList (SnocList Definition -> [Definition])
-> (ModuleBuilderState -> SnocList Definition)
-> ModuleBuilderState
-> [Definition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleBuilderState -> SnocList Definition
builderDefs)
  ((a, ModuleBuilderState) -> (a, [Definition]))
-> m (a, ModuleBuilderState) -> m (a, [Definition])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT ModuleBuilderState m a
-> ModuleBuilderState -> m (a, ModuleBuilderState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT ModuleBuilderState m a
m ModuleBuilderState
s

-- | Evaluate 'ModuleBuilder' to a list of definitions
execModuleBuilder :: ModuleBuilderState -> ModuleBuilder a -> [Definition]
execModuleBuilder :: forall a. ModuleBuilderState -> ModuleBuilder a -> [Definition]
execModuleBuilder ModuleBuilderState
s ModuleBuilder a
m = (a, [Definition]) -> [Definition]
forall a b. (a, b) -> b
snd ((a, [Definition]) -> [Definition])
-> (a, [Definition]) -> [Definition]
forall a b. (a -> b) -> a -> b
$ ModuleBuilderState -> ModuleBuilder a -> (a, [Definition])
forall a.
ModuleBuilderState -> ModuleBuilder a -> (a, [Definition])
runModuleBuilder ModuleBuilderState
s ModuleBuilder a
m

-- | Evaluate 'ModuleBuilderT' to a list of definitions
execModuleBuilderT :: Monad m => ModuleBuilderState -> ModuleBuilderT m a -> m [Definition]
execModuleBuilderT :: forall (m :: * -> *) a.
Monad m =>
ModuleBuilderState -> ModuleBuilderT m a -> m [Definition]
execModuleBuilderT ModuleBuilderState
s ModuleBuilderT m a
m = (a, [Definition]) -> [Definition]
forall a b. (a, b) -> b
snd ((a, [Definition]) -> [Definition])
-> m (a, [Definition]) -> m [Definition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleBuilderState -> ModuleBuilderT m a -> m (a, [Definition])
forall (m :: * -> *) a.
Monad m =>
ModuleBuilderState -> ModuleBuilderT m a -> m (a, [Definition])
runModuleBuilderT ModuleBuilderState
s ModuleBuilderT m a
m

emitDefn :: MonadModuleBuilder m => Definition -> m ()
emitDefn :: forall (m :: * -> *). MonadModuleBuilder m => Definition -> m ()
emitDefn Definition
def = State ModuleBuilderState () -> m ()
forall a. State ModuleBuilderState a -> m a
forall (m :: * -> *) a.
MonadModuleBuilder m =>
State ModuleBuilderState a -> m a
liftModuleState (State ModuleBuilderState () -> m ())
-> State ModuleBuilderState () -> m ()
forall a b. (a -> b) -> a -> b
$ (ModuleBuilderState -> ModuleBuilderState)
-> State ModuleBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ModuleBuilderState -> ModuleBuilderState)
 -> State ModuleBuilderState ())
-> (ModuleBuilderState -> ModuleBuilderState)
-> State ModuleBuilderState ()
forall a b. (a -> b) -> a -> b
$ \ModuleBuilderState
s -> ModuleBuilderState
s { builderDefs :: SnocList Definition
builderDefs = ModuleBuilderState -> SnocList Definition
builderDefs ModuleBuilderState
s SnocList Definition -> Definition -> SnocList Definition
forall a. SnocList a -> a -> SnocList a
`snoc` Definition
def }

-- | A parameter name suggestion
data ParameterName
  = NoParameterName
  | ParameterName ShortByteString
  deriving (ParameterName -> ParameterName -> Bool
(ParameterName -> ParameterName -> Bool)
-> (ParameterName -> ParameterName -> Bool) -> Eq ParameterName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParameterName -> ParameterName -> Bool
== :: ParameterName -> ParameterName -> Bool
$c/= :: ParameterName -> ParameterName -> Bool
/= :: ParameterName -> ParameterName -> Bool
Eq, Eq ParameterName
Eq ParameterName
-> (ParameterName -> ParameterName -> Ordering)
-> (ParameterName -> ParameterName -> Bool)
-> (ParameterName -> ParameterName -> Bool)
-> (ParameterName -> ParameterName -> Bool)
-> (ParameterName -> ParameterName -> Bool)
-> (ParameterName -> ParameterName -> ParameterName)
-> (ParameterName -> ParameterName -> ParameterName)
-> Ord ParameterName
ParameterName -> ParameterName -> Bool
ParameterName -> ParameterName -> Ordering
ParameterName -> ParameterName -> ParameterName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ParameterName -> ParameterName -> Ordering
compare :: ParameterName -> ParameterName -> Ordering
$c< :: ParameterName -> ParameterName -> Bool
< :: ParameterName -> ParameterName -> Bool
$c<= :: ParameterName -> ParameterName -> Bool
<= :: ParameterName -> ParameterName -> Bool
$c> :: ParameterName -> ParameterName -> Bool
> :: ParameterName -> ParameterName -> Bool
$c>= :: ParameterName -> ParameterName -> Bool
>= :: ParameterName -> ParameterName -> Bool
$cmax :: ParameterName -> ParameterName -> ParameterName
max :: ParameterName -> ParameterName -> ParameterName
$cmin :: ParameterName -> ParameterName -> ParameterName
min :: ParameterName -> ParameterName -> ParameterName
Ord, ReadPrec [ParameterName]
ReadPrec ParameterName
Int -> ReadS ParameterName
ReadS [ParameterName]
(Int -> ReadS ParameterName)
-> ReadS [ParameterName]
-> ReadPrec ParameterName
-> ReadPrec [ParameterName]
-> Read ParameterName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ParameterName
readsPrec :: Int -> ReadS ParameterName
$creadList :: ReadS [ParameterName]
readList :: ReadS [ParameterName]
$creadPrec :: ReadPrec ParameterName
readPrec :: ReadPrec ParameterName
$creadListPrec :: ReadPrec [ParameterName]
readListPrec :: ReadPrec [ParameterName]
Read, Int -> ParameterName -> ShowS
[ParameterName] -> ShowS
ParameterName -> String
(Int -> ParameterName -> ShowS)
-> (ParameterName -> String)
-> ([ParameterName] -> ShowS)
-> Show ParameterName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParameterName -> ShowS
showsPrec :: Int -> ParameterName -> ShowS
$cshow :: ParameterName -> String
show :: ParameterName -> String
$cshowList :: [ParameterName] -> ShowS
showList :: [ParameterName] -> ShowS
Show, Typeable, Typeable ParameterName
Typeable ParameterName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ParameterName -> c ParameterName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ParameterName)
-> (ParameterName -> Constr)
-> (ParameterName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ParameterName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ParameterName))
-> ((forall b. Data b => b -> b) -> ParameterName -> ParameterName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParameterName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParameterName -> r)
-> (forall u. (forall d. Data d => d -> u) -> ParameterName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParameterName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ParameterName -> m ParameterName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParameterName -> m ParameterName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParameterName -> m ParameterName)
-> Data ParameterName
ParameterName -> Constr
ParameterName -> DataType
(forall b. Data b => b -> b) -> ParameterName -> ParameterName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ParameterName -> u
forall u. (forall d. Data d => d -> u) -> ParameterName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParameterName -> m ParameterName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParameterName -> m ParameterName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterName -> c ParameterName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterName -> c ParameterName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterName -> c ParameterName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterName
$ctoConstr :: ParameterName -> Constr
toConstr :: ParameterName -> Constr
$cdataTypeOf :: ParameterName -> DataType
dataTypeOf :: ParameterName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterName)
$cgmapT :: (forall b. Data b => b -> b) -> ParameterName -> ParameterName
gmapT :: (forall b. Data b => b -> b) -> ParameterName -> ParameterName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParameterName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParameterName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParameterName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParameterName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParameterName -> m ParameterName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParameterName -> m ParameterName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParameterName -> m ParameterName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParameterName -> m ParameterName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParameterName -> m ParameterName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParameterName -> m ParameterName
Data, (forall x. ParameterName -> Rep ParameterName x)
-> (forall x. Rep ParameterName x -> ParameterName)
-> Generic ParameterName
forall x. Rep ParameterName x -> ParameterName
forall x. ParameterName -> Rep ParameterName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParameterName -> Rep ParameterName x
from :: forall x. ParameterName -> Rep ParameterName x
$cto :: forall x. Rep ParameterName x -> ParameterName
to :: forall x. Rep ParameterName x -> ParameterName
Generic)

-- | Using 'fromString` on non-ASCII strings will throw an error.
instance IsString ParameterName where
  fromString :: String -> ParameterName
fromString String
s
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii String
s = ShortByteString -> ParameterName
ParameterName (String -> ShortByteString
forall a. IsString a => String -> a
fromString String
s)
    | Bool
otherwise =
      String -> ParameterName
forall a. HasCallStack => String -> a
error (String
"Only ASCII strings are automatically converted to LLVM parameter names. "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Other strings need to be encoded to a `ShortByteString` using an arbitrary encoding.")

-- | Define and emit a (non-variadic) function definition
function
  :: MonadModuleBuilder m
  => Name  -- ^ Function name
  -> [(Type, ParameterName)]  -- ^ Parameter types and name suggestions
  -> Type  -- ^ Return type
  -> ([Operand] -> IRBuilderT m ())  -- ^ Function body builder
  -> m Operand
function :: forall (m :: * -> *).
MonadModuleBuilder m =>
Name
-> [(Type, ParameterName)]
-> Type
-> ([Operand] -> IRBuilderT m ())
-> m Operand
function Name
label [(Type, ParameterName)]
argtys Type
retty [Operand] -> IRBuilderT m ()
body = do
  let tys :: [Type]
tys = (Type, ParameterName) -> Type
forall a b. (a, b) -> a
fst ((Type, ParameterName) -> Type)
-> [(Type, ParameterName)] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Type, ParameterName)]
argtys
  ([Name]
paramNames, [BasicBlock]
blocks) <- IRBuilderState -> IRBuilderT m [Name] -> m ([Name], [BasicBlock])
forall (m :: * -> *) a.
Monad m =>
IRBuilderState -> IRBuilderT m a -> m (a, [BasicBlock])
runIRBuilderT IRBuilderState
emptyIRBuilder (IRBuilderT m [Name] -> m ([Name], [BasicBlock]))
-> IRBuilderT m [Name] -> m ([Name], [BasicBlock])
forall a b. (a -> b) -> a -> b
$ do
    [Name]
paramNames <- [(Type, ParameterName)]
-> ((Type, ParameterName) -> IRBuilderT m Name)
-> IRBuilderT m [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Type, ParameterName)]
argtys (((Type, ParameterName) -> IRBuilderT m Name)
 -> IRBuilderT m [Name])
-> ((Type, ParameterName) -> IRBuilderT m Name)
-> IRBuilderT m [Name]
forall a b. (a -> b) -> a -> b
$ \(Type
_, ParameterName
paramName) -> case ParameterName
paramName of
      ParameterName
NoParameterName -> IRBuilderT m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
fresh
      ParameterName ShortByteString
p -> IRBuilderT m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
fresh IRBuilderT m Name -> ShortByteString -> IRBuilderT m Name
forall (m :: * -> *) r.
MonadIRBuilder m =>
m r -> ShortByteString -> m r
`named` ShortByteString
p
    [Operand] -> IRBuilderT m ()
body ([Operand] -> IRBuilderT m ()) -> [Operand] -> IRBuilderT m ()
forall a b. (a -> b) -> a -> b
$ (Type -> Name -> Operand) -> [Type] -> [Name] -> [Operand]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Type -> Name -> Operand
LocalReference [Type]
tys [Name]
paramNames
    [Name] -> IRBuilderT m [Name]
forall a. a -> IRBuilderT m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
paramNames
  let
    def :: Definition
def = Global -> Definition
GlobalDefinition Global
functionDefaults
      { name :: Name
name        = Name
label
      , parameters :: ([Parameter], Bool)
parameters  = ((Type -> Name -> Parameter) -> [Type] -> [Name] -> [Parameter]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Type
ty Name
nm -> Type -> Name -> [ParameterAttribute] -> Parameter
Parameter Type
ty Name
nm []) [Type]
tys [Name]
paramNames, Bool
False)
      , returnType :: Type
returnType  = Type
retty
      , basicBlocks :: [BasicBlock]
basicBlocks = [BasicBlock]
blocks
      }
    funty :: Type
funty = Type -> Type
ptr (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> [Type] -> Bool -> Type
FunctionType Type
retty ((Type, ParameterName) -> Type
forall a b. (a, b) -> a
fst ((Type, ParameterName) -> Type)
-> [(Type, ParameterName)] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Type, ParameterName)]
argtys) Bool
False
  Definition -> m ()
forall (m :: * -> *). MonadModuleBuilder m => Definition -> m ()
emitDefn Definition
def
  Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Operand -> m Operand) -> Operand -> m Operand
forall a b. (a -> b) -> a -> b
$ Constant -> Operand
ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Type -> Name -> Constant
C.GlobalReference Type
funty Name
label

-- | An external function definition
extern
  :: MonadModuleBuilder m
  => Name   -- ^ Definition name
  -> [Type] -- ^ Parameter types
  -> Type   -- ^ Type
  -> m Operand
extern :: forall (m :: * -> *).
MonadModuleBuilder m =>
Name -> [Type] -> Type -> m Operand
extern Name
nm [Type]
argtys Type
retty = do
  Definition -> m ()
forall (m :: * -> *). MonadModuleBuilder m => Definition -> m ()
emitDefn (Definition -> m ()) -> Definition -> m ()
forall a b. (a -> b) -> a -> b
$ Global -> Definition
GlobalDefinition Global
functionDefaults
    { name :: Name
name        = Name
nm
    , linkage :: Linkage
linkage     = Linkage
External
    , parameters :: ([Parameter], Bool)
parameters  = ([Type -> Name -> [ParameterAttribute] -> Parameter
Parameter Type
ty (String -> Name
mkName String
"") [] | Type
ty <- [Type]
argtys], Bool
False)
    , returnType :: Type
returnType  = Type
retty
    }
  let funty :: Type
funty = Type -> Type
ptr (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> [Type] -> Bool -> Type
FunctionType Type
retty [Type]
argtys Bool
False
  Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Operand -> m Operand) -> Operand -> m Operand
forall a b. (a -> b) -> a -> b
$ Constant -> Operand
ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Type -> Name -> Constant
C.GlobalReference Type
funty Name
nm

-- | An external variadic argument function definition
externVarArgs
  :: MonadModuleBuilder m
  => Name   -- ^ Definition name
  -> [Type] -- ^ Parameter types
  -> Type   -- ^ Type
  -> m Operand
externVarArgs :: forall (m :: * -> *).
MonadModuleBuilder m =>
Name -> [Type] -> Type -> m Operand
externVarArgs Name
nm [Type]
argtys Type
retty = do
  Definition -> m ()
forall (m :: * -> *). MonadModuleBuilder m => Definition -> m ()
emitDefn (Definition -> m ()) -> Definition -> m ()
forall a b. (a -> b) -> a -> b
$ Global -> Definition
GlobalDefinition Global
functionDefaults
    { name :: Name
name        = Name
nm
    , linkage :: Linkage
linkage     = Linkage
External
    , parameters :: ([Parameter], Bool)
parameters  = ([Type -> Name -> [ParameterAttribute] -> Parameter
Parameter Type
ty (String -> Name
mkName String
"") [] | Type
ty <- [Type]
argtys], Bool
True)
    , returnType :: Type
returnType  = Type
retty
    }
  let funty :: Type
funty = Type -> Type
ptr (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> [Type] -> Bool -> Type
FunctionType Type
retty [Type]
argtys Bool
True
  Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Operand -> m Operand) -> Operand -> m Operand
forall a b. (a -> b) -> a -> b
$ Constant -> Operand
ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Type -> Name -> Constant
C.GlobalReference Type
funty Name
nm

-- | A global variable definition
global
  :: MonadModuleBuilder m
  => Name       -- ^ Variable name
  -> Type       -- ^ Type
  -> C.Constant -- ^ Initializer
  -> m Operand
global :: forall (m :: * -> *).
MonadModuleBuilder m =>
Name -> Type -> Constant -> m Operand
global Name
nm Type
ty Constant
initVal = do
  Definition -> m ()
forall (m :: * -> *). MonadModuleBuilder m => Definition -> m ()
emitDefn (Definition -> m ()) -> Definition -> m ()
forall a b. (a -> b) -> a -> b
$ Global -> Definition
GlobalDefinition Global
globalVariableDefaults
    { name :: Name
name                  = Name
nm
    , type' :: Type
LLVM.AST.Global.type' = Type
ty
    , linkage :: Linkage
linkage               = Linkage
External
    , initializer :: Maybe Constant
initializer           = Constant -> Maybe Constant
forall a. a -> Maybe a
Just Constant
initVal
    }
  Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Operand -> m Operand) -> Operand -> m Operand
forall a b. (a -> b) -> a -> b
$ Constant -> Operand
ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Type -> Name -> Constant
C.GlobalReference (Type -> Type
ptr Type
ty) Name
nm

-- | A named type definition
typedef
  :: MonadModuleBuilder m
  => Name
  -> Maybe Type
  -> m Type
typedef :: forall (m :: * -> *).
MonadModuleBuilder m =>
Name -> Maybe Type -> m Type
typedef Name
nm Maybe Type
ty = do
  Definition -> m ()
forall (m :: * -> *). MonadModuleBuilder m => Definition -> m ()
emitDefn (Definition -> m ()) -> Definition -> m ()
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Type -> Definition
TypeDefinition Name
nm Maybe Type
ty
  Maybe Type -> (Type -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Type
ty ((Type -> m ()) -> m ()) -> (Type -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Type
ty' ->
    State ModuleBuilderState () -> m ()
forall a. State ModuleBuilderState a -> m a
forall (m :: * -> *) a.
MonadModuleBuilder m =>
State ModuleBuilderState a -> m a
liftModuleState ((ModuleBuilderState -> ModuleBuilderState)
-> State ModuleBuilderState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ModuleBuilderState
s -> ModuleBuilderState
s { builderTypeDefs :: Map Name Type
builderTypeDefs = Name -> Type -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
nm Type
ty' (ModuleBuilderState -> Map Name Type
builderTypeDefs ModuleBuilderState
s) }))
  Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Type
NamedTypeReference Name
nm)

-- | Convenience function for module construction
buildModule :: ShortByteString -> ModuleBuilder a -> Module
buildModule :: forall a. ShortByteString -> ModuleBuilder a -> Module
buildModule ShortByteString
nm = [Definition] -> Module
mkModule ([Definition] -> Module)
-> (ModuleBuilder a -> [Definition]) -> ModuleBuilder a -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleBuilderState -> ModuleBuilder a -> [Definition]
forall a. ModuleBuilderState -> ModuleBuilder a -> [Definition]
execModuleBuilder ModuleBuilderState
emptyModuleBuilder
  where
    mkModule :: [Definition] -> Module
mkModule [Definition]
ds = Module
defaultModule { moduleName :: ShortByteString
moduleName = ShortByteString
nm, moduleDefinitions :: [Definition]
moduleDefinitions = [Definition]
ds }

-- | Convenience function for module construction (transformer version)
buildModuleT :: Monad m => ShortByteString -> ModuleBuilderT m a -> m Module
buildModuleT :: forall (m :: * -> *) a.
Monad m =>
ShortByteString -> ModuleBuilderT m a -> m Module
buildModuleT ShortByteString
nm = ([Definition] -> Module) -> m [Definition] -> m Module
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Definition] -> Module
mkModule (m [Definition] -> m Module)
-> (ModuleBuilderT m a -> m [Definition])
-> ModuleBuilderT m a
-> m Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleBuilderState -> ModuleBuilderT m a -> m [Definition]
forall (m :: * -> *) a.
Monad m =>
ModuleBuilderState -> ModuleBuilderT m a -> m [Definition]
execModuleBuilderT ModuleBuilderState
emptyModuleBuilder
  where
    mkModule :: [Definition] -> Module
mkModule [Definition]
ds = Module
defaultModule { moduleName :: ShortByteString
moduleName = ShortByteString
nm, moduleDefinitions :: [Definition]
moduleDefinitions = [Definition]
ds }

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

instance MonadState s m => MonadState s (ModuleBuilderT m) where
  state :: forall a. (s -> (a, s)) -> ModuleBuilderT m a
state = m a -> ModuleBuilderT m a
forall (m :: * -> *) a. Monad m => m a -> ModuleBuilderT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ModuleBuilderT m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> ModuleBuilderT 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 MonadModuleBuilder m => MonadModuleBuilder (ContT r m)
instance MonadModuleBuilder m => MonadModuleBuilder (ExceptT e m)
instance MonadModuleBuilder m => MonadModuleBuilder (IdentityT m)
instance MonadModuleBuilder m => MonadModuleBuilder (MaybeT m)
instance MonadModuleBuilder m => MonadModuleBuilder (ReaderT r m)
instance (MonadModuleBuilder m, Monoid w) => MonadModuleBuilder (Strict.RWST r w s m)
instance (MonadModuleBuilder m, Monoid w) => MonadModuleBuilder (Lazy.RWST r w s m)
instance MonadModuleBuilder m => MonadModuleBuilder (StateT s m)
instance MonadModuleBuilder m => MonadModuleBuilder (Strict.StateT s m)
instance (Monoid w, MonadModuleBuilder m) => MonadModuleBuilder (Strict.WriterT w m)

-- Not an mtl instance, but necessary in order for @globalStringPtr@ to compile
instance MonadModuleBuilder m => MonadModuleBuilder (IRBuilderT m)