{-# 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)