{-# LANGUAGE
  GeneralizedNewtypeDeriving,
  MultiParamTypeClasses,
  UndecidableInstances,
  OverloadedStrings
  #-}
module LLVM.Internal.EncodeAST where

import LLVM.Prelude

import Control.Monad.AnyCont
import Control.Monad.Catch
import Control.Monad.State

import Foreign.Ptr
import Foreign.C

import qualified LLVM.Internal.FFI.ShortByteString as ShortByteString
import qualified Data.ByteString.Short as ShortByteString

import Data.Map (Map)
import qualified Data.Map as Map

import qualified LLVM.Internal.FFI.Attribute as FFI
import qualified LLVM.Internal.FFI.Builder as FFI
import qualified LLVM.Internal.FFI.GlobalValue as FFI
import qualified LLVM.Internal.FFI.PtrHierarchy as FFI
import qualified LLVM.Internal.FFI.Value as FFI

import qualified LLVM.AST as A
import qualified LLVM.AST.Attribute as A.A
import LLVM.Exception

import LLVM.Internal.Context
import LLVM.Internal.Coding
import LLVM.Internal.String ()

data LocalValue
  = ForwardValue (Ptr FFI.Value)
  | DefinedValue (Ptr FFI.Value)

data EncodeState = EncodeState {
      EncodeState -> Ptr Builder
encodeStateBuilder :: Ptr FFI.Builder,
      EncodeState -> Context
encodeStateContext :: Context,
      EncodeState -> Map Name LocalValue
encodeStateLocals :: Map A.Name LocalValue,
      EncodeState -> Map Name (Ptr GlobalValue)
encodeStateGlobals :: Map A.Name (Ptr FFI.GlobalValue),
      EncodeState -> Map (Name, Name) (Ptr BasicBlock)
encodeStateAllBlocks :: Map (A.Name, A.Name) (Ptr FFI.BasicBlock),
      EncodeState -> Map Name (Ptr BasicBlock)
encodeStateBlocks :: Map A.Name (Ptr FFI.BasicBlock),
      EncodeState -> Map MetadataNodeID (Ptr MDNode)
encodeStateMDNodes :: Map A.MetadataNodeID (Ptr FFI.MDNode),
      EncodeState -> Map Name (Ptr Type)
encodeStateNamedTypes :: Map A.Name (Ptr FFI.Type),
      EncodeState -> Map Name ShortByteString
encodeStateRenamedTypes :: Map A.Name ShortByteString,
      EncodeState -> Map GroupID FunctionAttributeSet
encodeStateAttributeGroups :: Map A.A.GroupID FFI.FunctionAttributeSet,
      EncodeState -> Map ShortByteString (Ptr COMDAT)
encodeStateCOMDATs :: Map ShortByteString (Ptr FFI.COMDAT)
    }

newtype EncodeAST a = EncodeAST { EncodeAST a -> AnyContT (StateT EncodeState IO) a
unEncodeAST :: AnyContT (StateT EncodeState IO) a }
    deriving (
       a -> EncodeAST b -> EncodeAST a
(a -> b) -> EncodeAST a -> EncodeAST b
(forall a b. (a -> b) -> EncodeAST a -> EncodeAST b)
-> (forall a b. a -> EncodeAST b -> EncodeAST a)
-> Functor EncodeAST
forall a b. a -> EncodeAST b -> EncodeAST a
forall a b. (a -> b) -> EncodeAST a -> EncodeAST b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EncodeAST b -> EncodeAST a
$c<$ :: forall a b. a -> EncodeAST b -> EncodeAST a
fmap :: (a -> b) -> EncodeAST a -> EncodeAST b
$cfmap :: forall a b. (a -> b) -> EncodeAST a -> EncodeAST b
Functor,
       Functor EncodeAST
a -> EncodeAST a
Functor EncodeAST =>
(forall a. a -> EncodeAST a)
-> (forall a b. EncodeAST (a -> b) -> EncodeAST a -> EncodeAST b)
-> (forall a b c.
    (a -> b -> c) -> EncodeAST a -> EncodeAST b -> EncodeAST c)
-> (forall a b. EncodeAST a -> EncodeAST b -> EncodeAST b)
-> (forall a b. EncodeAST a -> EncodeAST b -> EncodeAST a)
-> Applicative EncodeAST
EncodeAST a -> EncodeAST b -> EncodeAST b
EncodeAST a -> EncodeAST b -> EncodeAST a
EncodeAST (a -> b) -> EncodeAST a -> EncodeAST b
(a -> b -> c) -> EncodeAST a -> EncodeAST b -> EncodeAST c
forall a. a -> EncodeAST a
forall a b. EncodeAST a -> EncodeAST b -> EncodeAST a
forall a b. EncodeAST a -> EncodeAST b -> EncodeAST b
forall a b. EncodeAST (a -> b) -> EncodeAST a -> EncodeAST b
forall a b c.
(a -> b -> c) -> EncodeAST a -> EncodeAST b -> EncodeAST 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
<* :: EncodeAST a -> EncodeAST b -> EncodeAST a
$c<* :: forall a b. EncodeAST a -> EncodeAST b -> EncodeAST a
*> :: EncodeAST a -> EncodeAST b -> EncodeAST b
$c*> :: forall a b. EncodeAST a -> EncodeAST b -> EncodeAST b
liftA2 :: (a -> b -> c) -> EncodeAST a -> EncodeAST b -> EncodeAST c
$cliftA2 :: forall a b c.
(a -> b -> c) -> EncodeAST a -> EncodeAST b -> EncodeAST c
<*> :: EncodeAST (a -> b) -> EncodeAST a -> EncodeAST b
$c<*> :: forall a b. EncodeAST (a -> b) -> EncodeAST a -> EncodeAST b
pure :: a -> EncodeAST a
$cpure :: forall a. a -> EncodeAST a
$cp1Applicative :: Functor EncodeAST
Applicative,
       Applicative EncodeAST
a -> EncodeAST a
Applicative EncodeAST =>
(forall a b. EncodeAST a -> (a -> EncodeAST b) -> EncodeAST b)
-> (forall a b. EncodeAST a -> EncodeAST b -> EncodeAST b)
-> (forall a. a -> EncodeAST a)
-> Monad EncodeAST
EncodeAST a -> (a -> EncodeAST b) -> EncodeAST b
EncodeAST a -> EncodeAST b -> EncodeAST b
forall a. a -> EncodeAST a
forall a b. EncodeAST a -> EncodeAST b -> EncodeAST b
forall a b. EncodeAST a -> (a -> EncodeAST b) -> EncodeAST 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 -> EncodeAST a
$creturn :: forall a. a -> EncodeAST a
>> :: EncodeAST a -> EncodeAST b -> EncodeAST b
$c>> :: forall a b. EncodeAST a -> EncodeAST b -> EncodeAST b
>>= :: EncodeAST a -> (a -> EncodeAST b) -> EncodeAST b
$c>>= :: forall a b. EncodeAST a -> (a -> EncodeAST b) -> EncodeAST b
$cp1Monad :: Applicative EncodeAST
Monad,
       Monad EncodeAST
Monad EncodeAST =>
(forall a. IO a -> EncodeAST a) -> MonadIO EncodeAST
IO a -> EncodeAST a
forall a. IO a -> EncodeAST a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> EncodeAST a
$cliftIO :: forall a. IO a -> EncodeAST a
$cp1MonadIO :: Monad EncodeAST
MonadIO,
       MonadState EncodeState,
       Monad EncodeAST
e -> EncodeAST a
Monad EncodeAST =>
(forall e a. Exception e => e -> EncodeAST a)
-> MonadThrow EncodeAST
forall e a. Exception e => e -> EncodeAST a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> EncodeAST a
$cthrowM :: forall e a. Exception e => e -> EncodeAST a
$cp1MonadThrow :: Monad EncodeAST
MonadThrow,
       MonadAnyCont IO,
       EncodeAST a -> EncodeAST a
(forall a. EncodeAST a -> EncodeAST a) -> ScopeAnyCont EncodeAST
forall a. EncodeAST a -> EncodeAST a
forall (m :: * -> *). (forall a. m a -> m a) -> ScopeAnyCont m
scopeAnyCont :: EncodeAST a -> EncodeAST a
$cscopeAnyCont :: forall a. EncodeAST a -> EncodeAST a
ScopeAnyCont
     )

lookupNamedType :: A.Name -> EncodeAST (Ptr FFI.Type)
lookupNamedType :: Name -> EncodeAST (Ptr Type)
lookupNamedType n :: Name
n = do
  Maybe (Ptr Type)
t <- (EncodeState -> Maybe (Ptr Type)) -> EncodeAST (Maybe (Ptr Type))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((EncodeState -> Maybe (Ptr Type)) -> EncodeAST (Maybe (Ptr Type)))
-> (EncodeState -> Maybe (Ptr Type))
-> EncodeAST (Maybe (Ptr Type))
forall a b. (a -> b) -> a -> b
$ Name -> Map Name (Ptr Type) -> Maybe (Ptr Type)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n (Map Name (Ptr Type) -> Maybe (Ptr Type))
-> (EncodeState -> Map Name (Ptr Type))
-> EncodeState
-> Maybe (Ptr Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeState -> Map Name (Ptr Type)
encodeStateNamedTypes
  EncodeAST (Ptr Type)
-> (Ptr Type -> EncodeAST (Ptr Type))
-> Maybe (Ptr Type)
-> EncodeAST (Ptr Type)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EncodeException -> EncodeAST (Ptr Type)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (EncodeException -> EncodeAST (Ptr Type))
-> (String -> EncodeException) -> String -> EncodeAST (Ptr Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EncodeException
EncodeException (String -> EncodeAST (Ptr Type)) -> String -> EncodeAST (Ptr Type)
forall a b. (a -> b) -> a -> b
$ "reference to undefined type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
n) Ptr Type -> EncodeAST (Ptr Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Ptr Type)
t

defineType :: A.Name -> Maybe ShortByteString -> Ptr FFI.Type -> EncodeAST ()
defineType :: Name -> Maybe ShortByteString -> Ptr Type -> EncodeAST ()
defineType n :: Name
n n' :: Maybe ShortByteString
n' t :: Ptr Type
t = do
  (EncodeState -> EncodeState) -> EncodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EncodeState -> EncodeState) -> EncodeAST ())
-> (EncodeState -> EncodeState) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \s :: EncodeState
s -> EncodeState
s { encodeStateNamedTypes :: Map Name (Ptr Type)
encodeStateNamedTypes = Name -> Ptr Type -> Map Name (Ptr Type) -> Map Name (Ptr Type)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n Ptr Type
t (EncodeState -> Map Name (Ptr Type)
encodeStateNamedTypes EncodeState
s) }
  Maybe ShortByteString
-> (ShortByteString -> EncodeAST ()) -> EncodeAST ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe ShortByteString
n' ((ShortByteString -> EncodeAST ()) -> EncodeAST ())
-> (ShortByteString -> EncodeAST ()) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \renamedName :: ShortByteString
renamedName ->
    (EncodeState -> EncodeState) -> EncodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EncodeState -> EncodeState) -> EncodeAST ())
-> (EncodeState -> EncodeState) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \s :: EncodeState
s -> EncodeState
s { encodeStateRenamedTypes :: Map Name ShortByteString
encodeStateRenamedTypes = Name
-> ShortByteString
-> Map Name ShortByteString
-> Map Name ShortByteString
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n ShortByteString
renamedName (EncodeState -> Map Name ShortByteString
encodeStateRenamedTypes EncodeState
s) }

runEncodeAST :: Context -> EncodeAST a -> IO a
runEncodeAST :: Context -> EncodeAST a -> IO a
runEncodeAST context :: Context
context@(Context ctx :: Ptr Context
ctx) (EncodeAST a :: AnyContT (StateT EncodeState IO) a
a) =
    IO (Ptr Builder)
-> (Ptr Builder -> IO ()) -> (Ptr Builder -> IO a) -> IO a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (Ptr Context -> IO (Ptr Builder)
FFI.createBuilderInContext Ptr Context
ctx) Ptr Builder -> IO ()
FFI.disposeBuilder ((Ptr Builder -> IO a) -> IO a) -> (Ptr Builder -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \builder :: Ptr Builder
builder -> do
      let initEncodeState :: EncodeState
initEncodeState = EncodeState :: Ptr Builder
-> Context
-> Map Name LocalValue
-> Map Name (Ptr GlobalValue)
-> Map (Name, Name) (Ptr BasicBlock)
-> Map Name (Ptr BasicBlock)
-> Map MetadataNodeID (Ptr MDNode)
-> Map Name (Ptr Type)
-> Map Name ShortByteString
-> Map GroupID FunctionAttributeSet
-> Map ShortByteString (Ptr COMDAT)
-> EncodeState
EncodeState {
              encodeStateBuilder :: Ptr Builder
encodeStateBuilder = Ptr Builder
builder,
              encodeStateContext :: Context
encodeStateContext = Context
context,
              encodeStateLocals :: Map Name LocalValue
encodeStateLocals = Map Name LocalValue
forall k a. Map k a
Map.empty,
              encodeStateGlobals :: Map Name (Ptr GlobalValue)
encodeStateGlobals = Map Name (Ptr GlobalValue)
forall k a. Map k a
Map.empty,
              encodeStateAllBlocks :: Map (Name, Name) (Ptr BasicBlock)
encodeStateAllBlocks = Map (Name, Name) (Ptr BasicBlock)
forall k a. Map k a
Map.empty,
              encodeStateBlocks :: Map Name (Ptr BasicBlock)
encodeStateBlocks = Map Name (Ptr BasicBlock)
forall k a. Map k a
Map.empty,
              encodeStateMDNodes :: Map MetadataNodeID (Ptr MDNode)
encodeStateMDNodes = Map MetadataNodeID (Ptr MDNode)
forall k a. Map k a
Map.empty,
              encodeStateNamedTypes :: Map Name (Ptr Type)
encodeStateNamedTypes = Map Name (Ptr Type)
forall k a. Map k a
Map.empty,
              encodeStateRenamedTypes :: Map Name ShortByteString
encodeStateRenamedTypes = Map Name ShortByteString
forall k a. Map k a
Map.empty,
              encodeStateAttributeGroups :: Map GroupID FunctionAttributeSet
encodeStateAttributeGroups = Map GroupID FunctionAttributeSet
forall k a. Map k a
Map.empty,
              encodeStateCOMDATs :: Map ShortByteString (Ptr COMDAT)
encodeStateCOMDATs = Map ShortByteString (Ptr COMDAT)
forall k a. Map k a
Map.empty
            }
      (StateT EncodeState IO a -> EncodeState -> IO a)
-> EncodeState -> StateT EncodeState IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT EncodeState IO a -> EncodeState -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT EncodeState
initEncodeState (StateT EncodeState IO a -> IO a)
-> (AnyContT (StateT EncodeState IO) a -> StateT EncodeState IO a)
-> AnyContT (StateT EncodeState IO) a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnyContT (StateT EncodeState IO) a
 -> (a -> StateT EncodeState IO a) -> StateT EncodeState IO a)
-> (a -> StateT EncodeState IO a)
-> AnyContT (StateT EncodeState IO) a
-> StateT EncodeState IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT (StateT EncodeState IO) a
-> (a -> StateT EncodeState IO a) -> StateT EncodeState IO a
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT a -> StateT EncodeState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT (StateT EncodeState IO) a -> IO a)
-> AnyContT (StateT EncodeState IO) a -> IO a
forall a b. (a -> b) -> a -> b
$ AnyContT (StateT EncodeState IO) a
a

withName :: A.Name -> (CString -> IO a) -> IO a
withName :: Name -> (CString -> IO a) -> IO a
withName (A.Name n :: ShortByteString
n) = ShortByteString -> (CString -> IO a) -> IO a
forall a. ShortByteString -> (CString -> IO a) -> IO a
ShortByteString.useAsCString ShortByteString
n
withName (A.UnName _) = String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString ""

instance MonadAnyCont IO m => EncodeM m A.Name CString where
  encodeM :: Name -> m CString
encodeM (A.Name n :: ShortByteString
n) = ShortByteString -> m CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
n
  encodeM _ = ShortByteString -> m CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
ShortByteString.empty

phase :: EncodeAST a -> EncodeAST (EncodeAST a)
phase :: EncodeAST a -> EncodeAST (EncodeAST a)
phase p :: EncodeAST a
p = do
  let s0 :: EncodeState
s0 withLocalsFrom :: EncodeState -> EncodeState -> EncodeState
`withLocalsFrom` s1 :: EncodeState
s1 = EncodeState
s0 {
         encodeStateLocals :: Map Name LocalValue
encodeStateLocals = EncodeState -> Map Name LocalValue
encodeStateLocals EncodeState
s1,
         encodeStateBlocks :: Map Name (Ptr BasicBlock)
encodeStateBlocks = EncodeState -> Map Name (Ptr BasicBlock)
encodeStateBlocks EncodeState
s1
        }
  EncodeState
s <- EncodeAST EncodeState
forall s (m :: * -> *). MonadState s m => m s
get
  EncodeAST a -> EncodeAST (EncodeAST a)
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodeAST a -> EncodeAST (EncodeAST a))
-> EncodeAST a -> EncodeAST (EncodeAST a)
forall a b. (a -> b) -> a -> b
$ do
    EncodeState
s' <- EncodeAST EncodeState
forall s (m :: * -> *). MonadState s m => m s
get
    EncodeState -> EncodeAST ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (EncodeState -> EncodeAST ()) -> EncodeState -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ EncodeState
s' EncodeState -> EncodeState -> EncodeState
`withLocalsFrom` EncodeState
s
    a
r <- EncodeAST a
p
    (EncodeState -> EncodeState) -> EncodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (EncodeState -> EncodeState -> EncodeState
`withLocalsFrom` EncodeState
s')
    a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

defineLocal :: FFI.DescendentOf FFI.Value v => A.Name -> Ptr v -> EncodeAST ()
defineLocal :: Name -> Ptr v -> EncodeAST ()
defineLocal n :: Name
n v' :: Ptr v
v' = do
  let v :: Ptr Value
v = Ptr v -> Ptr Value
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr v
v'
  case Name
n of
    A.Name s :: ShortByteString
s
      | ShortByteString -> Bool
ShortByteString.null ShortByteString
s -> () -> EncodeAST ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    _ -> do
      Maybe LocalValue
def <- (EncodeState -> Maybe LocalValue) -> EncodeAST (Maybe LocalValue)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((EncodeState -> Maybe LocalValue) -> EncodeAST (Maybe LocalValue))
-> (EncodeState -> Maybe LocalValue)
-> EncodeAST (Maybe LocalValue)
forall a b. (a -> b) -> a -> b
$ Name -> Map Name LocalValue -> Maybe LocalValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n (Map Name LocalValue -> Maybe LocalValue)
-> (EncodeState -> Map Name LocalValue)
-> EncodeState
-> Maybe LocalValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeState -> Map Name LocalValue
encodeStateLocals
      case Maybe LocalValue
def of
        Just (ForwardValue dummy :: Ptr Value
dummy) -> IO () -> EncodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ Ptr Value -> Ptr Value -> IO ()
FFI.replaceAllUsesWith Ptr Value
dummy Ptr Value
v
        Just _ -> EncodeException -> EncodeAST ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> EncodeException
EncodeException ("Duplicate definition of local variable: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "."))
        _ -> () -> EncodeAST ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (EncodeState -> EncodeState) -> EncodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EncodeState -> EncodeState) -> EncodeAST ())
-> (EncodeState -> EncodeState) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \b :: EncodeState
b -> EncodeState
b { encodeStateLocals :: Map Name LocalValue
encodeStateLocals = Name -> LocalValue -> Map Name LocalValue -> Map Name LocalValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n (Ptr Value -> LocalValue
DefinedValue Ptr Value
v) (EncodeState -> Map Name LocalValue
encodeStateLocals EncodeState
b) }

defineGlobal :: FFI.DescendentOf FFI.GlobalValue v => A.Name -> Ptr v -> EncodeAST ()
defineGlobal :: Name -> Ptr v -> EncodeAST ()
defineGlobal n :: Name
n v :: Ptr v
v = (EncodeState -> EncodeState) -> EncodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EncodeState -> EncodeState) -> EncodeAST ())
-> (EncodeState -> EncodeState) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \b :: EncodeState
b -> EncodeState
b { encodeStateGlobals :: Map Name (Ptr GlobalValue)
encodeStateGlobals =  Name
-> Ptr GlobalValue
-> Map Name (Ptr GlobalValue)
-> Map Name (Ptr GlobalValue)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n (Ptr v -> Ptr GlobalValue
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr v
v) (EncodeState -> Map Name (Ptr GlobalValue)
encodeStateGlobals EncodeState
b) }

defineMDNode :: A.MetadataNodeID -> Ptr FFI.MDNode -> EncodeAST ()
defineMDNode :: MetadataNodeID -> Ptr MDNode -> EncodeAST ()
defineMDNode n :: MetadataNodeID
n v :: Ptr MDNode
v = (EncodeState -> EncodeState) -> EncodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EncodeState -> EncodeState) -> EncodeAST ())
-> (EncodeState -> EncodeState) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \b :: EncodeState
b -> EncodeState
b { encodeStateMDNodes :: Map MetadataNodeID (Ptr MDNode)
encodeStateMDNodes = MetadataNodeID
-> Ptr MDNode
-> Map MetadataNodeID (Ptr MDNode)
-> Map MetadataNodeID (Ptr MDNode)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert MetadataNodeID
n (Ptr MDNode -> Ptr MDNode
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr MDNode
v) (EncodeState -> Map MetadataNodeID (Ptr MDNode)
encodeStateMDNodes EncodeState
b) }

defineAttributeGroup :: A.A.GroupID -> FFI.FunctionAttributeSet -> EncodeAST ()
defineAttributeGroup :: GroupID -> FunctionAttributeSet -> EncodeAST ()
defineAttributeGroup gid :: GroupID
gid attrs :: FunctionAttributeSet
attrs = (EncodeState -> EncodeState) -> EncodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EncodeState -> EncodeState) -> EncodeAST ())
-> (EncodeState -> EncodeState) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \b :: EncodeState
b -> EncodeState
b { encodeStateAttributeGroups :: Map GroupID FunctionAttributeSet
encodeStateAttributeGroups = GroupID
-> FunctionAttributeSet
-> Map GroupID FunctionAttributeSet
-> Map GroupID FunctionAttributeSet
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert GroupID
gid FunctionAttributeSet
attrs (EncodeState -> Map GroupID FunctionAttributeSet
encodeStateAttributeGroups EncodeState
b) }

defineCOMDAT :: ShortByteString -> Ptr FFI.COMDAT -> EncodeAST ()
defineCOMDAT :: ShortByteString -> Ptr COMDAT -> EncodeAST ()
defineCOMDAT name :: ShortByteString
name cd :: Ptr COMDAT
cd = (EncodeState -> EncodeState) -> EncodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EncodeState -> EncodeState) -> EncodeAST ())
-> (EncodeState -> EncodeState) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \b :: EncodeState
b -> EncodeState
b { encodeStateCOMDATs :: Map ShortByteString (Ptr COMDAT)
encodeStateCOMDATs = ShortByteString
-> Ptr COMDAT
-> Map ShortByteString (Ptr COMDAT)
-> Map ShortByteString (Ptr COMDAT)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ShortByteString
name Ptr COMDAT
cd (EncodeState -> Map ShortByteString (Ptr COMDAT)
encodeStateCOMDATs EncodeState
b) }

refer :: (Show n, Ord n) => (EncodeState -> Map n v) -> n -> EncodeAST v -> EncodeAST v
refer :: (EncodeState -> Map n v) -> n -> EncodeAST v -> EncodeAST v
refer r :: EncodeState -> Map n v
r n :: n
n f :: EncodeAST v
f = do
  Maybe v
mop <- (EncodeState -> Maybe v) -> EncodeAST (Maybe v)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((EncodeState -> Maybe v) -> EncodeAST (Maybe v))
-> (EncodeState -> Maybe v) -> EncodeAST (Maybe v)
forall a b. (a -> b) -> a -> b
$ n -> Map n v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup n
n (Map n v -> Maybe v)
-> (EncodeState -> Map n v) -> EncodeState -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeState -> Map n v
r
  EncodeAST v -> (v -> EncodeAST v) -> Maybe v -> EncodeAST v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EncodeAST v
f v -> EncodeAST v
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
mop

undefinedReference :: Show n => String -> n -> EncodeAST a
undefinedReference :: String -> n -> EncodeAST a
undefinedReference m :: String
m n :: n
n = EncodeException -> EncodeAST a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (EncodeException -> EncodeAST a)
-> (String -> EncodeException) -> String -> EncodeAST a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EncodeException
EncodeException (String -> EncodeAST a) -> String -> EncodeAST a
forall a b. (a -> b) -> a -> b
$ "reference to undefined " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ n -> String
forall a. Show a => a -> String
show n
n

referOrThrow :: (Show n, Ord n) => (EncodeState -> Map n v) -> String -> n -> EncodeAST v
referOrThrow :: (EncodeState -> Map n v) -> String -> n -> EncodeAST v
referOrThrow r :: EncodeState -> Map n v
r m :: String
m n :: n
n = (EncodeState -> Map n v) -> n -> EncodeAST v -> EncodeAST v
forall n v.
(Show n, Ord n) =>
(EncodeState -> Map n v) -> n -> EncodeAST v -> EncodeAST v
refer EncodeState -> Map n v
r n
n (EncodeAST v -> EncodeAST v) -> EncodeAST v -> EncodeAST v
forall a b. (a -> b) -> a -> b
$ String -> n -> EncodeAST v
forall n a. Show n => String -> n -> EncodeAST a
undefinedReference String
m n
n

referGlobal :: A.Name -> EncodeAST (Ptr FFI.GlobalValue)
referGlobal :: Name -> EncodeAST (Ptr GlobalValue)
referGlobal = (EncodeState -> Map Name (Ptr GlobalValue))
-> String -> Name -> EncodeAST (Ptr GlobalValue)
forall n v.
(Show n, Ord n) =>
(EncodeState -> Map n v) -> String -> n -> EncodeAST v
referOrThrow EncodeState -> Map Name (Ptr GlobalValue)
encodeStateGlobals "global"
referMDNode :: A.MetadataNodeID -> EncodeAST (Ptr FFI.MDNode)
referMDNode :: MetadataNodeID -> EncodeAST (Ptr MDNode)
referMDNode = (EncodeState -> Map MetadataNodeID (Ptr MDNode))
-> String -> MetadataNodeID -> EncodeAST (Ptr MDNode)
forall n v.
(Show n, Ord n) =>
(EncodeState -> Map n v) -> String -> n -> EncodeAST v
referOrThrow EncodeState -> Map MetadataNodeID (Ptr MDNode)
encodeStateMDNodes "metadata node"
referAttributeGroup :: A.A.GroupID -> EncodeAST FFI.FunctionAttributeSet
referAttributeGroup :: GroupID -> EncodeAST FunctionAttributeSet
referAttributeGroup = (EncodeState -> Map GroupID FunctionAttributeSet)
-> String -> GroupID -> EncodeAST FunctionAttributeSet
forall n v.
(Show n, Ord n) =>
(EncodeState -> Map n v) -> String -> n -> EncodeAST v
referOrThrow EncodeState -> Map GroupID FunctionAttributeSet
encodeStateAttributeGroups "attribute group"
referCOMDAT :: ShortByteString -> EncodeAST (Ptr FFI.COMDAT)
referCOMDAT :: ShortByteString -> EncodeAST (Ptr COMDAT)
referCOMDAT = (EncodeState -> Map ShortByteString (Ptr COMDAT))
-> String -> ShortByteString -> EncodeAST (Ptr COMDAT)
forall n v.
(Show n, Ord n) =>
(EncodeState -> Map n v) -> String -> n -> EncodeAST v
referOrThrow EncodeState -> Map ShortByteString (Ptr COMDAT)
encodeStateCOMDATs "COMDAT"

defineBasicBlock :: A.Name -> A.Name -> Ptr FFI.BasicBlock -> EncodeAST ()
defineBasicBlock :: Name -> Name -> Ptr BasicBlock -> EncodeAST ()
defineBasicBlock fn :: Name
fn n :: Name
n b :: Ptr BasicBlock
b = (EncodeState -> EncodeState) -> EncodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EncodeState -> EncodeState) -> EncodeAST ())
-> (EncodeState -> EncodeState) -> EncodeAST ()
forall a b. (a -> b) -> a -> b
$ \s :: EncodeState
s -> EncodeState
s {
  encodeStateBlocks :: Map Name (Ptr BasicBlock)
encodeStateBlocks = Name
-> Ptr BasicBlock
-> Map Name (Ptr BasicBlock)
-> Map Name (Ptr BasicBlock)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n Ptr BasicBlock
b (EncodeState -> Map Name (Ptr BasicBlock)
encodeStateBlocks EncodeState
s),
  encodeStateAllBlocks :: Map (Name, Name) (Ptr BasicBlock)
encodeStateAllBlocks = (Name, Name)
-> Ptr BasicBlock
-> Map (Name, Name) (Ptr BasicBlock)
-> Map (Name, Name) (Ptr BasicBlock)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Name
fn, Name
n) Ptr BasicBlock
b (EncodeState -> Map (Name, Name) (Ptr BasicBlock)
encodeStateAllBlocks EncodeState
s)
}

instance EncodeM EncodeAST A.Name (Ptr FFI.BasicBlock) where
  encodeM :: Name -> EncodeAST (Ptr BasicBlock)
encodeM = (EncodeState -> Map Name (Ptr BasicBlock))
-> String -> Name -> EncodeAST (Ptr BasicBlock)
forall n v.
(Show n, Ord n) =>
(EncodeState -> Map n v) -> String -> n -> EncodeAST v
referOrThrow EncodeState -> Map Name (Ptr BasicBlock)
encodeStateBlocks "block"

getBlockForAddress :: A.Name -> A.Name -> EncodeAST (Ptr FFI.BasicBlock)
getBlockForAddress :: Name -> Name -> EncodeAST (Ptr BasicBlock)
getBlockForAddress fn :: Name
fn n :: Name
n = (EncodeState -> Map (Name, Name) (Ptr BasicBlock))
-> String -> (Name, Name) -> EncodeAST (Ptr BasicBlock)
forall n v.
(Show n, Ord n) =>
(EncodeState -> Map n v) -> String -> n -> EncodeAST v
referOrThrow EncodeState -> Map (Name, Name) (Ptr BasicBlock)
encodeStateAllBlocks "blockaddress" (Name
fn, Name
n)