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

module LLVM.IRBuilder.Module where

import Prelude hiding (and, or)

import Control.Applicative
import Control.Monad.Cont
import Control.Monad.Except
import Control.Monad.Fail
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.List
import Control.Monad.Trans.Maybe
#if !(MIN_VERSION_mtl(2,2,2))
import Control.Monad.Trans.Identity
#endif

import Data.Bifunctor
import Data.ByteString.Short as BS
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 { ModuleBuilderT m a -> StateT ModuleBuilderState m a
unModuleBuilderT :: StateT ModuleBuilderState m a }
  deriving
    ( a -> ModuleBuilderT m b -> ModuleBuilderT m a
(a -> b) -> ModuleBuilderT m a -> ModuleBuilderT m b
(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
<$ :: a -> ModuleBuilderT m b -> ModuleBuilderT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ModuleBuilderT m b -> ModuleBuilderT m a
fmap :: (a -> b) -> ModuleBuilderT m a -> ModuleBuilderT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ModuleBuilderT m a -> ModuleBuilderT m b
Functor, Applicative (ModuleBuilderT m)
ModuleBuilderT m a
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)
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
ModuleBuilderT m a -> ModuleBuilderT m [a]
ModuleBuilderT m a -> ModuleBuilderT m [a]
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
many :: ModuleBuilderT m a -> ModuleBuilderT m [a]
$cmany :: forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m [a]
some :: ModuleBuilderT m a -> ModuleBuilderT m [a]
$csome :: forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m [a]
<|> :: ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
$c<|> :: forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
empty :: ModuleBuilderT m a
$cempty :: forall (m :: * -> *) a. MonadPlus m => ModuleBuilderT m a
$cp1Alternative :: forall (m :: * -> *). MonadPlus m => Applicative (ModuleBuilderT m)
Alternative, Functor (ModuleBuilderT m)
a -> ModuleBuilderT m a
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)
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m a
ModuleBuilderT m (a -> b)
-> ModuleBuilderT m a -> ModuleBuilderT m b
(a -> b -> c)
-> ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m c
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
<* :: ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m a
*> :: ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
liftA2 :: (a -> b -> c)
-> ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m c
<*> :: ModuleBuilderT m (a -> b)
-> ModuleBuilderT m a -> ModuleBuilderT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m (a -> b)
-> ModuleBuilderT m a -> ModuleBuilderT m b
pure :: a -> ModuleBuilderT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> ModuleBuilderT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (ModuleBuilderT m)
Applicative, Applicative (ModuleBuilderT m)
a -> ModuleBuilderT m a
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)
ModuleBuilderT m a
-> (a -> ModuleBuilderT m b) -> ModuleBuilderT m b
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
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
return :: a -> ModuleBuilderT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> ModuleBuilderT m a
>> :: ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a -> ModuleBuilderT m b -> ModuleBuilderT m b
>>= :: ModuleBuilderT m a
-> (a -> ModuleBuilderT m b) -> ModuleBuilderT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ModuleBuilderT m a
-> (a -> ModuleBuilderT m b) -> ModuleBuilderT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (ModuleBuilderT m)
Monad, Monad (ModuleBuilderT m)
Monad (ModuleBuilderT m) =>
(forall a b.
 ((a -> ModuleBuilderT m b) -> ModuleBuilderT m a)
 -> ModuleBuilderT m a)
-> MonadCont (ModuleBuilderT m)
((a -> ModuleBuilderT m b) -> ModuleBuilderT m a)
-> ModuleBuilderT m a
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
callCC :: ((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
$cp1MonadCont :: forall (m :: * -> *). MonadCont m => Monad (ModuleBuilderT m)
MonadCont, MonadError e
    , Monad (ModuleBuilderT m)
Monad (ModuleBuilderT m) =>
(forall a. (a -> ModuleBuilderT m a) -> ModuleBuilderT m a)
-> MonadFix (ModuleBuilderT m)
(a -> ModuleBuilderT m a) -> ModuleBuilderT m a
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
mfix :: (a -> ModuleBuilderT m a) -> ModuleBuilderT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> ModuleBuilderT m a) -> ModuleBuilderT m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (ModuleBuilderT m)
MonadFix, Monad (ModuleBuilderT m)
Monad (ModuleBuilderT m) =>
(forall a. IO a -> ModuleBuilderT m a)
-> MonadIO (ModuleBuilderT m)
IO a -> ModuleBuilderT m a
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
liftIO :: IO a -> ModuleBuilderT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ModuleBuilderT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (ModuleBuilderT m)
MonadIO, Monad (ModuleBuilderT m)
Alternative (ModuleBuilderT m)
ModuleBuilderT m a
(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)
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
forall a. ModuleBuilderT m a
forall a.
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
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
mplus :: ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
ModuleBuilderT m a -> ModuleBuilderT m a -> ModuleBuilderT m a
mzero :: ModuleBuilderT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => ModuleBuilderT m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (ModuleBuilderT m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (ModuleBuilderT m)
MonadPlus, MonadReader r, m a -> ModuleBuilderT m a
(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
lift :: m a -> ModuleBuilderT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> ModuleBuilderT m a
MonadTrans, MonadWriter w
    )

instance MonadFail m => MonadFail (ModuleBuilderT m) where
  fail :: String -> ModuleBuilderT m a
fail str :: 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
$ \_ -> String -> m (a, ModuleBuilderState)
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 :: SnocList Definition -> Map Name Type -> ModuleBuilderState
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 -> t m1 a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 a -> t m1 a)
-> (State ModuleBuilderState a -> m1 a)
-> State ModuleBuilderState a
-> t m1 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ModuleBuilderState a -> m1 a
forall (m :: * -> *) a.
MonadModuleBuilder m =>
State ModuleBuilderState a -> m a
liftModuleState

instance Monad m => MonadModuleBuilder (ModuleBuilderT m) where
  liftModuleState :: State ModuleBuilderState a -> ModuleBuilderT m a
liftModuleState (StateT s :: 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 (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 :: ModuleBuilderState -> ModuleBuilder a -> (a, [Definition])
runModuleBuilder s :: ModuleBuilderState
s m :: 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 :: ModuleBuilderState -> ModuleBuilderT m a -> m (a, [Definition])
runModuleBuilderT s :: ModuleBuilderState
s (ModuleBuilderT m :: StateT ModuleBuilderState m a
m)
  = (ModuleBuilderState -> [Definition])
-> (a, ModuleBuilderState) -> (a, [Definition])
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 :: ModuleBuilderState -> ModuleBuilder a -> [Definition]
execModuleBuilder s :: ModuleBuilderState
s m :: 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 :: ModuleBuilderState -> ModuleBuilderT m a -> m [Definition]
execModuleBuilderT s :: ModuleBuilderState
s m :: 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 :: Definition -> m ()
emitDefn def :: Definition
def = State ModuleBuilderState () -> m ()
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
$ \s :: 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
/= :: ParameterName -> ParameterName -> Bool
$c/= :: ParameterName -> ParameterName -> Bool
== :: ParameterName -> ParameterName -> Bool
$c== :: 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
min :: ParameterName -> ParameterName -> ParameterName
$cmin :: ParameterName -> ParameterName -> ParameterName
max :: ParameterName -> ParameterName -> ParameterName
$cmax :: ParameterName -> ParameterName -> ParameterName
>= :: ParameterName -> ParameterName -> Bool
$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
compare :: ParameterName -> ParameterName -> Ordering
$ccompare :: ParameterName -> ParameterName -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [ParameterName]
$creadListPrec :: ReadPrec [ParameterName]
readPrec :: ReadPrec ParameterName
$creadPrec :: ReadPrec ParameterName
readList :: ReadS [ParameterName]
$creadList :: ReadS [ParameterName]
readsPrec :: Int -> ReadS ParameterName
$creadsPrec :: Int -> ReadS 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
showList :: [ParameterName] -> ShowS
$cshowList :: [ParameterName] -> ShowS
show :: ParameterName -> String
$cshow :: ParameterName -> String
showsPrec :: Int -> ParameterName -> ShowS
$cshowsPrec :: Int -> ParameterName -> ShowS
Show, Typeable, Typeable ParameterName
DataType
Constr
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 -> DataType
ParameterName -> Constr
(forall b. Data b => b -> b) -> ParameterName -> ParameterName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterName -> c ParameterName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cParameterName :: Constr
$cNoParameterName :: Constr
$tParameterName :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> ParameterName -> m ParameterName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParameterName -> m ParameterName
gmapQi :: Int -> (forall d. Data d => d -> u) -> ParameterName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParameterName -> u
gmapQ :: (forall d. Data d => d -> u) -> ParameterName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParameterName -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterName -> r
gmapT :: (forall b. Data b => b -> b) -> ParameterName -> ParameterName
$cgmapT :: (forall b. Data b => b -> b) -> ParameterName -> ParameterName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ParameterName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterName)
dataTypeOf :: ParameterName -> DataType
$cdataTypeOf :: ParameterName -> DataType
toConstr :: ParameterName -> Constr
$ctoConstr :: ParameterName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterName -> c ParameterName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterName -> c ParameterName
$cp1Data :: Typeable 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
$cto :: forall x. Rep ParameterName x -> ParameterName
$cfrom :: forall x. ParameterName -> Rep ParameterName x
Generic)

-- | Using 'fromString` on non-ASCII strings will throw an error.
instance IsString ParameterName where
  fromString :: String -> ParameterName
fromString s :: 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 ("Only ASCII strings are automatically converted to LLVM parameter names. "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "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 :: Name
-> [(Type, ParameterName)]
-> Type
-> ([Operand] -> IRBuilderT m ())
-> m Operand
function label :: Name
label argtys :: [(Type, ParameterName)]
argtys retty :: Type
retty body :: [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
  (paramNames :: [Name]
paramNames, blocks :: [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
$ \(_, paramName :: ParameterName
paramName) -> case ParameterName
paramName of
      NoParameterName -> IRBuilderT m Name
forall (m :: * -> *). MonadIRBuilder m => m Name
fresh
      ParameterName p :: 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 (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 (\ty :: Type
ty nm :: 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 (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 :: Name -> [Type] -> Type -> m Operand
extern nm :: Name
nm argtys :: [Type]
argtys retty :: 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 "") [] | 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 (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 :: Name -> [Type] -> Type -> m Operand
externVarArgs nm :: Name
nm argtys :: [Type]
argtys retty :: 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 "") [] | 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 (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 :: Name -> Type -> Constant -> m Operand
global nm :: Name
nm ty :: Type
ty initVal :: 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 (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 :: Name -> Maybe Type -> m Type
typedef nm :: Name
nm ty :: 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
$ \ty' :: Type
ty' ->
    State ModuleBuilderState () -> m ()
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 (\s :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Type
NamedTypeReference Name
nm)

-- | Convenience function for module construction
buildModule :: ShortByteString -> ModuleBuilder a -> Module
buildModule :: ShortByteString -> ModuleBuilder a -> Module
buildModule nm :: 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 ds :: [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 :: ShortByteString -> ModuleBuilderT m a -> m Module
buildModuleT nm :: ShortByteString
nm = ([Definition] -> Module) -> m [Definition] -> m Module
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 ds :: [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 :: (s -> (a, s)) -> ModuleBuilderT m a
state = 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 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 (ListT 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)