{-# LANGUAGE RecordWildCards #-}

-- | Querying the type of LLVM expressions
module LLVM.AST.Typed (
  Typed(..),
  getElementType,
  indexTypeByConstants,
  indexTypeByOperands,
  extractValueType,
) where

import LLVM.Prelude

import Control.Monad.State (gets)
import qualified Data.Map.Lazy as Map
import qualified Data.Either as Either
import GHC.Stack

import LLVM.AST
import LLVM.AST.Global
import LLVM.AST.Type

import LLVM.IRBuilder.Module

import qualified LLVM.AST.Constant as C
import qualified LLVM.AST.Float as F

class Typed a where
  typeOf :: (HasCallStack, MonadModuleBuilder m) => a -> m (Either String Type)

instance Typed Operand where
  typeOf :: forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Operand -> m (Either String Type)
typeOf (LocalReference Type
t Name
_) = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
t
  typeOf (ConstantOperand Constant
c)  = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
c
  typeOf Operand
_                    = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
MetadataType

instance Typed CallableOperand where
  typeOf :: forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
CallableOperand -> m (Either String Type)
typeOf (Right Operand
op) = Operand -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Operand -> m (Either String Type)
typeOf Operand
op
  typeOf (Left InlineAssembly
_) = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left String
"typeOf inline assembler is not defined. (Malformed AST)"

instance Typed C.Constant where
  typeOf :: forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf (C.Int Word32
bits Integer
_)       = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Word32 -> Type
IntegerType Word32
bits
  typeOf (C.Float SomeFloat
t)          = SomeFloat -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
SomeFloat -> m (Either String Type)
typeOf SomeFloat
t
  typeOf (C.Null Type
t)           = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
t
  typeOf (C.AggregateZero Type
t)  = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
t
  typeOf (C.Struct {Bool
[Constant]
Maybe Name
structName :: Maybe Name
isPacked :: Bool
memberValues :: [Constant]
structName :: Constant -> Maybe Name
isPacked :: Constant -> Bool
memberValues :: Constant -> [Constant]
..}) = case Maybe Name
structName of
                             Maybe Name
Nothing -> do
                               [Either String Type]
mvtys <- (Constant -> m (Either String Type))
-> [Constant] -> m [Either String Type]
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 Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf [Constant]
memberValues
                               case ((Either String Type -> Bool) -> [Either String Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Either String Type -> Bool
forall a b. Either a b -> Bool
Either.isRight [Either String Type]
mvtys) of
                                 Bool
True -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Bool -> [Type] -> Type
StructureType Bool
isPacked ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$ [Either String Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either String Type]
mvtys
                                 Bool
False -> do
                                   let (Left String
s) = [Either String Type] -> Either String Type
forall a. HasCallStack => [a] -> a
head ([Either String Type] -> Either String Type)
-> [Either String Type] -> Either String Type
forall a b. (a -> b) -> a -> b
$ (Either String Type -> Bool)
-> [Either String Type] -> [Either String Type]
forall a. (a -> Bool) -> [a] -> [a]
filter Either String Type -> Bool
forall a b. Either a b -> Bool
Either.isLeft [Either String Type]
mvtys
                                   Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Could not deduce type for struct field: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
                             Just Name
sn -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
NamedTypeReference Name
sn
  typeOf (C.Array {[Constant]
Type
memberValues :: Constant -> [Constant]
memberType :: Type
memberValues :: [Constant]
memberType :: Constant -> Type
..})  = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Word64 -> Type -> Type
ArrayType (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [Constant] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Constant]
memberValues) Type
memberType
  typeOf (C.Vector {[Constant]
memberValues :: Constant -> [Constant]
memberValues :: [Constant]
..}) = case [Constant]
memberValues of
                             []    -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left String
"Vectors of size zero are not allowed. (Malformed AST)"
                             (Constant
x:[Constant]
_) -> do
                               Either String Type
t <- Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
x
                               case Either String Type
t of
                                 (Left String
_) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Type
t
                                 (Right Type
t') -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Word32 -> Type -> Type
VectorType (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Constant] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Constant]
memberValues) Type
t'

  typeOf (C.Undef Type
t)     = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
t
  typeOf (C.BlockAddress {}) = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptr Type
i8
  typeOf (C.GlobalReference Type
t Name
_) = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
t
  typeOf (C.Add {Bool
Constant
nsw :: Bool
nuw :: Bool
operand0 :: Constant
operand1 :: Constant
nsw :: Constant -> Bool
nuw :: Constant -> Bool
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
..})     = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.FAdd {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.FDiv {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.FRem {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.Sub {Bool
Constant
nsw :: Constant -> Bool
nuw :: Constant -> Bool
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
nsw :: Bool
nuw :: Bool
operand0 :: Constant
operand1 :: Constant
..})     = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.FSub {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.Mul {Bool
Constant
nsw :: Constant -> Bool
nuw :: Constant -> Bool
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
nsw :: Bool
nuw :: Bool
operand0 :: Constant
operand1 :: Constant
..})     = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.FMul {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.UDiv {Bool
Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
exact :: Bool
operand0 :: Constant
operand1 :: Constant
exact :: Constant -> Bool
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.SDiv {Bool
Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
exact :: Constant -> Bool
exact :: Bool
operand0 :: Constant
operand1 :: Constant
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.URem {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.SRem {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.Shl {Bool
Constant
nsw :: Constant -> Bool
nuw :: Constant -> Bool
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
nsw :: Bool
nuw :: Bool
operand0 :: Constant
operand1 :: Constant
..})     = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.LShr {Bool
Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
exact :: Constant -> Bool
exact :: Bool
operand0 :: Constant
operand1 :: Constant
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.AShr {Bool
Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
exact :: Constant -> Bool
exact :: Bool
operand0 :: Constant
operand1 :: Constant
..})    = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.And {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
..})     = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.Or  {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
..})     = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.Xor {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
..})     = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
  typeOf (C.GetElementPtr {Bool
[Constant]
Constant
inBounds :: Bool
address :: Constant
indices :: [Constant]
inBounds :: Constant -> Bool
address :: Constant -> Constant
indices :: Constant -> [Constant]
..}) = do
    Either String Type
aty <- Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
address
    case Either String Type
aty of
      (Left String
_) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Type
aty
      (Right Type
aty') -> Type -> [Constant] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Constant] -> m (Either String Type)
indexTypeByConstants Type
aty' [Constant]
indices
  typeOf (C.Trunc {Type
Constant
operand0 :: Constant -> Constant
operand0 :: Constant
type' :: Type
type' :: Constant -> Type
..})    = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.ZExt {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..})     = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.SExt {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..})     = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.FPToUI {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..})   = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.FPToSI {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..})   = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.UIToFP {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..})   = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.SIToFP {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..})   = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.FPTrunc {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..})  = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.FPExt {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..})    = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.PtrToInt {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..}) = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.IntToPtr {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..}) = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.BitCast {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..})  = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'
  typeOf (C.ICmp {IntegerPredicate
Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
iPredicate :: IntegerPredicate
operand0 :: Constant
operand1 :: Constant
iPredicate :: Constant -> IntegerPredicate
..})    = do
    Either String Type
t <- Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
    case Either String Type
t of
      (Left String
_) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Type
t
      (Right (VectorType Word32
n Type
_)) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Word32 -> Type -> Type
VectorType Word32
n Type
i1
      (Right Type
_) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
i1
  typeOf (C.FCmp {FloatingPointPredicate
Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
fpPredicate :: FloatingPointPredicate
operand0 :: Constant
operand1 :: Constant
fpPredicate :: Constant -> FloatingPointPredicate
..})    = do
    Either String Type
t <- Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
    case Either String Type
t of
      (Left String
_) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Type
t
      (Right (VectorType Word32
n Type
_)) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Word32 -> Type -> Type
VectorType Word32
n Type
i1
      (Right Type
_) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
i1
  typeOf (C.Select {Constant
condition' :: Constant
trueValue :: Constant
falseValue :: Constant
condition' :: Constant -> Constant
trueValue :: Constant -> Constant
falseValue :: Constant -> Constant
..})  = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
trueValue
  typeOf (C.ExtractElement {Constant
vector :: Constant
index :: Constant
vector :: Constant -> Constant
index :: Constant -> Constant
..})  = do
    Either String Type
t <- Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
vector
    case Either String Type
t of
      (Left String
_) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Type
t
      (Right (VectorType Word32
_ Type
t')) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
t'
      (Right Type
_) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left String
"The first operand of an extractelement instruction is a value of vector type. (Malformed AST)"
  typeOf (C.InsertElement {Constant
vector :: Constant -> Constant
index :: Constant -> Constant
vector :: Constant
element :: Constant
index :: Constant
element :: Constant -> Constant
..})   = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
vector
  typeOf (C.ShuffleVector {Constant
operand0 :: Constant -> Constant
operand1 :: Constant -> Constant
operand0 :: Constant
operand1 :: Constant
mask :: Constant
mask :: Constant -> Constant
..})   = do
    Either String Type
t0 <- Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
operand0
    Either String Type
tm <- Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
mask
    case (Either String Type
t0, Either String Type
tm) of
      (Right (VectorType Word32
_ Type
t), Right (VectorType Word32
m Type
_)) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Word32 -> Type -> Type
VectorType Word32
m Type
t
      (Either String Type, Either String Type)
_ -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left String
"The first operand of an shufflevector instruction is a value of vector type. (Malformed AST)"
  typeOf (C.ExtractValue {[Word32]
Constant
aggregate :: Constant
indices' :: [Word32]
aggregate :: Constant -> Constant
indices' :: Constant -> [Word32]
..})    = do
    Either String Type
t <- Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
aggregate
    case Either String Type
t of
      (Left String
_) -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Type
t
      (Right Type
t') -> [Word32] -> Type -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
[Word32] -> Type -> m (Either String Type)
extractValueType [Word32]
indices' Type
t'
  typeOf (C.InsertValue {[Word32]
Constant
element :: Constant -> Constant
aggregate :: Constant -> Constant
indices' :: Constant -> [Word32]
aggregate :: Constant
element :: Constant
indices' :: [Word32]
..})   = Constant -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Constant -> m (Either String Type)
typeOf Constant
aggregate
  typeOf (Constant
C.TokenNone)          = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
TokenType
  typeOf (C.AddrSpaceCast {Type
Constant
operand0 :: Constant -> Constant
type' :: Constant -> Type
operand0 :: Constant
type' :: Type
..}) = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
type'

-- | Index into a type using a list of 'Constant' values. Returns a pointer type whose referent is the indexed type, or an error message if indexing was not possible.
indexTypeByConstants :: (HasCallStack, MonadModuleBuilder m) => Type -> [C.Constant] -> m (Either String Type)
indexTypeByConstants :: forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Constant] -> m (Either String Type)
indexTypeByConstants Type
ty [] = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptr Type
ty
indexTypeByConstants (PointerType Type
ty AddrSpace
_) (Constant
_:[Constant]
is) = Type -> [Constant] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Constant] -> m (Either String Type)
indexTypeByConstants Type
ty [Constant]
is
indexTypeByConstants (StructureType Bool
_ [Type]
elTys) (C.Int Word32
32 Integer
val:[Constant]
is) =
  Type -> [Constant] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Constant] -> m (Either String Type)
indexTypeByConstants ([Type]
elTys [Type] -> Int -> Type
forall a. HasCallStack => [a] -> Int -> a
!! Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
val) [Constant]
is
indexTypeByConstants (StructureType Bool
_ [Type]
_) (Constant
i:[Constant]
_) =
  Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Indices into structures should be 32-bit integer constants. (Malformed AST): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Constant -> String
forall a. Show a => a -> String
show Constant
i
indexTypeByConstants (VectorType Word32
_ Type
elTy) (Constant
_:[Constant]
is) = Type -> [Constant] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Constant] -> m (Either String Type)
indexTypeByConstants Type
elTy [Constant]
is
indexTypeByConstants (ArrayType Word64
_ Type
elTy) (Constant
_:[Constant]
is) = Type -> [Constant] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Constant] -> m (Either String Type)
indexTypeByConstants Type
elTy [Constant]
is
indexTypeByConstants (NamedTypeReference Name
n) [Constant]
is = do
  Maybe Type
mayTy <- State ModuleBuilderState (Maybe Type) -> m (Maybe Type)
forall a. State ModuleBuilderState a -> m a
forall (m :: * -> *) a.
MonadModuleBuilder m =>
State ModuleBuilderState a -> m a
liftModuleState ((ModuleBuilderState -> Maybe Type)
-> State ModuleBuilderState (Maybe Type)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Name -> Map Name Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n (Map Name Type -> Maybe Type)
-> (ModuleBuilderState -> Map Name Type)
-> ModuleBuilderState
-> Maybe Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleBuilderState -> Map Name Type
builderTypeDefs))
  case Maybe Type
mayTy of
    Maybe Type
Nothing -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Couldn’t resolve typedef for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
n
    Just Type
ty -> Type -> [Constant] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Constant] -> m (Either String Type)
indexTypeByConstants Type
ty [Constant]
is
indexTypeByConstants Type
ty [Constant]
_ = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Expecting aggregate type. (Malformed AST): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
ty

-- | Index into a type using a list of 'Operand' values. Returns a pointer type whose referent is the indexed type, or an error message if indexing was not possible.
indexTypeByOperands :: (HasCallStack, MonadModuleBuilder m) => Type -> [Operand] -> m (Either String Type)
indexTypeByOperands :: forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Operand] -> m (Either String Type)
indexTypeByOperands Type
ty [] = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptr Type
ty
indexTypeByOperands (PointerType Type
ty AddrSpace
_) (Operand
_:[Operand]
is) = Type -> [Operand] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Operand] -> m (Either String Type)
indexTypeByOperands Type
ty [Operand]
is
indexTypeByOperands (StructureType Bool
_ [Type]
elTys) (ConstantOperand (C.Int Word32
32 Integer
val):[Operand]
is) =
  Type -> [Operand] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Operand] -> m (Either String Type)
indexTypeByOperands ([Type]
elTys [Type] -> Int -> Type
forall a. HasCallStack => [a] -> Int -> a
!! Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
val) [Operand]
is
indexTypeByOperands (StructureType Bool
_ [Type]
_) (Operand
i:[Operand]
_) =
  Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Indices into structures should be 32-bit integer constants. (Malformed AST): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Operand -> String
forall a. Show a => a -> String
show Operand
i
indexTypeByOperands (VectorType Word32
_ Type
elTy) (Operand
_:[Operand]
is) = Type -> [Operand] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Operand] -> m (Either String Type)
indexTypeByOperands Type
elTy [Operand]
is
indexTypeByOperands (ArrayType Word64
_ Type
elTy) (Operand
_:[Operand]
is) = Type -> [Operand] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Operand] -> m (Either String Type)
indexTypeByOperands Type
elTy [Operand]
is
indexTypeByOperands (NamedTypeReference Name
n) [Operand]
is = do
  Maybe Type
mayTy <- State ModuleBuilderState (Maybe Type) -> m (Maybe Type)
forall a. State ModuleBuilderState a -> m a
forall (m :: * -> *) a.
MonadModuleBuilder m =>
State ModuleBuilderState a -> m a
liftModuleState ((ModuleBuilderState -> Maybe Type)
-> State ModuleBuilderState (Maybe Type)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Name -> Map Name Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n (Map Name Type -> Maybe Type)
-> (ModuleBuilderState -> Map Name Type)
-> ModuleBuilderState
-> Maybe Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleBuilderState -> Map Name Type
builderTypeDefs))
  case Maybe Type
mayTy of
    Maybe Type
Nothing -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Couldn’t resolve typedef for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
n
    Just Type
ty -> Type -> [Operand] -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Type -> [Operand] -> m (Either String Type)
indexTypeByOperands Type
ty [Operand]
is
indexTypeByOperands Type
ty [Operand]
_ = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Expecting aggregate type. (Malformed AST): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
ty

getElementType :: Type -> Either String Type
getElementType :: Type -> Either String Type
getElementType (PointerType Type
t AddrSpace
_) = Type -> Either String Type
forall a b. b -> Either a b
Right Type
t
getElementType Type
t = String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Expecting pointer type. (Malformed AST): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t

extractValueType :: (HasCallStack, MonadModuleBuilder m) => [Word32] -> Type -> m (Either String Type)
extractValueType :: forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
[Word32] -> Type -> m (Either String Type)
extractValueType [] Type
ty = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
ty
extractValueType (Word32
i : [Word32]
is) (ArrayType Word64
numEls Type
elTy)
  | Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
numEls = [Word32] -> Type -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
[Word32] -> Type -> m (Either String Type)
extractValueType [Word32]
is Type
elTy
  | Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
numEls = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Expecting valid index into array type. (Malformed AST): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
i
extractValueType (Word32
i : [Word32]
is) (StructureType Bool
_ [Type]
elTys)
  | Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
elTys = [Word32] -> Type -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
[Word32] -> Type -> m (Either String Type)
extractValueType [Word32]
is ([Type]
elTys [Type] -> Int -> Type
forall a. HasCallStack => [a] -> Int -> a
!! Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i)
  | Bool
otherwise = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Expecting valid index into structure type. (Malformed AST): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
i
extractValueType [Word32]
_ Type
ty = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Expecting vector type. (Malformed AST): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
ty

instance Typed F.SomeFloat where
  typeOf :: forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
SomeFloat -> m (Either String Type)
typeOf (F.Half Word16
_)          = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ FloatingPointType -> Type
FloatingPointType FloatingPointType
HalfFP
  typeOf (F.Single Float
_)        = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ FloatingPointType -> Type
FloatingPointType FloatingPointType
FloatFP
  typeOf (F.Double Double
_)        = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ FloatingPointType -> Type
FloatingPointType FloatingPointType
DoubleFP
  typeOf (F.Quadruple Word64
_ Word64
_)   = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ FloatingPointType -> Type
FloatingPointType FloatingPointType
FP128FP
  typeOf (F.X86_FP80 Word16
_ Word64
_)    = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ FloatingPointType -> Type
FloatingPointType FloatingPointType
X86_FP80FP
  typeOf (F.PPC_FP128 Word64
_ Word64
_)   = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ FloatingPointType -> Type
FloatingPointType FloatingPointType
PPC_FP128FP

instance Typed Global where
  typeOf :: forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Global -> m (Either String Type)
typeOf (GlobalVariable {Bool
[(ShortByteString, MDRef MDNode)]
Maybe ShortByteString
Maybe Model
Maybe StorageClass
Maybe Constant
Maybe UnnamedAddr
Word32
Visibility
Name
Linkage
AddrSpace
Type
name :: Name
linkage :: Linkage
visibility :: Visibility
dllStorageClass :: Maybe StorageClass
threadLocalMode :: Maybe Model
unnamedAddr :: Maybe UnnamedAddr
isConstant :: Bool
type' :: Type
addrSpace :: AddrSpace
initializer :: Maybe Constant
section :: Maybe ShortByteString
comdat :: Maybe ShortByteString
alignment :: Word32
metadata :: [(ShortByteString, MDRef MDNode)]
name :: Global -> Name
linkage :: Global -> Linkage
visibility :: Global -> Visibility
dllStorageClass :: Global -> Maybe StorageClass
threadLocalMode :: Global -> Maybe Model
unnamedAddr :: Global -> Maybe UnnamedAddr
isConstant :: Global -> Bool
type' :: Global -> Type
addrSpace :: Global -> AddrSpace
initializer :: Global -> Maybe Constant
section :: Global -> Maybe ShortByteString
comdat :: Global -> Maybe ShortByteString
alignment :: Global -> Word32
metadata :: Global -> [(ShortByteString, MDRef MDNode)]
..}) = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Type
type'
  typeOf (GlobalAlias {Maybe Model
Maybe StorageClass
Maybe UnnamedAddr
Visibility
Name
Linkage
AddrSpace
Type
Constant
name :: Global -> Name
linkage :: Global -> Linkage
visibility :: Global -> Visibility
dllStorageClass :: Global -> Maybe StorageClass
threadLocalMode :: Global -> Maybe Model
unnamedAddr :: Global -> Maybe UnnamedAddr
type' :: Global -> Type
addrSpace :: Global -> AddrSpace
name :: Name
linkage :: Linkage
visibility :: Visibility
dllStorageClass :: Maybe StorageClass
threadLocalMode :: Maybe Model
unnamedAddr :: Maybe UnnamedAddr
type' :: Type
addrSpace :: AddrSpace
aliasee :: Constant
aliasee :: Global -> Constant
..})    = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Type
type'
  typeOf (Function {[Either GroupID FunctionAttribute]
[(ShortByteString, MDRef MDNode)]
[ParameterAttribute]
[BasicBlock]
Maybe ShortByteString
Maybe StorageClass
Maybe Constant
Word32
([Parameter], Bool)
Visibility
Name
Linkage
CallingConvention
Type
name :: Global -> Name
linkage :: Global -> Linkage
visibility :: Global -> Visibility
dllStorageClass :: Global -> Maybe StorageClass
section :: Global -> Maybe ShortByteString
comdat :: Global -> Maybe ShortByteString
alignment :: Global -> Word32
metadata :: Global -> [(ShortByteString, MDRef MDNode)]
linkage :: Linkage
visibility :: Visibility
dllStorageClass :: Maybe StorageClass
callingConvention :: CallingConvention
returnAttributes :: [ParameterAttribute]
returnType :: Type
name :: Name
parameters :: ([Parameter], Bool)
functionAttributes :: [Either GroupID FunctionAttribute]
section :: Maybe ShortByteString
comdat :: Maybe ShortByteString
alignment :: Word32
garbageCollectorName :: Maybe ShortByteString
prefix :: Maybe Constant
basicBlocks :: [BasicBlock]
personalityFunction :: Maybe Constant
metadata :: [(ShortByteString, MDRef MDNode)]
callingConvention :: Global -> CallingConvention
returnAttributes :: Global -> [ParameterAttribute]
returnType :: Global -> Type
parameters :: Global -> ([Parameter], Bool)
functionAttributes :: Global -> [Either GroupID FunctionAttribute]
garbageCollectorName :: Global -> Maybe ShortByteString
prefix :: Global -> Maybe Constant
basicBlocks :: Global -> [BasicBlock]
personalityFunction :: Global -> Maybe Constant
..})       = do
    let ([Parameter]
params, Bool
isVarArg) = ([Parameter], Bool)
parameters
    [Either String Type]
ptys <- (Parameter -> m (Either String Type))
-> [Parameter] -> m [Either String Type]
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 Parameter -> m (Either String Type)
forall a (m :: * -> *).
(Typed a, HasCallStack, MonadModuleBuilder m) =>
a -> m (Either String Type)
forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Parameter -> m (Either String Type)
typeOf [Parameter]
params
    case ((Either String Type -> Bool) -> [Either String Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Either String Type -> Bool
forall a b. Either a b -> Bool
Either.isRight [Either String Type]
ptys) of
      Bool
True -> Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Type -> [Type] -> Bool -> Type
FunctionType Type
returnType ([Either String Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either String Type]
ptys) Bool
isVarArg
      Bool
False -> do
        let (Left String
s) = [Either String Type] -> Either String Type
forall a. HasCallStack => [a] -> a
head ([Either String Type] -> Either String Type)
-> [Either String Type] -> Either String Type
forall a b. (a -> b) -> a -> b
$ (Either String Type -> Bool)
-> [Either String Type] -> [Either String Type]
forall a. (a -> Bool) -> [a] -> [a]
filter Either String Type -> Bool
forall a b. Either a b -> Bool
Either.isLeft [Either String Type]
ptys
        Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ String -> Either String Type
forall a b. a -> Either a b
Left (String -> Either String Type) -> String -> Either String Type
forall a b. (a -> b) -> a -> b
$ String
"Could not deduce type for function parameter: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

instance Typed Parameter where
  typeOf :: forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
Parameter -> m (Either String Type)
typeOf (Parameter Type
t Name
_ [ParameterAttribute]
_) = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right Type
t

instance Typed [Int32] where
  typeOf :: forall (m :: * -> *).
(HasCallStack, MonadModuleBuilder m) =>
[Int32] -> m (Either String Type)
typeOf [Int32]
mask = Either String Type -> m (Either String Type)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Type -> m (Either String Type))
-> Either String Type -> m (Either String Type)
forall a b. (a -> b) -> a -> b
$ Type -> Either String Type
forall a b. b -> Either a b
Right (Type -> Either String Type) -> Type -> Either String Type
forall a b. (a -> b) -> a -> b
$ Word32 -> Type -> Type
VectorType (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Int32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int32]
mask) Type
i32