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

import LLVM.Prelude

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

import Foreign.Ptr
import Foreign.C

import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Array (Array)
import qualified Data.Array as Array

import qualified LLVM.Internal.FFI.Attribute 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.Internal.FFI.Type as FFI

import qualified LLVM.AST.Name as A
import qualified LLVM.AST.Operand as A (MetadataNodeID(..))
import qualified LLVM.AST.Attribute as A.A
import qualified LLVM.AST.COMDAT as A.COMDAT

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

type NameMap a = Map (Ptr a) Word

data DecodeState = DecodeState {
    DecodeState -> NameMap GlobalValue
globalVarNum :: NameMap FFI.GlobalValue,
    DecodeState -> NameMap Value
localVarNum :: NameMap FFI.Value,
    DecodeState -> Maybe Word
localNameCounter :: Maybe Word,
    DecodeState -> NameMap Type
namedTypeNum :: NameMap FFI.Type,
    DecodeState -> Seq (Ptr Type)
typesToDefine :: Seq (Ptr FFI.Type),
    DecodeState -> Seq (MetadataNodeID, Ptr MDNode)
metadataNodesToDefine :: Seq (A.MetadataNodeID, Ptr FFI.MDNode),
    DecodeState -> Map (Ptr MDNode) MetadataNodeID
metadataNodes :: Map (Ptr FFI.MDNode) A.MetadataNodeID,
    DecodeState -> Array Word ShortByteString
metadataKinds :: Array Word ShortByteString,
    DecodeState -> Map ParameterAttributeSet [ParameterAttribute]
parameterAttributeLists :: Map FFI.ParameterAttributeSet [A.A.ParameterAttribute],
    DecodeState -> [(FunctionAttributeSet, GroupID)]
functionAttributeListIDs :: [(FFI.FunctionAttributeSet, A.A.GroupID)],
    DecodeState -> Map (Ptr COMDAT) (ShortByteString, SelectionKind)
comdats :: Map (Ptr FFI.COMDAT) (ShortByteString, A.COMDAT.SelectionKind)
  }

initialDecode :: DecodeState
initialDecode :: DecodeState
initialDecode = DecodeState :: NameMap GlobalValue
-> NameMap Value
-> Maybe Word
-> NameMap Type
-> Seq (Ptr Type)
-> Seq (MetadataNodeID, Ptr MDNode)
-> Map (Ptr MDNode) MetadataNodeID
-> Array Word ShortByteString
-> Map ParameterAttributeSet [ParameterAttribute]
-> [(FunctionAttributeSet, GroupID)]
-> Map (Ptr COMDAT) (ShortByteString, SelectionKind)
-> DecodeState
DecodeState {
    globalVarNum :: NameMap GlobalValue
globalVarNum = NameMap GlobalValue
forall k a. Map k a
Map.empty,
    localVarNum :: NameMap Value
localVarNum = NameMap Value
forall k a. Map k a
Map.empty,
    localNameCounter :: Maybe Word
localNameCounter = Maybe Word
forall a. Maybe a
Nothing,
    namedTypeNum :: NameMap Type
namedTypeNum = NameMap Type
forall k a. Map k a
Map.empty,
    typesToDefine :: Seq (Ptr Type)
typesToDefine = Seq (Ptr Type)
forall a. Seq a
Seq.empty,
    metadataNodesToDefine :: Seq (MetadataNodeID, Ptr MDNode)
metadataNodesToDefine = Seq (MetadataNodeID, Ptr MDNode)
forall a. Seq a
Seq.empty,
    metadataNodes :: Map (Ptr MDNode) MetadataNodeID
metadataNodes = Map (Ptr MDNode) MetadataNodeID
forall k a. Map k a
Map.empty,
    metadataKinds :: Array Word ShortByteString
metadataKinds = (Word, Word) -> [ShortByteString] -> Array Word ShortByteString
forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (1,0) [],
    parameterAttributeLists :: Map ParameterAttributeSet [ParameterAttribute]
parameterAttributeLists = Map ParameterAttributeSet [ParameterAttribute]
forall k a. Map k a
Map.empty,
    functionAttributeListIDs :: [(FunctionAttributeSet, GroupID)]
functionAttributeListIDs = [],
    comdats :: Map (Ptr COMDAT) (ShortByteString, SelectionKind)
comdats = Map (Ptr COMDAT) (ShortByteString, SelectionKind)
forall k a. Map k a
Map.empty
  }
newtype DecodeAST a = DecodeAST { DecodeAST a -> AnyContT (StateT DecodeState IO) a
unDecodeAST :: AnyContT (StateT DecodeState IO) a }
  deriving (
    Functor DecodeAST
a -> DecodeAST a
Functor DecodeAST =>
(forall a. a -> DecodeAST a)
-> (forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b)
-> (forall a b c.
    (a -> b -> c) -> DecodeAST a -> DecodeAST b -> DecodeAST c)
-> (forall a b. DecodeAST a -> DecodeAST b -> DecodeAST b)
-> (forall a b. DecodeAST a -> DecodeAST b -> DecodeAST a)
-> Applicative DecodeAST
DecodeAST a -> DecodeAST b -> DecodeAST b
DecodeAST a -> DecodeAST b -> DecodeAST a
DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
(a -> b -> c) -> DecodeAST a -> DecodeAST b -> DecodeAST c
forall a. a -> DecodeAST a
forall a b. DecodeAST a -> DecodeAST b -> DecodeAST a
forall a b. DecodeAST a -> DecodeAST b -> DecodeAST b
forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
forall a b c.
(a -> b -> c) -> DecodeAST a -> DecodeAST b -> DecodeAST 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
<* :: DecodeAST a -> DecodeAST b -> DecodeAST a
$c<* :: forall a b. DecodeAST a -> DecodeAST b -> DecodeAST a
*> :: DecodeAST a -> DecodeAST b -> DecodeAST b
$c*> :: forall a b. DecodeAST a -> DecodeAST b -> DecodeAST b
liftA2 :: (a -> b -> c) -> DecodeAST a -> DecodeAST b -> DecodeAST c
$cliftA2 :: forall a b c.
(a -> b -> c) -> DecodeAST a -> DecodeAST b -> DecodeAST c
<*> :: DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
$c<*> :: forall a b. DecodeAST (a -> b) -> DecodeAST a -> DecodeAST b
pure :: a -> DecodeAST a
$cpure :: forall a. a -> DecodeAST a
$cp1Applicative :: Functor DecodeAST
Applicative,
    a -> DecodeAST b -> DecodeAST a
(a -> b) -> DecodeAST a -> DecodeAST b
(forall a b. (a -> b) -> DecodeAST a -> DecodeAST b)
-> (forall a b. a -> DecodeAST b -> DecodeAST a)
-> Functor DecodeAST
forall a b. a -> DecodeAST b -> DecodeAST a
forall a b. (a -> b) -> DecodeAST a -> DecodeAST b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DecodeAST b -> DecodeAST a
$c<$ :: forall a b. a -> DecodeAST b -> DecodeAST a
fmap :: (a -> b) -> DecodeAST a -> DecodeAST b
$cfmap :: forall a b. (a -> b) -> DecodeAST a -> DecodeAST b
Functor,
    Applicative DecodeAST
a -> DecodeAST a
Applicative DecodeAST =>
(forall a b. DecodeAST a -> (a -> DecodeAST b) -> DecodeAST b)
-> (forall a b. DecodeAST a -> DecodeAST b -> DecodeAST b)
-> (forall a. a -> DecodeAST a)
-> Monad DecodeAST
DecodeAST a -> (a -> DecodeAST b) -> DecodeAST b
DecodeAST a -> DecodeAST b -> DecodeAST b
forall a. a -> DecodeAST a
forall a b. DecodeAST a -> DecodeAST b -> DecodeAST b
forall a b. DecodeAST a -> (a -> DecodeAST b) -> DecodeAST 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 -> DecodeAST a
$creturn :: forall a. a -> DecodeAST a
>> :: DecodeAST a -> DecodeAST b -> DecodeAST b
$c>> :: forall a b. DecodeAST a -> DecodeAST b -> DecodeAST b
>>= :: DecodeAST a -> (a -> DecodeAST b) -> DecodeAST b
$c>>= :: forall a b. DecodeAST a -> (a -> DecodeAST b) -> DecodeAST b
$cp1Monad :: Applicative DecodeAST
Monad,
    Monad DecodeAST
Monad DecodeAST =>
(forall a. IO a -> DecodeAST a) -> MonadIO DecodeAST
IO a -> DecodeAST a
forall a. IO a -> DecodeAST a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> DecodeAST a
$cliftIO :: forall a. IO a -> DecodeAST a
$cp1MonadIO :: Monad DecodeAST
MonadIO,
    Monad DecodeAST
Monad DecodeAST =>
(forall a. String -> DecodeAST a) -> MonadFail DecodeAST
String -> DecodeAST a
forall a. String -> DecodeAST a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
fail :: String -> DecodeAST a
$cfail :: forall a. String -> DecodeAST a
$cp1MonadFail :: Monad DecodeAST
MonadFail,
    MonadState DecodeState,
    Monad DecodeAST
e -> DecodeAST a
Monad DecodeAST =>
(forall e a. Exception e => e -> DecodeAST a)
-> MonadThrow DecodeAST
forall e a. Exception e => e -> DecodeAST a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> DecodeAST a
$cthrowM :: forall e a. Exception e => e -> DecodeAST a
$cp1MonadThrow :: Monad DecodeAST
MonadThrow,
    MonadAnyCont IO,
    DecodeAST a -> DecodeAST a
(forall a. DecodeAST a -> DecodeAST a) -> ScopeAnyCont DecodeAST
forall a. DecodeAST a -> DecodeAST a
forall (m :: * -> *). (forall a. m a -> m a) -> ScopeAnyCont m
scopeAnyCont :: DecodeAST a -> DecodeAST a
$cscopeAnyCont :: forall a. DecodeAST a -> DecodeAST a
ScopeAnyCont
  )

runDecodeAST :: DecodeAST a -> IO a
runDecodeAST :: DecodeAST a -> IO a
runDecodeAST d :: DecodeAST a
d = (StateT DecodeState IO a -> DecodeState -> IO a)
-> DecodeState -> StateT DecodeState IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT DecodeState IO a -> DecodeState -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT DecodeState
initialDecode (StateT DecodeState IO a -> IO a)
-> (DecodeAST a -> StateT DecodeState IO a) -> DecodeAST a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnyContT (StateT DecodeState IO) a
 -> (a -> StateT DecodeState IO a) -> StateT DecodeState IO a)
-> (a -> StateT DecodeState IO a)
-> AnyContT (StateT DecodeState IO) a
-> StateT DecodeState IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT (StateT DecodeState IO) a
-> (a -> StateT DecodeState IO a) -> StateT DecodeState IO a
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT a -> StateT DecodeState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT (StateT DecodeState IO) a -> StateT DecodeState IO a)
-> (DecodeAST a -> AnyContT (StateT DecodeState IO) a)
-> DecodeAST a
-> StateT DecodeState IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeAST a -> AnyContT (StateT DecodeState IO) a
forall a. DecodeAST a -> AnyContT (StateT DecodeState IO) a
unDecodeAST (DecodeAST a -> IO a) -> DecodeAST a -> IO a
forall a b. (a -> b) -> a -> b
$ DecodeAST a
d

localScope :: DecodeAST a -> DecodeAST a
localScope :: DecodeAST a -> DecodeAST a
localScope (DecodeAST x :: AnyContT (StateT DecodeState IO) a
x) = AnyContT (StateT DecodeState IO) a -> DecodeAST a
forall a. AnyContT (StateT DecodeState IO) a -> DecodeAST a
DecodeAST (AnyContT (StateT DecodeState IO) a
-> AnyContT (StateT DecodeState IO) a
forall (m :: * -> *) b. MonadState DecodeState m => m b -> m b
tweak AnyContT (StateT DecodeState IO) a
x)
  where tweak :: m b -> m b
tweak x :: m b
x = do
          (DecodeState -> DecodeState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: DecodeState
s@DecodeState { localNameCounter :: DecodeState -> Maybe Word
localNameCounter = Maybe Word
Nothing } -> DecodeState
s { localNameCounter :: Maybe Word
localNameCounter = Word -> Maybe Word
forall a. a -> Maybe a
Just 0 })
          b
r <- m b
x
          (DecodeState -> DecodeState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: DecodeState
s@DecodeState { localNameCounter :: DecodeState -> Maybe Word
localNameCounter = Just _ } -> DecodeState
s { localNameCounter :: Maybe Word
localNameCounter = Maybe Word
forall a. Maybe a
Nothing })
          b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r

getName :: (Ptr a -> IO CString)
           -> Ptr a
           -> (DecodeState -> NameMap a)
           -> DecodeAST Word
           -> DecodeAST A.Name
getName :: (Ptr a -> IO CString)
-> Ptr a
-> (DecodeState -> NameMap a)
-> DecodeAST Word
-> DecodeAST Name
getName getCString :: Ptr a -> IO CString
getCString v :: Ptr a
v getNameMap :: DecodeState -> NameMap a
getNameMap generate :: DecodeAST Word
generate = do
  ShortByteString
name <- IO ShortByteString -> DecodeAST ShortByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortByteString -> DecodeAST ShortByteString)
-> IO ShortByteString -> DecodeAST ShortByteString
forall a b. (a -> b) -> a -> b
$ do
            CString
n <- Ptr a -> IO CString
getCString Ptr a
v
            if CString
n CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr then ShortByteString -> IO ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return "" else CString -> IO ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM CString
n
  if ShortByteString
name ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= "" 
     then
       Name -> DecodeAST Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> DecodeAST Name) -> Name -> DecodeAST Name
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Name
A.Name ShortByteString
name
     else
       Word -> Name
A.UnName (Word -> Name) -> DecodeAST Word -> DecodeAST Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
         NameMap a
nm <- (DecodeState -> NameMap a) -> DecodeAST (NameMap a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> NameMap a
getNameMap
         DecodeAST Word
-> (Word -> DecodeAST Word) -> Maybe Word -> DecodeAST Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DecodeAST Word
generate Word -> DecodeAST Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word -> DecodeAST Word) -> Maybe Word -> DecodeAST Word
forall a b. (a -> b) -> a -> b
$ Ptr a -> NameMap a -> Maybe Word
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr a
v NameMap a
nm

getValueName :: FFI.DescendentOf FFI.Value v => Ptr v -> (DecodeState -> NameMap v) -> DecodeAST Word -> DecodeAST A.Name
getValueName :: Ptr v
-> (DecodeState -> NameMap v) -> DecodeAST Word -> DecodeAST Name
getValueName = (Ptr v -> IO CString)
-> Ptr v
-> (DecodeState -> NameMap v)
-> DecodeAST Word
-> DecodeAST Name
forall a.
(Ptr a -> IO CString)
-> Ptr a
-> (DecodeState -> NameMap a)
-> DecodeAST Word
-> DecodeAST Name
getName (Ptr Value -> IO CString
FFI.getValueName (Ptr Value -> IO CString)
-> (Ptr v -> Ptr Value) -> Ptr v -> IO CString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr v -> Ptr Value
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast)

getLocalName :: FFI.DescendentOf FFI.Value v => Ptr v -> DecodeAST A.Name
getLocalName :: Ptr v -> DecodeAST Name
getLocalName 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'
  Ptr Value
-> (DecodeState -> NameMap Value)
-> DecodeAST Word
-> DecodeAST Name
forall v.
DescendentOf Value v =>
Ptr v
-> (DecodeState -> NameMap v) -> DecodeAST Word -> DecodeAST Name
getValueName Ptr Value
v DecodeState -> NameMap Value
localVarNum (DecodeAST Word -> DecodeAST Name)
-> DecodeAST Word -> DecodeAST Name
forall a b. (a -> b) -> a -> b
$ do
                    NameMap Value
nm <- (DecodeState -> NameMap Value) -> DecodeAST (NameMap Value)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> NameMap Value
localVarNum
                    Just n :: Word
n <- (DecodeState -> Maybe Word) -> DecodeAST (Maybe Word)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> Maybe Word
localNameCounter
                    (DecodeState -> DecodeState) -> DecodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DecodeState -> DecodeState) -> DecodeAST ())
-> (DecodeState -> DecodeState) -> DecodeAST ()
forall a b. (a -> b) -> a -> b
$ \s :: DecodeState
s -> DecodeState
s { localNameCounter :: Maybe Word
localNameCounter = Word -> Maybe Word
forall a. a -> Maybe a
Just (1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
n), localVarNum :: NameMap Value
localVarNum = Ptr Value -> Word -> NameMap Value -> NameMap Value
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ptr Value
v Word
n NameMap Value
nm }
                    Word -> DecodeAST Word
forall (m :: * -> *) a. Monad m => a -> m a
return Word
n

getGlobalName :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST A.Name
getGlobalName :: Ptr v -> DecodeAST Name
getGlobalName v' :: Ptr v
v' = do
  let v :: Ptr GlobalValue
v = Ptr v -> Ptr GlobalValue
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast Ptr v
v'
  Ptr GlobalValue
-> (DecodeState -> NameMap GlobalValue)
-> DecodeAST Word
-> DecodeAST Name
forall v.
DescendentOf Value v =>
Ptr v
-> (DecodeState -> NameMap v) -> DecodeAST Word -> DecodeAST Name
getValueName Ptr GlobalValue
v DecodeState -> NameMap GlobalValue
globalVarNum (DecodeAST Word -> DecodeAST Name)
-> DecodeAST Word -> DecodeAST Name
forall a b. (a -> b) -> a -> b
$ do
                     NameMap GlobalValue
nm <- (DecodeState -> NameMap GlobalValue)
-> DecodeAST (NameMap GlobalValue)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> NameMap GlobalValue
globalVarNum
                     let n :: Word
n = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ NameMap GlobalValue -> Int
forall k a. Map k a -> Int
Map.size NameMap GlobalValue
nm
                     (DecodeState -> DecodeState) -> DecodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DecodeState -> DecodeState) -> DecodeAST ())
-> (DecodeState -> DecodeState) -> DecodeAST ()
forall a b. (a -> b) -> a -> b
$ \s :: DecodeState
s -> DecodeState
s { globalVarNum :: NameMap GlobalValue
globalVarNum = Ptr GlobalValue
-> Word -> NameMap GlobalValue -> NameMap GlobalValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ptr GlobalValue
v Word
n NameMap GlobalValue
nm }
                     Word -> DecodeAST Word
forall (m :: * -> *) a. Monad m => a -> m a
return Word
n


getTypeName :: Ptr FFI.Type -> DecodeAST A.Name
getTypeName :: Ptr Type -> DecodeAST Name
getTypeName t :: Ptr Type
t = do
  (Ptr Type -> IO CString)
-> Ptr Type
-> (DecodeState -> NameMap Type)
-> DecodeAST Word
-> DecodeAST Name
forall a.
(Ptr a -> IO CString)
-> Ptr a
-> (DecodeState -> NameMap a)
-> DecodeAST Word
-> DecodeAST Name
getName Ptr Type -> IO CString
FFI.getStructName Ptr Type
t DecodeState -> NameMap Type
namedTypeNum (DecodeAST Word -> DecodeAST Name)
-> DecodeAST Word -> DecodeAST Name
forall a b. (a -> b) -> a -> b
$ do
                  NameMap Type
nm <- (DecodeState -> NameMap Type) -> DecodeAST (NameMap Type)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> NameMap Type
namedTypeNum
                  let n :: Word
n = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ NameMap Type -> Int
forall k a. Map k a -> Int
Map.size NameMap Type
nm
                  (DecodeState -> DecodeState) -> DecodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DecodeState -> DecodeState) -> DecodeAST ())
-> (DecodeState -> DecodeState) -> DecodeAST ()
forall a b. (a -> b) -> a -> b
$ \s :: DecodeState
s -> DecodeState
s { namedTypeNum :: NameMap Type
namedTypeNum = Ptr Type -> Word -> NameMap Type -> NameMap Type
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ptr Type
t Word
n NameMap Type
nm }
                  Word -> DecodeAST Word
forall (m :: * -> *) a. Monad m => a -> m a
return Word
n

saveNamedType :: Ptr FFI.Type -> DecodeAST ()
saveNamedType :: Ptr Type -> DecodeAST ()
saveNamedType t :: Ptr Type
t = do
  (DecodeState -> DecodeState) -> DecodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DecodeState -> DecodeState) -> DecodeAST ())
-> (DecodeState -> DecodeState) -> DecodeAST ()
forall a b. (a -> b) -> a -> b
$ \s :: DecodeState
s -> DecodeState
s { typesToDefine :: Seq (Ptr Type)
typesToDefine = Ptr Type
t Ptr Type -> Seq (Ptr Type) -> Seq (Ptr Type)
forall a. a -> Seq a -> Seq a
Seq.<| DecodeState -> Seq (Ptr Type)
typesToDefine DecodeState
s }

getMetadataNodeID :: Ptr FFI.MDNode -> DecodeAST A.MetadataNodeID
getMetadataNodeID :: Ptr MDNode -> DecodeAST MetadataNodeID
getMetadataNodeID p :: Ptr MDNode
p = do
  Map (Ptr MDNode) MetadataNodeID
mdns <- (DecodeState -> Map (Ptr MDNode) MetadataNodeID)
-> DecodeAST (Map (Ptr MDNode) MetadataNodeID)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> Map (Ptr MDNode) MetadataNodeID
metadataNodes
  case Ptr MDNode
-> Map (Ptr MDNode) MetadataNodeID -> Maybe MetadataNodeID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr MDNode
p Map (Ptr MDNode) MetadataNodeID
mdns of
    Just r :: MetadataNodeID
r -> MetadataNodeID -> DecodeAST MetadataNodeID
forall (m :: * -> *) a. Monad m => a -> m a
return MetadataNodeID
r
    Nothing -> do
      let r :: MetadataNodeID
r = Word -> MetadataNodeID
A.MetadataNodeID (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map (Ptr MDNode) MetadataNodeID -> Int
forall k a. Map k a -> Int
Map.size Map (Ptr MDNode) MetadataNodeID
mdns))
      (DecodeState -> DecodeState) -> DecodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DecodeState -> DecodeState) -> DecodeAST ())
-> (DecodeState -> DecodeState) -> DecodeAST ()
forall a b. (a -> b) -> a -> b
$ \s :: DecodeState
s -> DecodeState
s { 
        metadataNodesToDefine :: Seq (MetadataNodeID, Ptr MDNode)
metadataNodesToDefine = (MetadataNodeID
r, Ptr MDNode
p) (MetadataNodeID, Ptr MDNode)
-> Seq (MetadataNodeID, Ptr MDNode)
-> Seq (MetadataNodeID, Ptr MDNode)
forall a. a -> Seq a -> Seq a
Seq.<| DecodeState -> Seq (MetadataNodeID, Ptr MDNode)
metadataNodesToDefine DecodeState
s,
        metadataNodes :: Map (Ptr MDNode) MetadataNodeID
metadataNodes = Ptr MDNode
-> MetadataNodeID
-> Map (Ptr MDNode) MetadataNodeID
-> Map (Ptr MDNode) MetadataNodeID
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ptr MDNode
p MetadataNodeID
r (DecodeState -> Map (Ptr MDNode) MetadataNodeID
metadataNodes DecodeState
s)
      }
      MetadataNodeID -> DecodeAST MetadataNodeID
forall (m :: * -> *) a. Monad m => a -> m a
return MetadataNodeID
r

takeTypeToDefine :: DecodeAST (Maybe (Ptr FFI.Type))
takeTypeToDefine :: DecodeAST (Maybe (Ptr Type))
takeTypeToDefine = (DecodeState -> (Maybe (Ptr Type), DecodeState))
-> DecodeAST (Maybe (Ptr Type))
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((DecodeState -> (Maybe (Ptr Type), DecodeState))
 -> DecodeAST (Maybe (Ptr Type)))
-> (DecodeState -> (Maybe (Ptr Type), DecodeState))
-> DecodeAST (Maybe (Ptr Type))
forall a b. (a -> b) -> a -> b
$ \s :: DecodeState
s -> case Seq (Ptr Type) -> ViewR (Ptr Type)
forall a. Seq a -> ViewR a
Seq.viewr (DecodeState -> Seq (Ptr Type)
typesToDefine DecodeState
s) of
  remaining :: Seq (Ptr Type)
remaining Seq.:> t :: Ptr Type
t -> (Ptr Type -> Maybe (Ptr Type)
forall a. a -> Maybe a
Just Ptr Type
t, DecodeState
s { typesToDefine :: Seq (Ptr Type)
typesToDefine = Seq (Ptr Type)
remaining })
  _ -> (Maybe (Ptr Type)
forall a. Maybe a
Nothing, DecodeState
s)

takeMetadataNodeToDefine :: DecodeAST (Maybe (A.MetadataNodeID, Ptr FFI.MDNode))
takeMetadataNodeToDefine :: DecodeAST (Maybe (MetadataNodeID, Ptr MDNode))
takeMetadataNodeToDefine = (DecodeState -> (Maybe (MetadataNodeID, Ptr MDNode), DecodeState))
-> DecodeAST (Maybe (MetadataNodeID, Ptr MDNode))
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((DecodeState -> (Maybe (MetadataNodeID, Ptr MDNode), DecodeState))
 -> DecodeAST (Maybe (MetadataNodeID, Ptr MDNode)))
-> (DecodeState
    -> (Maybe (MetadataNodeID, Ptr MDNode), DecodeState))
-> DecodeAST (Maybe (MetadataNodeID, Ptr MDNode))
forall a b. (a -> b) -> a -> b
$ \s :: DecodeState
s -> case Seq (MetadataNodeID, Ptr MDNode)
-> ViewR (MetadataNodeID, Ptr MDNode)
forall a. Seq a -> ViewR a
Seq.viewr (DecodeState -> Seq (MetadataNodeID, Ptr MDNode)
metadataNodesToDefine DecodeState
s) of
  remaining :: Seq (MetadataNodeID, Ptr MDNode)
remaining Seq.:> md :: (MetadataNodeID, Ptr MDNode)
md -> ((MetadataNodeID, Ptr MDNode) -> Maybe (MetadataNodeID, Ptr MDNode)
forall a. a -> Maybe a
Just (MetadataNodeID, Ptr MDNode)
md, DecodeState
s { metadataNodesToDefine :: Seq (MetadataNodeID, Ptr MDNode)
metadataNodesToDefine = Seq (MetadataNodeID, Ptr MDNode)
remaining })
  _ -> (Maybe (MetadataNodeID, Ptr MDNode)
forall a. Maybe a
Nothing, DecodeState
s)                              

instance DecodeM DecodeAST A.Name (Ptr FFI.BasicBlock) where
  decodeM :: Ptr BasicBlock -> DecodeAST Name
decodeM = Ptr BasicBlock -> DecodeAST Name
forall v. DescendentOf Value v => Ptr v -> DecodeAST Name
getLocalName

getAttributeGroupID :: FFI.FunctionAttributeSet -> DecodeAST A.A.GroupID
getAttributeGroupID :: FunctionAttributeSet -> DecodeAST GroupID
getAttributeGroupID p :: FunctionAttributeSet
p = do
  [(FunctionAttributeSet, GroupID)]
ids <- (DecodeState -> [(FunctionAttributeSet, GroupID)])
-> DecodeAST [(FunctionAttributeSet, GroupID)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> [(FunctionAttributeSet, GroupID)]
functionAttributeListIDs
  -- What we are interested in is the AttributeSetNode inside the
  -- AttributeSet but LLVM does not expose this. We thus have to
  -- resort to doing a linear scan and using the operator== which is
  -- implemented as a comparison on those AttributeSetNodes.
  Maybe (FunctionAttributeSet, GroupID)
id <- IO (Maybe (FunctionAttributeSet, GroupID))
-> DecodeAST (Maybe (FunctionAttributeSet, GroupID))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (((FunctionAttributeSet, GroupID) -> IO Bool)
-> [(FunctionAttributeSet, GroupID)]
-> IO (Maybe (FunctionAttributeSet, GroupID))
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM (\(as :: FunctionAttributeSet
as, _) -> LLVMBool -> IO Bool
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (LLVMBool -> IO Bool) -> IO LLVMBool -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FunctionAttributeSet -> FunctionAttributeSet -> IO LLVMBool
forall a. AttributeSet a -> AttributeSet a -> IO LLVMBool
FFI.attributeSetsEqual FunctionAttributeSet
as FunctionAttributeSet
p) [(FunctionAttributeSet, GroupID)]
ids)
  case Maybe (FunctionAttributeSet, GroupID)
id of
    Nothing -> do
      let r :: GroupID
r = Word -> GroupID
A.A.GroupID (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(FunctionAttributeSet, GroupID)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FunctionAttributeSet, GroupID)]
ids))
      (DecodeState -> DecodeState) -> DecodeAST ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DecodeState -> DecodeState) -> DecodeAST ())
-> (DecodeState -> DecodeState) -> DecodeAST ()
forall a b. (a -> b) -> a -> b
$ \s :: DecodeState
s -> DecodeState
s { functionAttributeListIDs :: [(FunctionAttributeSet, GroupID)]
functionAttributeListIDs = (FunctionAttributeSet
p,GroupID
r) (FunctionAttributeSet, GroupID)
-> [(FunctionAttributeSet, GroupID)]
-> [(FunctionAttributeSet, GroupID)]
forall a. a -> [a] -> [a]
: DecodeState -> [(FunctionAttributeSet, GroupID)]
functionAttributeListIDs DecodeState
s }
      GroupID -> DecodeAST GroupID
forall (m :: * -> *) a. Monad m => a -> m a
return GroupID
r
    Just (_, id' :: GroupID
id') -> do
      IO () -> DecodeAST ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FunctionAttributeSet -> IO ()
forall a. AttributeSet a -> IO ()
FFI.disposeAttributeSet FunctionAttributeSet
p)
      GroupID -> DecodeAST GroupID
forall (m :: * -> *) a. Monad m => a -> m a
return GroupID
id'