{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Data.LLVM.BitCode.IR.Function where
import qualified Data.LLVM.BitCode.Assert as Assert
import Data.LLVM.BitCode.Bitstream
import Data.LLVM.BitCode.IR.Blocks
import Data.LLVM.BitCode.IR.Constants
import Data.LLVM.BitCode.IR.Metadata
import Data.LLVM.BitCode.IR.Values
import Data.LLVM.BitCode.IR.Attrs
import Data.LLVM.BitCode.Match
import Data.LLVM.BitCode.Parse
import Data.LLVM.BitCode.Record
import Text.LLVM.AST
import Text.LLVM.Labels
import Text.LLVM.PP
import Control.Monad (when,unless,mplus,mzero,foldM,(<=<))
import Data.Bits (shiftR,bit,shiftL,testBit,(.&.),(.|.),complement,Bits)
import Data.Int (Int32)
import Data.Word (Word32)
import qualified Data.Foldable as F
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import qualified Data.Traversable as T
prettySym :: Symbol -> String
prettySym :: Symbol -> KindMd
prettySym Symbol
s = Doc -> KindMd
forall a. Show a => a -> KindMd
show (Doc -> KindMd) -> Doc -> KindMd
forall a b. (a -> b) -> a -> b
$ Int -> ((?config::Config) => Doc) -> Doc
forall a. Int -> ((?config::Config) => a) -> a
ppLLVM Int
llvmVlatest (((?config::Config) => Doc) -> Doc)
-> ((?config::Config) => Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ Symbol -> Doc
forall a. LLVMPretty a => Fmt a
llvmPP Symbol
s
type AliasList = Seq.Seq PartialAlias
data PartialAlias = PartialAlias
{ PartialAlias -> Maybe Linkage
paLinkage :: Maybe Linkage
, PartialAlias -> Maybe Visibility
paVisibility :: Maybe Visibility
, PartialAlias -> Symbol
paName :: Symbol
, PartialAlias -> Type' Ident
paType :: Type
, PartialAlias -> Word32
paTarget :: !Word32
} deriving Int -> PartialAlias -> ShowS
[PartialAlias] -> ShowS
PartialAlias -> KindMd
(Int -> PartialAlias -> ShowS)
-> (PartialAlias -> KindMd)
-> ([PartialAlias] -> ShowS)
-> Show PartialAlias
forall a.
(Int -> a -> ShowS) -> (a -> KindMd) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartialAlias -> ShowS
showsPrec :: Int -> PartialAlias -> ShowS
$cshow :: PartialAlias -> KindMd
show :: PartialAlias -> KindMd
$cshowList :: [PartialAlias] -> ShowS
showList :: [PartialAlias] -> ShowS
Show
parseAliasOld :: Int -> Record -> Parse PartialAlias
parseAliasOld :: Int -> Record -> Parse PartialAlias
parseAliasOld Int
n Record
r = do
KindMd
sym <- Int -> Parse KindMd
entryName Int
n
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
name :: Symbol
name = KindMd -> Symbol
Symbol KindMd
sym
Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
tgt <- LookupField Word32
forall {a}. LookupField a
field Int
1 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Linkage
lnk <- LookupField Linkage
forall {a}. LookupField a
field Int
2 Match Field Linkage
linkage
Visibility
vis <- LookupField Visibility
forall {a}. LookupField a
field Int
3 Match Field Visibility
visibility
Int
_ <- Typed PValue -> Parse Int
pushValue (Type' Ident -> PValue -> Typed PValue
forall a. Type' Ident -> a -> Typed a
Typed Type' Ident
ty (Symbol -> PValue
forall lab. Symbol -> Value' lab
ValSymbol Symbol
name))
PartialAlias -> Parse PartialAlias
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialAlias
{ paLinkage :: Maybe Linkage
paLinkage = Linkage -> Maybe Linkage
forall a. a -> Maybe a
Just Linkage
lnk
, paVisibility :: Maybe Visibility
paVisibility = Visibility -> Maybe Visibility
forall a. a -> Maybe a
Just Visibility
vis
, paName :: Symbol
paName = Symbol
name
, paType :: Type' Ident
paType = Type' Ident
ty
, paTarget :: Word32
paTarget = Word32
tgt
}
parseAlias :: Record -> Parse PartialAlias
parseAlias :: Record -> Parse PartialAlias
parseAlias Record
r = do
Int
n <- Parse Int
nextValueId
(Symbol
name, Int
offset) <- Int -> Record -> Parse (Symbol, Int)
oldOrStrtabName Int
n Record
r
let field :: Int -> Match Field a -> Parse a
field Int
i = Record -> Int -> Match Field a -> Parse a
forall a. Record -> LookupField a
parseField Record
r (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)
Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
_addrSp <- LookupField Word32
forall {a}. LookupField a
field Int
1 Match Field Word32
unsigned
Word32
tgt <- LookupField Word32
forall {a}. LookupField a
field Int
2 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Linkage
lnk <- LookupField Linkage
forall {a}. LookupField a
field Int
3 Match Field Linkage
linkage
Visibility
vis <- LookupField Visibility
forall {a}. LookupField a
field Int
4 Match Field Visibility
visibility
Int
_ <- Typed PValue -> Parse Int
pushValue (Type' Ident -> PValue -> Typed PValue
forall a. Type' Ident -> a -> Typed a
Typed (Type' Ident -> Type' Ident
forall ident. Type' ident -> Type' ident
PtrTo Type' Ident
ty) (Symbol -> PValue
forall lab. Symbol -> Value' lab
ValSymbol Symbol
name))
PartialAlias -> Parse PartialAlias
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialAlias
{ paLinkage :: Maybe Linkage
paLinkage = Linkage -> Maybe Linkage
forall a. a -> Maybe a
Just Linkage
lnk
, paVisibility :: Maybe Visibility
paVisibility = Visibility -> Maybe Visibility
forall a. a -> Maybe a
Just Visibility
vis
, paName :: Symbol
paName = Symbol
name
, paType :: Type' Ident
paType = Type' Ident
ty
, paTarget :: Word32
paTarget = Word32
tgt
}
finalizePartialAlias :: PartialAlias -> Parse GlobalAlias
finalizePartialAlias :: PartialAlias -> Parse GlobalAlias
finalizePartialAlias PartialAlias
pa = KindMd -> Parse GlobalAlias -> Parse GlobalAlias
forall a. KindMd -> Parse a -> Parse a
label KindMd
"finalizePartialAlias" (Parse GlobalAlias -> Parse GlobalAlias)
-> Parse GlobalAlias -> Parse GlobalAlias
forall a b. (a -> b) -> a -> b
$ do
Typed PValue
tv <- Type' Ident -> Int -> Parse (Typed PValue)
getFnValueById (PartialAlias -> Type' Ident
paType PartialAlias
pa) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PartialAlias -> Word32
paTarget PartialAlias
pa))
Value' BlockLabel
tgt <- Finalize (Value' BlockLabel) -> Parse (Value' BlockLabel)
forall a. Finalize a -> Parse a
liftFinalize (Finalize (Value' BlockLabel) -> Parse (Value' BlockLabel))
-> Finalize (Value' BlockLabel) -> Parse (Value' BlockLabel)
forall a b. (a -> b) -> a -> b
$ (Maybe Symbol -> Int -> Finalize BlockLabel)
-> PValue -> Finalize (Value' BlockLabel)
forall (f :: * -> *) (m :: * -> *) a b.
(HasLabel f, Applicative m) =>
(Maybe Symbol -> a -> m b) -> f a -> m (f b)
forall (m :: * -> *) a b.
Applicative m =>
(Maybe Symbol -> a -> m b) -> Value' a -> m (Value' b)
relabel ((Int -> Finalize BlockLabel)
-> Maybe Symbol -> Int -> Finalize BlockLabel
forall a b. a -> b -> a
const Int -> Finalize BlockLabel
requireBbEntryName) (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
tv)
GlobalAlias -> Parse GlobalAlias
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return GlobalAlias
{ aliasLinkage :: Maybe Linkage
aliasLinkage = PartialAlias -> Maybe Linkage
paLinkage PartialAlias
pa
, aliasVisibility :: Maybe Visibility
aliasVisibility = PartialAlias -> Maybe Visibility
paVisibility PartialAlias
pa
, aliasName :: Symbol
aliasName = PartialAlias -> Symbol
paName PartialAlias
pa
, aliasType :: Type' Ident
aliasType = PartialAlias -> Type' Ident
paType PartialAlias
pa
, aliasTarget :: Value' BlockLabel
aliasTarget = Value' BlockLabel
tgt
}
type DeclareList = Seq.Seq FunProto
finalizeDeclare :: FunProto -> Parse Declare
finalizeDeclare :: FunProto -> Parse Declare
finalizeDeclare FunProto
fp = case FunProto -> Type' Ident
protoType FunProto
fp of
PtrTo (FunTy Type' Ident
ret [Type' Ident]
args Bool
va) -> Declare -> Parse Declare
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Declare
{ decLinkage :: Maybe Linkage
decLinkage = FunProto -> Maybe Linkage
protoLinkage FunProto
fp
, decVisibility :: Maybe Visibility
decVisibility = FunProto -> Maybe Visibility
protoVisibility FunProto
fp
, decRetType :: Type' Ident
decRetType = Type' Ident
ret
, decName :: Symbol
decName = FunProto -> Symbol
protoSym FunProto
fp
, decArgs :: [Type' Ident]
decArgs = [Type' Ident]
args
, decVarArgs :: Bool
decVarArgs = Bool
va
, decAttrs :: [FunAttr]
decAttrs = []
, decComdat :: Maybe KindMd
decComdat = FunProto -> Maybe KindMd
protoComdat FunProto
fp
}
Type' Ident
_ -> KindMd -> Parse Declare
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"invalid type on function prototype"
type DefineList = Seq.Seq PartialDefine
data PartialDefine = PartialDefine
{ PartialDefine -> Maybe Linkage
partialLinkage :: Maybe Linkage
, PartialDefine -> Maybe Visibility
partialVisibility :: Maybe Visibility
, PartialDefine -> Maybe GC
partialGC :: Maybe GC
, PartialDefine -> Maybe KindMd
partialSection :: Maybe String
, PartialDefine -> Type' Ident
partialRetType :: Type
, PartialDefine -> Symbol
partialName :: Symbol
, PartialDefine -> [Typed Ident]
partialArgs :: [Typed Ident]
, PartialDefine -> Bool
partialVarArgs :: Bool
, PartialDefine -> BlockList
partialBody :: BlockList
, PartialDefine -> StmtList
partialBlock :: StmtList
, PartialDefine -> Int
partialBlockId :: !Int
, PartialDefine -> ValueSymtab
partialSymtab :: ValueSymtab
, PartialDefine -> Map Int PValMd
partialMetadata :: Map.Map PKindMd PValMd
, PartialDefine -> Seq PartialUnnamedMd
partialGlobalMd :: !(Seq.Seq PartialUnnamedMd)
, PartialDefine -> Maybe KindMd
partialComdatName :: Maybe String
} deriving Int -> PartialDefine -> ShowS
[PartialDefine] -> ShowS
PartialDefine -> KindMd
(Int -> PartialDefine -> ShowS)
-> (PartialDefine -> KindMd)
-> ([PartialDefine] -> ShowS)
-> Show PartialDefine
forall a.
(Int -> a -> ShowS) -> (a -> KindMd) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartialDefine -> ShowS
showsPrec :: Int -> PartialDefine -> ShowS
$cshow :: PartialDefine -> KindMd
show :: PartialDefine -> KindMd
$cshowList :: [PartialDefine] -> ShowS
showList :: [PartialDefine] -> ShowS
Show
emptyPartialDefine :: FunProto -> Parse PartialDefine
emptyPartialDefine :: FunProto -> Parse PartialDefine
emptyPartialDefine FunProto
proto = do
(Type' Ident
rty,[Type' Ident]
tys,Bool
va) <- Type' Ident -> Parse (Type' Ident, [Type' Ident], Bool)
forall (m :: * -> *).
MonadPlus m =>
Type' Ident -> m (Type' Ident, [Type' Ident], Bool)
elimFunPtr (FunProto -> Type' Ident
protoType FunProto
proto)
Parse (Type' Ident, [Type' Ident], Bool)
-> Parse (Type' Ident, [Type' Ident], Bool)
-> Parse (Type' Ident, [Type' Ident], Bool)
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` KindMd -> Parse (Type' Ident, [Type' Ident], Bool)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"invalid function type in prototype"
[Ident]
names <- (Type' Ident -> Parse Ident) -> [Type' Ident] -> Parse [Ident]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type' Ident -> Parse Ident
nameNextValue [Type' Ident]
tys
ValueSymtab
symtab <- Parse ValueSymtab
initialPartialSymtab
PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
{ partialLinkage :: Maybe Linkage
partialLinkage = FunProto -> Maybe Linkage
protoLinkage FunProto
proto
, partialVisibility :: Maybe Visibility
partialVisibility = FunProto -> Maybe Visibility
protoVisibility FunProto
proto
, partialGC :: Maybe GC
partialGC = FunProto -> Maybe GC
protoGC FunProto
proto
, partialSection :: Maybe KindMd
partialSection = FunProto -> Maybe KindMd
protoSect FunProto
proto
, partialRetType :: Type' Ident
partialRetType = Type' Ident
rty
, partialName :: Symbol
partialName = FunProto -> Symbol
protoSym FunProto
proto
, partialArgs :: [Typed Ident]
partialArgs = (Type' Ident -> Ident -> Typed Ident)
-> [Type' Ident] -> [Ident] -> [Typed Ident]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Type' Ident -> Ident -> Typed Ident
forall a. Type' Ident -> a -> Typed a
Typed [Type' Ident]
tys [Ident]
names
, partialVarArgs :: Bool
partialVarArgs = Bool
va
, partialBody :: BlockList
partialBody = BlockList
forall a. Monoid a => a
mempty
, partialBlock :: StmtList
partialBlock = StmtList
forall a. Monoid a => a
mempty
, partialBlockId :: Int
partialBlockId = Int
0
, partialSymtab :: ValueSymtab
partialSymtab = ValueSymtab
symtab
, partialMetadata :: Map Int PValMd
partialMetadata = Map Int PValMd
forall a. Monoid a => a
mempty
, partialGlobalMd :: Seq PartialUnnamedMd
partialGlobalMd = Seq PartialUnnamedMd
forall a. Monoid a => a
mempty
, partialComdatName :: Maybe KindMd
partialComdatName = FunProto -> Maybe KindMd
protoComdat FunProto
proto
}
setPartialBlock :: StmtList -> PartialDefine -> PartialDefine
setPartialBlock :: StmtList -> PartialDefine -> PartialDefine
setPartialBlock StmtList
stmts PartialDefine
pd = PartialDefine
pd { partialBlock = stmts }
setPartialBody :: BlockList -> PartialDefine -> PartialDefine
setPartialBody :: BlockList -> PartialDefine -> PartialDefine
setPartialBody BlockList
blocks PartialDefine
pd = PartialDefine
pd { partialBody = blocks }
initialPartialSymtab :: Parse ValueSymtab
initialPartialSymtab :: Parse ValueSymtab
initialPartialSymtab = do
Maybe BlockLabel
mb <- Finalize (Maybe BlockLabel) -> Parse (Maybe BlockLabel)
forall a. Finalize a -> Parse a
liftFinalize (Finalize (Maybe BlockLabel) -> Parse (Maybe BlockLabel))
-> Finalize (Maybe BlockLabel) -> Parse (Maybe BlockLabel)
forall a b. (a -> b) -> a -> b
$ Int -> Finalize (Maybe BlockLabel)
bbEntryName Int
0
case Maybe BlockLabel
mb of
Just{} -> ValueSymtab -> Parse ValueSymtab
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return ValueSymtab
emptyValueSymtab
Maybe BlockLabel
Nothing -> do
Int
i <- Parse Int
nextResultId
ValueSymtab -> Parse ValueSymtab
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> ValueSymtab -> ValueSymtab
addBBAnon Int
0 Int
i ValueSymtab
emptyValueSymtab)
updateLastStmt :: (PStmt -> PStmt) -> PartialDefine -> Parse PartialDefine
updateLastStmt :: (Stmt' Int -> Stmt' Int) -> PartialDefine -> Parse PartialDefine
updateLastStmt Stmt' Int -> Stmt' Int
f PartialDefine
pd = case Maybe PartialDefine
updatePartialBlock Maybe PartialDefine -> Maybe PartialDefine -> Maybe PartialDefine
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe PartialDefine
updatePartialBody of
Just PartialDefine
pd' -> PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
pd'
Maybe PartialDefine
Nothing -> KindMd -> Parse PartialDefine
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"No statement to update"
where
updatePartialBlock :: Maybe PartialDefine
updatePartialBlock = (PartialDefine -> StmtList)
-> (StmtList -> PartialDefine -> PartialDefine)
-> PartialDefine
-> Maybe PartialDefine
forall {m :: * -> *} {t} {a}.
MonadPlus m =>
(t -> StmtList) -> (StmtList -> t -> a) -> t -> m a
updateStmts PartialDefine -> StmtList
partialBlock StmtList -> PartialDefine -> PartialDefine
setPartialBlock PartialDefine
pd
updatePartialBody :: Maybe PartialDefine
updatePartialBody = case BlockList -> ViewR PartialBlock
forall a. Seq a -> ViewR a
Seq.viewr (PartialDefine -> BlockList
partialBody PartialDefine
pd) of
BlockList
blocks Seq.:> PartialBlock
b -> do
PartialBlock
b' <- (PartialBlock -> StmtList)
-> (StmtList -> PartialBlock -> PartialBlock)
-> PartialBlock
-> Maybe PartialBlock
forall {m :: * -> *} {t} {a}.
MonadPlus m =>
(t -> StmtList) -> (StmtList -> t -> a) -> t -> m a
updateStmts PartialBlock -> StmtList
partialStmts StmtList -> PartialBlock -> PartialBlock
setPartialStmts PartialBlock
b
PartialDefine -> Maybe PartialDefine
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockList -> PartialDefine -> PartialDefine
setPartialBody (BlockList
blocks BlockList -> PartialBlock -> BlockList
forall a. Seq a -> a -> Seq a
Seq.|> PartialBlock
b') PartialDefine
pd)
ViewR PartialBlock
Seq.EmptyR -> Maybe PartialDefine
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
updateStmts :: (t -> StmtList) -> (StmtList -> t -> a) -> t -> m a
updateStmts t -> StmtList
prj StmtList -> t -> a
upd t
a = case StmtList -> ViewR (Stmt' Int)
forall a. Seq a -> ViewR a
Seq.viewr (t -> StmtList
prj t
a) of
StmtList
stmts Seq.:> Stmt' Int
stmt -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (StmtList -> t -> a
upd (StmtList
stmts StmtList -> Stmt' Int -> StmtList
forall a. Seq a -> a -> Seq a
Seq.|> Stmt' Int -> Stmt' Int
f Stmt' Int
stmt) t
a)
ViewR (Stmt' Int)
Seq.EmptyR -> m a
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
type BlockLookup = Symbol -> Int -> Finalize BlockLabel
lookupBlockName :: DefineList -> BlockLookup
lookupBlockName :: DefineList -> BlockLookup
lookupBlockName DefineList
dl = BlockLookup
forall {m :: * -> *}. MonadFail m => Symbol -> Int -> m BlockLabel
lkp
where
syms :: Map Symbol ValueSymtab
syms = [(Symbol, ValueSymtab)] -> Map Symbol ValueSymtab
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (PartialDefine -> Symbol
partialName PartialDefine
d, PartialDefine -> ValueSymtab
partialSymtab PartialDefine
d) | PartialDefine
d <- DefineList -> [PartialDefine]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList DefineList
dl ]
lkp :: Symbol -> Int -> m BlockLabel
lkp Symbol
fn Int
bid = case Symbol -> Map Symbol ValueSymtab -> Maybe ValueSymtab
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
fn Map Symbol ValueSymtab
syms of
Maybe ValueSymtab
Nothing -> KindMd -> m BlockLabel
forall a. KindMd -> m a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd
"symbol " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Symbol -> KindMd
prettySym Symbol
fn KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ KindMd
" is not defined")
Just ValueSymtab
st -> case Int -> IntMap SymName -> Maybe SymName
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
bid (ValueSymtab -> IntMap SymName
bbSymtab ValueSymtab
st) of
Maybe SymName
Nothing -> KindMd -> m BlockLabel
forall a. KindMd -> m a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd
"block id " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> KindMd
forall a. Show a => a -> KindMd
show Int
bid KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ KindMd
" does not exist")
Just SymName
sn -> BlockLabel -> m BlockLabel
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SymName -> BlockLabel
mkBlockLabel SymName
sn)
finalizePartialDefine :: BlockLookup -> PartialDefine -> Parse Define
finalizePartialDefine :: BlockLookup -> PartialDefine -> Parse Define
finalizePartialDefine BlockLookup
lkp PartialDefine
pd =
KindMd -> Parse Define -> Parse Define
forall a. KindMd -> Parse a -> Parse a
label KindMd
"finalizePartialDefine" (Parse Define -> Parse Define) -> Parse Define -> Parse Define
forall a b. (a -> b) -> a -> b
$
ValueSymtab -> Parse Define -> Parse Define
forall a. ValueSymtab -> Parse a -> Parse a
withValueSymtab (PartialDefine -> ValueSymtab
partialSymtab PartialDefine
pd) (Parse Define -> Parse Define) -> Parse Define -> Parse Define
forall a b. (a -> b) -> a -> b
$ do
[BasicBlock]
body <- Finalize [BasicBlock] -> Parse [BasicBlock]
forall a. Finalize a -> Parse a
liftFinalize (Finalize [BasicBlock] -> Parse [BasicBlock])
-> Finalize [BasicBlock] -> Parse [BasicBlock]
forall a b. (a -> b) -> a -> b
$ BlockLookup -> BlockList -> Finalize [BasicBlock]
finalizeBody BlockLookup
lkp (PartialDefine -> BlockList
partialBody PartialDefine
pd)
FnMdAttachments
md <- Map Int PValMd -> Parse FnMdAttachments
finalizeMetadata (PartialDefine -> Map Int PValMd
partialMetadata PartialDefine
pd)
Define -> Parse Define
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Define
{ defLinkage :: Maybe Linkage
defLinkage = PartialDefine -> Maybe Linkage
partialLinkage PartialDefine
pd
, defVisibility :: Maybe Visibility
defVisibility = PartialDefine -> Maybe Visibility
partialVisibility PartialDefine
pd
, defGC :: Maybe GC
defGC = PartialDefine -> Maybe GC
partialGC PartialDefine
pd
, defAttrs :: [FunAttr]
defAttrs = []
, defRetType :: Type' Ident
defRetType = PartialDefine -> Type' Ident
partialRetType PartialDefine
pd
, defName :: Symbol
defName = PartialDefine -> Symbol
partialName PartialDefine
pd
, defArgs :: [Typed Ident]
defArgs = PartialDefine -> [Typed Ident]
partialArgs PartialDefine
pd
, defVarArgs :: Bool
defVarArgs = PartialDefine -> Bool
partialVarArgs PartialDefine
pd
, defBody :: [BasicBlock]
defBody = [BasicBlock]
body
, defSection :: Maybe KindMd
defSection = PartialDefine -> Maybe KindMd
partialSection PartialDefine
pd
, defMetadata :: FnMdAttachments
defMetadata = FnMdAttachments
md
, defComdat :: Maybe KindMd
defComdat = PartialDefine -> Maybe KindMd
partialComdatName PartialDefine
pd
}
finalizeMetadata :: PFnMdAttachments -> Parse FnMdAttachments
finalizeMetadata :: Map Int PValMd -> Parse FnMdAttachments
finalizeMetadata Map Int PValMd
patt = [(KindMd, ValMd)] -> FnMdAttachments
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KindMd, ValMd)] -> FnMdAttachments)
-> Parse [(KindMd, ValMd)] -> Parse FnMdAttachments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, PValMd) -> Parse (KindMd, ValMd))
-> [(Int, PValMd)] -> Parse [(KindMd, ValMd)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int, PValMd) -> Parse (KindMd, ValMd)
f (Map Int PValMd -> [(Int, PValMd)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int PValMd
patt)
where f :: (Int, PValMd) -> Parse (KindMd, ValMd)
f (Int
k,PValMd
md) = (,) (KindMd -> ValMd -> (KindMd, ValMd))
-> Parse KindMd -> Parse (ValMd -> (KindMd, ValMd))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parse KindMd
getKind Int
k Parse (ValMd -> (KindMd, ValMd))
-> Parse ValMd -> Parse (KindMd, ValMd)
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Finalize ValMd -> Parse ValMd
forall a. Finalize a -> Parse a
liftFinalize (PValMd -> Finalize ValMd
finalizePValMd PValMd
md)
resolveBlockLabel :: BlockLookup -> Maybe Symbol -> Int -> Finalize BlockLabel
resolveBlockLabel :: BlockLookup -> Maybe Symbol -> Int -> Finalize BlockLabel
resolveBlockLabel BlockLookup
lkp Maybe Symbol
mbSym = case Maybe Symbol
mbSym of
Maybe Symbol
Nothing -> Int -> Finalize BlockLabel
requireBbEntryName
Just Symbol
sym -> BlockLookup
lkp Symbol
sym
nameNextValue :: Type -> Parse Ident
nameNextValue :: Type' Ident -> Parse Ident
nameNextValue Type' Ident
ty = do
ValueTable
vs <- Parse ValueTable
getValueTable
let nextId :: Int
nextId = ValueTable -> Int
valueNextId ValueTable
vs
KindMd
name <- Int -> Parse KindMd
entryName Int
nextId Parse KindMd -> Parse KindMd -> Parse KindMd
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Int -> KindMd
forall a. Show a => a -> KindMd
show (Int -> KindMd) -> Parse Int -> Parse KindMd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Int
nextResultId)
let i :: Ident
i = KindMd -> Ident
Ident KindMd
name
tv :: Typed (Value' lab)
tv = Type' Ident -> Value' lab -> Typed (Value' lab)
forall a. Type' Ident -> a -> Typed a
Typed Type' Ident
ty (Ident -> Value' lab
forall lab. Ident -> Value' lab
ValIdent Ident
i)
ValueTable -> Parse ()
setValueTable (Typed PValue -> ValueTable -> ValueTable
addValue Typed PValue
forall {lab}. Typed (Value' lab)
tv ValueTable
vs)
Ident -> Parse Ident
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Ident
i
declareBlocksRecord :: Match Entry UnabbrevRecord
declareBlocksRecord :: Match Entry UnabbrevRecord
declareBlocksRecord = Int -> Match UnabbrevRecord UnabbrevRecord
hasUnabbrevCode Int
1 Match UnabbrevRecord UnabbrevRecord
-> Match Entry UnabbrevRecord -> Match Entry UnabbrevRecord
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Match Entry UnabbrevRecord
unabbrev
addStmt :: Stmt' Int -> PartialDefine -> Parse PartialDefine
addStmt :: Stmt' Int -> PartialDefine -> Parse PartialDefine
addStmt Stmt' Int
s PartialDefine
d
| Instr' Int -> Bool
forall lab. Instr' lab -> Bool
isTerminator (Stmt' Int -> Instr' Int
forall lab. Stmt' lab -> Instr' lab
stmtInstr Stmt' Int
s) = PartialDefine -> Parse PartialDefine
terminateBlock PartialDefine
d'
| Bool
otherwise = PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d'
where
d' :: PartialDefine
d' = PartialDefine
d { partialBlock = partialBlock d Seq.|> s }
terminateBlock :: PartialDefine -> Parse PartialDefine
terminateBlock :: PartialDefine -> Parse PartialDefine
terminateBlock PartialDefine
d = do
let next :: Int
next = PartialDefine -> Int
partialBlockId PartialDefine
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Maybe BlockLabel
mb <- Finalize (Maybe BlockLabel) -> Parse (Maybe BlockLabel)
forall a. Finalize a -> Parse a
liftFinalize (Finalize (Maybe BlockLabel) -> Parse (Maybe BlockLabel))
-> Finalize (Maybe BlockLabel) -> Parse (Maybe BlockLabel)
forall a b. (a -> b) -> a -> b
$ Int -> Finalize (Maybe BlockLabel)
bbEntryName Int
next
PartialDefine
d' <- case Maybe BlockLabel
mb of
Just BlockLabel
_ -> PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d
Maybe BlockLabel
Nothing -> do
Int
l <- Parse Int
nextResultId
PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d { partialSymtab = addBBAnon next l (partialSymtab d) }
PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d'
{ partialBody = partialBody d Seq.|> PartialBlock
{ partialLabel = partialBlockId d
, partialStmts = partialBlock d
}
, partialBlockId = next
, partialBlock = Seq.empty
}
type BlockList = Seq.Seq PartialBlock
finalizeBody :: BlockLookup -> BlockList -> Finalize [BasicBlock]
finalizeBody :: BlockLookup -> BlockList -> Finalize [BasicBlock]
finalizeBody BlockLookup
lkp = (Seq BasicBlock -> [BasicBlock])
-> Finalize (Seq BasicBlock) -> Finalize [BasicBlock]
forall a b. (a -> b) -> Finalize a -> Finalize b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq BasicBlock -> [BasicBlock]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Finalize (Seq BasicBlock) -> Finalize [BasicBlock])
-> (BlockList -> Finalize (Seq BasicBlock))
-> BlockList
-> Finalize [BasicBlock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PartialBlock -> Finalize BasicBlock)
-> BlockList -> Finalize (Seq BasicBlock)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Seq a -> m (Seq b)
T.mapM (BlockLookup -> PartialBlock -> Finalize BasicBlock
finalizePartialBlock BlockLookup
lkp)
data PartialBlock = PartialBlock
{ PartialBlock -> Int
partialLabel :: !Int
, PartialBlock -> StmtList
partialStmts :: StmtList
} deriving (Int -> PartialBlock -> ShowS
[PartialBlock] -> ShowS
PartialBlock -> KindMd
(Int -> PartialBlock -> ShowS)
-> (PartialBlock -> KindMd)
-> ([PartialBlock] -> ShowS)
-> Show PartialBlock
forall a.
(Int -> a -> ShowS) -> (a -> KindMd) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartialBlock -> ShowS
showsPrec :: Int -> PartialBlock -> ShowS
$cshow :: PartialBlock -> KindMd
show :: PartialBlock -> KindMd
$cshowList :: [PartialBlock] -> ShowS
showList :: [PartialBlock] -> ShowS
Show)
setPartialStmts :: StmtList -> PartialBlock -> PartialBlock
setPartialStmts :: StmtList -> PartialBlock -> PartialBlock
setPartialStmts StmtList
stmts PartialBlock
pb = PartialBlock
pb { partialStmts = stmts }
finalizePartialBlock :: BlockLookup -> PartialBlock -> Finalize BasicBlock
finalizePartialBlock :: BlockLookup -> PartialBlock -> Finalize BasicBlock
finalizePartialBlock BlockLookup
lkp PartialBlock
pb = Maybe BlockLabel -> [Stmt' BlockLabel] -> BasicBlock
forall lab. Maybe lab -> [Stmt' lab] -> BasicBlock' lab
BasicBlock
(Maybe BlockLabel -> [Stmt' BlockLabel] -> BasicBlock)
-> Finalize (Maybe BlockLabel)
-> Finalize ([Stmt' BlockLabel] -> BasicBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Finalize (Maybe BlockLabel)
bbEntryName (PartialBlock -> Int
partialLabel PartialBlock
pb)
Finalize ([Stmt' BlockLabel] -> BasicBlock)
-> Finalize [Stmt' BlockLabel] -> Finalize BasicBlock
forall a b. Finalize (a -> b) -> Finalize a -> Finalize b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockLookup -> StmtList -> Finalize [Stmt' BlockLabel]
finalizeStmts BlockLookup
lkp (PartialBlock -> StmtList
partialStmts PartialBlock
pb)
type PStmt = Stmt' Int
type StmtList = Seq.Seq PStmt
finalizeStmts :: BlockLookup -> StmtList -> Finalize [Stmt]
finalizeStmts :: BlockLookup -> StmtList -> Finalize [Stmt' BlockLabel]
finalizeStmts BlockLookup
lkp = (Stmt' Int -> Finalize (Stmt' BlockLabel))
-> [Stmt' Int] -> Finalize [Stmt' BlockLabel]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (BlockLookup -> Stmt' Int -> Finalize (Stmt' BlockLabel)
finalizeStmt BlockLookup
lkp) ([Stmt' Int] -> Finalize [Stmt' BlockLabel])
-> (StmtList -> [Stmt' Int])
-> StmtList
-> Finalize [Stmt' BlockLabel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StmtList -> [Stmt' Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
finalizeStmt :: BlockLookup -> Stmt' Int -> Finalize Stmt
finalizeStmt :: BlockLookup -> Stmt' Int -> Finalize (Stmt' BlockLabel)
finalizeStmt BlockLookup
lkp = (Maybe Symbol -> Int -> Finalize BlockLabel)
-> Stmt' Int -> Finalize (Stmt' BlockLabel)
forall (f :: * -> *) (m :: * -> *) a b.
(HasLabel f, Applicative m) =>
(Maybe Symbol -> a -> m b) -> f a -> m (f b)
forall (m :: * -> *) a b.
Applicative m =>
(Maybe Symbol -> a -> m b) -> Stmt' a -> m (Stmt' b)
relabel (BlockLookup -> Maybe Symbol -> Int -> Finalize BlockLabel
resolveBlockLabel BlockLookup
lkp)
callExplicitTypeBit :: Int
callExplicitTypeBit :: Int
callExplicitTypeBit = Int
15
parseFunctionBlock ::
Int ->
[Entry] -> Parse PartialDefine
parseFunctionBlock :: Int -> [Entry] -> Parse PartialDefine
parseFunctionBlock Int
unnamedGlobals [Entry]
ents =
KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNCTION_BLOCK" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ Parse PartialDefine -> Parse PartialDefine
forall a. Parse a -> Parse a
enterFunctionDef (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
ValueSymtab
symtab <- KindMd -> Parse ValueSymtab -> Parse ValueSymtab
forall a. KindMd -> Parse a -> Parse a
label KindMd
"VALUE_SYMTAB" (Parse ValueSymtab -> Parse ValueSymtab)
-> Parse ValueSymtab -> Parse ValueSymtab
forall a b. (a -> b) -> a -> b
$ do
Maybe [Entry]
mb <- Match [Entry] (Maybe [Entry]) -> [Entry] -> Parse (Maybe [Entry])
forall i a. Match i a -> i -> Parse a
match (Match Entry [Entry] -> Match [Entry] (Maybe [Entry])
forall a b. Match a b -> Match [a] (Maybe b)
findMatch Match Entry [Entry]
valueSymtabBlockId) [Entry]
ents
case Maybe [Entry]
mb of
Just [Entry]
es -> [Entry] -> Parse ValueSymtab
parseValueSymbolTableBlock [Entry]
es
Maybe [Entry]
Nothing -> ValueSymtab -> Parse ValueSymtab
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return ValueSymtab
forall a. Monoid a => a
mempty
FunProto
proto <- Parse FunProto
popFunProto
KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label (Symbol -> KindMd
prettySym (FunProto -> Symbol
protoSym FunProto
proto)) (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ ValueSymtab -> Parse PartialDefine -> Parse PartialDefine
forall a. ValueSymtab -> Parse a -> Parse a
withValueSymtab ValueSymtab
symtab (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
PartialDefine
pd <- FunProto -> Parse PartialDefine
emptyPartialDefine FunProto
proto
rec PartialDefine
pd' <- (PartialDefine -> Entry -> Parse PartialDefine)
-> PartialDefine -> [Entry] -> Parse PartialDefine
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Int -> ValueTable -> PartialDefine -> Entry -> Parse PartialDefine
parseFunctionBlockEntry Int
unnamedGlobals ValueTable
vt) PartialDefine
pd [Entry]
ents
ValueTable
vt <- Parse ValueTable
getValueTable
PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
pd' { partialSymtab = partialSymtab pd' `mappend` symtab }
parseFunctionBlockEntry ::
Int ->
ValueTable -> PartialDefine -> Entry ->
Parse PartialDefine
parseFunctionBlockEntry :: Int -> ValueTable -> PartialDefine -> Entry -> Parse PartialDefine
parseFunctionBlockEntry Int
_ ValueTable
_ PartialDefine
d (Match Entry [Entry]
constantsBlockId -> Just [Entry]
es) = do
[Entry] -> Parse ()
parseConstantsBlock [Entry]
es
PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d
parseFunctionBlockEntry Int
_ ValueTable
t PartialDefine
d (Match Entry Record
fromEntry -> Just Record
r) = case Record -> Int
recordCode Record
r of
Int
1 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_DECLARE_BLOCKS"
(Record -> Int -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> Int -> m ()
Assert.recordSizeGreater Record
r Int
0 Parse () -> Parse PartialDefine -> Parse PartialDefine
forall a b. Parse a -> Parse b -> Parse b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d)
Int
2 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_BINOP" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Typed PValue
lhs,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Typed PValue
rhs <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
lhs) (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe Int -> Typed PValue -> PValue -> Instr' Int
mkInstr <- LookupField (Maybe Int -> Typed PValue -> PValue -> Instr' Int)
forall {a}. LookupField a
field (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Match Field (Maybe Int -> Typed PValue -> PValue -> Instr' Int)
binop
let mbWord :: Maybe Int
mbWord = Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric Match Field Int -> Maybe Field -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Match Record Field
fieldAt (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Record
r
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
lhs) (Maybe Int -> Typed PValue -> PValue -> Instr' Int
mkInstr Maybe Int
mbWord Typed PValue
lhs (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
rhs)) PartialDefine
d
Int
3 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_CAST" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Typed PValue
tv,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Record -> [Int] -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> [Int] -> m ()
Assert.recordSizeIn Record
r [Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2]
Type' Ident
resty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Typed PValue -> Type' Ident -> Instr' Int
cast' <- LookupField (Typed PValue -> Type' Ident -> Instr' Int)
forall {a}. LookupField a
field (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Match Field (Typed PValue -> Type' Ident -> Instr' Int)
castOp
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
resty (Typed PValue -> Type' Ident -> Instr' Int
cast' Typed PValue
tv Type' Ident
resty) PartialDefine
d
Int
4 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_GEP_OLD" (ValueTable
-> Maybe Bool -> Record -> PartialDefine -> Parse PartialDefine
parseGEP ValueTable
t (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) Record
r PartialDefine
d)
Int
5 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_SELECT" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Typed PValue
tval,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Typed PValue
fval <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tval) (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Typed PValue
cond <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t (PrimType -> Type' Ident
forall ident. PrimType -> Type' ident
PrimType (Word32 -> PrimType
Integer Word32
1)) (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tval) (Typed PValue -> Typed PValue -> PValue -> Instr' Int
forall lab.
Typed (Value' lab)
-> Typed (Value' lab) -> Value' lab -> Instr' lab
Select Typed PValue
cond Typed PValue
tval (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
fval)) PartialDefine
d
Int
6 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_EXTRACTELT" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Typed PValue
tv,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Typed PValue
idx <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t (PrimType -> Type' Ident
forall ident. PrimType -> Type' ident
PrimType (Word32 -> PrimType
Integer Word32
32)) (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Word64
_, Type' Ident
ty) <- Type' Ident -> Parse (Word64, Type' Ident)
forall (m :: * -> *).
MonadPlus m =>
Type' Ident -> m (Word64, Type' Ident)
elimVector (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tv)
Parse (Word64, Type' Ident)
-> Parse (Word64, Type' Ident) -> Parse (Word64, Type' Ident)
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` KindMd -> Parse (Word64, Type' Ident)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"invalid EXTRACTELT record"
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ty (Typed PValue -> PValue -> Instr' Int
forall lab. Typed (Value' lab) -> Value' lab -> Instr' lab
ExtractElt Typed PValue
tv (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
idx)) PartialDefine
d
Int
7 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_INSERTELT" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Typed PValue
tv,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
(Word64
_,Type' Ident
pty) <- Type' Ident -> Parse (Word64, Type' Ident)
forall (m :: * -> *).
MonadPlus m =>
Type' Ident -> m (Word64, Type' Ident)
elimVector (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tv)
Parse (Word64, Type' Ident)
-> Parse (Word64, Type' Ident) -> Parse (Word64, Type' Ident)
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` KindMd -> Parse (Word64, Type' Ident)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"invalid INSERTELT record (not a vector)"
Typed PValue
elt <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t Type' Ident
pty (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Typed PValue
idx <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t (PrimType -> Type' Ident
forall ident. PrimType -> Type' ident
PrimType (Word32 -> PrimType
Integer Word32
32)) (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tv) (Typed PValue -> Typed PValue -> PValue -> Instr' Int
forall lab.
Typed (Value' lab)
-> Typed (Value' lab) -> Value' lab -> Instr' lab
InsertElt Typed PValue
tv Typed PValue
elt (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
idx)) PartialDefine
d
Int
8 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_SHUFFLEVEC" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Typed PValue
vec1,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Typed PValue
vec2 <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
vec1) (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Typed PValue
mask,Int
_) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Type' Ident
resTy <- case (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
vec1,Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
mask) of
(Vector Word64
_ Type' Ident
elemTy, Vector Word64
shuffleLen Type' Ident
_) ->
Type' Ident -> Parse (Type' Ident)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Type' Ident -> Type' Ident
forall ident. Word64 -> Type' ident -> Type' ident
Vector Word64
shuffleLen Type' Ident
elemTy)
(Type' Ident, Type' Ident)
_ -> KindMd -> Parse (Type' Ident)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"Invalid arguments to shuffle vector (not vectors)"
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
resTy (Typed PValue -> PValue -> Typed PValue -> Instr' Int
forall lab.
Typed (Value' lab)
-> Value' lab -> Typed (Value' lab) -> Instr' lab
ShuffleVector Typed PValue
vec1 (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
vec2) Typed PValue
mask) PartialDefine
d
Int
10 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_RET" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ case [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) of
Int
0 -> Instr' Int -> PartialDefine -> Parse PartialDefine
effect Instr' Int
forall lab. Instr' lab
RetVoid PartialDefine
d
Int
_ -> do
(Typed PValue
tv, Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Record -> [Int] -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> [Int] -> m ()
Assert.recordSizeIn Record
r [Int
ix]
Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Typed PValue -> Instr' Int
forall lab. Typed (Value' lab) -> Instr' lab
Ret Typed PValue
tv) PartialDefine
d
Int
11 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_BR" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Record -> [Int] -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> [Int] -> m ()
Assert.recordSizeIn Record
r [Int
1, Int
3]
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Int
bb1 <- LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let jump :: Parse PartialDefine
jump = Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Int -> Instr' Int
forall lab. lab -> Instr' lab
Jump Int
bb1) PartialDefine
d
branch :: Parse PartialDefine
branch = do
Int
bb2 <- LookupField Int
forall {a}. LookupField a
field Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
n <- LookupField Int
forall {a}. LookupField a
field Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Typed PValue
cond <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t (PrimType -> Type' Ident
forall ident. PrimType -> Type' ident
PrimType (Word32 -> PrimType
Integer Word32
1)) Int
n
Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Typed PValue -> Int -> Int -> Instr' Int
forall lab. Typed (Value' lab) -> lab -> lab -> Instr' lab
Br Typed PValue
cond Int
bb1 Int
bb2) PartialDefine
d
Parse PartialDefine
branch Parse PartialDefine -> Parse PartialDefine -> Parse PartialDefine
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Parse PartialDefine
jump
Int
12 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_SWITCH" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
let switchInstMagic :: Int
switchInstMagic :: Int
switchInstMagic = Int
0x4B5
Int
n <- LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let newSwitch :: Parse PartialDefine
newSwitch = do
Type' Ident
opty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
width <- case Type' Ident
opty of
PrimType (Integer Word32
w) -> Word32 -> Parse Word32
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
w
Type' Ident
_ -> KindMd -> Parse Word32
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"invalid switch discriminate"
Typed PValue
cond <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t Type' Ident
opty (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
def <- LookupField Int
forall {a}. LookupField a
field Int
3 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
numCases <- LookupField Int
forall {a}. LookupField a
field Int
4 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[(Integer, Int)]
ls <- Word32 -> Record -> Int -> Int -> Parse [(Integer, Int)]
parseNewSwitchLabels Word32
width Record
r Int
numCases Int
5
Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Typed PValue -> Int -> [(Integer, Int)] -> Instr' Int
forall lab.
Typed (Value' lab) -> lab -> [(Integer, lab)] -> Instr' lab
Switch Typed PValue
cond Int
def [(Integer, Int)]
ls) PartialDefine
d
let oldSwitch :: Parse PartialDefine
oldSwitch = do
Type' Ident
opty <- Int -> Parse (Type' Ident)
getType Int
n
Typed PValue
cond <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t Type' Ident
opty (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
def <- LookupField Int
forall {a}. LookupField a
field Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[(Integer, Int)]
ls <- Type' Ident -> Record -> Int -> Parse [(Integer, Int)]
parseSwitchLabels Type' Ident
opty Record
r Int
3
Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Typed PValue -> Int -> [(Integer, Int)] -> Instr' Int
forall lab.
Typed (Value' lab) -> lab -> [(Integer, lab)] -> Instr' lab
Switch Typed PValue
cond Int
def [(Integer, Int)]
ls) PartialDefine
d
if Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
switchInstMagic then Parse PartialDefine
newSwitch else Parse PartialDefine
oldSwitch
Int
13 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_INVOKE" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Record -> Int -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> Int -> m ()
Assert.recordSizeGreater Record
r Int
3
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Word32
ccinfo <- LookupField Word32
forall {a}. LookupField a
field Int
1 Match Field Word32
unsigned
Int
normal <- LookupField Int
forall {a}. LookupField a
field Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
unwind <- LookupField Int
forall {a}. LookupField a
field Int
3 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Maybe (Type' Ident)
mbFTy,Int
ix) <-
if Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
ccinfo Int
13
then do Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
4 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Maybe (Type' Ident), Int) -> Parse (Maybe (Type' Ident), Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type' Ident -> Maybe (Type' Ident)
forall a. a -> Maybe a
Just Type' Ident
ty, Int
5)
else (Maybe (Type' Ident), Int) -> Parse (Maybe (Type' Ident), Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Type' Ident)
forall a. Maybe a
Nothing, Int
4)
(Typed PValue
f,Int
ix') <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
ix
Type' Ident
fty <- case Maybe (Type' Ident)
mbFTy of
Just Type' Ident
ty -> Type' Ident -> Parse (Type' Ident)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Type' Ident
ty
Maybe (Type' Ident)
Nothing -> KindMd -> Type' Ident -> Parse (Type' Ident)
forall (m :: * -> *).
(MonadFail m, MonadPlus m) =>
KindMd -> Type' Ident -> m (Type' Ident)
Assert.elimPtrTo KindMd
"Callee is not a pointer" (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
f)
(Type' Ident
ret,[Type' Ident]
as,Bool
va) <- Type' Ident -> Parse (Type' Ident, [Type' Ident], Bool)
forall (m :: * -> *).
MonadPlus m =>
Type' Ident -> m (Type' Ident, [Type' Ident], Bool)
elimFunTy Type' Ident
fty
Parse (Type' Ident, [Type' Ident], Bool)
-> Parse (Type' Ident, [Type' Ident], Bool)
-> Parse (Type' Ident, [Type' Ident], Bool)
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` KindMd -> Parse (Type' Ident, [Type' Ident], Bool)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"invalid INVOKE record"
[Typed PValue]
args <- ValueTable
-> Bool -> Record -> Int -> [Type' Ident] -> Parse [Typed PValue]
parseInvokeArgs ValueTable
t Bool
va Record
r Int
ix' [Type' Ident]
as
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ret (Type' Ident -> PValue -> [Typed PValue] -> Int -> Int -> Instr' Int
forall lab.
Type' Ident
-> Value' lab -> [Typed (Value' lab)] -> lab -> lab -> Instr' lab
Invoke Type' Ident
fty (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
f) [Typed PValue]
args Int
normal Int
unwind) PartialDefine
d
Int
14 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_UNWIND" (Instr' Int -> PartialDefine -> Parse PartialDefine
effect Instr' Int
forall lab. Instr' lab
Unwind PartialDefine
d)
Int
15 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_UNREACHABLE" (Instr' Int -> PartialDefine -> Parse PartialDefine
effect Instr' Int
forall lab. Instr' lab
Unreachable PartialDefine
d)
Int
16 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_PHI" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Bool
useRelIds <- Parse Bool
getRelIds
[(PValue, Int)]
args <- Bool -> ValueTable -> Record -> Parse [(PValue, Int)]
parsePhiArgs Bool
useRelIds ValueTable
t Record
r
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
forall a. Integral a => a -> Bool
even ([Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r))) (Parse () -> Parse ()) -> Parse () -> Parse ()
forall a b. (a -> b) -> a -> b
$ do
() -> Parse ()
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ty (Type' Ident -> [(PValue, Int)] -> Instr' Int
forall lab. Type' Ident -> [(Value' lab, lab)] -> Instr' lab
Phi Type' Ident
ty [(PValue, Int)]
args) PartialDefine
d
Int
19 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_ALLOCA" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Record -> [Int] -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> [Int] -> m ()
Assert.recordSizeIn Record
r [Int
4]
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type' Ident
instty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Typed PValue
size <- Type' Ident -> Int -> Parse (Typed PValue)
getFnValueById Type' Ident
ty (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
align <- LookupField Word32
forall {a}. LookupField a
field Int
3 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
let sval :: Maybe (Typed PValue)
sval = case Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
size of
ValInteger Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 -> Maybe (Typed PValue)
forall a. Maybe a
Nothing
PValue
_ -> Typed PValue -> Maybe (Typed PValue)
forall a. a -> Maybe a
Just Typed PValue
size
mask :: Word32
mask :: Word32
mask = (Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
5) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
(Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
6) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
(Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
7)
aval :: Int
aval = (Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
align Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
mask))) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
explicitType :: Bool
explicitType = Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
align Int
6
ity :: Type' Ident
ity = if Bool
explicitType then Type' Ident -> Type' Ident
forall ident. Type' ident -> Type' ident
PtrTo Type' Ident
instty else Type' Ident
instty
Type' Ident
ret <- if Bool
explicitType
then Type' Ident -> Parse (Type' Ident)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Type' Ident
instty
else KindMd -> Type' Ident -> Parse (Type' Ident)
forall (m :: * -> *).
(MonadFail m, MonadPlus m) =>
KindMd -> Type' Ident -> m (Type' Ident)
Assert.elimPtrTo KindMd
"In return type:" Type' Ident
instty
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ity (Type' Ident -> Maybe (Typed PValue) -> Maybe Int -> Instr' Int
forall lab.
Type' Ident
-> Maybe (Typed (Value' lab)) -> Maybe Int -> Instr' lab
Alloca Type' Ident
ret Maybe (Typed PValue)
sval (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
aval)) PartialDefine
d
Int
20 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_LOAD" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Typed PValue
tv,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Record -> [Int] -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> [Int] -> m ()
Assert.recordSizeIn Record
r [Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2, Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3]
(Type' Ident
ret,Int
ix') <-
if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3
then do Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Type' Ident, Int) -> Parse (Type' Ident, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type' Ident
ty,Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
else do Type' Ident
ty <- KindMd -> Type' Ident -> Parse (Type' Ident)
forall (m :: * -> *).
(MonadFail m, MonadPlus m) =>
KindMd -> Type' Ident -> m (Type' Ident)
Assert.elimPtrTo KindMd
"" (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tv)
(Type' Ident, Int) -> Parse (Type' Ident, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type' Ident
ty,Int
ix)
Int
aval <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
ix' Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let align :: Maybe Int
align | Int
aval Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Bits a => Int -> a
bit Int
aval Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
| Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ret (Type' Ident
-> Typed PValue -> Maybe AtomicOrdering -> Maybe Int -> Instr' Int
forall lab.
Type' Ident
-> Typed (Value' lab)
-> Maybe AtomicOrdering
-> Maybe Int
-> Instr' lab
Load Type' Ident
ret Typed PValue
tv Maybe AtomicOrdering
forall a. Maybe a
Nothing Maybe Int
align) PartialDefine
d
Int
23 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_VAARG" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Record -> Int -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> Int -> m ()
Assert.recordSizeGreater Record
r Int
2
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Typed PValue
op <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t Type' Ident
ty (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Type' Ident
resTy <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
resTy (Typed PValue -> Type' Ident -> Instr' Int
forall lab. Typed (Value' lab) -> Type' Ident -> Instr' lab
VaArg Typed PValue
op Type' Ident
resTy) PartialDefine
d
Int
24 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_STORE_OLD" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Typed PValue
ptr,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Type' Ident
ty <- KindMd -> Type' Ident -> Parse (Type' Ident)
forall (m :: * -> *).
(MonadFail m, MonadPlus m) =>
KindMd -> Type' Ident -> m (Type' Ident)
Assert.elimPtrTo KindMd
"" (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
ptr)
Typed PValue
val <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t Type' Ident
ty (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
aval <- LookupField Int
forall {a}. LookupField a
field (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let align :: Maybe Int
align | Int
aval Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Bits a => Int -> a
bit Int
aval Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
| Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Typed PValue
-> Typed PValue -> Maybe AtomicOrdering -> Maybe Int -> Instr' Int
forall lab.
Typed (Value' lab)
-> Typed (Value' lab)
-> Maybe AtomicOrdering
-> Maybe Int
-> Instr' lab
Store Typed PValue
val Typed PValue
ptr Maybe AtomicOrdering
forall a. Maybe a
Nothing Maybe Int
align) PartialDefine
d
Int
26 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_EXTRACTVAL" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Typed PValue
tv, Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ix) (Parse () -> Parse ()) -> Parse () -> Parse ()
forall a b. (a -> b) -> a -> b
$
KindMd -> Parse ()
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"`extractval` instruction had zero indices"
[Int32]
ixs <- Record -> Int -> Parse [Int32]
forall a. (Num a, Bits a) => Record -> Int -> Parse [a]
parseIndexes Record
r Int
ix
let instr :: Instr' Int
instr = Typed PValue -> [Int32] -> Instr' Int
forall lab. Typed (Value' lab) -> [Int32] -> Instr' lab
ExtractValue Typed PValue
tv [Int32]
ixs
Type' Ident
ret <- Type' Ident -> [Int32] -> Parse (Type' Ident)
interpValueIndex (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tv) [Int32]
ixs
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ret Instr' Int
instr PartialDefine
d
Int
27 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_INSERTVAL" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Typed PValue
tv,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ix) (Parse () -> Parse ()) -> Parse () -> Parse ()
forall a b. (a -> b) -> a -> b
$
KindMd -> Parse ()
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"Invalid instruction with zero indices"
(Typed PValue
elt,Int
ix') <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
ix
[Int32]
ixs <- Record -> Int -> Parse [Int32]
forall a. (Num a, Bits a) => Record -> Int -> Parse [a]
parseIndexes Record
r Int
ix'
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tv) (Typed PValue -> Typed PValue -> [Int32] -> Instr' Int
forall lab.
Typed (Value' lab) -> Typed (Value' lab) -> [Int32] -> Instr' lab
InsertValue Typed PValue
tv Typed PValue
elt [Int32]
ixs) PartialDefine
d
Int
29 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_VSELECT" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Typed PValue
tv,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Typed PValue
fv <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tv) (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Typed PValue
c,Int
_) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tv) (Typed PValue -> Typed PValue -> PValue -> Instr' Int
forall lab.
Typed (Value' lab)
-> Typed (Value' lab) -> Value' lab -> Instr' lab
Select Typed PValue
c Typed PValue
tv (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
fv)) PartialDefine
d
Int
30 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_INBOUNDS_GEP_OLD" (ValueTable
-> Maybe Bool -> Record -> PartialDefine -> Parse PartialDefine
parseGEP ValueTable
t (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Record
r PartialDefine
d)
Int
31 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_INDIRECTBR" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Typed PValue
addr <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t Type' Ident
ty (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[Int]
ls <- Record -> Int -> Parse [Int]
forall a. (Num a, Bits a) => Record -> Int -> Parse [a]
parseIndexes Record
r Int
2
Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Typed PValue -> [Int] -> Instr' Int
forall lab. Typed (Value' lab) -> [lab] -> Instr' lab
IndirectBr Typed PValue
addr [Int]
ls) PartialDefine
d
Int
33 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_DEBUG_LOC_AGAIN" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
PDebugLoc
loc <- Parse PDebugLoc
getLastLoc
(Stmt' Int -> Stmt' Int) -> PartialDefine -> Parse PartialDefine
updateLastStmt ((KindMd, PValMd) -> Stmt' Int -> Stmt' Int
forall lab. (KindMd, ValMd' lab) -> Stmt' lab -> Stmt' lab
extendMetadata (KindMd
"dbg", PDebugLoc -> PValMd
forall lab. DebugLoc' lab -> ValMd' lab
ValMdLoc PDebugLoc
loc)) PartialDefine
d
Int
34 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_CALL" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Record -> Int -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> Int -> m ()
Assert.recordSizeGreater Record
r Int
2
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Word32
ccinfo <- LookupField Word32
forall {a}. LookupField a
field Int
1 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
let ix0 :: Int
ix0 = if Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
ccinfo Int
17 then Int
3 else Int
2
(Maybe (Type' Ident)
mbFnTy, Int
ix1) <- if Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Word32
ccinfo :: Word32) Int
callExplicitTypeBit
then do Type' Ident
fnTy <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Maybe (Type' Ident), Int) -> Parse (Maybe (Type' Ident), Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type' Ident -> Maybe (Type' Ident)
forall a. a -> Maybe a
Just Type' Ident
fnTy, Int
ix0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
else (Maybe (Type' Ident), Int) -> Parse (Maybe (Type' Ident), Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Type' Ident)
forall a. Maybe a
Nothing, Int
ix0)
(Typed Type' Ident
opTy PValue
fn, Int
ix2) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
ix1
Parse (Typed PValue, Int)
-> Parse (Typed PValue, Int) -> Parse (Typed PValue, Int)
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` KindMd -> Parse (Typed PValue, Int)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"Invalid record"
Type' Ident
fnty <- case Maybe (Type' Ident)
mbFnTy of
Just Type' Ident
ty -> Type' Ident -> Parse (Type' Ident)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Type' Ident
ty
Maybe (Type' Ident)
Nothing -> do
Type' Ident
op <- KindMd -> Type' Ident -> Parse (Type' Ident)
forall (m :: * -> *).
(MonadFail m, MonadPlus m) =>
KindMd -> Type' Ident -> m (Type' Ident)
Assert.elimPtrTo KindMd
"Callee is not a pointer type" Type' Ident
opTy
case Type' Ident
op of
FunTy{} -> Type' Ident -> Parse (Type' Ident)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Type' Ident
op
Type' Ident
_ -> KindMd -> Parse (Type' Ident)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"Callee is not of pointer to function type"
KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label (PValue -> KindMd
forall a. Show a => a -> KindMd
show PValue
fn) (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Type' Ident
ret,[Type' Ident]
as,Bool
va) <- Type' Ident -> Parse (Type' Ident, [Type' Ident], Bool)
forall (m :: * -> *).
MonadPlus m =>
Type' Ident -> m (Type' Ident, [Type' Ident], Bool)
elimFunTy Type' Ident
fnty Parse (Type' Ident, [Type' Ident], Bool)
-> Parse (Type' Ident, [Type' Ident], Bool)
-> Parse (Type' Ident, [Type' Ident], Bool)
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` KindMd -> Parse (Type' Ident, [Type' Ident], Bool)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"invalid CALL record"
[Typed PValue]
args <- ValueTable
-> Bool -> Record -> Int -> [Type' Ident] -> Parse [Typed PValue]
parseCallArgs ValueTable
t Bool
va Record
r Int
ix2 [Type' Ident]
as
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ret (Bool -> Type' Ident -> PValue -> [Typed PValue] -> Instr' Int
forall lab.
Bool
-> Type' Ident -> Value' lab -> [Typed (Value' lab)] -> Instr' lab
Call Bool
False Type' Ident
fnty PValue
fn [Typed PValue]
args) PartialDefine
d
Int
35 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_DEBUG_LOC" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Record -> Int -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> Int -> m ()
Assert.recordSizeGreater Record
r Int
3
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Word32
line <- LookupField Word32
forall {a}. LookupField a
field Int
0 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
col <- LookupField Word32
forall {a}. LookupField a
field Int
1 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Int
scopeId <- LookupField Int
forall {a}. LookupField a
field Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
iaId <- LookupField Int
forall {a}. LookupField a
field Int
3 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Typed PValMd
scope <- if Int
scopeId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Int -> Parse (Typed PValMd)
getMetadata (Int
scopeId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else KindMd -> Parse (Typed PValMd)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"No scope provided"
Maybe (Typed PValMd)
ia <- if Int
iaId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Typed PValMd -> Maybe (Typed PValMd)
forall a. a -> Maybe a
Just (Typed PValMd -> Maybe (Typed PValMd))
-> Parse (Typed PValMd) -> Parse (Maybe (Typed PValMd))
forall a b. (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> Parse (Typed PValMd)
getMetadata (Int
iaId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else Maybe (Typed PValMd) -> Parse (Maybe (Typed PValMd))
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Typed PValMd)
forall a. Maybe a
Nothing
let loc :: PDebugLoc
loc = DebugLoc
{ dlLine :: Word32
dlLine = Word32
line
, dlCol :: Word32
dlCol = Word32
col
, dlScope :: PValMd
dlScope = Typed PValMd -> PValMd
forall a. Typed a -> a
typedValue Typed PValMd
scope
, dlIA :: Maybe PValMd
dlIA = Typed PValMd -> PValMd
forall a. Typed a -> a
typedValue (Typed PValMd -> PValMd) -> Maybe (Typed PValMd) -> Maybe PValMd
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (Typed PValMd)
ia
, dlImplicit :: Bool
dlImplicit = Bool
False
}
PDebugLoc -> Parse ()
setLastLoc PDebugLoc
loc
(Stmt' Int -> Stmt' Int) -> PartialDefine -> Parse PartialDefine
updateLastStmt ((KindMd, PValMd) -> Stmt' Int -> Stmt' Int
forall lab. (KindMd, ValMd' lab) -> Stmt' lab -> Stmt' lab
extendMetadata (KindMd
"dbg", PDebugLoc -> PValMd
forall lab. DebugLoc' lab -> ValMd' lab
ValMdLoc PDebugLoc
loc)) PartialDefine
d
Int
36 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_FENCE" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Record -> [Int] -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> [Int] -> m ()
Assert.recordSizeIn Record
r [Int
2]
Maybe AtomicOrdering
mordval <- Word32 -> Parse (Maybe AtomicOrdering)
getDecodedOrdering (Word32 -> Parse (Maybe AtomicOrdering))
-> Parse Word32 -> Parse (Maybe AtomicOrdering)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Word32
unsigned
case Maybe AtomicOrdering
mordval of
Just AtomicOrdering
ordval -> Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Maybe KindMd -> AtomicOrdering -> Instr' Int
forall lab. Maybe KindMd -> AtomicOrdering -> Instr' lab
Fence Maybe KindMd
forall a. Maybe a
Nothing AtomicOrdering
ordval) PartialDefine
d
Maybe AtomicOrdering
Nothing -> KindMd -> Parse PartialDefine
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"`fence` instruction requires ordering"
Int
37 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_CMPXCHG_OLD" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Parse PartialDefine
forall a. Parse a
notImplemented
Int
38 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_ATOMICRMW_OLD" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$
Bool
-> ValueTable -> Record -> PartialDefine -> Parse PartialDefine
parseAtomicRMW Bool
True ValueTable
t Record
r PartialDefine
d
Int
39 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_RESUME" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Typed PValue
tv,Int
_) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Typed PValue -> Instr' Int
forall lab. Typed (Value' lab) -> Instr' lab
Resume Typed PValue
tv) PartialDefine
d
Int
40 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_LANDINGPAD_OLD" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Record -> Int -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> Int -> m ()
Assert.recordSizeGreater Record
r Int
3
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Typed PValue
persFn,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
1
Int
val <- LookupField Int
forall {a}. LookupField a
field Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let isCleanup :: Bool
isCleanup = Int
val Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
0 :: Int)
Int
len <- LookupField Int
forall {a}. LookupField a
field (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[PClause]
clauses <- ValueTable -> Record -> Int -> Int -> Parse [PClause]
parseClauses ValueTable
t Record
r Int
len (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ty (Type' Ident
-> Maybe (Typed PValue) -> Bool -> [PClause] -> Instr' Int
forall lab.
Type' Ident
-> Maybe (Typed (Value' lab))
-> Bool
-> [Clause' lab]
-> Instr' lab
LandingPad Type' Ident
ty (Typed PValue -> Maybe (Typed PValue)
forall a. a -> Maybe a
Just Typed PValue
persFn) Bool
isCleanup [PClause]
clauses) PartialDefine
d
Int
41 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_LOADATOMIC" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Typed PValue
tv,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Record -> [Int] -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> [Int] -> m ()
Assert.recordSizeIn Record
r [Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4, Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5]
(Type' Ident
ret,Int
ix') <-
if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5
then do Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Type' Ident, Int) -> Parse (Type' Ident, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type' Ident
ty, Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
else do Type' Ident
ty <- KindMd -> Type' Ident -> Parse (Type' Ident)
forall (m :: * -> *).
(MonadFail m, MonadPlus m) =>
KindMd -> Type' Ident -> m (Type' Ident)
Assert.elimPtrTo KindMd
"" (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tv)
(Type' Ident, Int) -> Parse (Type' Ident, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type' Ident
ty, Int
ix)
Maybe AtomicOrdering
ordval <- Word32 -> Parse (Maybe AtomicOrdering)
getDecodedOrdering (Word32 -> Parse (Maybe AtomicOrdering))
-> Parse Word32 -> Parse (Maybe AtomicOrdering)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r (Int
ix' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Match Field Word32
unsigned
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AtomicOrdering
ordval Maybe AtomicOrdering -> [Maybe AtomicOrdering] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Maybe AtomicOrdering
forall a. Maybe a
NothingMaybe AtomicOrdering
-> [Maybe AtomicOrdering] -> [Maybe AtomicOrdering]
forall a. a -> [a] -> [a]
:(AtomicOrdering -> Maybe AtomicOrdering)
-> [AtomicOrdering] -> [Maybe AtomicOrdering]
forall a b. (a -> b) -> [a] -> [b]
map AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just [AtomicOrdering
Release, AtomicOrdering
AcqRel]) (Parse () -> Parse ()) -> Parse () -> Parse ()
forall a b. (a -> b) -> a -> b
$
KindMd -> Parse ()
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd -> Parse ()) -> KindMd -> Parse ()
forall a b. (a -> b) -> a -> b
$ KindMd
"Invalid atomic ordering: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe AtomicOrdering -> KindMd
forall a. Show a => a -> KindMd
show Maybe AtomicOrdering
ordval
Int
aval <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
ix' Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let align :: Maybe Int
align | Int
aval Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Bits a => Int -> a
bit Int
aval Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
| Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AtomicOrdering
ordval Maybe AtomicOrdering -> Maybe AtomicOrdering -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe AtomicOrdering
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Maybe Int
align Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
forall a. Maybe a
Nothing)
(KindMd -> Parse ()
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"Invalid record")
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ret (Type' Ident
-> Typed PValue -> Maybe AtomicOrdering -> Maybe Int -> Instr' Int
forall lab.
Type' Ident
-> Typed (Value' lab)
-> Maybe AtomicOrdering
-> Maybe Int
-> Instr' lab
Load Type' Ident
ret Typed PValue
tv Maybe AtomicOrdering
ordval Maybe Int
align) PartialDefine
d
Int
42 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_STOREATOMIC_OLD" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Parse PartialDefine
forall a. Parse a
notImplemented
Int
43 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_GEP" (ValueTable
-> Maybe Bool -> Record -> PartialDefine -> Parse PartialDefine
parseGEP ValueTable
t Maybe Bool
forall a. Maybe a
Nothing Record
r PartialDefine
d)
Int
44 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_STORE" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Typed PValue
ptr,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
(Typed PValue
val,Int
ix') <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
ix
Record -> [Int] -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> [Int] -> m ()
Assert.recordSizeIn Record
r [Int
ix' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2]
Int
aval <- LookupField Int
forall {a}. LookupField a
field Int
ix' Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let align :: Maybe Int
align | Int
aval Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Bits a => Int -> a
bit Int
aval Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
| Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Typed PValue
-> Typed PValue -> Maybe AtomicOrdering -> Maybe Int -> Instr' Int
forall lab.
Typed (Value' lab)
-> Typed (Value' lab)
-> Maybe AtomicOrdering
-> Maybe Int
-> Instr' lab
Store Typed PValue
val Typed PValue
ptr Maybe AtomicOrdering
forall a. Maybe a
Nothing Maybe Int
align) PartialDefine
d
Int
45 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_STOREATOMIC" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Typed PValue
ptr, Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
(Typed PValue
val, Int
ix') <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
ix
Record -> [Int] -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> [Int] -> m ()
Assert.recordSizeIn Record
r [Int
ix' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4]
Maybe AtomicOrdering
ordering <- Word32 -> Parse (Maybe AtomicOrdering)
getDecodedOrdering (Word32 -> Parse (Maybe AtomicOrdering))
-> Parse Word32 -> Parse (Maybe AtomicOrdering)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r (Int
ix' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Match Field Word32
unsigned
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AtomicOrdering
ordering Maybe AtomicOrdering -> [Maybe AtomicOrdering] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Maybe AtomicOrdering
forall a. Maybe a
NothingMaybe AtomicOrdering
-> [Maybe AtomicOrdering] -> [Maybe AtomicOrdering]
forall a. a -> [a] -> [a]
:(AtomicOrdering -> Maybe AtomicOrdering)
-> [AtomicOrdering] -> [Maybe AtomicOrdering]
forall a b. (a -> b) -> [a] -> [b]
map AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just [AtomicOrdering
Acquire, AtomicOrdering
AcqRel]) (Parse () -> Parse ()) -> Parse () -> Parse ()
forall a b. (a -> b) -> a -> b
$
KindMd -> Parse ()
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd -> Parse ()) -> KindMd -> Parse ()
forall a b. (a -> b) -> a -> b
$ KindMd
"Invalid atomic ordering: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe AtomicOrdering -> KindMd
forall a. Show a => a -> KindMd
show Maybe AtomicOrdering
ordering
Int
aval <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
ix' Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let align :: Maybe Int
align | Int
aval Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Bits a => Int -> a
bit Int
aval Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
| Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
Instr' Int -> PartialDefine -> Parse PartialDefine
effect (Typed PValue
-> Typed PValue -> Maybe AtomicOrdering -> Maybe Int -> Instr' Int
forall lab.
Typed (Value' lab)
-> Typed (Value' lab)
-> Maybe AtomicOrdering
-> Maybe Int
-> Instr' lab
Store Typed PValue
val Typed PValue
ptr Maybe AtomicOrdering
ordering Maybe Int
align) PartialDefine
d
Int
46 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_CMPXCHG" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Typed PValue
ptr, Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
(Typed PValue
val, Int
ix') <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
ix
Typed PValue
new <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
val) (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
ix' Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let ix'' :: Int
ix'' = Int
ix' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
val Type' Ident -> Type' Ident -> Bool
forall ident. Eq ident => Type' ident -> Type' ident -> Bool
`eqTypeModuloOpaquePtrs` Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
new)
(Parse () -> Parse ()) -> Parse () -> Parse ()
forall a b. (a -> b) -> a -> b
$ KindMd -> Parse ()
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd -> Parse ()) -> KindMd -> Parse ()
forall a b. (a -> b) -> a -> b
$ [KindMd] -> KindMd
unlines ([KindMd] -> KindMd) -> [KindMd] -> KindMd
forall a b. (a -> b) -> a -> b
$
[ KindMd
"Mismatched value types:"
, KindMd
"cmp value: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ PValue -> KindMd
forall a. Show a => a -> KindMd
show (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
val)
, KindMd
"new value: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ PValue -> KindMd
forall a. Show a => a -> KindMd
show (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
new)
, KindMd
"cmp type: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Type' Ident -> KindMd
forall a. Show a => a -> KindMd
show (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
val)
, KindMd
"new type: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Type' Ident -> KindMd
forall a. Show a => a -> KindMd
show (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
new)
]
Bool
volatile <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
ix'' Match Field Bool
boolean
Maybe AtomicOrdering
successOrdering_ <- Word32 -> Parse (Maybe AtomicOrdering)
getDecodedOrdering (Word32 -> Parse (Maybe AtomicOrdering))
-> Parse Word32 -> Parse (Maybe AtomicOrdering)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r (Int
ix'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Match Field Word32
unsigned
let successOrderMsg :: a -> KindMd
successOrderMsg a
ord = KindMd
"Invalid success ordering: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> KindMd
forall a. Show a => a -> KindMd
show a
ord
AtomicOrdering
successOrdering <-
case Maybe AtomicOrdering
successOrdering_ of
Maybe AtomicOrdering
Nothing -> KindMd -> Parse AtomicOrdering
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (Maybe AtomicOrdering -> KindMd
forall a. Show a => a -> KindMd
successOrderMsg Maybe AtomicOrdering
successOrdering_)
Just AtomicOrdering
Unordered -> KindMd -> Parse AtomicOrdering
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (Maybe AtomicOrdering -> KindMd
forall a. Show a => a -> KindMd
successOrderMsg Maybe AtomicOrdering
successOrdering_)
Just AtomicOrdering
ordering -> AtomicOrdering -> Parse AtomicOrdering
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicOrdering
ordering
let len :: Int
len = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
Maybe AtomicOrdering
failureOrdering_ <-
if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7
then case AtomicOrdering
successOrdering of
AtomicOrdering
Release -> Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just AtomicOrdering
Monotonic)
AtomicOrdering
Monotonic -> Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just AtomicOrdering
Monotonic)
AtomicOrdering
Acquire -> Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just AtomicOrdering
Acquire)
AtomicOrdering
SeqCst -> Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just AtomicOrdering
SeqCst)
AtomicOrdering
_ -> KindMd -> Parse (Maybe AtomicOrdering)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (AtomicOrdering -> KindMd
forall a. Show a => a -> KindMd
successOrderMsg AtomicOrdering
successOrdering)
else Word32 -> Parse (Maybe AtomicOrdering)
getDecodedOrdering (Word32 -> Parse (Maybe AtomicOrdering))
-> Parse Word32 -> Parse (Maybe AtomicOrdering)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r (Int
ix'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Match Field Word32
unsigned
AtomicOrdering
failureOrdering <-
case Maybe AtomicOrdering
failureOrdering_ of
Maybe AtomicOrdering
Nothing -> KindMd -> Parse AtomicOrdering
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"Invalid failure ordering (Nothing)"
Just AtomicOrdering
ord -> AtomicOrdering -> Parse AtomicOrdering
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicOrdering
ord
Bool
weak <-
if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8
then KindMd -> Parse Bool
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"Not yet implemented: old-style cmpxchg instruction (weak)"
else Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r (Int
ix'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Match Field Bool
boolean
let ty :: Type' Ident
ty = [Type' Ident] -> Type' Ident
forall ident. [Type' ident] -> Type' ident
Struct [Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
val, PrimType -> Type' Ident
forall ident. PrimType -> Type' ident
PrimType (Word32 -> PrimType
Integer Word32
1)]
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ty (Bool
-> Bool
-> Typed PValue
-> Typed PValue
-> Typed PValue
-> Maybe KindMd
-> AtomicOrdering
-> AtomicOrdering
-> Instr' Int
forall lab.
Bool
-> Bool
-> Typed (Value' lab)
-> Typed (Value' lab)
-> Typed (Value' lab)
-> Maybe KindMd
-> AtomicOrdering
-> AtomicOrdering
-> Instr' lab
CmpXchg Bool
weak Bool
volatile Typed PValue
ptr Typed PValue
val Typed PValue
new Maybe KindMd
forall a. Maybe a
Nothing AtomicOrdering
successOrdering AtomicOrdering
failureOrdering) PartialDefine
d
Int
47 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_LANDINGPAD" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Record -> Int -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> Int -> m ()
Assert.recordSizeGreater Record
r Int
2
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Bool
isCleanup <- (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=(Int
0::Int)) (Int -> Bool) -> Parse Int -> Parse Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LookupField Int
forall {a}. LookupField a
field Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
len <- LookupField Int
forall {a}. LookupField a
field Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[PClause]
clauses <- ValueTable -> Record -> Int -> Int -> Parse [PClause]
parseClauses ValueTable
t Record
r Int
len Int
3
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ty (Type' Ident
-> Maybe (Typed PValue) -> Bool -> [PClause] -> Instr' Int
forall lab.
Type' Ident
-> Maybe (Typed (Value' lab))
-> Bool
-> [Clause' lab]
-> Instr' lab
LandingPad Type' Ident
ty Maybe (Typed PValue)
forall a. Maybe a
Nothing Bool
isCleanup [PClause]
clauses) PartialDefine
d
Int
48 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_CLEANUPRET" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Parse PartialDefine
forall a. Parse a
notImplemented
Int
49 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_CATCHRET" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Parse PartialDefine
forall a. Parse a
notImplemented
Int
50 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_CATCHPAD" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Parse PartialDefine
forall a. Parse a
notImplemented
Int
51 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_CLEANUPPAD" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Parse PartialDefine
forall a. Parse a
notImplemented
Int
52 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_CATCHSWITCH" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Parse PartialDefine
forall a. Parse a
notImplemented
Int
55 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_OPERAND_BUNDLE" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
Parse PartialDefine
forall a. Parse a
notImplemented
Int
56 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_UNOP" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Typed PValue
v,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Typed PValue -> Instr' Int
mkInstr <- LookupField (Typed PValue -> Instr' Int)
forall {a}. LookupField a
field Int
ix Match Field (Typed PValue -> Instr' Int)
unop
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
v) (Typed PValue -> Instr' Int
mkInstr Typed PValue
v) PartialDefine
d
Int
57 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_CALLBR" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Word32
ccinfo <- LookupField Word32
forall {a}. LookupField a
field Int
1 Match Field Word32
unsigned
Int
normal <- LookupField Int
forall {a}. LookupField a
field Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
numIndirect <- LookupField Int
forall {a}. LookupField a
field Int
3 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[Int]
indirectDests <- (Int -> Parse Int) -> [Int] -> Parse [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Int
idx -> LookupField Int
forall {a}. LookupField a
field (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
idx) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric) [Int
0..Int
numIndirect Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
let ix0 :: Int
ix0 = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numIndirect
(Maybe (Type' Ident)
mbFnTy, Int
ix1) <- if Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Word32
ccinfo :: Word32) Int
callExplicitTypeBit
then do Type' Ident
fnTy <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Maybe (Type' Ident), Int) -> Parse (Maybe (Type' Ident), Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type' Ident -> Maybe (Type' Ident)
forall a. a -> Maybe a
Just Type' Ident
fnTy, Int
ix0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
else (Maybe (Type' Ident), Int) -> Parse (Maybe (Type' Ident), Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Type' Ident)
forall a. Maybe a
Nothing, Int
ix0)
(Typed Type' Ident
opTy PValue
fn, Int
ix2) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
ix1
Parse (Typed PValue, Int)
-> Parse (Typed PValue, Int) -> Parse (Typed PValue, Int)
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` KindMd -> Parse (Typed PValue, Int)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"Invalid callbr record"
Type' Ident
fnty <- case Maybe (Type' Ident)
mbFnTy of
Just Type' Ident
ty -> Type' Ident -> Parse (Type' Ident)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Type' Ident
ty
Maybe (Type' Ident)
Nothing -> do
Type' Ident
op <- KindMd -> Type' Ident -> Parse (Type' Ident)
forall (m :: * -> *).
(MonadFail m, MonadPlus m) =>
KindMd -> Type' Ident -> m (Type' Ident)
Assert.elimPtrTo KindMd
"callbr callee is not a pointer type" Type' Ident
opTy
case Type' Ident
op of
FunTy{} -> Type' Ident -> Parse (Type' Ident)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Type' Ident
op
Type' Ident
_ -> KindMd -> Parse (Type' Ident)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"Callee is not of pointer to function type"
KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label (PValue -> KindMd
forall a. Show a => a -> KindMd
show PValue
fn) (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Type' Ident
ret,[Type' Ident]
as,Bool
va) <- Type' Ident -> Parse (Type' Ident, [Type' Ident], Bool)
forall (m :: * -> *).
MonadPlus m =>
Type' Ident -> m (Type' Ident, [Type' Ident], Bool)
elimFunTy Type' Ident
fnty Parse (Type' Ident, [Type' Ident], Bool)
-> Parse (Type' Ident, [Type' Ident], Bool)
-> Parse (Type' Ident, [Type' Ident], Bool)
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` KindMd -> Parse (Type' Ident, [Type' Ident], Bool)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"invalid CALLBR record"
[Typed PValue]
args <- ValueTable
-> Bool -> Record -> Int -> [Type' Ident] -> Parse [Typed PValue]
parseCallArgs ValueTable
t Bool
va Record
r Int
ix2 [Type' Ident]
as
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
ret (Type' Ident
-> PValue -> [Typed PValue] -> Int -> [Int] -> Instr' Int
forall lab.
Type' Ident
-> Value' lab -> [Typed (Value' lab)] -> lab -> [lab] -> Instr' lab
CallBr Type' Ident
fnty PValue
fn [Typed PValue]
args Int
normal [Int]
indirectDests) PartialDefine
d
Int
58 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_FREEZE" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
(Typed PValue
v,Int
_) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
v) (Typed PValue -> Instr' Int
forall lab. Typed (Value' lab) -> Instr' lab
Freeze Typed PValue
v) PartialDefine
d
Int
59 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_ATOMICRMW" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$
Bool
-> ValueTable -> Record -> PartialDefine -> Parse PartialDefine
parseAtomicRMW Bool
False ValueTable
t Record
r PartialDefine
d
Int
code
| Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9
Bool -> Bool -> Bool
|| Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
28 -> KindMd -> Parse PartialDefine -> Parse PartialDefine
forall a. KindMd -> Parse a -> Parse a
label KindMd
"FUNC_CODE_INST_CMP2" (Parse PartialDefine -> Parse PartialDefine)
-> Parse PartialDefine -> Parse PartialDefine
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Typed PValue
lhs,Int
ix) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Parse (Typed PValue, Int)
-> Parse (Typed PValue, Int) -> Parse (Typed PValue, Int)
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (do Int
i <- Int -> Parse Int
adjustId (Int -> Parse Int) -> Parse Int -> Parse Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[KindMd]
cxt <- Parse [KindMd]
getContext
(Typed PValue, Int) -> Parse (Typed PValue, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => [KindMd] -> Int -> ValueTable -> Typed PValue
[KindMd] -> Int -> ValueTable -> Typed PValue
forwardRef [KindMd]
cxt Int
i ValueTable
t, Int
1))
Typed PValue
rhs <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
lhs) (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let ty :: Type' Ident
ty = Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
lhs
parseOp :: Field -> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab)
parseOp | (PrimType -> Bool) -> Type' Ident -> Bool
isPrimTypeOf PrimType -> Bool
isFloatingPoint Type' Ident
ty Bool -> Bool -> Bool
||
(Type' Ident -> Bool) -> Type' Ident -> Bool
isVectorOf ((PrimType -> Bool) -> Type' Ident -> Bool
isPrimTypeOf PrimType -> Bool
isFloatingPoint) Type' Ident
ty =
(Typed (Value' lab) -> Value' lab -> Instr' lab)
-> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Typed (Value' lab) -> Value' lab -> Instr' lab)
-> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab))
-> (FCmpOp -> Typed (Value' lab) -> Value' lab -> Instr' lab)
-> FCmpOp
-> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FCmpOp -> Typed (Value' lab) -> Value' lab -> Instr' lab
forall lab.
FCmpOp -> Typed (Value' lab) -> Value' lab -> Instr' lab
FCmp (FCmpOp -> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab))
-> (Field -> Maybe FCmpOp)
-> Field
-> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Field -> Maybe FCmpOp
fcmpOp
| Bool
otherwise =
(Typed (Value' lab) -> Value' lab -> Instr' lab)
-> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Typed (Value' lab) -> Value' lab -> Instr' lab)
-> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab))
-> (ICmpOp -> Typed (Value' lab) -> Value' lab -> Instr' lab)
-> ICmpOp
-> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ICmpOp -> Typed (Value' lab) -> Value' lab -> Instr' lab
forall lab.
ICmpOp -> Typed (Value' lab) -> Value' lab -> Instr' lab
ICmp (ICmpOp -> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab))
-> (Field -> Maybe ICmpOp)
-> Field
-> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Field -> Maybe ICmpOp
icmpOp
Typed PValue -> PValue -> Instr' Int
op <- LookupField (Typed PValue -> PValue -> Instr' Int)
forall {a}. LookupField a
field (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Field -> Maybe (Typed PValue -> PValue -> Instr' Int)
forall {lab}.
Field -> Maybe (Typed (Value' lab) -> Value' lab -> Instr' lab)
parseOp
let boolTy :: PrimType
boolTy = Word32 -> PrimType
Integer Word32
1
let rty :: Type' ident
rty = case Type' Ident
ty of
Vector Word64
n Type' Ident
_ -> Word64 -> Type' ident -> Type' ident
forall ident. Word64 -> Type' ident -> Type' ident
Vector Word64
n (PrimType -> Type' ident
forall ident. PrimType -> Type' ident
PrimType PrimType
boolTy)
Type' Ident
_ -> PrimType -> Type' ident
forall ident. PrimType -> Type' ident
PrimType PrimType
boolTy
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
forall {ident}. Type' ident
rty (Typed PValue -> PValue -> Instr' Int
op Typed PValue
lhs (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
rhs)) PartialDefine
d
| Bool
otherwise -> KindMd -> Parse PartialDefine
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd
"instruction code " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> KindMd
forall a. Show a => a -> KindMd
show Int
code KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ KindMd
" is unknown")
parseFunctionBlockEntry Int
_ ValueTable
_ PartialDefine
d (Match Entry [Entry]
valueSymtabBlockId -> Just [Entry]
_) = do
PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d
parseFunctionBlockEntry Int
globals ValueTable
t PartialDefine
d (Match Entry [Entry]
metadataBlockId -> Just [Entry]
es) = do
(Seq NamedMd
_, (Seq PartialUnnamedMd
globalUnnamedMds, Seq PartialUnnamedMd
localUnnamedMds), InstrMdAttachments
_, Map Int PValMd
_, PGlobalAttachments
_) <- Int
-> ValueTable
-> [Entry]
-> Parse
(Seq NamedMd, (Seq PartialUnnamedMd, Seq PartialUnnamedMd),
InstrMdAttachments, Map Int PValMd, PGlobalAttachments)
parseMetadataBlock Int
globals ValueTable
t [Entry]
es
if (Seq PartialUnnamedMd -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq PartialUnnamedMd
localUnnamedMds)
then PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d { partialGlobalMd = globalUnnamedMds <> partialGlobalMd d }
else PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d
parseFunctionBlockEntry Int
globals ValueTable
t PartialDefine
d (Match Entry [Entry]
metadataAttachmentBlockId -> Just [Entry]
es) = do
(Seq NamedMd
_,(Seq PartialUnnamedMd
globalUnnamedMds, Seq PartialUnnamedMd
localUnnamedMds),InstrMdAttachments
instrAtt,Map Int PValMd
fnAtt,PGlobalAttachments
_)
<- Int
-> ValueTable
-> [Entry]
-> Parse
(Seq NamedMd, (Seq PartialUnnamedMd, Seq PartialUnnamedMd),
InstrMdAttachments, Map Int PValMd, PGlobalAttachments)
parseMetadataBlock Int
globals ValueTable
t [Entry]
es
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Seq PartialUnnamedMd -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq PartialUnnamedMd
localUnnamedMds)
(KindMd -> Parse ()
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"parseFunctionBlockEntry PANIC: unexpected local unnamed metadata")
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Seq PartialUnnamedMd -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq PartialUnnamedMd
globalUnnamedMds)
(KindMd -> Parse ()
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"parseFunctionBlockEntry PANIC: unexpected global unnamed metadata")
PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d { partialBody = addInstrAttachments instrAtt (partialBody d)
, partialMetadata = Map.union fnAtt (partialMetadata d)
}
parseFunctionBlockEntry Int
_ ValueTable
_ PartialDefine
d (Match Entry DefineAbbrev
abbrevDef -> Just DefineAbbrev
_) =
PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d
parseFunctionBlockEntry Int
_ ValueTable
_ PartialDefine
d (Match Entry [Entry]
uselistBlockId -> Just [Entry]
_) = do
PartialDefine -> Parse PartialDefine
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialDefine
d
parseFunctionBlockEntry Int
_ ValueTable
_ PartialDefine
_ Entry
e = do
KindMd -> Parse PartialDefine
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd
"function block: unexpected: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Entry -> KindMd
forall a. Show a => a -> KindMd
show Entry
e)
addInstrAttachments :: InstrMdAttachments -> BlockList -> BlockList
addInstrAttachments :: InstrMdAttachments -> BlockList -> BlockList
addInstrAttachments InstrMdAttachments
atts BlockList
blocks = Int
-> [(Int, [(KindMd, PValMd)])] -> ViewL PartialBlock -> BlockList
go Int
0 (InstrMdAttachments -> [(Int, [(KindMd, PValMd)])]
forall k a. Map k a -> [(k, a)]
Map.toList InstrMdAttachments
atts) (BlockList -> ViewL PartialBlock
forall a. Seq a -> ViewL a
Seq.viewl BlockList
blocks)
where
go :: Int
-> [(Int, [(KindMd, PValMd)])] -> ViewL PartialBlock -> BlockList
go Int
_ [] (PartialBlock
b Seq.:< BlockList
bs) = PartialBlock
b PartialBlock -> BlockList -> BlockList
forall a. a -> Seq a -> Seq a
Seq.<| BlockList
bs
go Int
off [(Int, [(KindMd, PValMd)])]
mds (PartialBlock
b Seq.:< BlockList
bs) =
PartialBlock
b' PartialBlock -> BlockList -> BlockList
forall a. a -> Seq a -> Seq a
Seq.<| Int
-> [(Int, [(KindMd, PValMd)])] -> ViewL PartialBlock -> BlockList
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numStmts) [(Int, [(KindMd, PValMd)])]
delay (BlockList -> ViewL PartialBlock
forall a. Seq a -> ViewL a
Seq.viewl BlockList
bs)
where
numStmts :: Int
numStmts = StmtList -> Int
forall a. Seq a -> Int
Seq.length (PartialBlock -> StmtList
partialStmts PartialBlock
b)
([(Int, [(KindMd, PValMd)])]
use,[(Int, [(KindMd, PValMd)])]
delay) = ((Int, [(KindMd, PValMd)]) -> Bool)
-> [(Int, [(KindMd, PValMd)])]
-> ([(Int, [(KindMd, PValMd)])], [(Int, [(KindMd, PValMd)])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int, [(KindMd, PValMd)]) -> Bool
forall {b}. (Int, b) -> Bool
applies [(Int, [(KindMd, PValMd)])]
mds
applies :: (Int, b) -> Bool
applies (Int
i,b
_) = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
numStmts
b' :: PartialBlock
b' | [(Int, [(KindMd, PValMd)])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, [(KindMd, PValMd)])]
use = PartialBlock
b
| Bool
otherwise = PartialBlock
b { partialStmts = foldl addMd (partialStmts b) use }
addMd :: Seq (Stmt' lab) -> (Int, [(KindMd, ValMd' lab)]) -> Seq (Stmt' lab)
addMd Seq (Stmt' lab)
stmts (Int
i,[(KindMd, ValMd' lab)]
md') = (Stmt' lab -> Stmt' lab)
-> Int -> Seq (Stmt' lab) -> Seq (Stmt' lab)
forall a. (a -> a) -> Int -> Seq a -> Seq a
Seq.adjust Stmt' lab -> Stmt' lab
update (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
off) Seq (Stmt' lab)
stmts
where
update :: Stmt' lab -> Stmt' lab
update (Result Ident
n Instr' lab
s [(KindMd, ValMd' lab)]
md) = Ident -> Instr' lab -> [(KindMd, ValMd' lab)] -> Stmt' lab
forall lab.
Ident -> Instr' lab -> [(KindMd, ValMd' lab)] -> Stmt' lab
Result Ident
n Instr' lab
s ([(KindMd, ValMd' lab)]
md [(KindMd, ValMd' lab)]
-> [(KindMd, ValMd' lab)] -> [(KindMd, ValMd' lab)]
forall a. [a] -> [a] -> [a]
++ [(KindMd, ValMd' lab)]
md')
update (Effect Instr' lab
s [(KindMd, ValMd' lab)]
md) = Instr' lab -> [(KindMd, ValMd' lab)] -> Stmt' lab
forall lab. Instr' lab -> [(KindMd, ValMd' lab)] -> Stmt' lab
Effect Instr' lab
s ([(KindMd, ValMd' lab)]
md [(KindMd, ValMd' lab)]
-> [(KindMd, ValMd' lab)] -> [(KindMd, ValMd' lab)]
forall a. [a] -> [a] -> [a]
++ [(KindMd, ValMd' lab)]
md')
go Int
_ [(Int, [(KindMd, PValMd)])]
_ ViewL PartialBlock
Seq.EmptyL = BlockList
forall a. Seq a
Seq.empty
parseGEP :: ValueTable -> Maybe Bool -> Record -> PartialDefine -> Parse PartialDefine
parseGEP :: ValueTable
-> Maybe Bool -> Record -> PartialDefine -> Parse PartialDefine
parseGEP ValueTable
t Maybe Bool
mbInBound Record
r PartialDefine
d = do
(Bool
ib, Type' Ident
ty, Typed PValue
tv, Record
r', Int
ix) <-
case Maybe Bool
mbInBound of
Just Bool
ib -> do
(Typed PValue
tv,Int
ix') <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
Type' Ident
ty <- KindMd -> Type' Ident -> Parse (Type' Ident)
forall (m :: * -> *).
(MonadFail m, MonadPlus m) =>
KindMd -> Type' Ident -> m (Type' Ident)
Assert.elimPtrTo KindMd
"GEP not headed by pointer" (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
tv)
(Bool, Type' Ident, Typed PValue, Record, Int)
-> Parse (Bool, Type' Ident, Typed PValue, Record, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
ib, Type' Ident
ty, Typed PValue
tv, Record
r, Int
ix')
Maybe Bool
Nothing -> do
let r' :: Record
r' = Record -> Record
flattenRecord Record
r
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r'
Bool
ib <- LookupField Bool
forall {a}. LookupField a
field Int
0 Match Field Bool
boolean
Type' Ident
ty <- Int -> Parse (Type' Ident)
getType (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Typed PValue
tv,Int
ix') <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r' Int
2
(Bool, Type' Ident, Typed PValue, Record, Int)
-> Parse (Bool, Type' Ident, Typed PValue, Record, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
ib, Type' Ident
ty, Typed PValue
tv, Record
r', Int
ix')
[Typed PValue]
args <- KindMd -> Parse [Typed PValue] -> Parse [Typed PValue]
forall a. KindMd -> Parse a -> Parse a
label KindMd
"parseGepArgs" (ValueTable -> Record -> Int -> Parse [Typed PValue]
parseGepArgs ValueTable
t Record
r' Int
ix)
Type' Ident
rty <- KindMd -> Parse (Type' Ident) -> Parse (Type' Ident)
forall a. KindMd -> Parse a -> Parse a
label KindMd
"interpGep" (Type' Ident
-> Typed PValue -> [Typed PValue] -> Parse (Type' Ident)
interpGep Type' Ident
ty Typed PValue
tv [Typed PValue]
args)
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result Type' Ident
rty (Bool -> Type' Ident -> Typed PValue -> [Typed PValue] -> Instr' Int
forall lab.
Bool
-> Type' Ident
-> Typed (Value' lab)
-> [Typed (Value' lab)]
-> Instr' lab
GEP Bool
ib Type' Ident
ty Typed PValue
tv [Typed PValue]
args) PartialDefine
d
parseAtomicRMW :: Bool -> ValueTable -> Record -> PartialDefine -> Parse PartialDefine
parseAtomicRMW :: Bool
-> ValueTable -> Record -> PartialDefine -> Parse PartialDefine
parseAtomicRMW Bool
old ValueTable
t Record
r PartialDefine
d = do
(Typed PValue
ptr, Int
ix0) <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
0
(Typed PValue
val, Int
ix1) <-
if Bool
old
then
do Type' Ident
ty <- KindMd -> Type' Ident -> Parse (Type' Ident)
forall (m :: * -> *).
(MonadFail m, MonadPlus m) =>
KindMd -> Type' Ident -> m (Type' Ident)
Assert.elimPtrTo KindMd
"atomicrmw instruction not headed by pointer" (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
ptr)
Typed PValue
typed <- ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t Type' Ident
ty (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
ix0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
if Type' Ident
ty Type' Ident -> Type' Ident -> Bool
forall a. Eq a => a -> a -> Bool
/= (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
typed)
then KindMd -> Parse (Typed PValue, Int)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd -> Parse (Typed PValue, Int))
-> KindMd -> Parse (Typed PValue, Int)
forall a b. (a -> b) -> a -> b
$ [KindMd] -> KindMd
unlines ([KindMd] -> KindMd) -> [KindMd] -> KindMd
forall a b. (a -> b) -> a -> b
$ [ KindMd
"Wrong type of value retrieved from value table"
, KindMd
"Expected: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Type' Ident -> KindMd
forall a. Show a => a -> KindMd
show (Type' Ident
ty)
, KindMd
"Got: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Type' Ident -> KindMd
forall a. Show a => a -> KindMd
show (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
typed)
]
else (Typed PValue, Int) -> Parse (Typed PValue, Int)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Typed PValue
typed, Int
ix0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
else
ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
ix0
let valTy :: Type' Ident
valTy = Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
val
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (case Type' Ident
valTy of
PrimType (Integer Word32
_) -> Bool
True
PrimType (FloatType FloatType
_) -> Bool
True
Type' Ident
_ -> Bool
False) (Parse () -> Parse ()) -> Parse () -> Parse ()
forall a b. (a -> b) -> a -> b
$
KindMd -> Parse ()
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd -> Parse ()) -> KindMd -> Parse ()
forall a b. (a -> b) -> a -> b
$ KindMd
"Expected integer or float operand, found " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Type' Ident -> KindMd
forall a. Show a => a -> KindMd
show Type' Ident
valTy
AtomicRWOp
operation <- Integer -> Parse AtomicRWOp
getDecodedAtomicRWOp (Integer -> Parse AtomicRWOp) -> Parse Integer -> Parse AtomicRWOp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Integer
forall a. Record -> LookupField a
parseField Record
r Int
ix1 Match Field Integer
forall a. (Num a, Bits a) => Match Field a
numeric
Bool
volatile <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r (Int
ix1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Match Field Bool
nonzero
AtomicOrdering
ordering <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r (Int
ix1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Match Field Word32
unsigned Parse Word32
-> (Word32 -> Parse (Maybe AtomicOrdering))
-> Parse (Maybe AtomicOrdering)
forall a b. Parse a -> (a -> Parse b) -> Parse b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Parse (Maybe AtomicOrdering)
getDecodedOrdering Parse (Maybe AtomicOrdering)
-> (Maybe AtomicOrdering -> Parse AtomicOrdering)
-> Parse AtomicOrdering
forall a b. Parse a -> (a -> Parse b) -> Parse b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\case
Just AtomicOrdering
ordering -> AtomicOrdering -> Parse AtomicOrdering
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicOrdering
ordering
Maybe AtomicOrdering
Nothing -> KindMd -> Parse AtomicOrdering
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd -> Parse AtomicOrdering) -> KindMd -> Parse AtomicOrdering
forall a b. (a -> b) -> a -> b
$ KindMd
"`atomicrmw` requires ordering: ix == " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> KindMd
forall a. Show a => a -> KindMd
show Int
ix1
Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result (Typed PValue -> Type' Ident
forall a. Typed a -> Type' Ident
typedType Typed PValue
val) (Bool
-> AtomicRWOp
-> Typed PValue
-> Typed PValue
-> Maybe KindMd
-> AtomicOrdering
-> Instr' Int
forall lab.
Bool
-> AtomicRWOp
-> Typed (Value' lab)
-> Typed (Value' lab)
-> Maybe KindMd
-> AtomicOrdering
-> Instr' lab
AtomicRW Bool
volatile AtomicRWOp
operation Typed PValue
ptr Typed PValue
val Maybe KindMd
forall a. Maybe a
Nothing AtomicOrdering
ordering) PartialDefine
d
effect :: Instr' Int -> PartialDefine -> Parse PartialDefine
effect :: Instr' Int -> PartialDefine -> Parse PartialDefine
effect Instr' Int
i PartialDefine
d = Stmt' Int -> PartialDefine -> Parse PartialDefine
addStmt (Instr' Int -> [(KindMd, PValMd)] -> Stmt' Int
forall lab. Instr' lab -> [(KindMd, ValMd' lab)] -> Stmt' lab
Effect Instr' Int
i []) PartialDefine
d
result :: Type -> Instr' Int -> PartialDefine -> Parse PartialDefine
result :: Type' Ident -> Instr' Int -> PartialDefine -> Parse PartialDefine
result (PrimType PrimType
Void) Instr' Int
i PartialDefine
d = Instr' Int -> PartialDefine -> Parse PartialDefine
effect Instr' Int
i PartialDefine
d
result Type' Ident
ty Instr' Int
i PartialDefine
d = do
Ident
res <- Type' Ident -> Parse Ident
nameNextValue Type' Ident
ty
Stmt' Int -> PartialDefine -> Parse PartialDefine
addStmt (Ident -> Instr' Int -> [(KindMd, PValMd)] -> Stmt' Int
forall lab.
Ident -> Instr' lab -> [(KindMd, ValMd' lab)] -> Stmt' lab
Result Ident
res Instr' Int
i []) PartialDefine
d
parsePhiArgs :: Bool -> ValueTable -> Record -> Parse [(PValue,Int)]
parsePhiArgs :: Bool -> ValueTable -> Record -> Parse [(PValue, Int)]
parsePhiArgs Bool
relIds ValueTable
t Record
r = Int -> Parse [(PValue, Int)]
forall {b}. (Num b, Bits b) => Int -> Parse [(PValue, b)]
loop Int
1
where
field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
len :: Int
len = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
getId :: Int -> Parse Int
getId Int
n
| Bool
relIds = do
Word64
i <- LookupField Word64
forall {a}. LookupField a
field Int
n Match Field Word64
signedWord64
Int
pos <- Parse Int
getNextId
Int -> Parse Int
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)
| Bool
otherwise =
LookupField Int
forall {a}. LookupField a
field Int
n Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
parse :: Int -> Parse (PValue, b)
parse Int
n = do
Int
i <- Int -> Parse Int
getId Int
n
[KindMd]
cxt <- Parse [KindMd]
getContext
let val :: Typed PValue
val = HasCallStack => [KindMd] -> Int -> ValueTable -> Typed PValue
[KindMd] -> Int -> ValueTable -> Typed PValue
forwardRef [KindMd]
cxt Int
i ValueTable
t
b
bid <- LookupField b
forall {a}. LookupField a
field (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Match Field b
forall a. (Num a, Bits a) => Match Field a
numeric
(PValue, b) -> Parse (PValue, b)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
val,b
bid)
loop :: Int -> Parse [(PValue, b)]
loop Int
n
| Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = [(PValue, b)] -> Parse [(PValue, b)]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = (:) ((PValue, b) -> [(PValue, b)] -> [(PValue, b)])
-> Parse (PValue, b) -> Parse ([(PValue, b)] -> [(PValue, b)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parse (PValue, b)
forall {b}. (Num b, Bits b) => Int -> Parse (PValue, b)
parse Int
n Parse ([(PValue, b)] -> [(PValue, b)])
-> Parse [(PValue, b)] -> Parse [(PValue, b)]
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parse [(PValue, b)]
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
parseCallArgs :: ValueTable -> Bool -> Record -> Int -> [Type] -> Parse [Typed PValue]
parseCallArgs :: ValueTable
-> Bool -> Record -> Int -> [Type' Ident] -> Parse [Typed PValue]
parseCallArgs ValueTable
t Bool
b Record
r = ValueTable
-> (Type' Ident -> Int -> Parse (Typed PValue))
-> Bool
-> Record
-> Int
-> [Type' Ident]
-> Parse [Typed PValue]
parseArgs ValueTable
t Type' Ident -> Int -> Parse (Typed PValue)
op Bool
b Record
r
where
op :: Type' Ident -> Int -> Parse (Typed PValue)
op Type' Ident
ty Int
i =
case Type' Ident
ty of
PrimType PrimType
Label -> Typed PValue -> Parse (Typed PValue)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type' Ident -> PValue -> Typed PValue
forall a. Type' Ident -> a -> Typed a
Typed Type' Ident
ty (Int -> PValue
forall lab. lab -> Value' lab
ValLabel Int
i))
Type' Ident
_ -> ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t Type' Ident
ty Int
i
parseInvokeArgs :: ValueTable -> Bool -> Record -> Int -> [Type] -> Parse [Typed PValue]
parseInvokeArgs :: ValueTable
-> Bool -> Record -> Int -> [Type' Ident] -> Parse [Typed PValue]
parseInvokeArgs ValueTable
t = ValueTable
-> (Type' Ident -> Int -> Parse (Typed PValue))
-> Bool
-> Record
-> Int
-> [Type' Ident]
-> Parse [Typed PValue]
parseArgs ValueTable
t (ValueTable -> Type' Ident -> Int -> Parse (Typed PValue)
getValue ValueTable
t)
parseArgs :: ValueTable -> (Type -> Int -> Parse (Typed PValue))
-> Bool -> Record -> Int -> [Type] -> Parse [Typed PValue]
parseArgs :: ValueTable
-> (Type' Ident -> Int -> Parse (Typed PValue))
-> Bool
-> Record
-> Int
-> [Type' Ident]
-> Parse [Typed PValue]
parseArgs ValueTable
t Type' Ident -> Int -> Parse (Typed PValue)
parse Bool
va Record
r = Int -> [Type' Ident] -> Parse [Typed PValue]
loop
where
field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
len :: Int
len = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
loop :: Int -> [Type' Ident] -> Parse [Typed PValue]
loop Int
ix (Type' Ident
ty:[Type' Ident]
tys) = do
Typed PValue
tv <- Type' Ident -> Int -> Parse (Typed PValue)
parse Type' Ident
ty (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[Typed PValue]
rest <- Int -> [Type' Ident] -> Parse [Typed PValue]
loop (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Type' Ident]
tys
[Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Typed PValue
tvTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
rest)
loop Int
ix []
| Bool
va = Int -> Parse [Typed PValue]
varArgs Int
ix
| Bool
otherwise = [Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return []
varArgs :: Int -> Parse [Typed PValue]
varArgs Int
ix
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = do
(Typed PValue
tv,Int
ix') <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
ix
[Typed PValue]
rest <- Int -> Parse [Typed PValue]
varArgs Int
ix'
[Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Typed PValue
tvTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
rest)
| Bool
otherwise = [Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return []
parseGepArgs :: ValueTable -> Record -> Int -> Parse [Typed PValue]
parseGepArgs :: ValueTable -> Record -> Int -> Parse [Typed PValue]
parseGepArgs ValueTable
t Record
r = Int -> Parse [Typed PValue]
loop
where
loop :: Int -> Parse [Typed PValue]
loop Int
n = Parse [Typed PValue]
parse Parse [Typed PValue]
-> Parse [Typed PValue] -> Parse [Typed PValue]
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return []
where
parse :: Parse [Typed PValue]
parse = do
(Typed PValue
tv,Int
ix') <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r Int
n
[Typed PValue]
rest <- Int -> Parse [Typed PValue]
loop Int
ix'
[Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Typed PValue
tvTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
rest)
interpGep :: Type -> Typed PValue -> [Typed PValue] -> Parse Type
interpGep :: Type' Ident
-> Typed PValue -> [Typed PValue] -> Parse (Type' Ident)
interpGep Type' Ident
baseTy Typed PValue
ptr [Typed PValue]
vs = IndexResult -> Parse (Type' Ident)
check (Type' Ident -> Typed PValue -> [Typed PValue] -> IndexResult
forall lab.
Type' Ident
-> Typed (Value' lab) -> [Typed (Value' lab)] -> IndexResult
resolveGep Type' Ident
baseTy Typed PValue
ptr [Typed PValue]
vs)
where
check :: IndexResult -> Parse (Type' Ident)
check IndexResult
res = case IndexResult
res of
HasType Type' Ident
rty -> Type' Ident -> Parse (Type' Ident)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type' Ident -> Type' Ident
forall ident. Type' ident -> Type' ident
PtrTo Type' Ident
rty)
IndexResult
Invalid -> KindMd -> Parse (Type' Ident)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd -> Parse (Type' Ident)) -> KindMd -> Parse (Type' Ident)
forall a b. (a -> b) -> a -> b
$ [KindMd] -> KindMd
unlines ([KindMd] -> KindMd) -> [KindMd] -> KindMd
forall a b. (a -> b) -> a -> b
$
[ KindMd
"Unable to determine the type of getelementptr"
, KindMd
"Base type: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Type' Ident -> KindMd
forall a. Show a => a -> KindMd
show Type' Ident
baseTy
, KindMd
"Pointer value: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Typed PValue -> KindMd
forall a. Show a => a -> KindMd
show Typed PValue
ptr
]
Resolve Ident
i Type' Ident -> IndexResult
k -> do
Type' Ident
ty' <- Int -> Parse (Type' Ident)
getType' (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ident -> Parse Int
getTypeId Ident
i
IndexResult -> Parse (Type' Ident)
check (Type' Ident -> IndexResult
k Type' Ident
ty')
parseIndexes :: (Num a, Bits a) => Record -> Int -> Parse [a]
parseIndexes :: forall a. (Num a, Bits a) => Record -> Int -> Parse [a]
parseIndexes Record
r = Int -> Parse [a]
forall {a}. (Num a, Bits a) => Int -> Parse [a]
loop
where
field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
loop :: Int -> Parse [a]
loop Int
n = do
a
ix <- LookupField a
forall {a}. LookupField a
field Int
n Match Field a
forall a. (Num a, Bits a) => Match Field a
numeric
[a]
rest <- Int -> Parse [a]
loop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Parse [a] -> Parse [a] -> Parse [a]
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [a] -> Parse [a]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return []
[a] -> Parse [a]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
ixa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest)
interpValueIndex :: Type
-> [Int32]
-> Parse Type
interpValueIndex :: Type' Ident -> [Int32] -> Parse (Type' Ident)
interpValueIndex Type' Ident
ty [Int32]
is = IndexResult -> Parse (Type' Ident)
check (Type' Ident -> [Int32] -> IndexResult
resolveValueIndex Type' Ident
ty [Int32]
is)
where
check :: IndexResult -> Parse (Type' Ident)
check IndexResult
res = case IndexResult
res of
IndexResult
Invalid ->
KindMd -> Parse (Type' Ident)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd -> Parse (Type' Ident)) -> KindMd -> Parse (Type' Ident)
forall a b. (a -> b) -> a -> b
$ [KindMd] -> KindMd
unlines ([KindMd] -> KindMd) -> [KindMd] -> KindMd
forall a b. (a -> b) -> a -> b
$
[ KindMd
"Unable to determine the return type of `extractvalue`"
, KindMd
"Hint: The input type should be an aggregate type (struct or array)"
, KindMd
"Input type: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Type' Ident -> KindMd
forall a. Show a => a -> KindMd
show Type' Ident
ty
, KindMd
"Indices: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int32] -> KindMd
forall a. Show a => a -> KindMd
show [Int32]
is
]
HasType Type' Ident
rty -> Type' Ident -> Parse (Type' Ident)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Type' Ident
rty
Resolve Ident
i Type' Ident -> IndexResult
k -> do
Type' Ident
ty' <- Int -> Parse (Type' Ident)
getType' (Int -> Parse (Type' Ident)) -> Parse Int -> Parse (Type' Ident)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ident -> Parse Int
getTypeId Ident
i
IndexResult -> Parse (Type' Ident)
check (Type' Ident -> IndexResult
k Type' Ident
ty')
parseSwitchLabels :: Type -> Record -> Int -> Parse [(Integer,Int)]
parseSwitchLabels :: Type' Ident -> Record -> Int -> Parse [(Integer, Int)]
parseSwitchLabels Type' Ident
ty Record
r = Int -> Parse [(Integer, Int)]
forall {b}. (Num b, Bits b) => Int -> Parse [(Integer, b)]
loop
where
field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
len :: Int
len = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
loop :: Int -> Parse [(Integer, b)]
loop Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = [(Integer, b)] -> Parse [(Integer, b)]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = do
Typed PValue
tv <- Type' Ident -> Int -> Parse (Typed PValue)
getFnValueById Type' Ident
ty (Int -> Parse (Typed PValue)) -> Parse Int -> Parse (Typed PValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
n Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Integer
i <- case Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
tv of
ValInteger Integer
i -> Integer -> Parse Integer
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
i
ValBool Bool
b -> Integer -> Parse Integer
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Integer
forall a. Enum a => Int -> a
toEnum (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
b))
PValue
v -> KindMd -> Parse Integer
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd -> Parse Integer) -> KindMd -> Parse Integer
forall a b. (a -> b) -> a -> b
$ [KindMd] -> KindMd
unwords [ KindMd
"Invalid value in SWITCH record. Found"
, PValue -> KindMd
forall a. Show a => a -> KindMd
show PValue
v
, KindMd
"at position"
, Int -> KindMd
forall a. Show a => a -> KindMd
show Int
n
]
b
l <- LookupField b
forall {a}. LookupField a
field (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Match Field b
forall a. (Num a, Bits a) => Match Field a
numeric
[(Integer, b)]
rest <- Int -> Parse [(Integer, b)]
loop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
[(Integer, b)] -> Parse [(Integer, b)]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer
i,b
l)(Integer, b) -> [(Integer, b)] -> [(Integer, b)]
forall a. a -> [a] -> [a]
:[(Integer, b)]
rest)
parseNewSwitchLabels :: Word32 -> Record -> Int -> Int -> Parse [(Integer,Int)]
parseNewSwitchLabels :: Word32 -> Record -> Int -> Int -> Parse [(Integer, Int)]
parseNewSwitchLabels Word32
width Record
r = Int -> Int -> Parse [(Integer, Int)]
forall {t} {b}.
(Ord t, Num t, Num b, Bits b) =>
t -> Int -> Parse [(Integer, b)]
loop
where
field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
len :: Int
len = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
loop :: t -> Int -> Parse [(Integer, b)]
loop t
numCases Int
n
| t
numCases t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [(Integer, b)] -> Parse [(Integer, b)]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = KindMd -> Parse [(Integer, b)]
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"invalid SWITCH record"
| Bool
otherwise = do
Int
numItems <- LookupField Int
forall {a}. LookupField a
field Int
n Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
([Integer]
ls,Int
n') <- Int -> Int -> Parse ([Integer], Int)
parseItems Int
numItems (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
b
lab <- LookupField b
forall {a}. LookupField a
field Int
n' Match Field b
forall a. (Num a, Bits a) => Match Field a
numeric
[(Integer, b)]
rest <- t -> Int -> Parse [(Integer, b)]
loop (t
numCases t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
[(Integer, b)] -> Parse [(Integer, b)]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ (Integer
l,b
lab) | Integer
l <- [Integer]
ls ] [(Integer, b)] -> [(Integer, b)] -> [(Integer, b)]
forall a. [a] -> [a] -> [a]
++ [(Integer, b)]
rest)
parseItems :: Int -> Int -> Parse ([Integer],Int)
parseItems :: Int -> Int -> Parse ([Integer], Int)
parseItems Int
numItems Int
n
| Int
numItems Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([Integer], Int) -> Parse ([Integer], Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],Int
n)
| Bool
otherwise = do
Bool
isSingleNumber <- LookupField Bool
forall {a}. LookupField a
field Int
n Match Field Bool
boolean
(Int
activeWords,Int
lowStart) <-
if Word32
width Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
64
then do Int
aw <- LookupField Int
forall {a}. LookupField a
field (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Int, Int) -> Parse (Int, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
aw, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
else (Int, Int) -> Parse (Int, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1,Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
[Word64]
chunks <- Record -> Int -> Int -> Match Field Word64 -> Parse [Word64]
forall a. Record -> Int -> Int -> Match Field a -> Parse [a]
parseSlice Record
r Int
lowStart Int
activeWords Match Field Word64
signedWord64
let low :: Integer
low = (Word64 -> Integer -> Integer) -> Integer -> [Word64] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Word64
l Integer
acc -> Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
64 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
l) Integer
0 [Word64]
chunks
(Integer
num,Int
n') <-
if Bool
isSingleNumber
then (Integer, Int) -> Parse (Integer, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
low, Int
lowStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
activeWords)
else KindMd -> Parse (Integer, Int)
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail KindMd
"Unhandled case in switch: Please send in this test case!"
([Integer]
rest,Int
nFinal) <- Int -> Int -> Parse ([Integer], Int)
parseItems (Int
numItems Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
n'
([Integer], Int) -> Parse ([Integer], Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
numInteger -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
rest,Int
nFinal)
type PClause = Clause' Int
parseClauses :: ValueTable -> Record -> Int -> Int -> Parse [PClause]
parseClauses :: ValueTable -> Record -> Int -> Int -> Parse [PClause]
parseClauses ValueTable
t Record
r = Int -> Int -> Parse [PClause]
forall {t}. (Ord t, Num t) => t -> Int -> Parse [PClause]
loop
where
loop :: t -> Int -> Parse [PClause]
loop t
n Int
ix
| t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [PClause] -> Parse [PClause]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = do
Int
cty <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
ix Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Typed PValue
val,Int
ix') <- ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
getValueTypePair ValueTable
t Record
r (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
[PClause]
cs <- t -> Int -> Parse [PClause]
loop (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) Int
ix'
case Int
cty :: Int of
Int
0 -> [PClause] -> Parse [PClause]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Typed PValue -> PClause
forall lab. Typed (Value' lab) -> Clause' lab
Catch Typed PValue
val PClause -> [PClause] -> [PClause]
forall a. a -> [a] -> [a]
: [PClause]
cs)
Int
1 -> [PClause] -> Parse [PClause]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Typed PValue -> PClause
forall lab. Typed (Value' lab) -> Clause' lab
Filter Typed PValue
val PClause -> [PClause] -> [PClause]
forall a. a -> [a] -> [a]
: [PClause]
cs)
Int
_ -> KindMd -> Parse [PClause]
forall a. KindMd -> Parse a
forall (m :: * -> *) a. MonadFail m => KindMd -> m a
fail (KindMd
"Invalid clause type: " KindMd -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> KindMd
forall a. Show a => a -> KindMd
show Int
cty)
getDecodedOrdering :: Word32 -> Parse (Maybe AtomicOrdering)
getDecodedOrdering :: Word32 -> Parse (Maybe AtomicOrdering)
getDecodedOrdering Word32
0 = Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AtomicOrdering
forall a. Maybe a
Nothing
getDecodedOrdering Word32
1 = Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just AtomicOrdering
Unordered)
getDecodedOrdering Word32
2 = Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just AtomicOrdering
Monotonic)
getDecodedOrdering Word32
3 = Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just AtomicOrdering
Acquire)
getDecodedOrdering Word32
4 = Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just AtomicOrdering
Release)
getDecodedOrdering Word32
5 = Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just AtomicOrdering
AcqRel)
getDecodedOrdering Word32
6 = Maybe AtomicOrdering -> Parse (Maybe AtomicOrdering)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (AtomicOrdering -> Maybe AtomicOrdering
forall a. a -> Maybe a
Just AtomicOrdering
SeqCst)
getDecodedOrdering Word32
i = KindMd -> Word32 -> Parse (Maybe AtomicOrdering)
forall (m :: * -> *) a b.
(MonadFail m, Show a) =>
KindMd -> a -> m b
Assert.unknownEntity KindMd
"atomic ordering" Word32
i
getDecodedAtomicRWOp :: Integer -> Parse AtomicRWOp
getDecodedAtomicRWOp :: Integer -> Parse AtomicRWOp
getDecodedAtomicRWOp Integer
0 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicXchg
getDecodedAtomicRWOp Integer
1 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicAdd
getDecodedAtomicRWOp Integer
2 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicSub
getDecodedAtomicRWOp Integer
3 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicAnd
getDecodedAtomicRWOp Integer
4 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicNand
getDecodedAtomicRWOp Integer
5 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicOr
getDecodedAtomicRWOp Integer
6 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicXor
getDecodedAtomicRWOp Integer
7 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicMax
getDecodedAtomicRWOp Integer
8 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicMin
getDecodedAtomicRWOp Integer
9 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicUMax
getDecodedAtomicRWOp Integer
10 = AtomicRWOp -> Parse AtomicRWOp
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomicRWOp
AtomicUMin
getDecodedAtomicRWOp Integer
v = KindMd -> Integer -> Parse AtomicRWOp
forall (m :: * -> *) a b.
(MonadFail m, Show a) =>
KindMd -> a -> m b
Assert.unknownEntity KindMd
"atomic RWOp" Integer
v