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

lookupNamedType :: A.Name -> EncodeAST (Ptr FFI.Type)
lookupNamedType :: Name -> EncodeAST (Ptr Type)
lookupNamedType 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 e a. Exception e => e -> EncodeAST a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (EncodeException -> EncodeAST (Ptr Type))
-> ([Char] -> EncodeException) -> [Char] -> EncodeAST (Ptr Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> EncodeException
EncodeException ([Char] -> EncodeAST (Ptr Type)) -> [Char] -> EncodeAST (Ptr Type)
forall a b. (a -> b) -> a -> b
$ [Char]
"reference to undefined type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n) Ptr Type -> EncodeAST (Ptr Type)
forall a. a -> EncodeAST a
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 Name
n Maybe ShortByteString
n' 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
$ \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
$ \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
$ \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 :: forall a. Context -> EncodeAST a -> IO a
runEncodeAST context :: Context
context@(Context Ptr Context
ctx) (EncodeAST 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
$ \Ptr Builder
builder -> do
      let initEncodeState :: EncodeState
initEncodeState = 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
. (a -> StateT EncodeState IO a)
-> AnyContT (StateT EncodeState IO) a -> StateT EncodeState IO a
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' a -> StateT EncodeState IO a
forall a. 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 :: forall a. Name -> (CString -> IO a) -> IO a
withName (A.Name ShortByteString
n) = ShortByteString -> (CString -> IO a) -> IO a
forall a. ShortByteString -> (CString -> IO a) -> IO a
ShortByteString.useAsCString ShortByteString
n
withName (A.UnName Word
_) = [Char] -> (CString -> IO a) -> IO a
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
""

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

phase :: EncodeAST a -> EncodeAST (EncodeAST a)
phase :: forall a. EncodeAST a -> EncodeAST (EncodeAST a)
phase EncodeAST a
p = do
  let EncodeState
s0 withLocalsFrom :: EncodeState -> EncodeState -> EncodeState
`withLocalsFrom` 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 a. a -> 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 a. 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 :: forall v. DescendentOf Value v => Name -> Ptr v -> EncodeAST ()
defineLocal Name
n 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 ShortByteString
s
      | ShortByteString -> Bool
ShortByteString.null ShortByteString
s -> () -> EncodeAST ()
forall a. a -> EncodeAST a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Name
_ -> 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 Ptr Value
dummy) -> IO () -> EncodeAST ()
forall a. IO a -> EncodeAST a
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 LocalValue
_ -> EncodeException -> EncodeAST ()
forall e a. Exception e => e -> EncodeAST a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ([Char] -> EncodeException
EncodeException ([Char]
"Duplicate definition of local variable: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"."))
        Maybe LocalValue
_ -> () -> EncodeAST ()
forall a. a -> EncodeAST a
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
$ \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 :: forall v.
DescendentOf GlobalValue v =>
Name -> Ptr v -> EncodeAST ()
defineGlobal Name
n 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
$ \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 MetadataNodeID
n 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
$ \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 GroupID
gid 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
$ \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 ShortByteString
name 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
$ \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 :: 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
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 a. a -> EncodeAST a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
mop

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

referOrThrow :: (Show n, Ord n) => (EncodeState -> Map n v) -> String -> n -> EncodeAST v
referOrThrow :: forall n v.
(Show n, Ord n) =>
(EncodeState -> Map n v) -> [Char] -> n -> EncodeAST v
referOrThrow EncodeState -> Map n v
r [Char]
m 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
$ [Char] -> n -> EncodeAST v
forall n a. Show n => [Char] -> n -> EncodeAST a
undefinedReference [Char]
m n
n

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

defineBasicBlock :: A.Name -> A.Name -> Ptr FFI.BasicBlock -> EncodeAST ()
defineBasicBlock :: Name -> Name -> Ptr BasicBlock -> EncodeAST ()
defineBasicBlock Name
fn Name
n 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
$ \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 :: HasCallStack => Name -> EncodeAST (Ptr BasicBlock)
encodeM = (EncodeState -> Map Name (Ptr BasicBlock))
-> [Char] -> Name -> EncodeAST (Ptr BasicBlock)
forall n v.
(Show n, Ord n) =>
(EncodeState -> Map n v) -> [Char] -> n -> EncodeAST v
referOrThrow EncodeState -> Map Name (Ptr BasicBlock)
encodeStateBlocks [Char]
"block"

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