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