-----------------------------------------------------------------------
-- |
-- Module           : Lang.Crucible.LLVM.Translation.Instruction
-- Description      : Translation of LLVM instructions
-- Copyright        : (c) Galois, Inc 2018
-- License          : BSD3
-- Maintainer       : Rob Dockins <rdockins@galois.com>
-- Stability        : provisional
--
-- This module represents the workhorse of the LLVM translation.  It
-- is responsible for interpreting the LLVM instruction set into
-- corresponding crucible statements.
-----------------------------------------------------------------------

{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE ImplicitParams        #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE ViewPatterns          #-}

module Lang.Crucible.LLVM.Translation.Instruction
  ( instrResultType
  , generateInstr
  , definePhiBlock
  , assignLLVMReg
  , callOrdinaryFunction
  ) where

import           Prelude hiding (exp, pred)

import           Control.Lens hiding (op, (:>) )
import           Control.Monad (MonadPlus(..), forM, unless)
import           Control.Monad.Except (MonadError(..), runExceptT)
import           Control.Monad.State.Strict (MonadState(..))
import           Control.Monad.Trans.Class (MonadTrans(..))
import           Control.Monad.Trans.Maybe
import           Data.Foldable (for_, toList)
import           Data.Functor (void)
import           Data.Int
import qualified Data.List as List
import           Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.Map.Strict as Map
import           Data.Maybe
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import           Data.String
import qualified Data.Text as Text
import qualified Data.Vector as V
import           Numeric.Natural
import           Prettyprinter (pretty)
import GHC.Exts ( Proxy#, proxy# )

import qualified Text.LLVM.AST as L

import qualified Data.BitVector.Sized as BV
import qualified Data.Parameterized.Context as Ctx
import           Data.Parameterized.NatRepr as NatRepr
import           Data.Parameterized.Some

import           What4.Utils.StringLiteral

import           Lang.Crucible.CFG.Expr
import           Lang.Crucible.CFG.Generator

import qualified Lang.Crucible.LLVM.Bytes as G
import           Lang.Crucible.LLVM.DataLayout
import qualified Lang.Crucible.LLVM.Errors.Poison as Poison
import qualified Lang.Crucible.LLVM.Errors.UndefinedBehavior as UB
import           Lang.Crucible.LLVM.Extension
import           Lang.Crucible.LLVM.MemModel
import           Lang.Crucible.LLVM.MemType
import qualified Lang.Crucible.LLVM.PrettyPrint as LPP
import           Lang.Crucible.LLVM.Translation.Constant
import           Lang.Crucible.LLVM.Translation.Expr
import           Lang.Crucible.LLVM.Translation.Monad
import           Lang.Crucible.LLVM.Translation.Options
import           Lang.Crucible.LLVM.Translation.Types
import           Lang.Crucible.LLVM.TypeContext
import           Lang.Crucible.Syntax hiding (IsExpr)
import           Lang.Crucible.Types

--------------------------------------------------------------------------------
-- Assertions

-- | Add a bunch of side conditions to a value.
--
-- Allows for effectful computation of the predicates and expressions.
sideConditionsA :: forall f ty s. Applicative f
                => GlobalVar Mem
                -> TypeRepr ty
                -> Expr LLVM s ty
                    -- ^ Expression with side-condition
                -> [( Bool
                    , f (Expr LLVM s BoolType)
                    , UB.UndefinedBehavior (Expr LLVM s)
                    )]
                    -- ^ Conditions to (conditionally) assert
                -> f (Expr LLVM s ty)
sideConditionsA :: forall (f :: Type -> Type) (ty :: CrucibleType) s.
Applicative f =>
GlobalVar Mem
-> TypeRepr ty
-> Expr LLVM s ty
-> [(Bool, f (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> f (Expr LLVM s ty)
sideConditionsA GlobalVar Mem
mvar TypeRepr ty
tyRepr Expr LLVM s ty
expr [(Bool, f (Expr LLVM s BoolType), UndefinedBehavior (Expr LLVM s))]
conds =
  let middle :: Applicative g => (a, g b, c) -> g (a, b, c)
      middle :: forall (g :: Type -> Type) a b c.
Applicative g =>
(a, g b, c) -> g (a, b, c)
middle (a
a, g b
fb, c
c) = (,,) (a -> b -> c -> (a, b, c)) -> g a -> g (b -> c -> (a, b, c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> g a
forall a. a -> g a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a g (b -> c -> (a, b, c)) -> g b -> g (c -> (a, b, c))
forall a b. g (a -> b) -> g a -> g b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> g b
fb g (c -> (a, b, c)) -> g c -> g (a, b, c)
forall a b. g (a -> b) -> g a -> g b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> c -> g c
forall a. a -> g a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure c
c

      fmapMaybe :: Functor g => g [a] -> (a -> Maybe b) -> g [b]
      fmapMaybe :: forall (g :: Type -> Type) a b.
Functor g =>
g [a] -> (a -> Maybe b) -> g [b]
fmapMaybe g [a]
gs a -> Maybe b
h = ([a] -> [b]) -> g [a] -> g [b]
forall a b. (a -> b) -> g a -> g b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
h) g [a]
gs

      conds' :: f [LLVMSideCondition (Expr LLVM s)]
      conds' :: f [LLVMSideCondition (Expr LLVM s)]
conds' = f [(Bool, Expr LLVM s BoolType, UndefinedBehavior (Expr LLVM s))]
-> ((Bool, Expr LLVM s BoolType, UndefinedBehavior (Expr LLVM s))
    -> Maybe (LLVMSideCondition (Expr LLVM s)))
-> f [LLVMSideCondition (Expr LLVM s)]
forall (g :: Type -> Type) a b.
Functor g =>
g [a] -> (a -> Maybe b) -> g [b]
fmapMaybe (((Bool, f (Expr LLVM s BoolType), UndefinedBehavior (Expr LLVM s))
 -> f (Bool, Expr LLVM s BoolType, UndefinedBehavior (Expr LLVM s)))
-> [(Bool, f (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> f [(Bool, Expr LLVM s BoolType,
       UndefinedBehavior (Expr LLVM s))]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Bool, f (Expr LLVM s BoolType), UndefinedBehavior (Expr LLVM s))
-> f (Bool, Expr LLVM s BoolType, UndefinedBehavior (Expr LLVM s))
forall (g :: Type -> Type) a b c.
Applicative g =>
(a, g b, c) -> g (a, b, c)
middle [(Bool, f (Expr LLVM s BoolType), UndefinedBehavior (Expr LLVM s))]
conds) (((Bool, Expr LLVM s BoolType, UndefinedBehavior (Expr LLVM s))
  -> Maybe (LLVMSideCondition (Expr LLVM s)))
 -> f [LLVMSideCondition (Expr LLVM s)])
-> ((Bool, Expr LLVM s BoolType, UndefinedBehavior (Expr LLVM s))
    -> Maybe (LLVMSideCondition (Expr LLVM s)))
-> f [LLVMSideCondition (Expr LLVM s)]
forall a b. (a -> b) -> a -> b
$ \(Bool
b, Expr LLVM s BoolType
pred, UndefinedBehavior (Expr LLVM s)
classifier) ->
                (if Bool
b then LLVMSideCondition (Expr LLVM s)
-> Maybe (LLVMSideCondition (Expr LLVM s))
forall a. a -> Maybe a
Just else Maybe (LLVMSideCondition (Expr LLVM s))
-> LLVMSideCondition (Expr LLVM s)
-> Maybe (LLVMSideCondition (Expr LLVM s))
forall a b. a -> b -> a
const Maybe (LLVMSideCondition (Expr LLVM s))
forall a. Maybe a
Nothing) (LLVMSideCondition (Expr LLVM s)
 -> Maybe (LLVMSideCondition (Expr LLVM s)))
-> LLVMSideCondition (Expr LLVM s)
-> Maybe (LLVMSideCondition (Expr LLVM s))
forall a b. (a -> b) -> a -> b
$
                  Expr LLVM s BoolType
-> UndefinedBehavior (Expr LLVM s)
-> LLVMSideCondition (Expr LLVM s)
forall (f :: CrucibleType -> Type).
f BoolType -> UndefinedBehavior f -> LLVMSideCondition f
LLVMSideCondition Expr LLVM s BoolType
pred UndefinedBehavior (Expr LLVM s)
classifier
  in (([LLVMSideCondition (Expr LLVM s)] -> Expr LLVM s ty)
 -> f [LLVMSideCondition (Expr LLVM s)] -> f (Expr LLVM s ty))
-> f [LLVMSideCondition (Expr LLVM s)]
-> ([LLVMSideCondition (Expr LLVM s)] -> Expr LLVM s ty)
-> f (Expr LLVM s ty)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([LLVMSideCondition (Expr LLVM s)] -> Expr LLVM s ty)
-> f [LLVMSideCondition (Expr LLVM s)] -> f (Expr LLVM s ty)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap f [LLVMSideCondition (Expr LLVM s)]
conds' (([LLVMSideCondition (Expr LLVM s)] -> Expr LLVM s ty)
 -> f (Expr LLVM s ty))
-> ([LLVMSideCondition (Expr LLVM s)] -> Expr LLVM s ty)
-> f (Expr LLVM s ty)
forall a b. (a -> b) -> a -> b
$
      \case
        []     -> Expr LLVM s ty
expr -- No assertions left, nothing to do.
        (LLVMSideCondition (Expr LLVM s)
x:[LLVMSideCondition (Expr LLVM s)]
xs) -> App LLVM (Expr LLVM s) ty -> Expr LLVM s ty
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) ty -> Expr LLVM s ty)
-> App LLVM (Expr LLVM s) ty -> Expr LLVM s ty
forall a b. (a -> b) -> a -> b
$ ExprExtension LLVM (Expr LLVM s) ty -> App LLVM (Expr LLVM s) ty
forall ext (f :: CrucibleType -> Type) (tp :: CrucibleType).
ExprExtension ext f tp -> App ext f tp
ExtensionApp (ExprExtension LLVM (Expr LLVM s) ty -> App LLVM (Expr LLVM s) ty)
-> ExprExtension LLVM (Expr LLVM s) ty -> App LLVM (Expr LLVM s) ty
forall a b. (a -> b) -> a -> b
$ GlobalVar Mem
-> TypeRepr ty
-> NonEmpty (LLVMSideCondition (Expr LLVM s))
-> Expr LLVM s ty
-> LLVMExtensionExpr (Expr LLVM s) ty
forall (b :: CrucibleType) (a :: CrucibleType -> Type).
GlobalVar Mem
-> TypeRepr b
-> NonEmpty (LLVMSideCondition a)
-> a b
-> LLVMExtensionExpr a b
LLVM_SideConditions GlobalVar Mem
mvar TypeRepr ty
tyRepr (LLVMSideCondition (Expr LLVM s)
x LLVMSideCondition (Expr LLVM s)
-> [LLVMSideCondition (Expr LLVM s)]
-> NonEmpty (LLVMSideCondition (Expr LLVM s))
forall a. a -> [a] -> NonEmpty a
:| [LLVMSideCondition (Expr LLVM s)]
xs) Expr LLVM s ty
expr

-- | Assert that evaluation doesn't result in a poison value
poisonSideCondition :: GlobalVar Mem
                    -> TypeRepr ty
                    -> Poison.Poison (Expr LLVM s)
                    -> Expr LLVM s ty
                       -- ^ Expression with side-condition
                    -> Expr LLVM s BoolType
                       -- ^ Condition to assert
                    -> Expr LLVM s ty
poisonSideCondition :: forall (ty :: CrucibleType) s.
GlobalVar Mem
-> TypeRepr ty
-> Poison (Expr LLVM s)
-> Expr LLVM s ty
-> Expr LLVM s BoolType
-> Expr LLVM s ty
poisonSideCondition GlobalVar Mem
mvar TypeRepr ty
tyRepr Poison (Expr LLVM s)
poison Expr LLVM s ty
expr Expr LLVM s BoolType
cond =
  Identity (Expr LLVM s ty) -> Expr LLVM s ty
forall a. Identity a -> a
runIdentity (Identity (Expr LLVM s ty) -> Expr LLVM s ty)
-> Identity (Expr LLVM s ty) -> Expr LLVM s ty
forall a b. (a -> b) -> a -> b
$ GlobalVar Mem
-> TypeRepr ty
-> Expr LLVM s ty
-> [(Bool, Identity (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Identity (Expr LLVM s ty)
forall (f :: Type -> Type) (ty :: CrucibleType) s.
Applicative f =>
GlobalVar Mem
-> TypeRepr ty
-> Expr LLVM s ty
-> [(Bool, f (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> f (Expr LLVM s ty)
sideConditionsA GlobalVar Mem
mvar TypeRepr ty
tyRepr Expr LLVM s ty
expr [(Bool
True, Expr LLVM s BoolType -> Identity (Expr LLVM s BoolType)
forall a. a -> Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr LLVM s BoolType
cond, Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated Poison (Expr LLVM s)
poison)]

--------------------------------------------------------------------------------
-- Translation

-- | Get the return type of an LLVM instruction
-- See <https://llvm.org/docs/LangRef.html#instruction-reference the language reference>.
instrResultType ::
  (?lc :: TypeContext, MonadError String m, HasPtrWidth wptr) =>
  L.Instr ->
  m MemType
instrResultType :: forall (m :: Type -> Type) (wptr :: Natural).
(?lc::TypeContext, MonadError String m, HasPtrWidth wptr) =>
Instr -> m MemType
instrResultType Instr
instr =
  case Instr
instr of
    L.Arith ArithOp
_ Typed (Value' BlockLabel)
x Value' BlockLabel
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
    L.UnaryArith UnaryArithOp
_ Typed (Value' BlockLabel)
x -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
    L.Bit BitOp
_ Typed (Value' BlockLabel)
x Value' BlockLabel
_   -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
    L.Conv ConvOp
_ Typed (Value' BlockLabel)
_ Type
ty -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType Type
ty
    L.Call Bool
_ (L.FunTy Type
ty [Type]
_ Bool
_) Value' BlockLabel
_ [Typed (Value' BlockLabel)]
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType Type
ty
    L.Call Bool
_ Type
ty Value' BlockLabel
_ [Typed (Value' BlockLabel)]
_ -> String -> m MemType
forall a. String -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> m MemType) -> String -> m MemType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"unexpected non-function type in call:", Type -> String
forall a. Show a => a -> String
show Type
ty]
    L.Invoke (L.FunTy Type
ty [Type]
_ Bool
_) Value' BlockLabel
_ [Typed (Value' BlockLabel)]
_ BlockLabel
_ BlockLabel
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType Type
ty
    L.Invoke Type
ty Value' BlockLabel
_ [Typed (Value' BlockLabel)]
_ BlockLabel
_ BlockLabel
_ -> String -> m MemType
forall a. String -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> m MemType) -> String -> m MemType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"unexpected non-function type in invoke:", Type -> String
forall a. Show a => a -> String
show Type
ty]
    L.CallBr (L.FunTy Type
ty [Type]
_ Bool
_) Value' BlockLabel
_ [Typed (Value' BlockLabel)]
_ BlockLabel
_ [BlockLabel]
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType Type
ty
    L.CallBr Type
ty Value' BlockLabel
_ [Typed (Value' BlockLabel)]
_ BlockLabel
_ [BlockLabel]
_ -> String -> m MemType
forall a. String -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> m MemType) -> String -> m MemType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"unexpected non-function type in callbr:", Type -> String
forall a. Show a => a -> String
show Type
ty]
    L.Alloca Type
ty Maybe (Typed (Value' BlockLabel))
_ Maybe Int
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Type -> Type
forall ident. Type' ident -> Type' ident
L.PtrTo Type
ty)
    L.Load Type
tp Typed (Value' BlockLabel)
_ Maybe AtomicOrdering
_ Maybe Int
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType Type
tp
    L.ICmp ICmpOp
_op Typed (Value' BlockLabel)
tv Value' BlockLabel
_ -> do
      MemType
inpType <- Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
tv)
      case MemType
inpType of
        VecType Natural
len MemType
_ -> MemType -> m MemType
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Natural -> MemType -> MemType
VecType Natural
len (Natural -> MemType
IntType Natural
1))
        MemType
_ -> MemType -> m MemType
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Natural -> MemType
IntType Natural
1)
    L.FCmp FCmpOp
_op Typed (Value' BlockLabel)
tv Value' BlockLabel
_ -> do
      MemType
inpType <- Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
tv)
      case MemType
inpType of
        VecType Natural
len MemType
_ -> MemType -> m MemType
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Natural -> MemType -> MemType
VecType Natural
len (Natural -> MemType
IntType Natural
1))
        MemType
_ -> MemType -> m MemType
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Natural -> MemType
IntType Natural
1)
    L.Phi Type
tp [(Value' BlockLabel, BlockLabel)]
_   -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType Type
tp

    L.GEP Bool
inbounds Type
baseTy Typed (Value' BlockLabel)
basePtr [Typed (Value' BlockLabel)]
elts ->
       do Either String (GEPResult (Typed (Value' BlockLabel)))
gepRes <- ExceptT String m (GEPResult (Typed (Value' BlockLabel)))
-> m (Either String (GEPResult (Typed (Value' BlockLabel))))
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (Bool
-> Type
-> Typed (Value' BlockLabel)
-> [Typed (Value' BlockLabel)]
-> ExceptT String m (GEPResult (Typed (Value' BlockLabel)))
forall (wptr :: Natural) (m :: Type -> Type).
(?lc::TypeContext, MonadError String m, HasPtrWidth wptr) =>
Bool
-> Type
-> Typed (Value' BlockLabel)
-> [Typed (Value' BlockLabel)]
-> m (GEPResult (Typed (Value' BlockLabel)))
translateGEP Bool
inbounds Type
baseTy Typed (Value' BlockLabel)
basePtr [Typed (Value' BlockLabel)]
elts)
          case Either String (GEPResult (Typed (Value' BlockLabel)))
gepRes of
            Left String
err -> String -> m MemType
forall a. String -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError String
err
            Right (GEPResult NatRepr n
lanes MemType
tp GEP n (Typed (Value' BlockLabel))
_gep) ->
              let n :: Natural
n = NatRepr n -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr n
lanes in
              if Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
1 then
                MemType -> m MemType
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SymType -> MemType
PtrType (MemType -> SymType
MemType MemType
tp))
              else
                MemType -> m MemType
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Natural -> MemType -> MemType
VecType Natural
n (SymType -> MemType
PtrType (MemType -> SymType
MemType MemType
tp)))

    L.Select Typed (Value' BlockLabel)
_ Typed (Value' BlockLabel)
x Value' BlockLabel
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)

    L.ExtractValue Typed (Value' BlockLabel)
x [Int32]
idxes -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x) m MemType -> (MemType -> m MemType) -> m MemType
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int32] -> MemType -> m MemType
go [Int32]
idxes
         where go :: [Int32] -> MemType -> m MemType
go [] MemType
tp = MemType -> m MemType
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return MemType
tp
               go (Int32
i:[Int32]
is) (ArrayType Natural
n MemType
tp')
                   | Int32
i Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Natural -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n = [Int32] -> MemType -> m MemType
go [Int32]
is MemType
tp'
                   | Bool
otherwise = String -> m MemType
forall a. String -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> m MemType) -> String -> m MemType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"invalid index into array type", Instr -> String
showInstr Instr
instr]
               go (Int32
i:[Int32]
is) (StructType StructInfo
si) =
                      case StructInfo -> Vector FieldInfo
siFields StructInfo
si Vector FieldInfo -> Int -> Maybe FieldInfo
forall a. Vector a -> Int -> Maybe a
V.!? (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i) of
                        Just FieldInfo
fi -> [Int32] -> MemType -> m MemType
go [Int32]
is (FieldInfo -> MemType
fiType FieldInfo
fi)
                        Maybe FieldInfo
Nothing -> String -> m MemType
forall a. String -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> m MemType) -> String -> m MemType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"invalid index into struct type", Instr -> String
showInstr Instr
instr]
               go [Int32]
_ MemType
_ = String -> m MemType
forall a. String -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> m MemType) -> String -> m MemType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"invalid type in extract value instruction", Instr -> String
showInstr Instr
instr]

    L.InsertValue Typed (Value' BlockLabel)
x Typed (Value' BlockLabel)
_ [Int32]
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)

    L.ExtractElt Typed (Value' BlockLabel)
x Value' BlockLabel
_ ->
       do MemType
tp <- Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
          case MemType
tp of
            VecType Natural
_n MemType
tp' -> MemType -> m MemType
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return MemType
tp'
            MemType
_ -> String -> m MemType
forall a. String -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> m MemType) -> String -> m MemType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"extract element of non-vector type", Instr -> String
showInstr Instr
instr]

    L.InsertElt Typed (Value' BlockLabel)
x Typed (Value' BlockLabel)
_ Value' BlockLabel
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)

    L.ShuffleVector Typed (Value' BlockLabel)
x Value' BlockLabel
_ Typed (Value' BlockLabel)
i ->
      do MemType
xtp <- Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
         MemType
itp <- Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
i)
         case (MemType
xtp, MemType
itp) of
           (VecType Natural
_n MemType
ty, VecType Natural
m MemType
_) -> MemType -> m MemType
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Natural -> MemType -> MemType
VecType Natural
m MemType
ty)
           (MemType, MemType)
_ -> String -> m MemType
forall a. String -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> m MemType) -> String -> m MemType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"invalid shufflevector:", Instr -> String
showInstr Instr
instr]

    L.LandingPad Type
x Maybe (Typed (Value' BlockLabel))
_ Bool
_ [Clause' BlockLabel]
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType Type
x

    -- LLVM Language Reference: "The original value at the location is returned."
    L.AtomicRW Bool
_ AtomicRWOp
_ Typed (Value' BlockLabel)
_ Typed (Value' BlockLabel)
v Maybe String
_ AtomicOrdering
_ -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
v)

    L.CmpXchg Bool
_weak Bool
_volatile Typed (Value' BlockLabel)
_ptr Typed (Value' BlockLabel)
_old Typed (Value' BlockLabel)
new Maybe String
_ AtomicOrdering
_ AtomicOrdering
_ ->
      do let dl :: DataLayout
dl = TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc
         MemType
tp <- Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
new)
         MemType -> m MemType
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (StructInfo -> MemType
StructType (DataLayout -> Bool -> [MemType] -> StructInfo
mkStructInfo DataLayout
dl Bool
False [MemType
tp, MemType
i1]))

    L.Freeze Typed (Value' BlockLabel)
x -> Type -> m MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)

    Instr
_ -> String -> m MemType
forall a. String -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> m MemType) -> String -> m MemType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"instrResultType, unsupported instruction:", Instr -> String
showInstr Instr
instr]

-- | Given an LLVM expression of vector type, select out the ith element.
extractElt
    :: forall s arch ret.
       L.Instr
    -> MemType    -- ^ type contained in the vector
    -> Integer   -- ^ size of the vector
    -> LLVMExpr s arch  -- ^ vector expression
    -> LLVMExpr s arch -- ^ index expression
    -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractElt :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
extractElt Instr
_instr MemType
ty Integer
_n (UndefExpr MemType
_) LLVMExpr s arch
_i =
   LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
UndefExpr MemType
ty
extractElt Instr
_instr MemType
ty Integer
_n (ZeroExpr MemType
_) LLVMExpr s arch
_i =
   LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
ZeroExpr MemType
ty
extractElt Instr
_ MemType
ty Integer
_ LLVMExpr s arch
_ (UndefExpr MemType
_) =
   LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
UndefExpr MemType
ty
extractElt Instr
instr MemType
ty Integer
n LLVMExpr s arch
v (ZeroExpr MemType
zty) =
   let ?err = ?err::String
      -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail in
   Proxy# arch
-> MemType
-> (forall {tp :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tp
    -> Expr LLVM s tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (arch :: LLVMArch) s.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
Proxy# arch
-> MemType
-> (forall (tp :: CrucibleType).
    Proxy# arch -> TypeRepr tp -> Expr LLVM s tp -> a)
-> a
zeroExpand (Proxy# arch
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# arch) MemType
zty ((forall {tp :: CrucibleType}.
  Proxy# arch
  -> TypeRepr tp
  -> Expr LLVM s tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tp
    -> Expr LLVM s tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \Proxy# arch
_archProxy TypeRepr tp
tyr Expr LLVM s tp
ex -> Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
extractElt Instr
instr MemType
ty Integer
n LLVMExpr s arch
v (TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp
tyr Expr LLVM s tp
ex)
extractElt Instr
instr MemType
_ Integer
n (VecExpr MemType
_ Seq (LLVMExpr s arch)
vs) LLVMExpr s arch
i
  | Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
_) (BitvectorAsPointerExpr NatRepr w
_ Expr LLVM s (BVType w)
x) <- LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
i
  , App (BVLit NatRepr w
_ BV w
x') <- Expr LLVM s (BVType w)
x
  = Integer -> LLVMGenerator s arch ret (LLVMExpr s arch)
constantExtract (BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
x')

 where
 constantExtract :: Integer -> LLVMGenerator s arch ret (LLVMExpr s arch)
 constantExtract :: Integer -> LLVMGenerator s arch ret (LLVMExpr s arch)
constantExtract Integer
idx =
    if (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq (LLVMExpr s arch) -> Int
forall a. Seq a -> Int
Seq.length Seq (LLVMExpr s arch)
vs) Bool -> Bool -> Bool
&& (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
idx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n)
        then LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ Seq (LLVMExpr s arch) -> Int -> LLVMExpr s arch
forall a. Seq a -> Int -> a
Seq.index Seq (LLVMExpr s arch)
vs (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
idx)
        else String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [String
"invalid extractelement instruction (index out of bounds)", Instr -> String
showInstr Instr
instr])

extractElt Instr
instr MemType
ty Integer
n (VecExpr MemType
_ Seq (LLVMExpr s arch)
vs) LLVMExpr s arch
i = do
   let ?err = ?err::String
      -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
   MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
ty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
tyr -> Proxy# arch
-> TypeRepr tp
-> [LLVMExpr s arch]
-> (Expr LLVM s (VectorType tp)
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (tpr :: CrucibleType) s (arch :: LLVMArch) a.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
Proxy# arch
-> TypeRepr tpr
-> [LLVMExpr s arch]
-> (Expr LLVM s (VectorType tpr) -> a)
-> a
unpackVec (Proxy# arch
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# arch) TypeRepr tp
tyr (Seq (LLVMExpr s arch) -> [LLVMExpr s arch]
forall a. Seq a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Seq (LLVMExpr s arch)
vs) ((Expr LLVM s (VectorType tp)
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (Expr LLVM s (VectorType tp)
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$
      \Expr LLVM s (VectorType tp)
ex -> Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
extractElt Instr
instr MemType
ty Integer
n (TypeRepr (VectorType tp)
-> Expr LLVM s (VectorType tp) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (TypeRepr tp -> TypeRepr (VectorType tp)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr tp
tyr) Expr LLVM s (VectorType tp)
ex) LLVMExpr s arch
i
extractElt Instr
instr MemType
_ Integer
n (BaseExpr (VectorRepr TypeRepr tp1
tyr) Expr LLVM s tp
v) LLVMExpr s arch
i =
  do GlobalVar Mem
mvar <- Generator LLVM s (LLVMState arch) ret IO (GlobalVar Mem)
forall s (arch :: LLVMArch) (reg :: CrucibleType).
LLVMGenerator s arch reg (GlobalVar Mem)
getMemVar
     Expr LLVM s NatType
idx <- case LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
i of
                   Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x ->
                     do Expr LLVM s (BVType w)
bv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x
                        -- The value is poisoned if the index is out of bounds.
                        let poison :: Poison (Expr LLVM s)
poison = Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> Poison e
Poison.ExtractElementIndex Expr LLVM s (BVType w)
bv
                        Expr LLVM s NatType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s NatType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s NatType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s NatType))
-> Expr LLVM s NatType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s NatType)
forall a b. (a -> b) -> a -> b
$ GlobalVar Mem
-> TypeRepr NatType
-> Poison (Expr LLVM s)
-> Expr LLVM s NatType
-> Expr LLVM s BoolType
-> Expr LLVM s NatType
forall (ty :: CrucibleType) s.
GlobalVar Mem
-> TypeRepr ty
-> Poison (Expr LLVM s)
-> Expr LLVM s ty
-> Expr LLVM s BoolType
-> Expr LLVM s ty
poisonSideCondition
                                   GlobalVar Mem
mvar
                                   TypeRepr NatType
NatRepr
                                   Poison (Expr LLVM s)
poison
                                   -- returned expression
                                   (App LLVM (Expr LLVM s) NatType -> Expr LLVM s NatType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w) -> App LLVM (Expr LLVM s) NatType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> App ext f NatType
BvToNat NatRepr w
w Expr LLVM s (BVType w)
bv))
                                   -- assertion condition
                                   (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVUlt NatRepr w
w Expr LLVM s (BVType w)
bv (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w -> BV w -> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
n)))))
                   ScalarView s arch
_ ->
                     String
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s NatType)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [String
"invalid extractelement instruction", Instr -> String
showInstr Instr
instr])
     LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1 -> Expr LLVM s tp1 -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp1
tyr (App LLVM (Expr LLVM s) tp1 -> Expr LLVM s tp1
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (TypeRepr tp1
-> Expr LLVM s ('VectorType tp1)
-> Expr LLVM s NatType
-> App LLVM (Expr LLVM s) tp1
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext.
TypeRepr tp -> f (VectorType tp) -> f NatType -> App ext f tp
VectorGetEntry TypeRepr tp1
tyr Expr LLVM s tp
Expr LLVM s ('VectorType tp1)
v Expr LLVM s NatType
idx))

extractElt Instr
instr MemType
_ Integer
_ LLVMExpr s arch
_ LLVMExpr s arch
_ = String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [String
"invalid extractelement instruction", Instr -> String
showInstr Instr
instr])


-- | Given an LLVM expression of vector type, insert a new element at location ith element.
insertElt :: forall s arch ret.
       L.Instr            -- ^ Actual instruction
    -> MemType            -- ^ type contained in the vector
    -> Integer            -- ^ size of the vector
    -> LLVMExpr s arch    -- ^ vector expression
    -> LLVMExpr s arch    -- ^ element to insert
    -> LLVMExpr s arch    -- ^ index expression
    -> LLVMGenerator s arch ret (LLVMExpr s arch)
insertElt :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertElt Instr
_ MemType
ty Integer
_ LLVMExpr s arch
_ LLVMExpr s arch
_ (UndefExpr MemType
_) = do
   LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
UndefExpr MemType
ty
insertElt Instr
instr MemType
ty Integer
n LLVMExpr s arch
v LLVMExpr s arch
a (ZeroExpr MemType
zty) = do
   let ?err = ?err::String
      -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
   Proxy# arch
-> MemType
-> (forall {tp :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tp
    -> Expr LLVM s tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (arch :: LLVMArch) s.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
Proxy# arch
-> MemType
-> (forall (tp :: CrucibleType).
    Proxy# arch -> TypeRepr tp -> Expr LLVM s tp -> a)
-> a
zeroExpand (Proxy# arch
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# arch) MemType
zty ((forall {tp :: CrucibleType}.
  Proxy# arch
  -> TypeRepr tp
  -> Expr LLVM s tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tp
    -> Expr LLVM s tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \Proxy# arch
_archProxy TypeRepr tp
tyr Expr LLVM s tp
ex -> Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertElt Instr
instr MemType
ty Integer
n LLVMExpr s arch
v LLVMExpr s arch
a (TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp
tyr Expr LLVM s tp
ex)

insertElt Instr
instr MemType
ty Integer
n (UndefExpr MemType
_) LLVMExpr s arch
a LLVMExpr s arch
i  = do
  Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertElt Instr
instr MemType
ty Integer
n (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
ty (Int -> LLVMExpr s arch -> Seq (LLVMExpr s arch)
forall a. Int -> a -> Seq a
Seq.replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
UndefExpr MemType
ty))) LLVMExpr s arch
a LLVMExpr s arch
i
insertElt Instr
instr MemType
ty Integer
n (ZeroExpr MemType
_) LLVMExpr s arch
a LLVMExpr s arch
i   = do
  Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertElt Instr
instr MemType
ty Integer
n (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
ty (Int -> LLVMExpr s arch -> Seq (LLVMExpr s arch)
forall a. Int -> a -> Seq a
Seq.replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
ZeroExpr MemType
ty))) LLVMExpr s arch
a LLVMExpr s arch
i

insertElt Instr
instr MemType
_ Integer
n (VecExpr MemType
ty Seq (LLVMExpr s arch)
vs) LLVMExpr s arch
a LLVMExpr s arch
i
  | Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
_) (BitvectorAsPointerExpr NatRepr w
_ Expr LLVM s (BVType w)
x) <- LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
i
  , App (BVLit NatRepr w
_ BV w
x') <- Expr LLVM s (BVType w)
x
  = Integer -> LLVMGenerator s arch ret (LLVMExpr s arch)
constantInsert (BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
x')
 where
 constantInsert :: Integer -> LLVMGenerator s arch ret (LLVMExpr s arch)
 constantInsert :: Integer -> LLVMGenerator s arch ret (LLVMExpr s arch)
constantInsert Integer
idx =
     if (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq (LLVMExpr s arch) -> Int
forall a. Seq a -> Int
Seq.length Seq (LLVMExpr s arch)
vs) Bool -> Bool -> Bool
&& (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
idx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n)
       then LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
ty (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ (LLVMExpr s arch -> LLVMExpr s arch)
-> Int -> Seq (LLVMExpr s arch) -> Seq (LLVMExpr s arch)
forall a. (a -> a) -> Int -> Seq a -> Seq a
Seq.adjust (\LLVMExpr s arch
_ -> LLVMExpr s arch
a) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
idx) Seq (LLVMExpr s arch)
vs
       else String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [String
"invalid insertelement instruction (index out of bounds)", Instr -> String
showInstr Instr
instr])

insertElt Instr
instr MemType
ty Integer
n (VecExpr MemType
_ Seq (LLVMExpr s arch)
vs) LLVMExpr s arch
a LLVMExpr s arch
i = do
   let ?err = ?err::String
      -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
   MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
ty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
tyr -> Proxy# arch
-> TypeRepr tp
-> [LLVMExpr s arch]
-> (Expr LLVM s (VectorType tp)
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (tpr :: CrucibleType) s (arch :: LLVMArch) a.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
Proxy# arch
-> TypeRepr tpr
-> [LLVMExpr s arch]
-> (Expr LLVM s (VectorType tpr) -> a)
-> a
unpackVec (Proxy# arch
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# arch) TypeRepr tp
tyr (Seq (LLVMExpr s arch) -> [LLVMExpr s arch]
forall a. Seq a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Seq (LLVMExpr s arch)
vs) ((Expr LLVM s (VectorType tp)
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (Expr LLVM s (VectorType tp)
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$
        \Expr LLVM s (VectorType tp)
ex -> Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertElt Instr
instr MemType
ty Integer
n (TypeRepr (VectorType tp)
-> Expr LLVM s (VectorType tp) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (TypeRepr tp -> TypeRepr (VectorType tp)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr tp
tyr) Expr LLVM s (VectorType tp)
ex) LLVMExpr s arch
a LLVMExpr s arch
i

insertElt Instr
instr MemType
_ Integer
n (BaseExpr (VectorRepr TypeRepr tp1
tyr) Expr LLVM s tp
v) LLVMExpr s arch
a LLVMExpr s arch
i =
  do GlobalVar Mem
mvar <- Generator LLVM s (LLVMState arch) ret IO (GlobalVar Mem)
forall s (arch :: LLVMArch) (reg :: CrucibleType).
LLVMGenerator s arch reg (GlobalVar Mem)
getMemVar
     (Expr LLVM s NatType
idx :: Expr LLVM s NatType)
         <- case LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
i of
                   Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x ->
                     do Expr LLVM s (BVType w)
bv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x
                        -- The value is poisoned if the index is out of bounds.
                        let poison :: Poison (Expr LLVM s)
poison = Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> Poison e
Poison.InsertElementIndex Expr LLVM s (BVType w)
bv
                        Expr LLVM s NatType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s NatType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s NatType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s NatType))
-> Expr LLVM s NatType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s NatType)
forall a b. (a -> b) -> a -> b
$
                          GlobalVar Mem
-> TypeRepr NatType
-> Poison (Expr LLVM s)
-> Expr LLVM s NatType
-> Expr LLVM s BoolType
-> Expr LLVM s NatType
forall (ty :: CrucibleType) s.
GlobalVar Mem
-> TypeRepr ty
-> Poison (Expr LLVM s)
-> Expr LLVM s ty
-> Expr LLVM s BoolType
-> Expr LLVM s ty
poisonSideCondition
                            GlobalVar Mem
mvar
                            TypeRepr NatType
NatRepr
                            Poison (Expr LLVM s)
poison
                            -- returned expression
                            (App LLVM (Expr LLVM s) NatType -> Expr LLVM s NatType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w) -> App LLVM (Expr LLVM s) NatType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> App ext f NatType
BvToNat NatRepr w
w Expr LLVM s (BVType w)
bv))
                            -- assertion condition
                            (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVUlt NatRepr w
w Expr LLVM s (BVType w)
bv (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w -> BV w -> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
n)))))
                   ScalarView s arch
_ ->
                     String
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s NatType)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [String
"invalid insertelement instruction", Instr -> String
showInstr Instr
instr, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
i])
     let ?err = ?err::String
      -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
     LLVMExpr s arch
-> (forall {tp :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tp
    -> Expr LLVM s tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (arch :: LLVMArch) s.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch
-> (forall (tpr :: CrucibleType).
    Proxy# arch -> TypeRepr tpr -> Expr LLVM s tpr -> a)
-> a
unpackOne LLVMExpr s arch
a ((forall {tp :: CrucibleType}.
  Proxy# arch
  -> TypeRepr tp
  -> Expr LLVM s tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tp
    -> Expr LLVM s tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \Proxy# arch
_archProxy TypeRepr tpr
tyra Expr LLVM s tpr
a' ->
      case TypeRepr tp1 -> TypeRepr tpr -> Maybe (tp1 :~: tpr)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality TypeRepr tp1
tyr TypeRepr tpr
tyra of
        Just tp1 :~: tpr
Refl ->
          LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('VectorType tp1)
-> Expr LLVM s ('VectorType tp1) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (TypeRepr tp1 -> TypeRepr ('VectorType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr tp1
tyr) (App LLVM (Expr LLVM s) ('VectorType tp1)
-> Expr LLVM s ('VectorType tp1)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (TypeRepr tp1
-> Expr LLVM s ('VectorType tp1)
-> Expr LLVM s NatType
-> Expr LLVM s tp1
-> App LLVM (Expr LLVM s) ('VectorType tp1)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> Type) ext.
TypeRepr tp1
-> f (VectorType tp1)
-> f NatType
-> f tp1
-> App ext f (VectorType tp1)
VectorSetEntry TypeRepr tp1
tyr Expr LLVM s tp
Expr LLVM s ('VectorType tp1)
v Expr LLVM s NatType
idx Expr LLVM s tp1
Expr LLVM s tpr
a'))
        Maybe (tp1 :~: tpr)
Nothing -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [String
"type mismatch in insertelement instruction", Instr -> String
showInstr Instr
instr])
insertElt Instr
instr MemType
_tp Integer
n LLVMExpr s arch
v LLVMExpr s arch
a LLVMExpr s arch
i = String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [String
"invalid insertelement instruction", Instr -> String
showInstr Instr
instr, Integer -> String
forall a. Show a => a -> String
show Integer
n, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
v, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
a, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
i])

-- Given an LLVM expression of vector or structure type, select out the
-- element indicated by the sequence of given concrete indices.
extractValue
    :: LLVMExpr s arch  -- ^ aggregate expression
    -> [Int32]     -- ^ sequence of indices
    -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue LLVMExpr s arch
v [] = LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LLVMExpr s arch
v
extractValue (UndefExpr (StructType StructInfo
si)) [Int32]
is =
   LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue (Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
StructExpr (Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch)
-> Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ [(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch)
forall a. [a] -> Seq a
Seq.fromList ([(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch))
-> [(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ (MemType -> (MemType, LLVMExpr s arch))
-> [MemType] -> [(MemType, LLVMExpr s arch)]
forall a b. (a -> b) -> [a] -> [b]
map (\MemType
tp -> (MemType
tp, MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
UndefExpr MemType
tp)) [MemType]
tps) [Int32]
is
 where tps :: [MemType]
tps = (FieldInfo -> MemType) -> [FieldInfo] -> [MemType]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> MemType
fiType ([FieldInfo] -> [MemType]) -> [FieldInfo] -> [MemType]
forall a b. (a -> b) -> a -> b
$ Vector FieldInfo -> [FieldInfo]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Vector FieldInfo -> [FieldInfo])
-> Vector FieldInfo -> [FieldInfo]
forall a b. (a -> b) -> a -> b
$ StructInfo -> Vector FieldInfo
siFields StructInfo
si
extractValue (UndefExpr (ArrayType Natural
n MemType
tp)) [Int32]
is =
   LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
tp (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ Int -> LLVMExpr s arch -> Seq (LLVMExpr s arch)
forall a. Int -> a -> Seq a
Seq.replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) (MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
UndefExpr MemType
tp)) [Int32]
is
extractValue (ZeroExpr (StructType StructInfo
si)) [Int32]
is =
   LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue (Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
StructExpr (Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch)
-> Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ [(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch)
forall a. [a] -> Seq a
Seq.fromList ([(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch))
-> [(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ (MemType -> (MemType, LLVMExpr s arch))
-> [MemType] -> [(MemType, LLVMExpr s arch)]
forall a b. (a -> b) -> [a] -> [b]
map (\MemType
tp -> (MemType
tp, MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
ZeroExpr MemType
tp)) [MemType]
tps) [Int32]
is
 where tps :: [MemType]
tps = (FieldInfo -> MemType) -> [FieldInfo] -> [MemType]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> MemType
fiType ([FieldInfo] -> [MemType]) -> [FieldInfo] -> [MemType]
forall a b. (a -> b) -> a -> b
$ Vector FieldInfo -> [FieldInfo]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Vector FieldInfo -> [FieldInfo])
-> Vector FieldInfo -> [FieldInfo]
forall a b. (a -> b) -> a -> b
$ StructInfo -> Vector FieldInfo
siFields StructInfo
si
extractValue (ZeroExpr (ArrayType Natural
n MemType
tp)) [Int32]
is =
   LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
tp (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ Int -> LLVMExpr s arch -> Seq (LLVMExpr s arch)
forall a. Int -> a -> Seq a
Seq.replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) (MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
ZeroExpr MemType
tp)) [Int32]
is
extractValue (StructExpr Seq (MemType, LLVMExpr s arch)
vs) (Int32
i:[Int32]
is)
   | Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq (MemType, LLVMExpr s arch) -> Int
forall a. Seq a -> Int
Seq.length Seq (MemType, LLVMExpr s arch)
vs = LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue ((MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a, b) -> b
snd ((MemType, LLVMExpr s arch) -> LLVMExpr s arch)
-> (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ Seq (MemType, LLVMExpr s arch) -> Int -> (MemType, LLVMExpr s arch)
forall a. Seq a -> Int -> a
Seq.index Seq (MemType, LLVMExpr s arch)
vs (Int -> (MemType, LLVMExpr s arch))
-> Int -> (MemType, LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i) [Int32]
is
extractValue (VecExpr MemType
_ Seq (LLVMExpr s arch)
vs) (Int32
i:[Int32]
is)
   | Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq (LLVMExpr s arch) -> Int
forall a. Seq a -> Int
Seq.length Seq (LLVMExpr s arch)
vs = LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue (Seq (LLVMExpr s arch) -> Int -> LLVMExpr s arch
forall a. Seq a -> Int -> a
Seq.index Seq (LLVMExpr s arch)
vs (Int -> LLVMExpr s arch) -> Int -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i) [Int32]
is
extractValue (BaseExpr (StructRepr CtxRepr ctx
ctx) Expr LLVM s tp
x) (Int32
i:[Int32]
is)
   | Just (Some Index ctx x
idx) <- Int -> Size ctx -> Maybe (Some (Index ctx))
forall {k} (ctx :: Ctx k).
Int -> Size ctx -> Maybe (Some (Index ctx))
Ctx.intIndex (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i) (CtxRepr ctx -> Size ctx
forall {k} (f :: k -> Type) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size CtxRepr ctx
ctx) = do
           let tpr :: TypeRepr x
tpr = CtxRepr ctx
ctx CtxRepr ctx -> Index ctx x -> TypeRepr x
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index ctx x
idx
           LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue (TypeRepr x -> Expr LLVM s x -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr x
tpr (Index ctx x -> Expr LLVM s ('StructType ctx) -> Expr LLVM s x
forall (e :: CrucibleType -> Type) (ctx :: Ctx CrucibleType)
       (tp :: CrucibleType).
IsExpr e =>
Index ctx tp -> e (StructType ctx) -> e tp
getStruct Index ctx x
idx Expr LLVM s tp
Expr LLVM s ('StructType ctx)
x)) [Int32]
is
extractValue (BaseExpr (VectorRepr TypeRepr tp1
elTp) Expr LLVM s tp
x) (Int32
i:[Int32]
is)
   | Int32
i Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
0 =
   do let n :: Natural
n = Int32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i :: Natural
      LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue (TypeRepr tp1 -> Expr LLVM s tp1 -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp1
elTp (App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp1 -> Expr LLVM s tp1
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (TypeRepr tp1
-> Expr LLVM s ('VectorType tp1)
-> Expr LLVM s NatType
-> App LLVM (Expr LLVM s) tp1
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext.
TypeRepr tp -> f (VectorType tp) -> f NatType -> App ext f tp
VectorGetEntry TypeRepr tp1
elTp Expr LLVM s tp
Expr LLVM s ('VectorType tp1)
x (Natural -> Expr LLVM s NatType
forall (e :: CrucibleType -> Type) (tp :: CrucibleType) ty.
(LitExpr e tp ty, IsExpr e) =>
ty -> e tp
litExpr Natural
n)))) [Int32]
is
extractValue LLVMExpr s arch
_ [Int32]
_ = String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"invalid extractValue instruction"


-- Given an LLVM expression of vector or structure type, insert a new element in the posistion
-- given by the concrete indices.
insertValue
    :: LLVMExpr s arch  -- ^ aggregate expression
    -> LLVMExpr s arch  -- ^ element to insert
    -> [Int32]     -- ^ sequence of concrete indices
    -> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue LLVMExpr s arch
_ LLVMExpr s arch
v [] = LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LLVMExpr s arch
v
insertValue (UndefExpr (StructType StructInfo
si)) LLVMExpr s arch
v [Int32]
is =
   LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue (Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
StructExpr (Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch)
-> Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ [(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch)
forall a. [a] -> Seq a
Seq.fromList ([(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch))
-> [(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ (MemType -> (MemType, LLVMExpr s arch))
-> [MemType] -> [(MemType, LLVMExpr s arch)]
forall a b. (a -> b) -> [a] -> [b]
map (\MemType
tp -> (MemType
tp, MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
UndefExpr MemType
tp)) [MemType]
tps) LLVMExpr s arch
v [Int32]
is
 where tps :: [MemType]
tps = (FieldInfo -> MemType) -> [FieldInfo] -> [MemType]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> MemType
fiType ([FieldInfo] -> [MemType]) -> [FieldInfo] -> [MemType]
forall a b. (a -> b) -> a -> b
$ Vector FieldInfo -> [FieldInfo]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Vector FieldInfo -> [FieldInfo])
-> Vector FieldInfo -> [FieldInfo]
forall a b. (a -> b) -> a -> b
$ StructInfo -> Vector FieldInfo
siFields StructInfo
si
insertValue (UndefExpr (ArrayType Natural
n MemType
tp)) LLVMExpr s arch
v [Int32]
is =
   LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
tp (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ Int -> LLVMExpr s arch -> Seq (LLVMExpr s arch)
forall a. Int -> a -> Seq a
Seq.replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) (MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
UndefExpr MemType
tp)) LLVMExpr s arch
v [Int32]
is
insertValue (ZeroExpr (StructType StructInfo
si)) LLVMExpr s arch
v [Int32]
is =
   LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue (Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
StructExpr (Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch)
-> Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ [(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch)
forall a. [a] -> Seq a
Seq.fromList ([(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch))
-> [(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ (MemType -> (MemType, LLVMExpr s arch))
-> [MemType] -> [(MemType, LLVMExpr s arch)]
forall a b. (a -> b) -> [a] -> [b]
map (\MemType
tp -> (MemType
tp, MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
ZeroExpr MemType
tp)) [MemType]
tps) LLVMExpr s arch
v [Int32]
is
 where tps :: [MemType]
tps = (FieldInfo -> MemType) -> [FieldInfo] -> [MemType]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> MemType
fiType ([FieldInfo] -> [MemType]) -> [FieldInfo] -> [MemType]
forall a b. (a -> b) -> a -> b
$ Vector FieldInfo -> [FieldInfo]
forall a. Vector a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Vector FieldInfo -> [FieldInfo])
-> Vector FieldInfo -> [FieldInfo]
forall a b. (a -> b) -> a -> b
$ StructInfo -> Vector FieldInfo
siFields StructInfo
si
insertValue (ZeroExpr (ArrayType Natural
n MemType
tp)) LLVMExpr s arch
v [Int32]
is =
   LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
tp (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ Int -> LLVMExpr s arch -> Seq (LLVMExpr s arch)
forall a. Int -> a -> Seq a
Seq.replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) (MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
ZeroExpr MemType
tp)) LLVMExpr s arch
v [Int32]
is
insertValue (StructExpr Seq (MemType, LLVMExpr s arch)
vs) LLVMExpr s arch
v (Int32
i:[Int32]
is)
   | Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq (MemType, LLVMExpr s arch) -> Int
forall a. Seq a -> Int
Seq.length Seq (MemType, LLVMExpr s arch)
vs = do
        let (MemType
xtp, LLVMExpr s arch
x) = Seq (MemType, LLVMExpr s arch) -> Int -> (MemType, LLVMExpr s arch)
forall a. Seq a -> Int -> a
Seq.index Seq (MemType, LLVMExpr s arch)
vs (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
        LLVMExpr s arch
x' <- LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue LLVMExpr s arch
x LLVMExpr s arch
v [Int32]
is
        LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
StructExpr (((MemType, LLVMExpr s arch) -> (MemType, LLVMExpr s arch))
-> Int
-> Seq (MemType, LLVMExpr s arch)
-> Seq (MemType, LLVMExpr s arch)
forall a. (a -> a) -> Int -> Seq a -> Seq a
Seq.adjust (\(MemType, LLVMExpr s arch)
_ -> (MemType
xtp,LLVMExpr s arch
x')) (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i) Seq (MemType, LLVMExpr s arch)
vs))
insertValue (VecExpr MemType
tp Seq (LLVMExpr s arch)
vs) LLVMExpr s arch
v (Int32
i:[Int32]
is)
   | Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq (LLVMExpr s arch) -> Int
forall a. Seq a -> Int
Seq.length Seq (LLVMExpr s arch)
vs = do
        let x :: LLVMExpr s arch
x = Seq (LLVMExpr s arch) -> Int -> LLVMExpr s arch
forall a. Seq a -> Int -> a
Seq.index Seq (LLVMExpr s arch)
vs (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
        LLVMExpr s arch
x' <- LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue LLVMExpr s arch
x LLVMExpr s arch
v [Int32]
is
        LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
tp ((LLVMExpr s arch -> LLVMExpr s arch)
-> Int -> Seq (LLVMExpr s arch) -> Seq (LLVMExpr s arch)
forall a. (a -> a) -> Int -> Seq a -> Seq a
Seq.adjust (\LLVMExpr s arch
_ -> LLVMExpr s arch
x') (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i) Seq (LLVMExpr s arch)
vs))
insertValue (BaseExpr (StructRepr CtxRepr ctx
ctx) Expr LLVM s tp
x) LLVMExpr s arch
v (Int32
i:[Int32]
is)
   | Just (Some Index ctx x
idx) <- Int -> Size ctx -> Maybe (Some (Index ctx))
forall {k} (ctx :: Ctx k).
Int -> Size ctx -> Maybe (Some (Index ctx))
Ctx.intIndex (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i) (CtxRepr ctx -> Size ctx
forall {k} (f :: k -> Type) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size CtxRepr ctx
ctx) = do
           let tpr :: TypeRepr x
tpr = CtxRepr ctx
ctx CtxRepr ctx -> Index ctx x -> TypeRepr x
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index ctx x
idx
           LLVMExpr s arch
x' <- LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue (TypeRepr x -> Expr LLVM s x -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr x
tpr (Index ctx x -> Expr LLVM s ('StructType ctx) -> Expr LLVM s x
forall (e :: CrucibleType -> Type) (ctx :: Ctx CrucibleType)
       (tp :: CrucibleType).
IsExpr e =>
Index ctx tp -> e (StructType ctx) -> e tp
getStruct Index ctx x
idx Expr LLVM s tp
Expr LLVM s ('StructType ctx)
x)) LLVMExpr s arch
v [Int32]
is
           let ?err = ?err::String
      -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
           LLVMExpr s arch
-> (forall {tpr :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tpr
    -> Expr LLVM s tpr
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (arch :: LLVMArch) s.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch
-> (forall (tpr :: CrucibleType).
    Proxy# arch -> TypeRepr tpr -> Expr LLVM s tpr -> a)
-> a
unpackOne LLVMExpr s arch
x' ((forall {tpr :: CrucibleType}.
  Proxy# arch
  -> TypeRepr tpr
  -> Expr LLVM s tpr
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tpr :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tpr
    -> Expr LLVM s tpr
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \Proxy# arch
_px TypeRepr tpr
tpr' Expr LLVM s tpr
x'' ->
             case TypeRepr x -> TypeRepr tpr -> Maybe (x :~: tpr)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality TypeRepr x
tpr TypeRepr tpr
tpr' of
               Just x :~: tpr
Refl -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('StructType ctx)
-> Expr LLVM s ('StructType ctx) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (CtxRepr ctx -> TypeRepr ('StructType ctx)
forall (ctx :: Ctx CrucibleType).
CtxRepr ctx -> TypeRepr ('StructType ctx)
StructRepr CtxRepr ctx
ctx) (CtxRepr ctx
-> Expr LLVM s ('StructType ctx)
-> Index ctx x
-> Expr LLVM s x
-> Expr LLVM s ('StructType ctx)
forall (e :: CrucibleType -> Type) (ctx :: Ctx CrucibleType)
       (tp :: CrucibleType).
IsExpr e =>
CtxRepr ctx
-> e (StructType ctx) -> Index ctx tp -> e tp -> e (StructType ctx)
setStruct CtxRepr ctx
ctx Expr LLVM s tp
Expr LLVM s ('StructType ctx)
x Index ctx x
idx Expr LLVM s x
Expr LLVM s tpr
x'')
               Maybe (x :~: tpr)
Nothing   -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"insertValue was expected to return base value of same type (struct case)"
insertValue (BaseExpr (VectorRepr TypeRepr tp1
elTp) Expr LLVM s tp
x) LLVMExpr s arch
v (Int32
i:[Int32]
is)
   | Int32
i Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
0 =
   do let n :: Natural
n = Int32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i :: Natural
      LLVMExpr s arch
x' <- LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue (TypeRepr tp1 -> Expr LLVM s tp1 -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp1
elTp (App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp1 -> Expr LLVM s tp1
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (TypeRepr tp1
-> Expr LLVM s ('VectorType tp1)
-> Expr LLVM s NatType
-> App LLVM (Expr LLVM s) tp1
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext.
TypeRepr tp -> f (VectorType tp) -> f NatType -> App ext f tp
VectorGetEntry TypeRepr tp1
elTp Expr LLVM s tp
Expr LLVM s ('VectorType tp1)
x (Natural -> Expr LLVM s NatType
forall (e :: CrucibleType -> Type) (tp :: CrucibleType) ty.
(LitExpr e tp ty, IsExpr e) =>
ty -> e tp
litExpr Natural
n)))) LLVMExpr s arch
v [Int32]
is
      let ?err = ?err::String
      -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
      LLVMExpr s arch
-> (forall {tpr :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tpr
    -> Expr LLVM s tpr
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (arch :: LLVMArch) s.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch
-> (forall (tpr :: CrucibleType).
    Proxy# arch -> TypeRepr tpr -> Expr LLVM s tpr -> a)
-> a
unpackOne LLVMExpr s arch
x' ((forall {tpr :: CrucibleType}.
  Proxy# arch
  -> TypeRepr tpr
  -> Expr LLVM s tpr
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tpr :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tpr
    -> Expr LLVM s tpr
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \Proxy# arch
_px TypeRepr tpr
tpr' Expr LLVM s tpr
x'' ->
        case TypeRepr tp1 -> TypeRepr tpr -> Maybe (tp1 :~: tpr)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality TypeRepr tp1
elTp TypeRepr tpr
tpr' of
          Just tp1 :~: tpr
Refl -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('VectorType tp1)
-> Expr LLVM s ('VectorType tp1) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (TypeRepr tp1 -> TypeRepr ('VectorType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr tp1
elTp) (App (ExprExt (Expr LLVM s)) (Expr LLVM s) ('VectorType tp1)
-> Expr LLVM s ('VectorType tp1)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (TypeRepr tp1
-> Expr LLVM s ('VectorType tp1)
-> Expr LLVM s NatType
-> Expr LLVM s tp1
-> App LLVM (Expr LLVM s) ('VectorType tp1)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> Type) ext.
TypeRepr tp1
-> f (VectorType tp1)
-> f NatType
-> f tp1
-> App ext f (VectorType tp1)
VectorSetEntry TypeRepr tp1
elTp Expr LLVM s tp
Expr LLVM s ('VectorType tp1)
x (Natural -> Expr LLVM s NatType
forall (e :: CrucibleType -> Type) (tp :: CrucibleType) ty.
(LitExpr e tp ty, IsExpr e) =>
ty -> e tp
litExpr Natural
n) Expr LLVM s tp1
Expr LLVM s tpr
x''))
          Maybe (tp1 :~: tpr)
Nothing   -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"insertValue was expected to return base value of same type (vector case)"
insertValue LLVMExpr s arch
_ LLVMExpr s arch
_ [Int32]
_ = String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"invalid insertValue instruction"



evalGEP :: forall s arch ret wptr.
  wptr ~ ArchWidth arch =>
  L.Instr ->
  GEPResult (LLVMExpr s arch) ->
  LLVMGenerator s arch ret (LLVMExpr s arch)
evalGEP :: forall s (arch :: LLVMArch) (ret :: CrucibleType)
       (wptr :: Natural).
(wptr ~ ArchWidth arch) =>
Instr
-> GEPResult (LLVMExpr s arch)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
evalGEP Instr
instr (GEPResult NatRepr n
_lanes MemType
finalMemType GEP n (LLVMExpr s arch)
gep0) = Seq (Expr LLVM s (LLVMPointerType wptr))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
finish (Seq (Expr LLVM s (LLVMPointerType wptr))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Seq (Expr LLVM s (LLVMPointerType wptr)))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< GEP n (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall (n :: Natural).
GEP n (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
go GEP n (LLVMExpr s arch)
gep0
 where
 finish :: Seq (Expr LLVM s (LLVMPointerType wptr))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
finish Seq (Expr LLVM s (LLVMPointerType wptr))
xs =
   case Seq (Expr LLVM s (LLVMPointerType wptr))
-> ViewL (Expr LLVM s (LLVMPointerType wptr))
forall a. Seq a -> ViewL a
Seq.viewl Seq (Expr LLVM s (LLVMPointerType wptr))
xs of
     Expr LLVM s (LLVMPointerType wptr)
x Seq.:< (Seq (Expr LLVM s (LLVMPointerType wptr)) -> Bool
forall a. Seq a -> Bool
Seq.null -> Bool
True) -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr (LLVMPointerType wptr)
forall (wptr :: Natural) (ty :: CrucibleType).
(HasPtrWidth wptr, ty ~ LLVMPointerType wptr) =>
TypeRepr ty
PtrRepr Expr LLVM s (LLVMPointerType wptr)
x)
     ViewL (Expr LLVM s (LLVMPointerType wptr))
_ -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr (SymType -> MemType
PtrType (MemType -> SymType
MemType MemType
finalMemType)) ((Expr LLVM s (LLVMPointerType wptr) -> LLVMExpr s arch)
-> Seq (Expr LLVM s (LLVMPointerType wptr))
-> Seq (LLVMExpr s arch)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeRepr (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr (LLVMPointerType wptr)
forall (wptr :: Natural) (ty :: CrucibleType).
(HasPtrWidth wptr, ty ~ LLVMPointerType wptr) =>
TypeRepr ty
PtrRepr) Seq (Expr LLVM s (LLVMPointerType wptr))
xs))

 badGEP :: LLVMGenerator s arch ret a
 badGEP :: forall a. LLVMGenerator s arch ret a
badGEP = String -> Generator LLVM s (LLVMState arch) ret IO a
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO a)
-> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"Unexpected failure when evaluating GEP", Instr -> String
showInstr Instr
instr]

 asPtr :: LLVMExpr s arch -> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
 asPtr :: LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
asPtr LLVMExpr s arch
x =
   case LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x of
     Scalar Proxy# arch
_archProxy TypeRepr tp
PtrRepr Expr LLVM s tp
p -> Expr LLVM s (LLVMPointerType wptr)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr LLVM s tp
Expr LLVM s (LLVMPointerType wptr)
p
     ScalarView s arch
_ -> Generator
  LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
forall a. LLVMGenerator s arch ret a
badGEP

 go :: GEP n (LLVMExpr s arch) -> LLVMGenerator s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))

 go :: forall (n :: Natural).
GEP n (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
go (GEP_scalar_base LLVMExpr s arch
x) =
      do Expr LLVM s (LLVMPointerType wptr)
p <- LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
asPtr LLVMExpr s arch
x
         Seq (Expr LLVM s (LLVMPointerType wptr))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (LLVMPointerType wptr)
-> Seq (Expr LLVM s (LLVMPointerType wptr))
forall a. a -> Seq a
Seq.singleton Expr LLVM s (LLVMPointerType wptr)
p)

 go (GEP_vector_base NatRepr n
n LLVMExpr s arch
x) =
      do Seq (Expr LLVM s (LLVMPointerType wptr))
xs <- Generator
  LLVM
  s
  (LLVMState arch)
  ret
  IO
  (Seq (Expr LLVM s (LLVMPointerType wptr)))
-> (Seq (LLVMExpr s arch)
    -> Generator
         LLVM
         s
         (LLVMState arch)
         ret
         IO
         (Seq (Expr LLVM s (LLVMPointerType wptr))))
-> Maybe (Seq (LLVMExpr s arch))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Generator
  LLVM
  s
  (LLVMState arch)
  ret
  IO
  (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall a. LLVMGenerator s arch ret a
badGEP ((LLVMExpr s arch
 -> Generator
      LLVM
      s
      (LLVMState arch)
      ret
      IO
      (Expr LLVM s (LLVMPointerType wptr)))
-> Seq (LLVMExpr s arch)
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse (\LLVMExpr s arch
y -> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
asPtr LLVMExpr s arch
y)) (LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
asVector LLVMExpr s arch
x)
         Bool
-> Generator LLVM s (LLVMState arch) ret IO ()
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Seq (Expr LLVM s (LLVMPointerType wptr)) -> Int
forall a. Seq a -> Int
Seq.length Seq (Expr LLVM s (LLVMPointerType wptr))
xs) Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== NatRepr n -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr n
n) Generator LLVM s (LLVMState arch) ret IO ()
forall a. LLVMGenerator s arch ret a
badGEP
         Seq (Expr LLVM s (LLVMPointerType wptr))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Seq (Expr LLVM s (LLVMPointerType wptr))
xs

 go (GEP_scatter NatRepr n
n GEP 1 (LLVMExpr s arch)
gep) =
      do Seq (Expr LLVM s (LLVMPointerType wptr))
xs <- GEP 1 (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall (n :: Natural).
GEP n (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
go GEP 1 (LLVMExpr s arch)
gep
         Bool
-> Generator LLVM s (LLVMState arch) ret IO ()
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Seq (Expr LLVM s (LLVMPointerType wptr)) -> Int
forall a. Seq a -> Int
Seq.length Seq (Expr LLVM s (LLVMPointerType wptr))
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) Generator LLVM s (LLVMState arch) ret IO ()
forall a. LLVMGenerator s arch ret a
badGEP
         Seq (Expr LLVM s (LLVMPointerType wptr))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int
-> Seq (Expr LLVM s (LLVMPointerType wptr))
-> Seq (Expr LLVM s (LLVMPointerType wptr))
forall a. Int -> Seq a -> Seq a
Seq.cycleTaking (NatRepr n -> Int
forall (n :: Natural). NatRepr n -> Int
widthVal NatRepr n
n) Seq (Expr LLVM s (LLVMPointerType wptr))
xs)

 go (GEP_field FieldInfo
fi GEP n (LLVMExpr s arch)
gep) =
      do Seq (Expr LLVM s (LLVMPointerType wptr))
xs <- GEP n (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall (n :: Natural).
GEP n (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
go GEP n (LLVMExpr s arch)
gep
         (Expr LLVM s (LLVMPointerType wptr)
 -> Generator
      LLVM
      s
      (LLVMState arch)
      ret
      IO
      (Expr LLVM s (LLVMPointerType wptr)))
-> Seq (Expr LLVM s (LLVMPointerType wptr))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse (\Expr LLVM s (LLVMPointerType wptr)
x -> FieldInfo
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
FieldInfo
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
calcGEP_struct FieldInfo
fi Expr LLVM s (LLVMPointerType wptr)
x) Seq (Expr LLVM s (LLVMPointerType wptr))
xs

 go (GEP_index_each MemType
mt' GEP n (LLVMExpr s arch)
gep LLVMExpr s arch
idx) =
      do Seq (Expr LLVM s (LLVMPointerType wptr))
xs <- GEP n (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall (n :: Natural).
GEP n (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
go GEP n (LLVMExpr s arch)
gep
         (Expr LLVM s (LLVMPointerType wptr)
 -> Generator
      LLVM
      s
      (LLVMState arch)
      ret
      IO
      (Expr LLVM s (LLVMPointerType wptr)))
-> Seq (Expr LLVM s (LLVMPointerType wptr))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse (\Expr LLVM s (LLVMPointerType wptr)
x -> MemType
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (wptr :: Natural) s (arch :: LLVMArch)
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
MemType
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
calcGEP_array MemType
mt' Expr LLVM s (LLVMPointerType wptr)
x LLVMExpr s arch
idx) Seq (Expr LLVM s (LLVMPointerType wptr))
xs

 go (GEP_index_vector MemType
mt' GEP n (LLVMExpr s arch)
gep LLVMExpr s arch
idx) =
      do Seq (Expr LLVM s (LLVMPointerType wptr))
xs <- GEP n (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall (n :: Natural).
GEP n (LLVMExpr s arch)
-> LLVMGenerator
     s arch ret (Seq (Expr LLVM s (LLVMPointerType wptr)))
go GEP n (LLVMExpr s arch)
gep
         Seq (LLVMExpr s arch)
idxs <- Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
-> (Seq (LLVMExpr s arch)
    -> Generator
         LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch)))
-> Maybe (Seq (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall a. LLVMGenerator s arch ret a
badGEP Seq (LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
asVector LLVMExpr s arch
idx)
         Bool
-> Generator LLVM s (LLVMState arch) ret IO ()
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Seq (LLVMExpr s arch) -> Int
forall a. Seq a -> Int
Seq.length Seq (LLVMExpr s arch)
idxs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq (Expr LLVM s (LLVMPointerType wptr)) -> Int
forall a. Seq a -> Int
Seq.length Seq (Expr LLVM s (LLVMPointerType wptr))
xs) Generator LLVM s (LLVMState arch) ret IO ()
forall a. LLVMGenerator s arch ret a
badGEP
         ((Expr LLVM s (LLVMPointerType wptr), LLVMExpr s arch)
 -> Generator
      LLVM
      s
      (LLVMState arch)
      ret
      IO
      (Expr LLVM s (LLVMPointerType wptr)))
-> Seq (Expr LLVM s (LLVMPointerType wptr), LLVMExpr s arch)
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Seq (Expr LLVM s (LLVMPointerType wptr)))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse (\(Expr LLVM s (LLVMPointerType wptr)
x,LLVMExpr s arch
i) -> MemType
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (wptr :: Natural) s (arch :: LLVMArch)
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
MemType
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
calcGEP_array MemType
mt' Expr LLVM s (LLVMPointerType wptr)
x LLVMExpr s arch
i) (Seq (Expr LLVM s (LLVMPointerType wptr))
-> Seq (LLVMExpr s arch)
-> Seq (Expr LLVM s (LLVMPointerType wptr), LLVMExpr s arch)
forall a b. Seq a -> Seq b -> Seq (a, b)
Seq.zip Seq (Expr LLVM s (LLVMPointerType wptr))
xs Seq (LLVMExpr s arch)
idxs)


calcGEP_array :: forall wptr s arch ret.
  wptr ~ ArchWidth arch =>
  MemType {- ^ Type of the array elements -} ->
  Expr LLVM s (LLVMPointerType wptr) {- ^ Base pointer -} ->
  LLVMExpr s arch {- ^ index value -} ->
  LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
calcGEP_array :: forall (wptr :: Natural) s (arch :: LLVMArch)
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
MemType
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
calcGEP_array MemType
_typ Expr LLVM s (LLVMPointerType wptr)
base (ZeroExpr MemType
_) = Expr LLVM s (LLVMPointerType wptr)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr LLVM s (LLVMPointerType wptr)
base
  -- If the array index is the concrete number 0, then return the base
  -- pointer unchanged.
calcGEP_array MemType
typ Expr LLVM s (LLVMPointerType wptr)
base LLVMExpr s arch
idx =
  do -- sign-extend the index value if necessary to make it
     -- the same width as a pointer
     (Expr LLVM s (BVType wptr)
idx' :: Expr LLVM s (BVType wptr))
       <- case LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
idx of
              Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x
                 | Just w :~: wptr
Refl <- NatRepr w -> NatRepr wptr -> Maybe (w :~: wptr)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth ->
                      NatRepr wptr
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType wptr))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Expr LLVM s tp
Expr LLVM s (LLVMPointerType wptr)
x
                 | Just LeqProof (w + 1) wptr
LeqProof <- NatRepr (w + 1) -> NatRepr wptr -> Maybe (LeqProof (w + 1) wptr)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr w -> NatRepr (w + 1)
forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat NatRepr w
w) NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth ->
                   do Expr LLVM s (BVType w)
x' <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x
                      Expr LLVM s (BVType wptr)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType wptr))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (BVType wptr)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType wptr)))
-> Expr LLVM s (BVType wptr)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType wptr))
forall a b. (a -> b) -> a -> b
$ App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
-> Expr LLVM s (BVType wptr)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (NatRepr wptr
-> NatRepr w
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType wptr)
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVSext NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth NatRepr w
w Expr LLVM s (BVType w)
x')
              ScalarView s arch
_ -> String
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType wptr))
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType wptr)))
-> String
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType wptr))
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Invalid index value in GEP", LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
idx]

     -- Calculate the size of the element memtype and check that it fits
     -- in the pointer width
     let dl :: DataLayout
dl  = TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc
     let isz :: Integer
isz = Bytes -> Integer
G.bytesToInteger (Bytes -> Integer) -> Bytes -> Integer
forall a b. (a -> b) -> a -> b
$ DataLayout -> MemType -> Bytes
memTypeSize DataLayout
dl MemType
typ
     Bool
-> Generator LLVM s (LLVMState arch) ret IO ()
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Integer
isz Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= NatRepr wptr -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth)
       (String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO ())
-> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Type size too large for pointer width:", MemType -> String
forall a. Show a => a -> String
show MemType
typ])

     -- Perform the multiply
     GlobalVar Mem
mvar <- Generator LLVM s (LLVMState arch) ret IO (GlobalVar Mem)
forall s (arch :: LLVMArch) (reg :: CrucibleType).
LLVMGenerator s arch reg (GlobalVar Mem)
getMemVar
     Expr LLVM s (BVType wptr)
off0 <- Atom s (BVType wptr) -> Expr LLVM s (BVType wptr)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s (BVType wptr) -> Expr LLVM s (BVType wptr))
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType wptr))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType wptr))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr LLVM s (BVType wptr)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType wptr))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (Expr LLVM s (BVType wptr)
 -> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType wptr)))
-> Expr LLVM s (BVType wptr)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType wptr))
forall a b. (a -> b) -> a -> b
$ App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
-> Expr LLVM s (BVType wptr)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
 -> Expr LLVM s (BVType wptr))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
-> Expr LLVM s (BVType wptr)
forall a b. (a -> b) -> a -> b
$ NatRepr wptr
-> Expr LLVM s (BVType wptr)
-> Expr LLVM s (BVType wptr)
-> App LLVM (Expr LLVM s) (BVType wptr)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVMul NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
-> Expr LLVM s (BVType wptr)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
 -> Expr LLVM s (BVType wptr))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
-> Expr LLVM s (BVType wptr)
forall a b. (a -> b) -> a -> b
$ NatRepr wptr -> BV wptr -> App LLVM (Expr LLVM s) (BVType wptr)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (NatRepr wptr -> Integer -> BV wptr
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Integer
isz)) Expr LLVM s (BVType wptr)
idx')
     let off :: Expr LLVM s (BVType wptr)
off  =
           if Integer
isz Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
           then Expr LLVM s (BVType wptr)
off0
           else
             let
               -- Compute safe upper and lower bounds for the index value to
               -- prevent multiplication overflow. Note that `minidx <= idx <=
               -- maxidx` iff `MININT <= (isz * idx) <= MAXINT` when `isz` and
               -- `idx` are considered as infinite precision integers. This
               -- property holds only if we use `quot` (which rounds toward 0)
               -- for the divisions in the following definitions.

               -- maximum and minimum indices to prevent multiplication overflow
               maxidx :: Integer
maxidx = NatRepr wptr -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
isz Integer
1)
               minidx :: Integer
minidx = NatRepr wptr -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
isz Integer
1)
               poison :: Poison (Expr LLVM s)
poison = Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (BVType wptr) -> Poison (Expr LLVM s)
forall (w :: Natural) (wptr :: Natural)
       (e :: CrucibleType -> Type).
(1 <= w, 1 <= wptr) =>
e (LLVMPointerType wptr) -> e (BVType w) -> Poison e
Poison.GEPOutOfBounds Expr LLVM s (LLVMPointerType wptr)
base Expr LLVM s (BVType wptr)
idx'
               cond :: Expr LLVM s BoolType
cond   =
                (App (ExprExt (Expr LLVM s)) (Expr LLVM s) BoolType
-> Expr LLVM s BoolType
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) BoolType
 -> Expr LLVM s BoolType)
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) BoolType
-> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ NatRepr wptr
-> Expr LLVM s (BVType wptr)
-> Expr LLVM s (BVType wptr)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVSle NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
-> Expr LLVM s (BVType wptr)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
 -> Expr LLVM s (BVType wptr))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
-> Expr LLVM s (BVType wptr)
forall a b. (a -> b) -> a -> b
$ NatRepr wptr -> BV wptr -> App LLVM (Expr LLVM s) (BVType wptr)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (NatRepr wptr -> Integer -> BV wptr
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Integer
minidx)) Expr LLVM s (BVType wptr)
idx') Expr LLVM s BoolType
-> Expr LLVM s BoolType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type).
IsExpr e =>
e BoolType -> e BoolType -> e BoolType
.&&
                  (App (ExprExt (Expr LLVM s)) (Expr LLVM s) BoolType
-> Expr LLVM s BoolType
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) BoolType
 -> Expr LLVM s BoolType)
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) BoolType
-> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ NatRepr wptr
-> Expr LLVM s (BVType wptr)
-> Expr LLVM s (BVType wptr)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVSle NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Expr LLVM s (BVType wptr)
idx' (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
-> Expr LLVM s (BVType wptr)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
 -> Expr LLVM s (BVType wptr))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType wptr)
-> Expr LLVM s (BVType wptr)
forall a b. (a -> b) -> a -> b
$ NatRepr wptr -> BV wptr -> App LLVM (Expr LLVM s) (BVType wptr)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (NatRepr wptr -> Integer -> BV wptr
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Integer
maxidx)))
             in
               -- Multiplication overflow will result in a pointer which is not "in
               -- bounds" for the given allocation. We translate all GEP
               -- instructions as if they had the `inbounds` flag set, so the
               -- result would be a poison value.
               GlobalVar Mem
-> TypeRepr (BVType wptr)
-> Poison (Expr LLVM s)
-> Expr LLVM s (BVType wptr)
-> Expr LLVM s BoolType
-> Expr LLVM s (BVType wptr)
forall (ty :: CrucibleType) s.
GlobalVar Mem
-> TypeRepr ty
-> Poison (Expr LLVM s)
-> Expr LLVM s ty
-> Expr LLVM s BoolType
-> Expr LLVM s ty
poisonSideCondition GlobalVar Mem
mvar (NatRepr wptr -> TypeRepr (BVType wptr)
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth) Poison (Expr LLVM s)
poison Expr LLVM s (BVType wptr)
off0 Expr LLVM s BoolType
cond

     -- Perform the pointer offset arithmetic
     Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (BVType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (BVType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
callPtrAddOffset Expr LLVM s (LLVMPointerType wptr)
base Expr LLVM s (BVType wptr)
off


calcGEP_struct ::
  wptr ~ ArchWidth arch =>
  FieldInfo ->
  Expr LLVM s (LLVMPointerType wptr) ->
  LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
calcGEP_struct :: forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
FieldInfo
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
calcGEP_struct FieldInfo
fi Expr LLVM s (LLVMPointerType wptr)
base =
  do -- Get the field offset and check that it fits
     -- in the pointer width
     let ioff :: Integer
ioff = Bytes -> Integer
G.bytesToInteger (Bytes -> Integer) -> Bytes -> Integer
forall a b. (a -> b) -> a -> b
$ FieldInfo -> Bytes
fiOffset FieldInfo
fi
     Bool
-> Generator LLVM s (LLVMState arch) ret IO ()
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Integer
ioff Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= NatRepr wptr -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth)
       (String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO ())
-> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Field offset too large for pointer width in structure:", Integer -> String
forall a. Show a => a -> String
show Integer
ioff])
     let off :: Expr LLVM s ('BaseToType (BaseBVType wptr))
off = App
  (ExprExt (Expr LLVM s))
  (Expr LLVM s)
  ('BaseToType (BaseBVType wptr))
-> Expr LLVM s ('BaseToType (BaseBVType wptr))
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App
   (ExprExt (Expr LLVM s))
   (Expr LLVM s)
   ('BaseToType (BaseBVType wptr))
 -> Expr LLVM s ('BaseToType (BaseBVType wptr)))
-> App
     (ExprExt (Expr LLVM s))
     (Expr LLVM s)
     ('BaseToType (BaseBVType wptr))
-> Expr LLVM s ('BaseToType (BaseBVType wptr))
forall a b. (a -> b) -> a -> b
$ NatRepr wptr
-> BV wptr
-> App
     (ExprExt (Expr LLVM s))
     (Expr LLVM s)
     ('BaseToType (BaseBVType wptr))
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (BV wptr
 -> App
      (ExprExt (Expr LLVM s))
      (Expr LLVM s)
      ('BaseToType (BaseBVType wptr)))
-> BV wptr
-> App
     (ExprExt (Expr LLVM s))
     (Expr LLVM s)
     ('BaseToType (BaseBVType wptr))
forall a b. (a -> b) -> a -> b
$ NatRepr wptr -> Integer -> BV wptr
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Integer
ioff

     -- Perform the pointer arithmetic and continue
     -- Skip pointer arithmetic when offset is 0
     if Integer
ioff Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Expr LLVM s (LLVMPointerType wptr)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr LLVM s (LLVMPointerType wptr)
base else Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s ('BaseToType (BaseBVType wptr))
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (BVType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
callPtrAddOffset Expr LLVM s (LLVMPointerType wptr)
base Expr LLVM s ('BaseToType (BaseBVType wptr))
off


translateConversion :: (?transOpts :: TranslationOptions) =>
  L.Instr ->
  L.ConvOp ->
  MemType {- Input type -} ->
  LLVMExpr s arch {- Value to convert -} ->
  MemType {- Output type -} ->
  LLVMGenerator s arch ret (LLVMExpr s arch)

-- Bitcast is a bit of a special case, handle separately
translateConversion :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
Instr
-> ConvOp
-> MemType
-> LLVMExpr s arch
-> MemType
-> LLVMGenerator s arch ret (LLVMExpr s arch)
translateConversion Instr
_instr ConvOp
L.BitCast MemType
inty LLVMExpr s arch
x MemType
outty = MemType
-> LLVMExpr s arch
-> MemType
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
MemType
-> LLVMExpr s arch
-> MemType
-> LLVMGenerator s arch ret (LLVMExpr s arch)
bitCast MemType
inty LLVMExpr s arch
x MemType
outty

-- Perform translations pointwise on vectors
translateConversion Instr
instr ConvOp
op (VecType Natural
n MemType
inty) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
xs) (VecType Natural
m MemType
outty)
  | Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
m = MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
outty (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Seq (LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse (\LLVMExpr s arch
x -> Instr
-> ConvOp
-> MemType
-> LLVMExpr s arch
-> MemType
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
Instr
-> ConvOp
-> MemType
-> LLVMExpr s arch
-> MemType
-> LLVMGenerator s arch ret (LLVMExpr s arch)
translateConversion Instr
instr ConvOp
op MemType
inty LLVMExpr s arch
x MemType
outty) Seq (LLVMExpr s arch)
xs

-- Otherwise, assume scalar values and do the basic conversions
translateConversion Instr
instr ConvOp
op MemType
_inty LLVMExpr s arch
x MemType
outty =
 let showI :: String
showI = Instr -> String
showInstr Instr
instr in
 case ConvOp
op of
    ConvOp
L.IntToPtr -> do
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
_, LLVMPointerRepr NatRepr w
w')
              | Just w :~: ArchWidth arch
Refl <- NatRepr w
-> NatRepr (ArchWidth arch) -> Maybe (w :~: ArchWidth arch)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth
              , Just w :~: w
Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w' NatRepr w
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LLVMExpr s arch
x
           (Scalar Proxy# arch
_ TypeRepr tp
t Expr LLVM s tp
v, TypeRepr tp
a)   ->
               String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [String
"integer-to-pointer conversion failed: "
                             , String
showI
                             , Expr LLVM s tp -> String
forall a. Show a => a -> String
show Expr LLVM s tp
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc Any -> String
forall a. Show a => a -> String
show (TypeRepr tp -> Doc Any
forall ann. TypeRepr tp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TypeRepr tp
t) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -to- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc Any -> String
forall a. Show a => a -> String
show (TypeRepr tp -> Doc Any
forall ann. TypeRepr tp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TypeRepr tp
a)
                             ])
           (ScalarView s arch
NotScalar, TypeRepr tp
_) -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [String
"integer-to-pointer conversion failed: non scalar", String
showI])

    ConvOp
L.PtrToInt -> do
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
_, LLVMPointerRepr NatRepr w
w')
              | Just w :~: ArchWidth arch
Refl <- NatRepr w
-> NatRepr (ArchWidth arch) -> Maybe (w :~: ArchWidth arch)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth
              , Just w :~: w
Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w' NatRepr w
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LLVMExpr s arch
x
           (ScalarView s arch, TypeRepr tp)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [String
"pointer-to-integer conversion failed", String
showI])

    ConvOp
L.Trunc -> do
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x', (LLVMPointerRepr NatRepr w
w'))
             | Just LeqProof 1 w
LeqProof <- NatRepr w -> Maybe (LeqProof 1 w)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr w
w'
             , Just LeqProof (w + 1) w
LeqProof <- NatRepr (w + 1) -> NatRepr w -> Maybe (LeqProof (w + 1) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr w -> NatRepr (w + 1)
forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat NatRepr w
w') NatRepr w
w ->
                 do Expr LLVM s (BVType w)
x_bv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x'
                    let bv' :: Expr LLVM s ('BaseToType (BaseBVType w))
bv' = App LLVM (Expr LLVM s) ('BaseToType (BaseBVType w))
-> Expr LLVM s ('BaseToType (BaseBVType w))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> NatRepr w
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType w))
forall (r :: Natural) (w :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= r, (r + 1) <= w) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVTrunc NatRepr w
w' NatRepr w
w Expr LLVM s (BVType w)
x_bv)
                    LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp
outty' (NatRepr w
-> Expr LLVM s ('BaseToType (BaseBVType w))
-> Expr LLVM s (LLVMPointerType w)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr w
w' Expr LLVM s ('BaseToType (BaseBVType w))
bv'))
           (ScalarView s arch, TypeRepr tp)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [[String] -> String
unwords [String
"invalid truncation:", LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, MemType -> String
forall a. Show a => a -> String
show MemType
outty], String
showI])

    ConvOp
L.ZExt -> do
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x', (LLVMPointerRepr NatRepr w
w'))
             | Just LeqProof 1 w
LeqProof <- NatRepr w -> Maybe (LeqProof 1 w)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr w
w
             , Just LeqProof (w + 1) w
LeqProof <- NatRepr (w + 1) -> NatRepr w -> Maybe (LeqProof (w + 1) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr w -> NatRepr (w + 1)
forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat NatRepr w
w) NatRepr w
w' ->
                 do Expr LLVM s (BVType w)
x_bv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x'
                    let bv' :: Expr LLVM s ('BaseToType (BaseBVType w))
bv' = App LLVM (Expr LLVM s) ('BaseToType (BaseBVType w))
-> Expr LLVM s ('BaseToType (BaseBVType w))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> NatRepr w
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType w))
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVZext NatRepr w
w' NatRepr w
w Expr LLVM s (BVType w)
x_bv)
                    LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp
outty' (NatRepr w
-> Expr LLVM s ('BaseToType (BaseBVType w))
-> Expr LLVM s (LLVMPointerType w)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr w
w' Expr LLVM s ('BaseToType (BaseBVType w))
bv'))
           (ScalarView s arch, TypeRepr tp)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [[String] -> String
unwords [String
"invalid zero extension:", LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, MemType -> String
forall a. Show a => a -> String
show MemType
outty], String
showI])

    ConvOp
L.SExt -> do
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x', (LLVMPointerRepr NatRepr w
w'))
             | Just LeqProof 1 w
LeqProof <- NatRepr w -> Maybe (LeqProof 1 w)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr w
w
             , Just LeqProof (w + 1) w
LeqProof <- NatRepr (w + 1) -> NatRepr w -> Maybe (LeqProof (w + 1) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr w -> NatRepr (w + 1)
forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat NatRepr w
w) NatRepr w
w' -> do
                 do Expr LLVM s (BVType w)
x_bv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x'
                    let bv' :: Expr LLVM s ('BaseToType (BaseBVType w))
bv' = App LLVM (Expr LLVM s) ('BaseToType (BaseBVType w))
-> Expr LLVM s ('BaseToType (BaseBVType w))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> NatRepr w
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType w))
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVSext NatRepr w
w' NatRepr w
w Expr LLVM s (BVType w)
x_bv)
                    LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp
outty' (NatRepr w
-> Expr LLVM s ('BaseToType (BaseBVType w))
-> Expr LLVM s (LLVMPointerType w)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr w
w' Expr LLVM s ('BaseToType (BaseBVType w))
bv'))
           (ScalarView s arch, TypeRepr tp)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [[String] -> String
unwords [String
"invalid sign extension", LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, MemType -> String
forall a. Show a => a -> String
show MemType
outty], String
showI])

#if __GLASGOW_HASKELL__ < 900
    -- This is redundant, but GHC's pattern-match coverage checker is only
    -- smart enough to realize this in 9.0 or later.
    L.BitCast -> bitCast _inty x outty
#endif

    ConvOp
L.UiToFp -> do
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x', FloatRepr FloatInfoRepr flt
fi) -> do
             Expr LLVM s (BVType w)
bv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x'
             LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('FloatType flt)
-> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (FloatInfoRepr flt -> TypeRepr ('FloatType flt)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr flt
fi) (Expr LLVM s ('FloatType flt) -> LLVMExpr s arch)
-> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) ('FloatType flt)
-> Expr LLVM s ('FloatType flt)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) ('FloatType flt)
 -> Expr LLVM s ('FloatType flt))
-> App LLVM (Expr LLVM s) ('FloatType flt)
-> Expr LLVM s ('FloatType flt)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr flt
-> RoundingMode
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('FloatType flt)
forall (w :: Natural) (fi :: FloatInfo) (f :: CrucibleType -> Type)
       ext.
(1 <= w) =>
FloatInfoRepr fi
-> RoundingMode -> f (BVType w) -> App ext f ('FloatType fi)
FloatFromBV FloatInfoRepr flt
fi RoundingMode
RNE Expr LLVM s (BVType w)
bv
           (ScalarView s arch, TypeRepr tp)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [[String] -> String
unwords [String
"Invalid uitofp:", ConvOp -> String
forall a. Show a => a -> String
show ConvOp
op, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, MemType -> String
forall a. Show a => a -> String
show MemType
outty], String
showI])

    ConvOp
L.SiToFp -> do
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x', FloatRepr FloatInfoRepr flt
fi) -> do
             Expr LLVM s (BVType w)
bv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x'
             LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('FloatType flt)
-> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (FloatInfoRepr flt -> TypeRepr ('FloatType flt)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr flt
fi) (Expr LLVM s ('FloatType flt) -> LLVMExpr s arch)
-> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) ('FloatType flt)
-> Expr LLVM s ('FloatType flt)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) ('FloatType flt)
 -> Expr LLVM s ('FloatType flt))
-> App LLVM (Expr LLVM s) ('FloatType flt)
-> Expr LLVM s ('FloatType flt)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr flt
-> RoundingMode
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('FloatType flt)
forall (w :: Natural) (fi :: FloatInfo) (f :: CrucibleType -> Type)
       ext.
(1 <= w) =>
FloatInfoRepr fi
-> RoundingMode -> f (BVType w) -> App ext f ('FloatType fi)
FloatFromSBV FloatInfoRepr flt
fi RoundingMode
RNE Expr LLVM s (BVType w)
bv
           (ScalarView s arch, TypeRepr tp)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [[String] -> String
unwords [String
"Invalid sitofp:", ConvOp -> String
forall a. Show a => a -> String
show ConvOp
op, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, MemType -> String
forall a. Show a => a -> String
show MemType
outty], String
showI])

    ConvOp
L.FpToUi -> do
       let demoteToInt :: (1 <= w) => NatRepr w -> Expr LLVM s (FloatType fi) -> LLVMExpr s arch
           demoteToInt :: forall (w :: Natural) s (fi :: FloatInfo) (arch :: LLVMArch).
(1 <= w) =>
NatRepr w -> Expr LLVM s (FloatType fi) -> LLVMExpr s arch
demoteToInt NatRepr w
w Expr LLVM s (FloatType fi)
v = TypeRepr (LLVMPointerType w)
-> Expr LLVM s (LLVMPointerType w) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr w -> TypeRepr (LLVMPointerType w)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr w
w) (NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr w
w (Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w))
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w))
-> App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> RoundingMode
-> Expr LLVM s (FloatType fi)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) (fi :: FloatInfo)
       ext.
(1 <= w) =>
NatRepr w
-> RoundingMode
-> f (FloatType fi)
-> App ext f ('BaseToType (BaseBVType w))
FloatToBV NatRepr w
w RoundingMode
RNE Expr LLVM s (FloatType fi)
v)
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (FloatRepr FloatInfoRepr flt
_) Expr LLVM s tp
x', LLVMPointerRepr NatRepr w
w) -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall (w :: Natural) s (fi :: FloatInfo) (arch :: LLVMArch).
(1 <= w) =>
NatRepr w -> Expr LLVM s (FloatType fi) -> LLVMExpr s arch
demoteToInt NatRepr w
w Expr LLVM s tp
Expr LLVM s ('FloatType flt)
x'
           (ScalarView s arch, TypeRepr tp)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [[String] -> String
unwords [String
"Invalid fptoui:", ConvOp -> String
forall a. Show a => a -> String
show ConvOp
op, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, MemType -> String
forall a. Show a => a -> String
show MemType
outty], String
showI])

    ConvOp
L.FpToSi -> do
       let demoteToInt :: (1 <= w) => NatRepr w -> Expr LLVM s (FloatType fi) -> LLVMExpr s arch
           demoteToInt :: forall (w :: Natural) s (fi :: FloatInfo) (arch :: LLVMArch).
(1 <= w) =>
NatRepr w -> Expr LLVM s (FloatType fi) -> LLVMExpr s arch
demoteToInt NatRepr w
w Expr LLVM s (FloatType fi)
v = TypeRepr (LLVMPointerType w)
-> Expr LLVM s (LLVMPointerType w) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr w -> TypeRepr (LLVMPointerType w)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr w
w) (NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr w
w (Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w))
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w))
-> App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> RoundingMode
-> Expr LLVM s (FloatType fi)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) (fi :: FloatInfo)
       ext.
(1 <= w) =>
NatRepr w
-> RoundingMode
-> f (FloatType fi)
-> App ext f ('BaseToType (BaseBVType w))
FloatToSBV NatRepr w
w RoundingMode
RNE Expr LLVM s (FloatType fi)
v)
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (FloatRepr FloatInfoRepr flt
_) Expr LLVM s tp
x', LLVMPointerRepr NatRepr w
w) -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall (w :: Natural) s (fi :: FloatInfo) (arch :: LLVMArch).
(1 <= w) =>
NatRepr w -> Expr LLVM s (FloatType fi) -> LLVMExpr s arch
demoteToInt NatRepr w
w Expr LLVM s tp
Expr LLVM s ('FloatType flt)
x'
           (ScalarView s arch, TypeRepr tp)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [[String] -> String
unwords [String
"Invalid fptosi:", ConvOp -> String
forall a. Show a => a -> String
show ConvOp
op, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, MemType -> String
forall a. Show a => a -> String
show MemType
outty], String
showI])

    ConvOp
L.FpTrunc -> do
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (FloatRepr FloatInfoRepr flt
_) Expr LLVM s tp
x', FloatRepr FloatInfoRepr flt
fi) -> do
             LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('FloatType flt)
-> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (FloatInfoRepr flt -> TypeRepr ('FloatType flt)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr flt
fi) (Expr LLVM s ('FloatType flt) -> LLVMExpr s arch)
-> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) ('FloatType flt)
-> Expr LLVM s ('FloatType flt)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) ('FloatType flt)
 -> Expr LLVM s ('FloatType flt))
-> App LLVM (Expr LLVM s) ('FloatType flt)
-> Expr LLVM s ('FloatType flt)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr flt
-> RoundingMode
-> Expr LLVM s ('FloatType flt)
-> App LLVM (Expr LLVM s) ('FloatType flt)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type)
       (fi' :: FloatInfo) ext.
FloatInfoRepr fi
-> RoundingMode -> f (FloatType fi') -> App ext f ('FloatType fi)
FloatCast FloatInfoRepr flt
fi RoundingMode
RNE Expr LLVM s tp
Expr LLVM s ('FloatType flt)
x'
           (ScalarView s arch, TypeRepr tp)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [[String] -> String
unwords [String
"Invalid fptrunc:", ConvOp -> String
forall a. Show a => a -> String
show ConvOp
op, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, MemType -> String
forall a. Show a => a -> String
show MemType
outty], String
showI])

    ConvOp
L.FpExt -> do
       MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
outty ((forall {tp :: CrucibleType}.
  TypeRepr tp
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
outty' ->
         case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, TypeRepr tp
outty') of
           (Scalar Proxy# arch
_archProxy (FloatRepr FloatInfoRepr flt
_) Expr LLVM s tp
x', FloatRepr FloatInfoRepr flt
fi) -> do
             LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('FloatType flt)
-> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (FloatInfoRepr flt -> TypeRepr ('FloatType flt)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr flt
fi) (Expr LLVM s ('FloatType flt) -> LLVMExpr s arch)
-> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) ('FloatType flt)
-> Expr LLVM s ('FloatType flt)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) ('FloatType flt)
 -> Expr LLVM s ('FloatType flt))
-> App LLVM (Expr LLVM s) ('FloatType flt)
-> Expr LLVM s ('FloatType flt)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr flt
-> RoundingMode
-> Expr LLVM s ('FloatType flt)
-> App LLVM (Expr LLVM s) ('FloatType flt)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type)
       (fi' :: FloatInfo) ext.
FloatInfoRepr fi
-> RoundingMode -> f (FloatType fi') -> App ext f ('FloatType fi)
FloatCast FloatInfoRepr flt
fi RoundingMode
RNE Expr LLVM s tp
Expr LLVM s ('FloatType flt)
x'
           (ScalarView s arch, TypeRepr tp)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail ([String] -> String
unlines [[String] -> String
unwords [String
"Invalid fpext:", ConvOp -> String
forall a. Show a => a -> String
show ConvOp
op, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, MemType -> String
forall a. Show a => a -> String
show MemType
outty], String
showI])


--------------------------------------------------------------------------------
-- Bit Cast


bitCast :: (?lc::TypeContext,HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
          MemType {- ^ starting type of the expression -} ->
          LLVMExpr s arch {- ^ expression to cast -} ->
          MemType {- ^ target type -} ->
          LLVMGenerator s arch ret (LLVMExpr s arch)

bitCast :: forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
MemType
-> LLVMExpr s arch
-> MemType
-> LLVMGenerator s arch ret (LLVMExpr s arch)
bitCast MemType
_ (ZeroExpr MemType
_) MemType
tgtT = LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
ZeroExpr MemType
tgtT)

bitCast MemType
_ (UndefExpr MemType
_) MemType
tgtT = LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
UndefExpr MemType
tgtT)

-- pointer casts always succeed
bitCast (PtrType SymType
_) LLVMExpr s arch
expr (PtrType SymType
_) = LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LLVMExpr s arch
expr
bitCast (PtrType SymType
_) LLVMExpr s arch
expr MemType
PtrOpaqueType = LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LLVMExpr s arch
expr
bitCast MemType
PtrOpaqueType LLVMExpr s arch
expr (PtrType SymType
_) = LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LLVMExpr s arch
expr
bitCast MemType
PtrOpaqueType LLVMExpr s arch
expr MemType
PtrOpaqueType = LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LLVMExpr s arch
expr

-- casts between vectors of the same length can just be done pointwise
bitCast (VecType Natural
n MemType
srcT) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
xs) (VecType Natural
n' MemType
tgtT)
  | Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
n' = MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
tgtT (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Seq (LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse (\LLVMExpr s arch
x -> MemType
-> LLVMExpr s arch
-> MemType
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
MemType
-> LLVMExpr s arch
-> MemType
-> LLVMGenerator s arch ret (LLVMExpr s arch)
bitCast MemType
srcT LLVMExpr s arch
x MemType
tgtT) Seq (LLVMExpr s arch)
xs

-- otherwise, cast via an intermediate integer type of common width
bitCast MemType
srcT LLVMExpr s arch
expr MemType
tgtT = Maybe (LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
mb (Maybe (LLVMExpr s arch)
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT (Generator LLVM s (LLVMState arch) ret IO) (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT (
  case (MemType -> Maybe Natural
memTypeBitwidth MemType
srcT, MemType -> Maybe Natural
memTypeBitwidth MemType
tgtT) of
    (Just Natural
w1, Just Natural
w2) | Natural
w1 Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
w2 -> MemType
-> LLVMExpr s arch
-> MaybeT
     (Generator LLVM s (LLVMState arch) ret IO) (LLVMExpr s arch)
forall (w :: Natural) (arch :: LLVMArch) s (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch) =>
MemType
-> LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
castToInt MemType
srcT LLVMExpr s arch
expr MaybeT (Generator LLVM s (LLVMState arch) ret IO) (LLVMExpr s arch)
-> (LLVMExpr s arch
    -> MaybeT
         (Generator LLVM s (LLVMState arch) ret IO) (LLVMExpr s arch))
-> MaybeT
     (Generator LLVM s (LLVMState arch) ret IO) (LLVMExpr s arch)
forall a b.
MaybeT (Generator LLVM s (LLVMState arch) ret IO) a
-> (a -> MaybeT (Generator LLVM s (LLVMState arch) ret IO) b)
-> MaybeT (Generator LLVM s (LLVMState arch) ret IO) b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= MemType
-> Natural
-> LLVMExpr s arch
-> MaybeT
     (Generator LLVM s (LLVMState arch) ret IO) (LLVMExpr s arch)
forall (w :: Natural) (arch :: LLVMArch) s (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch) =>
MemType
-> Natural
-> LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
castFromInt MemType
tgtT Natural
w2
    (Maybe Natural, Maybe Natural)
_ -> MaybeT (Generator LLVM s (LLVMState arch) ret IO) (LLVMExpr s arch)
forall a. MaybeT (Generator LLVM s (LLVMState arch) ret IO) a
forall (m :: Type -> Type) a. MonadPlus m => m a
mzero)

  where
  mb :: Maybe (LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
mb    = Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
-> (LLVMExpr s arch
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Maybe (LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String]
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall {m :: Type -> Type} {ext} {s} {t :: Type -> Type}
       {ret :: CrucibleType} {a}.
(Monad m, IsSyntaxExtension ext) =>
[String] -> Generator ext s t ret m a
err [ String
"*** Invalid coercion of expression"
                     , String -> String
indent (LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
expr)
                     , String
"of type"
                     , String -> String
indent (MemType -> String
forall a. Show a => a -> String
show MemType
srcT)
                     , String
"to type"
                     , String -> String
indent (MemType -> String
forall a. Show a => a -> String
show MemType
tgtT)
                     ]) LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
  err :: [String] -> Generator ext s t ret m a
err [String]
msg = Expr ext s (StringType Unicode) -> Generator ext s t ret m a
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr ext s (StringType Unicode) -> Generator ext s t ret m a)
-> Expr ext s (StringType Unicode) -> Generator ext s t ret m a
forall a b. (a -> b) -> a -> b
$ String -> Expr ext s (StringType Unicode)
forall a. IsString a => String -> a
fromString (String -> Expr ext s (StringType Unicode))
-> String -> Expr ext s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines (String
"[bitCast] Failed to perform cast:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msg)
  indent :: String -> String
indent String
msg = String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg

castToInt :: (?lc::TypeContext,HasPtrWidth w, w ~ ArchWidth arch) =>
  MemType {- ^ type of input expression -} ->
  LLVMExpr s arch ->
  MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
castToInt :: forall (w :: Natural) (arch :: LLVMArch) s (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch) =>
MemType
-> LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
castToInt (IntType Natural
w) (BaseExpr (LLVMPointerRepr NatRepr w
wrepr) Expr LLVM s tp
x)
  | Natural
w Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
wrepr
  = LLVMGenerator' s arch ret (LLVMExpr s arch)
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall (m :: Type -> Type) a. Monad m => m a -> MaybeT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TypeRepr ('BaseToType (BaseBVType w))
-> Expr LLVM s ('BaseToType (BaseBVType w)) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr w -> TypeRepr ('BaseToType (BaseBVType w))
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr w
wrepr) (Expr LLVM s ('BaseToType (BaseBVType w)) -> LLVMExpr s arch)
-> LLVMGenerator'
     s arch ret (Expr LLVM s ('BaseToType (BaseBVType w)))
-> LLVMGenerator' s arch ret (LLVMExpr s arch)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator
     s arch ret (Expr LLVM s ('BaseToType (BaseBVType w)))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
wrepr Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x)

castToInt MemType
FloatType (BaseExpr (FloatRepr FloatInfoRepr flt
SingleFloatRepr) Expr LLVM s tp
x)
  = LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall a. a -> MaybeT (LLVMGenerator' s arch ret) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr ('BaseToType (BaseBVType 32))
-> Expr LLVM s ('BaseToType (BaseBVType 32)) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr 32 -> TypeRepr ('BaseToType (BaseBVType 32))
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)) (App
  (ExprExt (Expr LLVM s)) (Expr LLVM s) ('BaseToType (BaseBVType 32))
-> Expr LLVM s ('BaseToType (BaseBVType 32))
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (FloatInfoRepr 'SingleFloat
-> Expr LLVM s (FloatType 'SingleFloat)
-> App
     LLVM
     (Expr LLVM s)
     ('BaseToType (BaseBVType (FloatInfoToBitWidth 'SingleFloat)))
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
(1 <= FloatInfoToBitWidth fi) =>
FloatInfoRepr fi
-> f (FloatType fi)
-> App ext f ('BaseToType (BaseBVType (FloatInfoToBitWidth fi)))
FloatToBinary FloatInfoRepr 'SingleFloat
SingleFloatRepr Expr LLVM s tp
Expr LLVM s (FloatType 'SingleFloat)
x)))
castToInt MemType
DoubleType (BaseExpr (FloatRepr FloatInfoRepr flt
DoubleFloatRepr) Expr LLVM s tp
x)
  = LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall a. a -> MaybeT (LLVMGenerator' s arch ret) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr ('BaseToType (BaseBVType 64))
-> Expr LLVM s ('BaseToType (BaseBVType 64)) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr 64 -> TypeRepr ('BaseToType (BaseBVType 64))
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @64)) (App
  (ExprExt (Expr LLVM s)) (Expr LLVM s) ('BaseToType (BaseBVType 64))
-> Expr LLVM s ('BaseToType (BaseBVType 64))
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (FloatInfoRepr 'DoubleFloat
-> Expr LLVM s (FloatType 'DoubleFloat)
-> App
     LLVM
     (Expr LLVM s)
     ('BaseToType (BaseBVType (FloatInfoToBitWidth 'DoubleFloat)))
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
(1 <= FloatInfoToBitWidth fi) =>
FloatInfoRepr fi
-> f (FloatType fi)
-> App ext f ('BaseToType (BaseBVType (FloatInfoToBitWidth fi)))
FloatToBinary FloatInfoRepr 'DoubleFloat
DoubleFloatRepr Expr LLVM s tp
Expr LLVM s (FloatType 'DoubleFloat)
x)))
castToInt MemType
X86_FP80Type (BaseExpr (FloatRepr FloatInfoRepr flt
X86_80FloatRepr) Expr LLVM s tp
x)
  = LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall a. a -> MaybeT (LLVMGenerator' s arch ret) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr ('BaseToType (BaseBVType 80))
-> Expr LLVM s ('BaseToType (BaseBVType 80)) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr 80 -> TypeRepr ('BaseToType (BaseBVType 80))
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @80)) (App
  (ExprExt (Expr LLVM s)) (Expr LLVM s) ('BaseToType (BaseBVType 80))
-> Expr LLVM s ('BaseToType (BaseBVType 80))
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (FloatInfoRepr 'X86_80Float
-> Expr LLVM s (FloatType 'X86_80Float)
-> App
     LLVM
     (Expr LLVM s)
     ('BaseToType (BaseBVType (FloatInfoToBitWidth 'X86_80Float)))
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
(1 <= FloatInfoToBitWidth fi) =>
FloatInfoRepr fi
-> f (FloatType fi)
-> App ext f ('BaseToType (BaseBVType (FloatInfoToBitWidth fi)))
FloatToBinary FloatInfoRepr 'X86_80Float
X86_80FloatRepr Expr LLVM s tp
Expr LLVM s (FloatType 'X86_80Float)
x)))

castToInt (VecType Natural
n MemType
tp) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
xs) =
  do [LLVMExpr s arch]
xs' <- (LLVMExpr s arch
 -> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch))
-> [LLVMExpr s arch]
-> MaybeT (LLVMGenerator' s arch ret) [LLVMExpr s arch]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (MemType
-> LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall (w :: Natural) (arch :: LLVMArch) s (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch) =>
MemType
-> LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
castToInt MemType
tp) (Seq (LLVMExpr s arch) -> [LLVMExpr s arch]
forall a. Seq a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Seq (LLVMExpr s arch)
xs)
     LLVMGenerator' s arch ret (Maybe (LLVMExpr s arch))
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe (LLVMExpr s arch)
-> LLVMGenerator' s arch ret (Maybe (LLVMExpr s arch))
forall a. a -> LLVMGenerator' s arch ret a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([LLVMExpr s arch] -> Maybe (LLVMExpr s arch)
forall (w :: Natural) (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch) =>
[LLVMExpr s arch] -> Maybe (LLVMExpr s arch)
vecJoin [LLVMExpr s arch]
xs'))
castToInt MemType
_ LLVMExpr s arch
_ = MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall a. MaybeT (LLVMGenerator' s arch ret) a
forall (m :: Type -> Type) a. MonadPlus m => m a
mzero

castFromInt :: (?lc::TypeContext,HasPtrWidth w, w ~ ArchWidth arch) =>
  MemType {- ^ target type -} ->
  Natural {- ^ bitvector width in bits -} ->
  LLVMExpr s arch -> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)

castFromInt :: forall (w :: Natural) (arch :: LLVMArch) s (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch) =>
MemType
-> Natural
-> LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
castFromInt (IntType Natural
w1) Natural
w2 (BaseExpr (BVRepr NatRepr n
w) Expr LLVM s tp
x)
  | Natural
w1 Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
w2, Natural
w1 Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== NatRepr n -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr n
w
  = LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall a. a -> MaybeT (LLVMGenerator' s arch ret) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr (LLVMPointerType n)
-> Expr LLVM s (LLVMPointerType n) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr n -> TypeRepr (LLVMPointerType n)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr n
w) (NatRepr n
-> Expr LLVM s ('BaseToType (BaseBVType n))
-> Expr LLVM s (LLVMPointerType n)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr n
w Expr LLVM s tp
Expr LLVM s ('BaseToType (BaseBVType n))
x))

castFromInt MemType
FloatType Natural
32 (BaseExpr (BVRepr NatRepr n
w) Expr LLVM s tp
x)
  | Just n :~: 32
Refl <- NatRepr n -> NatRepr 32 -> Maybe (n :~: 32)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr n
w (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)
  = LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall a. a -> MaybeT (LLVMGenerator' s arch ret) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr (FloatType 'SingleFloat)
-> Expr LLVM s (FloatType 'SingleFloat) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (FloatInfoRepr 'SingleFloat -> TypeRepr (FloatType 'SingleFloat)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr 'SingleFloat
SingleFloatRepr) (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (FloatType 'SingleFloat)
-> Expr LLVM s (FloatType 'SingleFloat)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (FloatInfoRepr 'SingleFloat
-> Expr
     LLVM
     s
     ('BaseToType (BaseBVType (FloatInfoToBitWidth 'SingleFloat)))
-> App LLVM (Expr LLVM s) (FloatType 'SingleFloat)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
FloatInfoRepr fi
-> f (BVType (FloatInfoToBitWidth fi)) -> App ext f ('FloatType fi)
FloatFromBinary FloatInfoRepr 'SingleFloat
SingleFloatRepr Expr LLVM s tp
Expr
  LLVM
  s
  ('BaseToType (BaseBVType (FloatInfoToBitWidth 'SingleFloat)))
x)))

castFromInt MemType
DoubleType Natural
64 (BaseExpr (BVRepr NatRepr n
w) Expr LLVM s tp
x)
  | Just n :~: 64
Refl <- NatRepr n -> NatRepr 64 -> Maybe (n :~: 64)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr n
w (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @64)
  = LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall a. a -> MaybeT (LLVMGenerator' s arch ret) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr (FloatType 'DoubleFloat)
-> Expr LLVM s (FloatType 'DoubleFloat) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (FloatInfoRepr 'DoubleFloat -> TypeRepr (FloatType 'DoubleFloat)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr 'DoubleFloat
DoubleFloatRepr) (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (FloatType 'DoubleFloat)
-> Expr LLVM s (FloatType 'DoubleFloat)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (FloatInfoRepr 'DoubleFloat
-> Expr
     LLVM
     s
     ('BaseToType (BaseBVType (FloatInfoToBitWidth 'DoubleFloat)))
-> App LLVM (Expr LLVM s) (FloatType 'DoubleFloat)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
FloatInfoRepr fi
-> f (BVType (FloatInfoToBitWidth fi)) -> App ext f ('FloatType fi)
FloatFromBinary FloatInfoRepr 'DoubleFloat
DoubleFloatRepr Expr LLVM s tp
Expr
  LLVM
  s
  ('BaseToType (BaseBVType (FloatInfoToBitWidth 'DoubleFloat)))
x)))

castFromInt MemType
X86_FP80Type Natural
80 (BaseExpr (BVRepr NatRepr n
w) Expr LLVM s tp
x)
  | Just n :~: 80
Refl <- NatRepr n -> NatRepr 80 -> Maybe (n :~: 80)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr n
w (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @80)
  = LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall a. a -> MaybeT (LLVMGenerator' s arch ret) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr (FloatType 'X86_80Float)
-> Expr LLVM s (FloatType 'X86_80Float) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (FloatInfoRepr 'X86_80Float -> TypeRepr (FloatType 'X86_80Float)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr 'X86_80Float
X86_80FloatRepr) (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (FloatType 'X86_80Float)
-> Expr LLVM s (FloatType 'X86_80Float)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (FloatInfoRepr 'X86_80Float
-> Expr
     LLVM
     s
     ('BaseToType (BaseBVType (FloatInfoToBitWidth 'X86_80Float)))
-> App LLVM (Expr LLVM s) (FloatType 'X86_80Float)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
FloatInfoRepr fi
-> f (BVType (FloatInfoToBitWidth fi)) -> App ext f ('FloatType fi)
FloatFromBinary FloatInfoRepr 'X86_80Float
X86_80FloatRepr Expr LLVM s tp
Expr
  LLVM
  s
  ('BaseToType (BaseBVType (FloatInfoToBitWidth 'X86_80Float)))
x)))

castFromInt (VecType Natural
n MemType
tp) Natural
w LLVMExpr s arch
expr
  | Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0
  , (Natural
w',Natural
0) <- Natural
w Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
`divMod` Natural
n
  , Some NatRepr x
wrepr' <- Natural -> Some NatRepr
mkNatRepr Natural
w'
  , Just LeqProof 1 x
LeqProof <- NatRepr x -> Maybe (LeqProof 1 x)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr x
wrepr'
  = do [LLVMExpr s arch]
xs <- LLVMGenerator' s arch ret (Maybe [LLVMExpr s arch])
-> MaybeT (LLVMGenerator' s arch ret) [LLVMExpr s arch]
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe [LLVMExpr s arch]
-> LLVMGenerator' s arch ret (Maybe [LLVMExpr s arch])
forall a. a -> LLVMGenerator' s arch ret a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (NatRepr x -> LLVMExpr s arch -> Maybe [LLVMExpr s arch]
forall s (n :: Natural) (w :: Natural) (arch :: LLVMArch).
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch, 1 <= n) =>
NatRepr n -> LLVMExpr s arch -> Maybe [LLVMExpr s arch]
vecSplit NatRepr x
wrepr' LLVMExpr s arch
expr))
       MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
tp (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> ([LLVMExpr s arch] -> Seq (LLVMExpr s arch))
-> [LLVMExpr s arch]
-> LLVMExpr s arch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LLVMExpr s arch] -> Seq (LLVMExpr s arch)
forall a. [a] -> Seq a
Seq.fromList ([LLVMExpr s arch] -> LLVMExpr s arch)
-> MaybeT (LLVMGenerator' s arch ret) [LLVMExpr s arch]
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (LLVMExpr s arch
 -> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch))
-> [LLVMExpr s arch]
-> MaybeT (LLVMGenerator' s arch ret) [LLVMExpr s arch]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (MemType
-> Natural
-> LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall (w :: Natural) (arch :: LLVMArch) s (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch) =>
MemType
-> Natural
-> LLVMExpr s arch
-> MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
castFromInt MemType
tp Natural
w') [LLVMExpr s arch]
xs
castFromInt MemType
_ Natural
_ LLVMExpr s arch
_ = MaybeT (LLVMGenerator' s arch ret) (LLVMExpr s arch)
forall a. MaybeT (LLVMGenerator' s arch ret) a
forall (m :: Type -> Type) a. MonadPlus m => m a
mzero


-- | Join the elements of a vector into a single bit-vector value.
-- The resulting bit-vector would be of length at least one.
vecJoin :: (?lc::TypeContext,HasPtrWidth w, w ~ ArchWidth arch) =>
  [LLVMExpr s arch] {- ^ Join these vector elements -} ->
  Maybe (LLVMExpr s arch)
vecJoin :: forall (w :: Natural) (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch) =>
[LLVMExpr s arch] -> Maybe (LLVMExpr s arch)
vecJoin [LLVMExpr s arch]
exprs =
  do (LLVMExpr s arch
a,[LLVMExpr s arch]
ys) <- [LLVMExpr s arch] -> Maybe (LLVMExpr s arch, [LLVMExpr s arch])
forall a. [a] -> Maybe (a, [a])
List.uncons [LLVMExpr s arch]
exprs
     Scalar Proxy# arch
_archProxy (BVRepr (NatRepr n
n :: NatRepr n)) Expr LLVM s tp
e1 <- ScalarView s arch -> Maybe (ScalarView s arch)
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
a)
     if [LLVMExpr s arch] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LLVMExpr s arch]
ys
       then do LeqProof 1 n
LeqProof <- NatRepr 1 -> NatRepr n -> Maybe (LeqProof 1 n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) NatRepr n
n
               LLVMExpr s arch -> Maybe (LLVMExpr s arch)
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr ('BaseToType (BaseBVType n))
-> Expr LLVM s ('BaseToType (BaseBVType n)) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr n
n) Expr LLVM s tp
Expr LLVM s ('BaseToType (BaseBVType n))
e1)
       else do BaseExpr (BVRepr NatRepr n
m) Expr LLVM s tp
e2 <- [LLVMExpr s arch] -> Maybe (LLVMExpr s arch)
forall (w :: Natural) (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch) =>
[LLVMExpr s arch] -> Maybe (LLVMExpr s arch)
vecJoin [LLVMExpr s arch]
ys
               let p1 :: LeqProof 0 n
p1 = forall (n :: Natural). LeqProof 0 n
leqZero @n
                   p2 :: LeqProof 1 n
p2 = NatRepr 1 -> NatRepr n -> LeqProof 1 n
forall (m :: Natural) (n :: Natural) (f :: Natural -> Type)
       (g :: Natural -> Type).
(m <= n) =>
f m -> g n -> LeqProof m n
leqProof (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) NatRepr n
m
               (LeqProof 1 (n + n)
LeqProof,LeqProof 1 (n + n)
LeqProof) <- (LeqProof 1 (n + n), LeqProof 1 (n + n))
-> Maybe (LeqProof 1 (n + n), LeqProof 1 (n + n))
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LeqProof 0 n -> LeqProof 1 n -> LeqProof (0 + 1) (n + n)
forall (x_l :: Natural) (x_h :: Natural) (y_l :: Natural)
       (y_h :: Natural).
LeqProof x_l x_h
-> LeqProof y_l y_h -> LeqProof (x_l + y_l) (x_h + y_h)
leqAdd2 LeqProof 0 n
p1 LeqProof 1 n
p2, LeqProof 1 n -> LeqProof 0 n -> LeqProof (1 + 0) (n + n)
forall (x_l :: Natural) (x_h :: Natural) (y_l :: Natural)
       (y_h :: Natural).
LeqProof x_l x_h
-> LeqProof y_l y_h -> LeqProof (x_l + y_l) (x_h + y_h)
leqAdd2 LeqProof 1 n
p2 LeqProof 0 n
p1)
               let bits :: NatRepr u
-> NatRepr v
-> Expr LLVM s (BVType u)
-> Expr LLVM s (BVType v)
-> LLVMExpr s arch
bits NatRepr u
u NatRepr v
v Expr LLVM s (BVType u)
x Expr LLVM s (BVType v)
y = NatRepr (u + v)
-> App LLVM (Expr LLVM s) (BVType (u + v)) -> LLVMExpr s arch
forall (n :: Natural) s (arch :: LLVMArch).
(1 <= n) =>
NatRepr n -> App LLVM (Expr LLVM s) (BVType n) -> LLVMExpr s arch
bitVal (NatRepr u -> NatRepr v -> NatRepr (u + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr u
u NatRepr v
v) (NatRepr u
-> NatRepr v
-> Expr LLVM s (BVType u)
-> Expr LLVM s (BVType v)
-> App LLVM (Expr LLVM s) (BVType (u + v))
forall (u :: Natural) (v :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= u, 1 <= v, 1 <= (u + v)) =>
NatRepr u
-> NatRepr v
-> f (BVType u)
-> f (BVType v)
-> App ext f ('BaseToType (BaseBVType (u + v)))
BVConcat NatRepr u
u NatRepr v
v Expr LLVM s (BVType u)
x Expr LLVM s (BVType v)
y)
               LLVMExpr s arch -> Maybe (LLVMExpr s arch)
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch -> Maybe (LLVMExpr s arch))
-> LLVMExpr s arch -> Maybe (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$! case TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc DataLayout
-> Getting EndianForm DataLayout EndianForm -> EndianForm
forall s a. s -> Getting a s a -> a
^. Getting EndianForm DataLayout EndianForm
Lens' DataLayout EndianForm
intLayout of
                           EndianForm
LittleEndian -> NatRepr n
-> NatRepr n
-> Expr LLVM s ('BaseToType (BaseBVType n))
-> Expr LLVM s ('BaseToType (BaseBVType n))
-> LLVMExpr s arch
forall {u :: Natural} {v :: Natural} {s} {arch :: LLVMArch}.
(Assert
   (OrdCond (CmpNat 1 (u + v)) 'True 'True 'False) (TypeError ...),
 Assert (OrdCond (CmpNat 1 u) 'True 'True 'False) (TypeError ...),
 Assert
   (OrdCond (CmpNat 1 v) 'True 'True 'False) (TypeError ...)) =>
NatRepr u
-> NatRepr v
-> Expr LLVM s (BVType u)
-> Expr LLVM s (BVType v)
-> LLVMExpr s arch
bits NatRepr n
m NatRepr n
n Expr LLVM s tp
Expr LLVM s ('BaseToType (BaseBVType n))
e2 Expr LLVM s tp
Expr LLVM s ('BaseToType (BaseBVType n))
e1
                           EndianForm
BigEndian    -> NatRepr n
-> NatRepr n
-> Expr LLVM s ('BaseToType (BaseBVType n))
-> Expr LLVM s ('BaseToType (BaseBVType n))
-> LLVMExpr s arch
forall {u :: Natural} {v :: Natural} {s} {arch :: LLVMArch}.
(Assert
   (OrdCond (CmpNat 1 (u + v)) 'True 'True 'False) (TypeError ...),
 Assert (OrdCond (CmpNat 1 u) 'True 'True 'False) (TypeError ...),
 Assert
   (OrdCond (CmpNat 1 v) 'True 'True 'False) (TypeError ...)) =>
NatRepr u
-> NatRepr v
-> Expr LLVM s (BVType u)
-> Expr LLVM s (BVType v)
-> LLVMExpr s arch
bits NatRepr n
n NatRepr n
m Expr LLVM s tp
Expr LLVM s ('BaseToType (BaseBVType n))
e1 Expr LLVM s tp
Expr LLVM s ('BaseToType (BaseBVType n))
e2


bitVal ::
  (1 <= n) =>
  NatRepr n ->
  App LLVM (Expr LLVM s) (BVType n) ->
  LLVMExpr s arch
bitVal :: forall (n :: Natural) s (arch :: LLVMArch).
(1 <= n) =>
NatRepr n -> App LLVM (Expr LLVM s) (BVType n) -> LLVMExpr s arch
bitVal NatRepr n
n App LLVM (Expr LLVM s) (BVType n)
e = TypeRepr (BVType n) -> Expr LLVM s (BVType n) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr n -> TypeRepr (BVType n)
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr n
n) (App LLVM (Expr LLVM s) (BVType n) -> Expr LLVM s (BVType n)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App App LLVM (Expr LLVM s) (BVType n)
e)


-- | Split a single bit-vector value into a vector of value of the given width.
vecSplit :: forall s n w arch. (?lc::TypeContext,HasPtrWidth w, w ~ ArchWidth arch, 1 <= n) =>
  NatRepr n  {- ^ Length of a single element -} ->
  LLVMExpr s arch {- ^ Bit-vector value -} ->
  Maybe [ LLVMExpr s arch ]
vecSplit :: forall s (n :: Natural) (w :: Natural) (arch :: LLVMArch).
(?lc::TypeContext, HasPtrWidth w, w ~ ArchWidth arch, 1 <= n) =>
NatRepr n -> LLVMExpr s arch -> Maybe [LLVMExpr s arch]
vecSplit NatRepr n
elLen LLVMExpr s arch
expr =
  do Scalar Proxy# arch
_archProxy (BVRepr NatRepr n
totLen) Expr LLVM s tp
e <- ScalarView s arch -> Maybe (ScalarView s arch)
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
expr)
     let getEl :: NatRepr offset -> Maybe [ LLVMExpr s arch ]
         getEl :: forall (offset :: Natural).
NatRepr offset -> Maybe [LLVMExpr s arch]
getEl NatRepr offset
offset = let end :: NatRepr (offset + n)
end = NatRepr offset -> NatRepr n -> NatRepr (offset + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr offset
offset NatRepr n
elLen
                        in case NatRepr (offset + n)
-> NatRepr n -> Maybe (LeqProof (offset + n) n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq NatRepr (offset + n)
end NatRepr n
totLen of
                             Just LeqProof (offset + n) n
LeqProof ->
                               do [LLVMExpr s arch]
rest <- NatRepr (offset + n) -> Maybe [LLVMExpr s arch]
forall (offset :: Natural).
NatRepr offset -> Maybe [LLVMExpr s arch]
getEl NatRepr (offset + n)
end
                                  let x :: LLVMExpr s arch
x = NatRepr n -> App LLVM (Expr LLVM s) (BVType n) -> LLVMExpr s arch
forall (n :: Natural) s (arch :: LLVMArch).
(1 <= n) =>
NatRepr n -> App LLVM (Expr LLVM s) (BVType n) -> LLVMExpr s arch
bitVal NatRepr n
elLen
                                            (NatRepr offset
-> NatRepr n
-> NatRepr n
-> Expr LLVM s ('BaseToType (BaseBVType n))
-> App LLVM (Expr LLVM s) (BVType n)
forall (w :: Natural) (len :: Natural) (idx :: Natural)
       (f :: CrucibleType -> Type) ext.
(1 <= w, 1 <= len, (idx + len) <= w) =>
NatRepr idx
-> NatRepr len
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType len))
BVSelect NatRepr offset
offset NatRepr n
elLen NatRepr n
totLen Expr LLVM s tp
Expr LLVM s ('BaseToType (BaseBVType n))
e)
                                  [LLVMExpr s arch] -> Maybe [LLVMExpr s arch]
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
x LLVMExpr s arch -> [LLVMExpr s arch] -> [LLVMExpr s arch]
forall a. a -> [a] -> [a]
: [LLVMExpr s arch]
rest)
                             Maybe (LeqProof (offset + n) n)
Nothing ->
                               do offset :~: n
Refl <- NatRepr offset -> NatRepr n -> Maybe (offset :~: n)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr offset
offset NatRepr n
totLen
                                  [LLVMExpr s arch] -> Maybe [LLVMExpr s arch]
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
     [LLVMExpr s arch]
els <- NatRepr 0 -> Maybe [LLVMExpr s arch]
forall (offset :: Natural).
NatRepr offset -> Maybe [LLVMExpr s arch]
getEl (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @0)
     -- in `els` the least significant chunk is first

     [LLVMExpr s arch] -> Maybe [LLVMExpr s arch]
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([LLVMExpr s arch] -> Maybe [LLVMExpr s arch])
-> [LLVMExpr s arch] -> Maybe [LLVMExpr s arch]
forall a b. (a -> b) -> a -> b
$! case DataLayout
lay DataLayout
-> Getting EndianForm DataLayout EndianForm -> EndianForm
forall s a. s -> Getting a s a -> a
^. Getting EndianForm DataLayout EndianForm
Lens' DataLayout EndianForm
intLayout of
                 EndianForm
LittleEndian -> [LLVMExpr s arch]
els
                 EndianForm
BigEndian    -> [LLVMExpr s arch] -> [LLVMExpr s arch]
forall a. [a] -> [a]
reverse [LLVMExpr s arch]
els
  where
  lay :: DataLayout
lay = TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc


bitop :: (?transOpts :: TranslationOptions) =>
  L.BitOp ->
  MemType ->
  LLVMExpr s arch ->
  LLVMExpr s arch ->
  LLVMGenerator s arch ret (LLVMExpr s arch)
bitop :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
BitOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
bitop BitOp
op (VecType Natural
n MemType
tp) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
xs) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
ys) =
  MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
tp (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => Seq (m a) -> m (Seq a)
sequence ((LLVMExpr s arch
 -> LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Seq (LLVMExpr s arch)
-> Seq (LLVMExpr s arch)
-> Seq (Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith (\LLVMExpr s arch
x LLVMExpr s arch
y -> BitOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
BitOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
bitop BitOp
op MemType
tp LLVMExpr s arch
x LLVMExpr s arch
y) Seq (LLVMExpr s arch)
xs Seq (LLVMExpr s arch)
ys)

bitop BitOp
op MemType
_ LLVMExpr s arch
x LLVMExpr s arch
y =
  case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
y) of
    (Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x',
     Scalar Proxy# arch
_archPrxy' (LLVMPointerRepr NatRepr w
w') Expr LLVM s tp
y')
      | Just w :~: w
Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr w
w'
      , Just LeqProof 1 w
LeqProof <- NatRepr w -> Maybe (LeqProof 1 w)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr w
w -> do
         Expr LLVM s (BVType w)
xbv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x'
         Expr LLVM s (BVType w)
ybv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
y'
         Expr LLVM s (BVType w)
ex  <- BitOp
-> NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions, 1 <= w) =>
BitOp
-> NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
raw_bitop BitOp
op NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
         LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr (LLVMPointerType w)
-> Expr LLVM s (LLVMPointerType w) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr w -> TypeRepr (LLVMPointerType w)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr w
w) (NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr w
w Expr LLVM s (BVType w)
ex))

    (ScalarView s arch, ScalarView s arch)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"bitwise operation on unsupported values", LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
y]

raw_bitop :: (?transOpts :: TranslationOptions, 1 <= w) =>
  L.BitOp ->
  NatRepr w ->
  Expr LLVM s (BVType w) ->
  Expr LLVM s (BVType w) ->
  LLVMGenerator s arch ret (Expr LLVM s (BVType w))
raw_bitop :: forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions, 1 <= w) =>
BitOp
-> NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
raw_bitop BitOp
op NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b =
  do GlobalVar Mem
mvar <- Generator LLVM s (LLVMState arch) ret IO (GlobalVar Mem)
forall s (arch :: LLVMArch) (reg :: CrucibleType).
LLVMGenerator s arch reg (GlobalVar Mem)
getMemVar
     let withSideConds :: Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds Expr LLVM s (BVType w)
val [(Bool,
  Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
  UndefinedBehavior (Expr LLVM s))]
lst = GlobalVar Mem
-> TypeRepr (BVType w)
-> Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) (ty :: CrucibleType) s.
Applicative f =>
GlobalVar Mem
-> TypeRepr ty
-> Expr LLVM s ty
-> [(Bool, f (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> f (Expr LLVM s ty)
sideConditionsA GlobalVar Mem
mvar (NatRepr w -> TypeRepr (BVType w)
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr w
w) Expr LLVM s (BVType w)
val [(Bool,
  Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
  UndefinedBehavior (Expr LLVM s))]
lst
     let noLaxArith :: Bool
noLaxArith = Bool -> Bool
not (TranslationOptions -> Bool
laxArith ?transOpts::TranslationOptions
TranslationOptions
?transOpts)
     case BitOp
op of
       BitOp
L.And -> Expr LLVM s (BVType w)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (BVType w)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w)))
-> Expr LLVM s (BVType w)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVAnd NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)
       BitOp
L.Or  -> Expr LLVM s (BVType w)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (BVType w)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w)))
-> Expr LLVM s (BVType w)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVOr NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)
       BitOp
L.Xor -> Expr LLVM s (BVType w)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (BVType w)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w)))
-> Expr LLVM s (BVType w)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVXor NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)

       L.Shl Bool
nuw Bool
nsw -> do
         let wlit :: Expr LLVM s (BVType w)
wlit = App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w -> BV w -> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w))
         Expr LLVM s (BVType w)
result <- Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVShl NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
         Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds Expr LLVM s (BVType w)
result
           [ ( Bool
noLaxArith
             , Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure  (Expr LLVM s BoolType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVUlt NatRepr w
w Expr LLVM s (BVType w)
b Expr LLVM s (BVType w)
wlit) -- TODO: is this the right condition?
             , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.ShlOp2Big Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
             )
           , ( Bool
nuw Bool -> Bool -> Bool
&& Bool
noLaxArith
             , (Atom s (BVType w) -> Expr LLVM s BoolType)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b.
(a -> b)
-> Generator LLVM s (LLVMState arch) ret IO a
-> Generator LLVM s (LLVMState arch) ret IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> (Atom s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> Atom s (BVType w)
-> Expr LLVM s BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
a (Expr LLVM s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Atom s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr)
                    (Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVLshr NatRepr w
w Expr LLVM s (BVType w)
result Expr LLVM s (BVType w)
b)))
             , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.ShlNoUnsignedWrap Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
             )
           , ( Bool
nsw Bool -> Bool -> Bool
&& Bool
noLaxArith
             , (Atom s (BVType w) -> Expr LLVM s BoolType)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b.
(a -> b)
-> Generator LLVM s (LLVMState arch) ret IO a
-> Generator LLVM s (LLVMState arch) ret IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> (Atom s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> Atom s (BVType w)
-> Expr LLVM s BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
a (Expr LLVM s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Atom s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr)
                    (Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVAshr NatRepr w
w Expr LLVM s (BVType w)
result Expr LLVM s (BVType w)
b)))
             , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.ShlNoSignedWrap Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
             )
           ]

       L.Lshr Bool
exact -> do
         let wlit :: Expr LLVM s (BVType w)
wlit = App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w -> BV w -> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w))
         Expr LLVM s (BVType w)
result <- Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVLshr NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
         Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds Expr LLVM s (BVType w)
result
           [ ( Bool
noLaxArith
             , Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure  (Expr LLVM s BoolType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVUlt NatRepr w
w Expr LLVM s (BVType w)
b Expr LLVM s (BVType w)
wlit)
             , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.LshrOp2Big Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
             )
           , ( Bool
exact Bool -> Bool -> Bool
&& Bool
noLaxArith
             , (Atom s (BVType w) -> Expr LLVM s BoolType)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b.
(a -> b)
-> Generator LLVM s (LLVMState arch) ret IO a
-> Generator LLVM s (LLVMState arch) ret IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> (Atom s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> Atom s (BVType w)
-> Expr LLVM s BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
a (Expr LLVM s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Atom s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr)
                    (Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVShl NatRepr w
w Expr LLVM s (BVType w)
result Expr LLVM s (BVType w)
b)))
             , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.LshrExact Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
             )
           ]

       L.Ashr Bool
exact
         | Just LeqProof 1 w
LeqProof <- NatRepr w -> Maybe (LeqProof 1 w)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr w
w -> do
             let wlit :: Expr LLVM s (BVType w)
wlit = App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w -> BV w -> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w))
             Expr LLVM s (BVType w)
result <- Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVAshr NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
             Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds Expr LLVM s (BVType w)
result
               [ ( Bool
noLaxArith
                 , Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure  (Expr LLVM s BoolType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVUlt NatRepr w
w Expr LLVM s (BVType w)
b Expr LLVM s (BVType w)
wlit)
                 , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.AshrOp2Big Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
                 )
               , ( Bool
exact Bool -> Bool -> Bool
&& Bool
noLaxArith
                 , (Expr LLVM s (BVType w) -> Expr LLVM s BoolType)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b.
(a -> b)
-> Generator LLVM s (LLVMState arch) ret IO a
-> Generator LLVM s (LLVMState arch) ret IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> (Expr LLVM s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> Expr LLVM s (BVType w)
-> Expr LLVM s BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
a)
                        (Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVShl NatRepr w
w Expr LLVM s (BVType w)
result Expr LLVM s (BVType w)
b)))
                 , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.AshrExact Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
                 )
               ]

         | Bool
otherwise -> String
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"cannot arithmetic right shift a 0-width integer"


-- | Translate an LLVM integer operation into a Crucible CFG expression.
--
-- Poison values can arise from such operations.
intop :: forall w s arch ret. (?transOpts :: TranslationOptions, 1 <= w)
      => L.ArithOp
      -> NatRepr w
      -> Expr LLVM s (BVType w)
      -> Expr LLVM s (BVType w)
      -> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
intop :: forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions, 1 <= w) =>
ArithOp
-> NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
intop ArithOp
op NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b =
  do GlobalVar Mem
mvar <- Generator LLVM s (LLVMState arch) ret IO (GlobalVar Mem)
forall s (arch :: LLVMArch) (reg :: CrucibleType).
LLVMGenerator s arch reg (GlobalVar Mem)
getMemVar
     let withSideConds :: Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds Expr LLVM s (BVType w)
val [(Bool,
  Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
  UndefinedBehavior (Expr LLVM s))]
lst = GlobalVar Mem
-> TypeRepr (BVType w)
-> Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) (ty :: CrucibleType) s.
Applicative f =>
GlobalVar Mem
-> TypeRepr ty
-> Expr LLVM s ty
-> [(Bool, f (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> f (Expr LLVM s ty)
sideConditionsA GlobalVar Mem
mvar (NatRepr w -> TypeRepr (BVType w)
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr w
w) Expr LLVM s (BVType w)
val [(Bool,
  Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
  UndefinedBehavior (Expr LLVM s))]
lst
     let withPoison :: Expr LLVM s (BVType w)
-> [(Bool, Expr LLVM s BoolType, Poison (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withPoison Expr LLVM s (BVType w)
val [(Bool, Expr LLVM s BoolType, Poison (Expr LLVM s))]
xs =
           do Expr LLVM s (BVType w)
v <- Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom Expr LLVM s (BVType w)
val
              Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds Expr LLVM s (BVType w)
v ([(Bool,
   Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
   UndefinedBehavior (Expr LLVM s))]
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w)))
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a b. (a -> b) -> a -> b
$ ((Bool, Expr LLVM s BoolType, Poison (Expr LLVM s))
 -> (Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s)))
-> [(Bool, Expr LLVM s BoolType, Poison (Expr LLVM s))]
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Bool
d, Expr LLVM s BoolType
e, Poison (Expr LLVM s)
c) -> (Bool
d, Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr LLVM s BoolType
e, Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated Poison (Expr LLVM s)
c)) [(Bool, Expr LLVM s BoolType, Poison (Expr LLVM s))]
xs
     let z :: Expr LLVM s (BVType w)
z        = App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w -> BV w -> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w))
     let bNeqZero :: UndefinedBehavior (Expr LLVM s)
-> (Bool,
    Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
    UndefinedBehavior (Expr LLVM s))
bNeqZero = \UndefinedBehavior (Expr LLVM s)
ub -> (Bool
True, Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Expr LLVM s BoolType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type).
IsExpr e =>
e BoolType -> e BoolType
notExpr (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
z Expr LLVM s (BVType w)
b))), UndefinedBehavior (Expr LLVM s)
ub)
     let neg1 :: Expr LLVM s (BVType w)
neg1     = App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w -> BV w -> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w (-Integer
1)))
     let minInt :: Expr LLVM s (BVType w)
minInt   = App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w -> BV w -> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> BV w
forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
BV.minSigned NatRepr w
w))
     let noLaxArith :: Bool
noLaxArith = Bool -> Bool
not (TranslationOptions -> Bool
laxArith ?transOpts::TranslationOptions
TranslationOptions
?transOpts)
     case ArithOp
op of
       L.Add Bool
nuw Bool
nsw -> Expr LLVM s (BVType w)
-> [(Bool, Expr LLVM s BoolType, Poison (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withPoison (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVAdd NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
         [ ( Bool
nuw Bool -> Bool -> Bool
&& Bool
noLaxArith
           , Expr LLVM s BoolType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type).
IsExpr e =>
e BoolType -> e BoolType
notExpr (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVCarry NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
           , Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.AddNoUnsignedWrap Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
           )
         , ( Bool
nsw Bool -> Bool -> Bool
&& Bool
noLaxArith
           , Expr LLVM s BoolType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type).
IsExpr e =>
e BoolType -> e BoolType
notExpr (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVSCarry NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
           , Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.AddNoSignedWrap Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
           )
         ]

       L.Sub Bool
nuw Bool
nsw -> Expr LLVM s (BVType w)
-> [(Bool, Expr LLVM s BoolType, Poison (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withPoison (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVSub NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
         [ ( Bool
nuw Bool -> Bool -> Bool
&& Bool
noLaxArith
           , Expr LLVM s BoolType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type).
IsExpr e =>
e BoolType -> e BoolType
notExpr (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVUlt NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
           , Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.SubNoUnsignedWrap Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
           )
         , ( Bool
nsw Bool -> Bool -> Bool
&& Bool
noLaxArith
           , Expr LLVM s BoolType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type).
IsExpr e =>
e BoolType -> e BoolType
notExpr (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVSBorrow NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
           , Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.SubNoSignedWrap Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
           )
         ]

       L.Mul Bool
nuw Bool
nsw -> do
         let w' :: NatRepr (w + w)
w' = NatRepr w -> NatRepr w -> NatRepr (w + w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr w
w NatRepr w
w
         Just LeqProof 1 (w + w)
LeqProof <- Maybe (LeqProof 1 (w + w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LeqProof 1 (w + w)))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 (w + w))
 -> Generator
      LLVM s (LLVMState arch) ret IO (Maybe (LeqProof 1 (w + w))))
-> Maybe (LeqProof 1 (w + w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LeqProof 1 (w + w)))
forall a b. (a -> b) -> a -> b
$ NatRepr (w + w) -> Maybe (LeqProof 1 (w + w))
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (w + w)
w'
         Just LeqProof (w + 1) (w + w)
LeqProof <- Maybe (LeqProof (w + 1) (w + w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LeqProof (w + 1) (w + w)))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof (w + 1) (w + w))
 -> Generator
      LLVM s (LLVMState arch) ret IO (Maybe (LeqProof (w + 1) (w + w))))
-> Maybe (LeqProof (w + 1) (w + w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LeqProof (w + 1) (w + w)))
forall a b. (a -> b) -> a -> b
$ NatRepr (w + 1)
-> NatRepr (w + w) -> Maybe (LeqProof (w + 1) (w + w))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr w -> NatRepr (w + 1)
forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat NatRepr w
w) NatRepr (w + w)
w'

         Expr LLVM s (BVType w)
prod <- Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVMul NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
         Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds Expr LLVM s (BVType w)
prod
           [ ( Bool
nuw Bool -> Bool -> Bool
&& Bool
noLaxArith
             , do
                 Expr LLVM s ('BaseToType (BaseBVType (w + w)))
az       <- Atom s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s ('BaseToType (BaseBVType (w + w)))
 -> Expr LLVM s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (w + w))))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr (w + w)
-> NatRepr w
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVZext NatRepr (w + w)
w' NatRepr w
w Expr LLVM s (BVType w)
a))
                 Expr LLVM s ('BaseToType (BaseBVType (w + w)))
bz       <- Atom s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s ('BaseToType (BaseBVType (w + w)))
 -> Expr LLVM s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (w + w))))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr (w + w)
-> NatRepr w
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVZext NatRepr (w + w)
w' NatRepr w
w Expr LLVM s (BVType w)
b))
                 Expr LLVM s ('BaseToType (BaseBVType (w + w)))
wideprod <- Atom s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s ('BaseToType (BaseBVType (w + w)))
 -> Expr LLVM s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (w + w))))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr (w + w)
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVMul NatRepr (w + w)
w' Expr LLVM s ('BaseToType (BaseBVType (w + w)))
az Expr LLVM s ('BaseToType (BaseBVType (w + w)))
bz))
                 Expr LLVM s ('BaseToType (BaseBVType (w + w)))
prodz    <- Atom s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s ('BaseToType (BaseBVType (w + w)))
 -> Expr LLVM s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (w + w))))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr (w + w)
-> NatRepr w
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVZext NatRepr (w + w)
w' NatRepr w
w Expr LLVM s (BVType w)
prod))
                 Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr (w + w)
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr (w + w)
w' Expr LLVM s ('BaseToType (BaseBVType (w + w)))
wideprod Expr LLVM s ('BaseToType (BaseBVType (w + w)))
prodz))
             , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.MulNoUnsignedWrap Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
             )
           , ( Bool
nsw Bool -> Bool -> Bool
&& Bool
noLaxArith
             , do
                 Expr LLVM s ('BaseToType (BaseBVType (w + w)))
as       <- Atom s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s ('BaseToType (BaseBVType (w + w)))
 -> Expr LLVM s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (w + w))))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr (w + w)
-> NatRepr w
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVSext NatRepr (w + w)
w' NatRepr w
w Expr LLVM s (BVType w)
a))
                 Expr LLVM s ('BaseToType (BaseBVType (w + w)))
bs       <- Atom s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s ('BaseToType (BaseBVType (w + w)))
 -> Expr LLVM s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (w + w))))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr (w + w)
-> NatRepr w
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVSext NatRepr (w + w)
w' NatRepr w
w Expr LLVM s (BVType w)
b))
                 Expr LLVM s ('BaseToType (BaseBVType (w + w)))
wideprod <- Atom s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s ('BaseToType (BaseBVType (w + w)))
 -> Expr LLVM s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (w + w))))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr (w + w)
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVMul NatRepr (w + w)
w' Expr LLVM s ('BaseToType (BaseBVType (w + w)))
as Expr LLVM s ('BaseToType (BaseBVType (w + w)))
bs))
                 Expr LLVM s ('BaseToType (BaseBVType (w + w)))
prods    <- Atom s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s ('BaseToType (BaseBVType (w + w)))
 -> Expr LLVM s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (w + w))))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Atom s ('BaseToType (BaseBVType (w + w))))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr (w + w)
-> NatRepr w
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) ('BaseToType (BaseBVType (w + w)))
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> Type)
       ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVSext NatRepr (w + w)
w' NatRepr w
w Expr LLVM s (BVType w)
prod))
                 Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr (w + w)
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> Expr LLVM s ('BaseToType (BaseBVType (w + w)))
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr (w + w)
w' Expr LLVM s ('BaseToType (BaseBVType (w + w)))
wideprod Expr LLVM s ('BaseToType (BaseBVType (w + w)))
prods))
             , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.MulNoSignedWrap Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
             )
           ]

       L.UDiv Bool
exact -> do
         Expr LLVM s (BVType w)
q <- Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVUdiv NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
         Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds Expr LLVM s (BVType w)
q
           [ ( Bool
exact Bool -> Bool -> Bool
&& Bool
noLaxArith
             , (Atom s (BVType w) -> Expr LLVM s BoolType)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b.
(a -> b)
-> Generator LLVM s (LLVMState arch) ret IO a
-> Generator LLVM s (LLVMState arch) ret IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> (Atom s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> Atom s (BVType w)
-> Expr LLVM s BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
a (Expr LLVM s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Atom s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr)
                    (Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVMul NatRepr w
w Expr LLVM s (BVType w)
q Expr LLVM s (BVType w)
b)))
             , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.UDivExact Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
             )
           , UndefinedBehavior (Expr LLVM s)
-> (Bool,
    Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
    UndefinedBehavior (Expr LLVM s))
bNeqZero (Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> UndefinedBehavior (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> UndefinedBehavior e
UB.UDivByZero Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)
           ]

       L.SDiv Bool
exact
         | Just LeqProof 1 w
LeqProof <- NatRepr w -> Maybe (LeqProof 1 w)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr w
w -> do
           Expr LLVM s (BVType w)
q <- Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVSdiv NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
           Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds Expr LLVM s (BVType w)
q
            [ ( Bool
exact Bool -> Bool -> Bool
&& Bool
noLaxArith
              , (Atom s (BVType w) -> Expr LLVM s BoolType)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b.
(a -> b)
-> Generator LLVM s (LLVMState arch) ret IO a
-> Generator LLVM s (LLVMState arch) ret IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> (Atom s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> Atom s (BVType w)
-> Expr LLVM s BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
a (Expr LLVM s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Atom s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr)
                     (Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVMul NatRepr w
w Expr LLVM s (BVType w)
q Expr LLVM s (BVType w)
b)))
              , Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s))
-> Poison (Expr LLVM s) -> UndefinedBehavior (Expr LLVM s)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> Poison (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> Poison e
Poison.SDivExact Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
              )
            , ( Bool
noLaxArith
              , Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Expr LLVM s BoolType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type).
IsExpr e =>
e BoolType -> e BoolType
notExpr (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
neg1 Expr LLVM s (BVType w)
b) Expr LLVM s BoolType
-> Expr LLVM s BoolType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type).
IsExpr e =>
e BoolType -> e BoolType -> e BoolType
.&& App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
minInt Expr LLVM s (BVType w)
a)))
              , Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> UndefinedBehavior (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> UndefinedBehavior e
UB.SDivOverflow Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
              )
            , UndefinedBehavior (Expr LLVM s)
-> (Bool,
    Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
    UndefinedBehavior (Expr LLVM s))
bNeqZero (Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> UndefinedBehavior (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> UndefinedBehavior e
UB.SDivByZero Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)
            ]

         | Bool
otherwise -> String
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"cannot take the signed quotient of a 0-width bitvector"

       ArithOp
L.URem -> Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVUrem NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)) [ UndefinedBehavior (Expr LLVM s)
-> (Bool,
    Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
    UndefinedBehavior (Expr LLVM s))
bNeqZero (Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> UndefinedBehavior (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> UndefinedBehavior e
UB.URemByZero Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b) ]

       ArithOp
L.SRem
         | Just LeqProof 1 w
LeqProof <- NatRepr w -> Maybe (LeqProof 1 w)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr w
w ->
            do Expr LLVM s (BVType w)
r <- Atom s (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType). Atom s tp -> Expr ext s tp
AtomExpr (Atom s (BVType w) -> Expr LLVM s (BVType w))
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Atom s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Atom s tp)
mkAtom (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVSrem NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b))
               Expr LLVM s (BVType w)
-> [(Bool,
     Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
     UndefinedBehavior (Expr LLVM s))]
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
withSideConds Expr LLVM s (BVType w)
r
                 [ ( Bool
noLaxArith
                   , Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Expr LLVM s BoolType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type).
IsExpr e =>
e BoolType -> e BoolType
notExpr (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
neg1 Expr LLVM s (BVType w)
b) Expr LLVM s BoolType
-> Expr LLVM s BoolType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type).
IsExpr e =>
e BoolType -> e BoolType -> e BoolType
.&& App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
minInt Expr LLVM s (BVType w)
a)))
                   , Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> UndefinedBehavior (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> UndefinedBehavior e
UB.SRemOverflow Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b
                   )
                 , UndefinedBehavior (Expr LLVM s)
-> (Bool,
    Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType),
    UndefinedBehavior (Expr LLVM s))
bNeqZero (Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w) -> UndefinedBehavior (Expr LLVM s)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> e (BVType w) -> UndefinedBehavior e
UB.SRemByZero Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)
                 ]

         | Bool
otherwise -> String
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"cannot take the signed remainder of a 0-width bitvector"

       ArithOp
_ -> String
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w)))
-> String
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"unsupported integer arith operation", ArithOp -> String
forall a. Show a => a -> String
show ArithOp
op]

caseptr
  :: (1 <= w)
  => NatRepr w
  -> TypeRepr a
  -> (Expr LLVM s (BVType w) ->
      LLVMGenerator s arch ret (Expr LLVM s a))
  -> (Expr LLVM s NatType -> Expr LLVM s (BVType w) ->
      LLVMGenerator s arch ret (Expr LLVM s a))
  -> Expr LLVM s (LLVMPointerType w)
  -> LLVMGenerator s arch ret (Expr LLVM s a)

caseptr :: forall (w :: Natural) (a :: CrucibleType) s (arch :: LLVMArch)
       (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> TypeRepr a
-> (Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s a)
caseptr NatRepr w
w TypeRepr a
tpr Expr LLVM s (BVType w) -> LLVMGenerator s arch ret (Expr LLVM s a)
bvCase Expr LLVM s NatType
-> Expr LLVM s (BVType w)
-> LLVMGenerator s arch ret (Expr LLVM s a)
ptrCase Expr LLVM s (LLVMPointerType w)
x =
  case Expr LLVM s (LLVMPointerType w)
x of
    PointerExpr NatRepr w
_ Expr LLVM s NatType
blk Expr LLVM s (BVType w)
off ->
      case Expr LLVM s NatType
-> Maybe (App (ExprExt (Expr LLVM s)) (Expr LLVM s) NatType)
forall (tp :: CrucibleType).
Expr LLVM s tp
-> Maybe (App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp)
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
e tp -> Maybe (App (ExprExt e) e tp)
asApp Expr LLVM s NatType
blk of
        Just (NatLit Natural
0) -> Expr LLVM s (BVType w) -> LLVMGenerator s arch ret (Expr LLVM s a)
bvCase Expr LLVM s (BVType w)
off
        Just (NatLit Natural
_) -> Expr LLVM s NatType
-> Expr LLVM s (BVType w)
-> LLVMGenerator s arch ret (Expr LLVM s a)
ptrCase Expr LLVM s NatType
blk Expr LLVM s (BVType w)
off
        Maybe (App (ExprExt (Expr LLVM s)) (Expr LLVM s) NatType)
_               -> Expr LLVM s NatType
-> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s a)
ptrSwitch Expr LLVM s NatType
blk Expr LLVM s (BVType w)
off

    Expr LLVM s (LLVMPointerType w)
_ -> do Expr LLVM s (LLVMPointerType w)
a_x <- Expr LLVM s (LLVMPointerType w)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Expr ext s tp)
forceEvaluation Expr LLVM s (LLVMPointerType w)
x
            Expr LLVM s NatType
blk <- Expr LLVM s NatType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s NatType)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Expr ext s tp)
forceEvaluation (App LLVM (Expr LLVM s) NatType -> Expr LLVM s NatType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (ExprExtension LLVM (Expr LLVM s) NatType
-> App LLVM (Expr LLVM s) NatType
forall ext (f :: CrucibleType -> Type) (tp :: CrucibleType).
ExprExtension ext f tp -> App ext f tp
ExtensionApp (NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMExtensionExpr (Expr LLVM s) NatType
forall (w :: Natural) (a :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> a (LLVMPointerType w) -> LLVMExtensionExpr a NatType
LLVM_PointerBlock NatRepr w
w Expr LLVM s (LLVMPointerType w)
a_x)))
            Expr LLVM s (BVType w)
off <- Expr LLVM s (BVType w)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Expr ext s tp)
forceEvaluation (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (ExprExtension LLVM (Expr LLVM s) (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall ext (f :: CrucibleType -> Type) (tp :: CrucibleType).
ExprExtension ext f tp -> App ext f tp
ExtensionApp (NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMExtensionExpr (Expr LLVM s) (BVType w)
forall (w :: Natural) (a :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w
-> a (LLVMPointerType w)
-> LLVMExtensionExpr a ('BaseToType (BaseBVType w))
LLVM_PointerOffset NatRepr w
w Expr LLVM s (LLVMPointerType w)
a_x)))
            Expr LLVM s NatType
-> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s a)
ptrSwitch Expr LLVM s NatType
blk Expr LLVM s (BVType w)
off
  where
  ptrSwitch :: Expr LLVM s NatType
-> Expr LLVM s (BVType w)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s a)
ptrSwitch Expr LLVM s NatType
blk Expr LLVM s (BVType w)
off =
    do let cond :: Expr LLVM s BoolType
cond = (Expr LLVM s NatType
blk Expr LLVM s NatType -> Expr LLVM s NatType -> Expr LLVM s BoolType
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
(EqExpr e tp, IsExpr e) =>
e tp -> e tp -> e BoolType
.== Natural -> Expr LLVM s NatType
forall (e :: CrucibleType -> Type) (tp :: CrucibleType) ty.
(LitExpr e tp ty, IsExpr e) =>
ty -> e tp
litExpr Natural
0)
       LambdaLabel s a
c_label  <- TypeRepr a
-> Generator LLVM s (LLVMState arch) ret IO (LambdaLabel s a)
forall (m :: Type -> Type) (tp :: CrucibleType) ext s
       (t :: Type -> Type) (ret :: CrucibleType).
Monad m =>
TypeRepr tp -> Generator ext s t ret m (LambdaLabel s tp)
newLambdaLabel' TypeRepr a
tpr
       Label s
bv_label <- (forall a. Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO (Label s)
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
(forall a. Generator ext s t ret m a)
-> Generator ext s t ret m (Label s)
defineBlockLabel (Expr LLVM s (BVType w) -> LLVMGenerator s arch ret (Expr LLVM s a)
bvCase Expr LLVM s (BVType w)
off Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s a)
-> (Expr LLVM s a -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a b.
Generator LLVM s (LLVMState arch) ret IO a
-> (a -> Generator LLVM s (LLVMState arch) ret IO b)
-> Generator LLVM s (LLVMState arch) ret IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= LambdaLabel s a
-> Expr LLVM s a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
LambdaLabel s tp -> Expr ext s tp -> Generator ext s t ret m a
jumpToLambda LambdaLabel s a
c_label)
       Label s
ptr_label <- (forall a. Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO (Label s)
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
(forall a. Generator ext s t ret m a)
-> Generator ext s t ret m (Label s)
defineBlockLabel (Expr LLVM s NatType
-> Expr LLVM s (BVType w)
-> LLVMGenerator s arch ret (Expr LLVM s a)
ptrCase Expr LLVM s NatType
blk Expr LLVM s (BVType w)
off Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s a)
-> (Expr LLVM s a -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a b.
Generator LLVM s (LLVMState arch) ret IO a
-> (a -> Generator LLVM s (LLVMState arch) ret IO b)
-> Generator LLVM s (LLVMState arch) ret IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= LambdaLabel s a
-> Expr LLVM s a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
LambdaLabel s tp -> Expr ext s tp -> Generator ext s t ret m a
jumpToLambda LambdaLabel s a
c_label)
       LambdaLabel s a
-> (forall a. Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s a)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
LambdaLabel s tp
-> (forall a. Generator ext s t ret m a)
-> Generator ext s t ret m (Expr ext s tp)
continueLambda LambdaLabel s a
c_label (Expr LLVM s BoolType
-> Label s -> Label s -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s BoolType
-> Label s -> Label s -> Generator ext s t ret m a
branch Expr LLVM s BoolType
cond Label s
bv_label Label s
ptr_label)

atomicRWOp ::
  L.AtomicRWOp ->
  LLVMExpr s arch ->
  LLVMExpr s arch ->
  LLVMGenerator s arch ret (LLVMExpr s arch)
atomicRWOp :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
AtomicRWOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
atomicRWOp AtomicRWOp
op LLVMExpr s arch
x LLVMExpr s arch
y =
  case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
y) of
    (Scalar Proxy# arch
_archProxy (LLVMPointerRepr (NatRepr w
w :: NatRepr w)) Expr LLVM s tp
x', Scalar Proxy# arch
_archProxy' (LLVMPointerRepr NatRepr w
w') Expr LLVM s tp
y')
      | Just w :~: w
Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr w
w'
      -> do Expr LLVM s (BVType w)
xbv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x'
            Expr LLVM s (BVType w)
ybv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
y'
            let newval :: Expr LLVM s (BVType w)
newval = case AtomicRWOp
op of
                   AtomicRWOp
L.AtomicXchg -> Expr LLVM s (BVType w)
ybv
                   AtomicRWOp
L.AtomicAdd  -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVAdd NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
                   AtomicRWOp
L.AtomicSub  -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVSub NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
                   AtomicRWOp
L.AtomicAnd  -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVAnd NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
                   AtomicRWOp
L.AtomicNand -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> App ext f (BVType w)
BVNot NatRepr w
w (Expr LLVM s (BVType w)
 -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w))
-> Expr LLVM s (BVType w)
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
forall a b. (a -> b) -> a -> b
$ App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVAnd NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
                   AtomicRWOp
L.AtomicOr   -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVOr NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
                   AtomicRWOp
L.AtomicXor  -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVXor NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
                   AtomicRWOp
L.AtomicMax  -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVSMax NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
                   AtomicRWOp
L.AtomicMin  -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVSMin NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
                   AtomicRWOp
L.AtomicUMax -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVUMax NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
                   AtomicRWOp
L.AtomicUMin -> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
 -> Expr LLVM s (BVType w))
-> App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BVType w)
-> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVUMin NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
            LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ TypeRepr (LLVMPointerType w)
-> Expr LLVM s (LLVMPointerType w) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr w -> TypeRepr (LLVMPointerType w)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr w
w) (Expr LLVM s (LLVMPointerType w) -> LLVMExpr s arch)
-> Expr LLVM s (LLVMPointerType w) -> LLVMExpr s arch
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr w
w Expr LLVM s (BVType w)
newval

    (ScalarView s arch, ScalarView s arch)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
"atomicRW operation on incompatible values"
                        , String
"Operation: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AtomicRWOp -> String
forall a. Show a => a -> String
show AtomicRWOp
op
                        , String
"Value 1: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x
                        , String
"Value 2: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
y
                        ]

floatingCompare ::
  L.FCmpOp ->
  MemType ->
  LLVMExpr s arch ->
  LLVMExpr s arch ->
  LLVMGenerator s arch ret (LLVMExpr s arch)
floatingCompare :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
FCmpOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
floatingCompare FCmpOp
op (VecType Natural
n MemType
tp) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
xs) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
ys) =
  MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr (Natural -> MemType
IntType Natural
1) (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => Seq (m a) -> m (Seq a)
sequence ((LLVMExpr s arch
 -> LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Seq (LLVMExpr s arch)
-> Seq (LLVMExpr s arch)
-> Seq (Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith (\LLVMExpr s arch
x LLVMExpr s arch
y -> FCmpOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
FCmpOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
floatingCompare FCmpOp
op MemType
tp LLVMExpr s arch
x LLVMExpr s arch
y) Seq (LLVMExpr s arch)
xs Seq (LLVMExpr s arch)
ys)

floatingCompare FCmpOp
op MemType
_ LLVMExpr s arch
x LLVMExpr s arch
y =
  do Expr LLVM s BoolType
b <- FCmpOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
FCmpOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
scalarFloatingCompare FCmpOp
op LLVMExpr s arch
x LLVMExpr s arch
y
     LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr (LLVMPointerType 1)
-> Expr LLVM s (LLVMPointerType 1) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr 1 -> TypeRepr (LLVMPointerType 1)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr (NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1))
                      (NatRepr 1
-> Expr LLVM s (BVType 1) -> Expr LLVM s (LLVMPointerType 1)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (App LLVM (Expr LLVM s) (BVType 1) -> Expr LLVM s (BVType 1)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr 1
-> Expr LLVM s BoolType -> App LLVM (Expr LLVM s) (BVType 1)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f BoolType -> App ext f ('BaseToType (BaseBVType w))
BoolToBV NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat Expr LLVM s BoolType
b))))

scalarFloatingCompare ::
  L.FCmpOp ->
  LLVMExpr s arch ->
  LLVMExpr s arch ->
  LLVMGenerator s arch ret (Expr LLVM s BoolType)
scalarFloatingCompare :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
FCmpOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
scalarFloatingCompare FCmpOp
op LLVMExpr s arch
x LLVMExpr s arch
y =
  case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
y) of
     (Scalar Proxy# arch
_archProxy (FloatRepr FloatInfoRepr flt
fi) Expr LLVM s tp
x',
      Scalar Proxy# arch
_archPrxy' (FloatRepr FloatInfoRepr flt
fi') Expr LLVM s tp
y')
      | Just flt :~: flt
Refl <- FloatInfoRepr flt -> FloatInfoRepr flt -> Maybe (flt :~: flt)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: FloatInfo) (b :: FloatInfo).
FloatInfoRepr a -> FloatInfoRepr b -> Maybe (a :~: b)
testEquality FloatInfoRepr flt
fi FloatInfoRepr flt
fi' ->
          Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (FCmpOp
-> Expr LLVM s ('FloatType flt)
-> Expr LLVM s ('FloatType flt)
-> Expr LLVM s BoolType
forall s (fi :: FloatInfo).
FCmpOp
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s BoolType
floatcmp FCmpOp
op Expr LLVM s tp
Expr LLVM s ('FloatType flt)
x' Expr LLVM s tp
Expr LLVM s ('FloatType flt)
y')

     (ScalarView s arch, ScalarView s arch)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> String
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Floating point comparison on incompatible values", LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
y]

floatcmp ::
  L.FCmpOp ->
  Expr LLVM s (FloatType fi) ->
  Expr LLVM s (FloatType fi) ->
  Expr LLVM s BoolType
floatcmp :: forall s (fi :: FloatInfo).
FCmpOp
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s BoolType
floatcmp FCmpOp
op Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b =
   let isNaNCond :: Expr ext s (FloatType fi) -> Expr ext s BoolType
isNaNCond = App ext (Expr ext s) BoolType -> Expr ext s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App ext (Expr ext s) BoolType -> Expr ext s BoolType)
-> (Expr ext s (FloatType fi) -> App ext (Expr ext s) BoolType)
-> Expr ext s (FloatType fi)
-> Expr ext s BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr ext s (FloatType fi) -> App ext (Expr ext s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> App ext f BoolType
FloatIsNaN
       -- True if a is NAN or b is NAN
       unoCond :: Expr LLVM s BoolType
unoCond = App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s BoolType
-> Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) ext.
f BoolType -> f BoolType -> App ext f BoolType
Or (Expr LLVM s (FloatType fi) -> Expr LLVM s BoolType
forall {ext} {s} {fi :: FloatInfo}.
Expr ext s (FloatType fi) -> Expr ext s BoolType
isNaNCond Expr LLVM s (FloatType fi)
a) (Expr LLVM s (FloatType fi) -> Expr LLVM s BoolType
forall {ext} {s} {fi :: FloatInfo}.
Expr ext s (FloatType fi) -> Expr ext s BoolType
isNaNCond Expr LLVM s (FloatType fi)
b)
       mkUno :: Expr LLVM s BoolType -> Expr LLVM s BoolType
mkUno Expr LLVM s BoolType
c = App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s BoolType
-> Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) ext.
f BoolType -> f BoolType -> App ext f BoolType
Or Expr LLVM s BoolType
c Expr LLVM s BoolType
unoCond
    in case FCmpOp
op of
          FCmpOp
L.Ftrue  -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Bool -> App LLVM (Expr LLVM s) BoolType
forall ext (f :: CrucibleType -> Type). Bool -> App ext f BoolType
BoolLit Bool
True
          FCmpOp
L.Ffalse -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Bool -> App LLVM (Expr LLVM s) BoolType
forall ext (f :: CrucibleType -> Type). Bool -> App ext f BoolType
BoolLit Bool
False
          FCmpOp
L.Foeq   -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatFpEq Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Folt   -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatLt Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Fole   -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatLe Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Fogt   -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatGt Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Foge   -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatGe Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Fone   -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatFpApart Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Fueq   -> Expr LLVM s BoolType -> Expr LLVM s BoolType
mkUno (Expr LLVM s BoolType -> Expr LLVM s BoolType)
-> Expr LLVM s BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatFpEq Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Fult   -> Expr LLVM s BoolType -> Expr LLVM s BoolType
mkUno (Expr LLVM s BoolType -> Expr LLVM s BoolType)
-> Expr LLVM s BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatLt Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Fule   -> Expr LLVM s BoolType -> Expr LLVM s BoolType
mkUno (Expr LLVM s BoolType -> Expr LLVM s BoolType)
-> Expr LLVM s BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatLe Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Fugt   -> Expr LLVM s BoolType -> Expr LLVM s BoolType
mkUno (Expr LLVM s BoolType -> Expr LLVM s BoolType)
-> Expr LLVM s BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatGt Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Fuge   -> Expr LLVM s BoolType -> Expr LLVM s BoolType
mkUno (Expr LLVM s BoolType -> Expr LLVM s BoolType)
-> Expr LLVM s BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatGe Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Fune   -> Expr LLVM s BoolType -> Expr LLVM s BoolType
mkUno (Expr LLVM s BoolType -> Expr LLVM s BoolType)
-> Expr LLVM s BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi) -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) (fi :: FloatInfo) ext.
f (FloatType fi) -> f (FloatType fi) -> App ext f BoolType
FloatFpApart Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
          FCmpOp
L.Ford   -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s BoolType
-> Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) ext.
f BoolType -> f BoolType -> App ext f BoolType
And (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) ext.
f BoolType -> App ext f BoolType
Not (Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType)
-> Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi) -> Expr LLVM s BoolType
forall {ext} {s} {fi :: FloatInfo}.
Expr ext s (FloatType fi) -> Expr ext s BoolType
isNaNCond Expr LLVM s (FloatType fi)
a) (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) ext.
f BoolType -> App ext f BoolType
Not (Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType)
-> Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall a b. (a -> b) -> a -> b
$ Expr LLVM s (FloatType fi) -> Expr LLVM s BoolType
forall {ext} {s} {fi :: FloatInfo}.
Expr ext s (FloatType fi) -> Expr ext s BoolType
isNaNCond Expr LLVM s (FloatType fi)
b)
          FCmpOp
L.Funo   -> Expr LLVM s BoolType
unoCond


integerCompare ::
  L.ICmpOp ->
  MemType ->
  LLVMExpr s arch ->
  LLVMExpr s arch ->
  LLVMGenerator s arch ret (LLVMExpr s arch)
integerCompare :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
ICmpOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
integerCompare ICmpOp
op (VecType Natural
n MemType
tp) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
xs) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
ys) =
  MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr (Natural -> MemType
IntType Natural
1) (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => Seq (m a) -> m (Seq a)
sequence ((LLVMExpr s arch
 -> LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Seq (LLVMExpr s arch)
-> Seq (LLVMExpr s arch)
-> Seq (Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith (\LLVMExpr s arch
x LLVMExpr s arch
y -> ICmpOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
ICmpOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
integerCompare ICmpOp
op MemType
tp LLVMExpr s arch
x LLVMExpr s arch
y) Seq (LLVMExpr s arch)
xs Seq (LLVMExpr s arch)
ys)

integerCompare ICmpOp
op MemType
_ LLVMExpr s arch
x LLVMExpr s arch
y = do
  Expr LLVM s BoolType
b <- ICmpOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
ICmpOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
scalarIntegerCompare ICmpOp
op LLVMExpr s arch
x LLVMExpr s arch
y
  LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr (LLVMPointerType 1)
-> Expr LLVM s (LLVMPointerType 1) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr 1 -> TypeRepr (LLVMPointerType 1)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr (NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1))
                   (NatRepr 1
-> Expr LLVM s (BVType 1) -> Expr LLVM s (LLVMPointerType 1)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (App LLVM (Expr LLVM s) (BVType 1) -> Expr LLVM s (BVType 1)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr 1
-> Expr LLVM s BoolType -> App LLVM (Expr LLVM s) (BVType 1)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f BoolType -> App ext f ('BaseToType (BaseBVType w))
BoolToBV NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat Expr LLVM s BoolType
b))))

scalarIntegerCompare ::
  L.ICmpOp ->
  LLVMExpr s arch ->
  LLVMExpr s arch ->
  LLVMGenerator s arch ret (Expr LLVM s BoolType)
scalarIntegerCompare :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
ICmpOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
scalarIntegerCompare ICmpOp
op LLVMExpr s arch
x LLVMExpr s arch
y =
  case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
y) of
    (Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x'', Scalar Proxy# arch
_archProxy' (LLVMPointerRepr NatRepr w
w') Expr LLVM s tp
y'')
       | Just w :~: w
Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr w
w'
       , Just w :~: ArchWidth arch
Refl <- NatRepr w
-> NatRepr (ArchWidth arch) -> Maybe (w :~: ArchWidth arch)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth
       -> ICmpOp
-> Expr LLVM s (LLVMPointerType w)
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
ICmpOp
-> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
pointerCmp ICmpOp
op Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x'' Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
y''
       | Just w :~: w
Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr w
w'
       -> do Expr LLVM s (BVType w)
xbv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x''
             Expr LLVM s (BVType w)
ybv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
y''
             Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (NatRepr w
-> ICmpOp
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> Expr LLVM s BoolType
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> ICmpOp
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> Expr LLVM s BoolType
intcmp NatRepr w
w ICmpOp
op Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv)
    (ScalarView s arch, ScalarView s arch)
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> String
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
"arithmetic comparison on incompatible values"
                        , String
"Comparison: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ICmpOp -> String
forall a. Show a => a -> String
show ICmpOp
op
                        , String
"Value 1: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x
                        , String
"Value 2: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
y
                        ]

intcmp :: (1 <= w)
    => NatRepr w
    -> L.ICmpOp
    -> Expr LLVM s (BVType w)
    -> Expr LLVM s (BVType w)
    -> Expr LLVM s BoolType
intcmp :: forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> ICmpOp
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> Expr LLVM s BoolType
intcmp NatRepr w
w ICmpOp
op Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b =
   case ICmpOp
op of
      ICmpOp
L.Ieq  -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)
      ICmpOp
L.Ine  -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) ext.
f BoolType -> App ext f BoolType
Not (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)))
      ICmpOp
L.Iult -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVUlt NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)
      ICmpOp
L.Iule -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVUle NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)
      ICmpOp
L.Iugt -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVUlt NatRepr w
w Expr LLVM s (BVType w)
b Expr LLVM s (BVType w)
a)
      ICmpOp
L.Iuge -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVUle NatRepr w
w Expr LLVM s (BVType w)
b Expr LLVM s (BVType w)
a)
      ICmpOp
L.Islt -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVSlt NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)
      ICmpOp
L.Isle -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVSle NatRepr w
w Expr LLVM s (BVType w)
a Expr LLVM s (BVType w)
b)
      ICmpOp
L.Isgt -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVSlt NatRepr w
w Expr LLVM s (BVType w)
b Expr LLVM s (BVType w)
a)
      ICmpOp
L.Isge -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f BoolType
BVSle NatRepr w
w Expr LLVM s (BVType w)
b Expr LLVM s (BVType w)
a)

pointerCmp
   :: (wptr ~ ArchWidth arch)
   => L.ICmpOp
   -> Expr LLVM s (LLVMPointerType wptr)
   -> Expr LLVM s (LLVMPointerType wptr)
   -> LLVMGenerator s arch ret (Expr LLVM s BoolType)
pointerCmp :: forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
ICmpOp
-> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
pointerCmp ICmpOp
op Expr LLVM s (LLVMPointerType wptr)
x Expr LLVM s (LLVMPointerType wptr)
y =
  NatRepr wptr
-> TypeRepr BoolType
-> (Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s BoolType))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s BoolType))
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall (w :: Natural) (a :: CrucibleType) s (arch :: LLVMArch)
       (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> TypeRepr a
-> (Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s a)
caseptr NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth TypeRepr BoolType
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    (\Expr LLVM s (BVType wptr)
x_bv ->
      NatRepr wptr
-> TypeRepr BoolType
-> (Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s BoolType))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s BoolType))
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall (w :: Natural) (a :: CrucibleType) s (arch :: LLVMArch)
       (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> TypeRepr a
-> (Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s a)
caseptr NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth TypeRepr BoolType
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
        (\Expr LLVM s (BVType wptr)
y_bv   -> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s BoolType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ NatRepr wptr
-> ICmpOp
-> Expr LLVM s (BVType wptr)
-> Expr LLVM s (BVType wptr)
-> Expr LLVM s BoolType
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> ICmpOp
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> Expr LLVM s BoolType
intcmp NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth ICmpOp
op Expr LLVM s (BVType wptr)
x_bv Expr LLVM s (BVType wptr)
y_bv)
        (\Expr LLVM s NatType
_ Expr LLVM s (BVType wptr)
_ -> Expr LLVM s (BVType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
ptr_bv_compare Expr LLVM s (BVType wptr)
x_bv Expr LLVM s (LLVMPointerType wptr)
y)
        Expr LLVM s (LLVMPointerType wptr)
y)
    (\Expr LLVM s NatType
_ Expr LLVM s (BVType wptr)
_ ->
      NatRepr wptr
-> TypeRepr BoolType
-> (Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s BoolType))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s BoolType))
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall (w :: Natural) (a :: CrucibleType) s (arch :: LLVMArch)
       (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> TypeRepr a
-> (Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s a)
caseptr NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth TypeRepr BoolType
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
        (\Expr LLVM s (BVType wptr)
y_bv   -> Expr LLVM s (BVType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
ptr_bv_compare Expr LLVM s (BVType wptr)
y_bv Expr LLVM s (LLVMPointerType wptr)
x)
        (\Expr LLVM s NatType
_ Expr LLVM s (BVType wptr)
_    -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
ptrOp)
        Expr LLVM s (LLVMPointerType wptr)
y)
    Expr LLVM s (LLVMPointerType wptr)
x
 where

  -- Special case: a pointer can be compared for equality with an integer, as long as
  -- that integer is 0, representing the null pointer.
  ptr_bv_compare :: Expr LLVM s (BVType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
ptr_bv_compare Expr LLVM s (BVType wptr)
bv Expr LLVM s (LLVMPointerType wptr)
ptr = do
    -- TODO: We can't use assertUndefinedSym here since the type variable 'sym'
    -- isn't in scope. How should this be fixed?
    Expr LLVM s BoolType
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s BoolType
-> Expr ext s (StringType Unicode) -> Generator ext s t ret m ()
assertExpr
      (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr wptr
-> Expr LLVM s (BVType wptr)
-> Expr LLVM s (BVType wptr)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Expr LLVM s (BVType wptr)
bv (App LLVM (Expr LLVM s) (BVType wptr) -> Expr LLVM s (BVType wptr)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr wptr -> BV wptr -> App LLVM (Expr LLVM s) (BVType wptr)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (NatRepr wptr -> BV wptr
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth)))))
      (Text -> Expr LLVM s (StringType Unicode)
forall (e :: CrucibleType -> Type) (tp :: CrucibleType) ty.
(LitExpr e tp ty, IsExpr e) =>
ty -> e tp
litExpr Text
"Undefined comparison between pointer and integer")
    case ICmpOp
op of
      ICmpOp
L.Ieq  -> NatRepr wptr
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
callIsNull NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Expr LLVM s (LLVMPointerType wptr)
ptr
      ICmpOp
L.Ine  -> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> (Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType)
-> Expr LLVM s BoolType
-> Expr LLVM s BoolType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) ext.
f BoolType -> App ext f BoolType
Not (Expr LLVM s BoolType -> Expr LLVM s BoolType)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NatRepr wptr
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
callIsNull NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Expr LLVM s (LLVMPointerType wptr)
ptr
      ICmpOp
_ -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ Text -> Expr LLVM s (StringType Unicode)
forall (e :: CrucibleType -> Type) (tp :: CrucibleType) ty.
(LitExpr e tp ty, IsExpr e) =>
ty -> e tp
litExpr (Text -> Expr LLVM s (StringType Unicode))
-> Text -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
            [ String
"Arithmetic comparison on incompatible values"
            , String
"Comparison operation: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ICmpOp -> String
forall a. Show a => a -> String
show ICmpOp
op
            , String
"Value 1: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr LLVM s (LLVMPointerType wptr) -> String
forall a. Show a => a -> String
show Expr LLVM s (LLVMPointerType wptr)
x
            , String
"Value 2: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr LLVM s (LLVMPointerType wptr) -> String
forall a. Show a => a -> String
show Expr LLVM s (LLVMPointerType wptr)
y
            ]

  ptrOp :: Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
ptrOp =
    do GlobalVar Mem
memVar <- Generator LLVM s (LLVMState arch) ret IO (GlobalVar Mem)
forall s (arch :: LLVMArch) (reg :: CrucibleType).
LLVMGenerator s arch reg (GlobalVar Mem)
getMemVar
       case ICmpOp
op of
         ICmpOp
L.Ieq -> do
           Expr LLVM s BoolType
isEq <- StmtExtension LLVM (Expr LLVM s) BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
StmtExtension ext (Expr ext s) tp
-> Generator ext s t ret m (Expr ext s tp)
extensionStmt (GlobalVar Mem
-> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMStmt (Expr LLVM s) BoolType
forall (wptr :: Natural) (f :: CrucibleType -> Type).
HasPtrWidth wptr =>
GlobalVar Mem
-> f (LLVMPointerType wptr)
-> f (LLVMPointerType wptr)
-> LLVMStmt f BoolType
LLVM_PtrEq GlobalVar Mem
memVar Expr LLVM s (LLVMPointerType wptr)
x Expr LLVM s (LLVMPointerType wptr)
y)
           Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s BoolType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s BoolType
isEq
         ICmpOp
L.Ine -> do
           Expr LLVM s BoolType
isEq <- StmtExtension LLVM (Expr LLVM s) BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
StmtExtension ext (Expr ext s) tp
-> Generator ext s t ret m (Expr ext s tp)
extensionStmt (GlobalVar Mem
-> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMStmt (Expr LLVM s) BoolType
forall (wptr :: Natural) (f :: CrucibleType -> Type).
HasPtrWidth wptr =>
GlobalVar Mem
-> f (LLVMPointerType wptr)
-> f (LLVMPointerType wptr)
-> LLVMStmt f BoolType
LLVM_PtrEq GlobalVar Mem
memVar Expr LLVM s (LLVMPointerType wptr)
x Expr LLVM s (LLVMPointerType wptr)
y)
           Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s BoolType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) ext.
f BoolType -> App ext f BoolType
Not Expr LLVM s BoolType
isEq)
         ICmpOp
L.Iule -> do
           Expr LLVM s BoolType
isLe <- StmtExtension LLVM (Expr LLVM s) BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
StmtExtension ext (Expr ext s) tp
-> Generator ext s t ret m (Expr ext s tp)
extensionStmt (GlobalVar Mem
-> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMStmt (Expr LLVM s) BoolType
forall (wptr :: Natural) (f :: CrucibleType -> Type).
HasPtrWidth wptr =>
GlobalVar Mem
-> f (LLVMPointerType wptr)
-> f (LLVMPointerType wptr)
-> LLVMStmt f BoolType
LLVM_PtrLe GlobalVar Mem
memVar Expr LLVM s (LLVMPointerType wptr)
x Expr LLVM s (LLVMPointerType wptr)
y)
           Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s BoolType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s BoolType
isLe
         ICmpOp
L.Iult -> do
           Expr LLVM s BoolType
isGe <- StmtExtension LLVM (Expr LLVM s) BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
StmtExtension ext (Expr ext s) tp
-> Generator ext s t ret m (Expr ext s tp)
extensionStmt (GlobalVar Mem
-> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMStmt (Expr LLVM s) BoolType
forall (wptr :: Natural) (f :: CrucibleType -> Type).
HasPtrWidth wptr =>
GlobalVar Mem
-> f (LLVMPointerType wptr)
-> f (LLVMPointerType wptr)
-> LLVMStmt f BoolType
LLVM_PtrLe GlobalVar Mem
memVar Expr LLVM s (LLVMPointerType wptr)
y Expr LLVM s (LLVMPointerType wptr)
x)
           Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s BoolType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) ext.
f BoolType -> App ext f BoolType
Not Expr LLVM s BoolType
isGe)
         ICmpOp
L.Iuge -> do
           Expr LLVM s BoolType
isGe <- StmtExtension LLVM (Expr LLVM s) BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
StmtExtension ext (Expr ext s) tp
-> Generator ext s t ret m (Expr ext s tp)
extensionStmt (GlobalVar Mem
-> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMStmt (Expr LLVM s) BoolType
forall (wptr :: Natural) (f :: CrucibleType -> Type).
HasPtrWidth wptr =>
GlobalVar Mem
-> f (LLVMPointerType wptr)
-> f (LLVMPointerType wptr)
-> LLVMStmt f BoolType
LLVM_PtrLe GlobalVar Mem
memVar Expr LLVM s (LLVMPointerType wptr)
y Expr LLVM s (LLVMPointerType wptr)
x)
           Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s BoolType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ Expr LLVM s BoolType
isGe
         ICmpOp
L.Iugt -> do
           Expr LLVM s BoolType
isLe <- StmtExtension LLVM (Expr LLVM s) BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
StmtExtension ext (Expr ext s) tp
-> Generator ext s t ret m (Expr ext s tp)
extensionStmt (GlobalVar Mem
-> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMStmt (Expr LLVM s) BoolType
forall (wptr :: Natural) (f :: CrucibleType -> Type).
HasPtrWidth wptr =>
GlobalVar Mem
-> f (LLVMPointerType wptr)
-> f (LLVMPointerType wptr)
-> LLVMStmt f BoolType
LLVM_PtrLe GlobalVar Mem
memVar Expr LLVM s (LLVMPointerType wptr)
x Expr LLVM s (LLVMPointerType wptr)
y)
           Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s BoolType
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (Expr LLVM s BoolType -> App LLVM (Expr LLVM s) BoolType
forall (f :: CrucibleType -> Type) ext.
f BoolType -> App ext f BoolType
Not Expr LLVM s BoolType
isLe)
         ICmpOp
_ -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType))
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a b. (a -> b) -> a -> b
$ Text -> Expr LLVM s (StringType Unicode)
forall (e :: CrucibleType -> Type) (tp :: CrucibleType) ty.
(LitExpr e tp ty, IsExpr e) =>
ty -> e tp
litExpr (Text -> Expr LLVM s (StringType Unicode))
-> Text -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                [ String
"Signed comparison on pointer values"
                , String
"Comparison operation: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ICmpOp -> String
forall a. Show a => a -> String
show ICmpOp
op
                , String
"Value 1:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr LLVM s (LLVMPointerType wptr) -> String
forall a. Show a => a -> String
show Expr LLVM s (LLVMPointerType wptr)
x
                , String
"Value 2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr LLVM s (LLVMPointerType wptr) -> String
forall a. Show a => a -> String
show Expr LLVM s (LLVMPointerType wptr)
y
                ]

pointerOp
   :: (wptr ~ ArchWidth arch, ?transOpts :: TranslationOptions)
   => L.ArithOp
   -> Expr LLVM s (LLVMPointerType wptr)
   -> Expr LLVM s (LLVMPointerType wptr)
   -> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
pointerOp :: forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch, ?transOpts::TranslationOptions) =>
ArithOp
-> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
pointerOp ArithOp
op Expr LLVM s (LLVMPointerType wptr)
x Expr LLVM s (LLVMPointerType wptr)
y =
  NatRepr wptr
-> TypeRepr (LLVMPointerType wptr)
-> (Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr)))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr)))
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (w :: Natural) (a :: CrucibleType) s (arch :: LLVMArch)
       (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> TypeRepr a
-> (Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s a)
caseptr NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth TypeRepr (LLVMPointerType wptr)
forall (wptr :: Natural) (ty :: CrucibleType).
(HasPtrWidth wptr, ty ~ LLVMPointerType wptr) =>
TypeRepr ty
PtrRepr
    (\Expr LLVM s (BVType wptr)
x_bv  ->
      NatRepr wptr
-> TypeRepr (LLVMPointerType wptr)
-> (Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr)))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr)))
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (w :: Natural) (a :: CrucibleType) s (arch :: LLVMArch)
       (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> TypeRepr a
-> (Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s a)
caseptr NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth TypeRepr (LLVMPointerType wptr)
forall (wptr :: Natural) (ty :: CrucibleType).
(HasPtrWidth wptr, ty ~ LLVMPointerType wptr) =>
TypeRepr ty
PtrRepr
        (\Expr LLVM s (BVType wptr)
y_bv  -> NatRepr wptr
-> Expr LLVM s (BVType wptr) -> Expr LLVM s (LLVMPointerType wptr)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (Expr LLVM s (BVType wptr) -> Expr LLVM s (LLVMPointerType wptr))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType wptr))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
                     ArithOp
-> NatRepr wptr
-> Expr LLVM s (BVType wptr)
-> Expr LLVM s (BVType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType wptr))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions, 1 <= w) =>
ArithOp
-> NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
intop ArithOp
op NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Expr LLVM s (BVType wptr)
x_bv Expr LLVM s (BVType wptr)
y_bv)
        (\Expr LLVM s NatType
_ Expr LLVM s (BVType wptr)
_   -> Expr LLVM s (BVType wptr)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
bv_ptr_op Expr LLVM s (BVType wptr)
x_bv)
        Expr LLVM s (LLVMPointerType wptr)
y)
    (\Expr LLVM s NatType
_ Expr LLVM s (BVType wptr)
_ ->
      NatRepr wptr
-> TypeRepr (LLVMPointerType wptr)
-> (Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr)))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType wptr)
    -> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr)))
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (w :: Natural) (a :: CrucibleType) s (arch :: LLVMArch)
       (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> TypeRepr a
-> (Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> (Expr LLVM s NatType
    -> Expr LLVM s (BVType w)
    -> LLVMGenerator s arch ret (Expr LLVM s a))
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s a)
caseptr NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth TypeRepr (LLVMPointerType wptr)
forall (wptr :: Natural) (ty :: CrucibleType).
(HasPtrWidth wptr, ty ~ LLVMPointerType wptr) =>
TypeRepr ty
PtrRepr
        (\Expr LLVM s (BVType wptr)
y_bv  -> Expr LLVM s (BVType wptr)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
ptr_bv_op Expr LLVM s (BVType wptr)
y_bv)
        (\Expr LLVM s NatType
_ Expr LLVM s (BVType wptr)
_   -> Generator
  LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
ptr_ptr_op)
      Expr LLVM s (LLVMPointerType wptr)
y)
    Expr LLVM s (LLVMPointerType wptr)
x
 where
  ptr_bv_op :: Expr LLVM s (BVType wptr)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
ptr_bv_op Expr LLVM s (BVType wptr)
y_bv =
    case ArithOp
op of
      L.Add Bool
_ Bool
_ ->
           Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (BVType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (BVType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
callPtrAddOffset Expr LLVM s (LLVMPointerType wptr)
x Expr LLVM s (BVType wptr)
y_bv
      L.Sub Bool
_ Bool
_ ->
        do let off :: Expr LLVM s (BVType wptr)
off = App LLVM (Expr LLVM s) (BVType wptr) -> Expr LLVM s (BVType wptr)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr wptr
-> Expr LLVM s (BVType wptr)
-> Expr LLVM s (BVType wptr)
-> App LLVM (Expr LLVM s) (BVType wptr)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVSub NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (App LLVM (Expr LLVM s) (BVType wptr) -> Expr LLVM s (BVType wptr)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (BVType wptr) -> Expr LLVM s (BVType wptr))
-> App LLVM (Expr LLVM s) (BVType wptr)
-> Expr LLVM s (BVType wptr)
forall a b. (a -> b) -> a -> b
$ NatRepr wptr -> BV wptr -> App LLVM (Expr LLVM s) (BVType wptr)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (NatRepr wptr -> BV wptr
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth)) Expr LLVM s (BVType wptr)
y_bv)
           Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (BVType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (BVType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
callPtrAddOffset Expr LLVM s (LLVMPointerType wptr)
x Expr LLVM s (BVType wptr)
off
      ArithOp
_ -> Generator
  LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
err

  bv_ptr_op :: Expr LLVM s (BVType wptr)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
bv_ptr_op Expr LLVM s (BVType wptr)
x_bv =
    case ArithOp
op of
      L.Add Bool
_ Bool
_ -> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (BVType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (BVType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
callPtrAddOffset Expr LLVM s (LLVMPointerType wptr)
y Expr LLVM s (BVType wptr)
x_bv
      ArithOp
_ -> Generator
  LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
err

  ptr_ptr_op :: Generator
  LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
ptr_ptr_op =
    case ArithOp
op of
      L.Sub Bool
_ Bool
_ -> NatRepr wptr
-> Expr LLVM s (BVType wptr) -> Expr LLVM s (LLVMPointerType wptr)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (Expr LLVM s (BVType wptr) -> Expr LLVM s (LLVMPointerType wptr))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BVType wptr))
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType wptr))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType wptr))
callPtrSubtract Expr LLVM s (LLVMPointerType wptr)
x Expr LLVM s (LLVMPointerType wptr)
y
      ArithOp
_ -> Generator
  LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
err

  err :: Generator
  LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
err = Expr LLVM s (StringType Unicode)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator
      LLVM
      s
      (LLVMState arch)
      ret
      IO
      (Expr LLVM s (LLVMPointerType wptr)))
-> Expr LLVM s (StringType Unicode)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType wptr))
forall a b. (a -> b) -> a -> b
$ Text -> Expr LLVM s (StringType Unicode)
forall (e :: CrucibleType -> Type) (tp :: CrucibleType) ty.
(LitExpr e tp ty, IsExpr e) =>
ty -> e tp
litExpr (Text -> Expr LLVM s (StringType Unicode))
-> Text -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
          [ String
"Invalid pointer operation"
          , String
"Operation: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ArithOp -> String
forall a. Show a => a -> String
show ArithOp
op
          , String
"Value 1: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr LLVM s (LLVMPointerType wptr) -> String
forall a. Show a => a -> String
show Expr LLVM s (LLVMPointerType wptr)
x
          , String
"Value 2: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr LLVM s (LLVMPointerType wptr) -> String
forall a. Show a => a -> String
show Expr LLVM s (LLVMPointerType wptr)
y
          ]


baseSelect ::
   (?lc :: TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
   LLVMExpr s arch {- ^ Selection expression -} ->
   LLVMExpr s arch {- ^ true expression -} ->
   LLVMExpr s arch {- ^ false expression -} ->
   LLVMGenerator s arch ret (Maybe (LLVMExpr s arch))
baseSelect :: forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Maybe (LLVMExpr s arch))
baseSelect (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar -> Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
wc) Expr LLVM s tp
c) (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar -> Scalar Proxy# arch
_ TypeRepr tp
xtp Expr LLVM s tp
x) (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar -> Scalar Proxy# arch
_ TypeRepr tp
ytp Expr LLVM s tp
y)
  | Just tp :~: tp
Refl <- TypeRepr tp -> TypeRepr tp -> Maybe (tp :~: tp)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality TypeRepr tp
xtp TypeRepr tp
ytp
  , LLVMPointerRepr NatRepr w
w <- TypeRepr tp
xtp
  = do Expr LLVM s BoolType
c' <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
callIntToBool NatRepr w
wc Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
c
       Expr LLVM s (LLVMPointerType w)
z <- Expr LLVM s (LLVMPointerType w)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (LLVMPointerType w))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Expr ext s tp)
forceEvaluation (App LLVM (Expr LLVM s) (LLVMPointerType w)
-> Expr LLVM s (LLVMPointerType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (ExprExtension LLVM (Expr LLVM s) (LLVMPointerType w)
-> App LLVM (Expr LLVM s) (LLVMPointerType w)
forall ext (f :: CrucibleType -> Type) (tp :: CrucibleType).
ExprExtension ext f tp -> App ext f tp
ExtensionApp (NatRepr w
-> Expr LLVM s BoolType
-> Expr LLVM s (LLVMPointerType w)
-> Expr LLVM s (LLVMPointerType w)
-> LLVMExtensionExpr (Expr LLVM s) (LLVMPointerType w)
forall (w :: Natural) (a :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w
-> a BoolType
-> a (LLVMPointerType w)
-> a (LLVMPointerType w)
-> LLVMExtensionExpr a (LLVMPointerType w)
LLVM_PointerIte NatRepr w
w Expr LLVM s BoolType
c' Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
y)))
       Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch -> Maybe (LLVMExpr s arch)
forall a. a -> Maybe a
Just (TypeRepr (LLVMPointerType w)
-> Expr LLVM s (LLVMPointerType w) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr w -> TypeRepr (LLVMPointerType w)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr w
w) Expr LLVM s (LLVMPointerType w)
z))

baseSelect (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar -> Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
wc) Expr LLVM s tp
c) (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar -> Scalar Proxy# arch
_ TypeRepr tp
xtp Expr LLVM s tp
x) (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar -> Scalar Proxy# arch
_ TypeRepr tp
ytp Expr LLVM s tp
y)
  | Just tp :~: tp
Refl <- TypeRepr tp -> TypeRepr tp -> Maybe (tp :~: tp)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality TypeRepr tp
xtp TypeRepr tp
ytp
  , AsBaseType BaseTypeRepr bt
btp <- TypeRepr tp -> AsBaseType tp
forall (tp :: CrucibleType). TypeRepr tp -> AsBaseType tp
asBaseType TypeRepr tp
xtp
  = do Expr LLVM s BoolType
c' <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
callIntToBool NatRepr w
wc Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
c
       Expr LLVM s (BaseToType bt)
z <- Expr LLVM s (BaseToType bt)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (BaseToType bt))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s tp -> Generator ext s t ret m (Expr ext s tp)
forceEvaluation (App (ExprExt (Expr LLVM s)) (Expr LLVM s) (BaseToType bt)
-> Expr LLVM s (BaseToType bt)
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (BaseTypeRepr bt
-> Expr LLVM s BoolType
-> Expr LLVM s (BaseToType bt)
-> Expr LLVM s (BaseToType bt)
-> App LLVM (Expr LLVM s) (BaseToType bt)
forall (tp1 :: BaseType) (f :: CrucibleType -> Type) ext.
BaseTypeRepr tp1
-> f BoolType
-> f (BaseToType tp1)
-> f (BaseToType tp1)
-> App ext f (BaseToType tp1)
BaseIte BaseTypeRepr bt
btp Expr LLVM s BoolType
c' Expr LLVM s tp
Expr LLVM s (BaseToType bt)
x Expr LLVM s tp
Expr LLVM s (BaseToType bt)
y))
       Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch -> Maybe (LLVMExpr s arch)
forall a. a -> Maybe a
Just (TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp
xtp Expr LLVM s tp
Expr LLVM s (BaseToType bt)
z))

baseSelect LLVMExpr s arch
_ LLVMExpr s arch
_ LLVMExpr s arch
_ = Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (LLVMExpr s arch)
forall a. Maybe a
Nothing


translateSelect ::
   (?lc :: TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
   L.Instr        {- ^ The instruction to translate -} ->
   (LLVMExpr s arch -> LLVMGenerator s arch ret ())
     {- ^ A continuation to assign the produced value of this instruction to a register -} ->
   MemType {- ^ Type of the selector variable -} ->
   LLVMExpr s arch {- ^ Selection expression -} ->
   MemType {- ^ Type of the select branches -} ->
   LLVMExpr s arch {- ^ true expression -} ->
   LLVMExpr s arch {- ^ false expression -} ->
   LLVMGenerator s arch ret ()
translateSelect :: forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
Instr
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> MemType
-> LLVMExpr s arch
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret ()
translateSelect Instr
instr LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f
                  (VecType Natural
n MemType
_) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
cs)
                  (VecType Natural
m MemType
eltp) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
xs) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
ys)
  | Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
m
  = do [LLVMExpr s arch]
zs <- [Natural]
-> (Natural
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO [LLVMExpr s arch]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Natural
0..Natural
nNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
1] ((Natural
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO [LLVMExpr s arch])
-> (Natural
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO [LLVMExpr s arch]
forall a b. (a -> b) -> a -> b
$ \Natural
i ->
               do Just LLVMExpr s arch
c <- Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LLVMExpr s arch)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch)))
-> Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a b. (a -> b) -> a -> b
$ Int -> Seq (LLVMExpr s arch) -> Maybe (LLVMExpr s arch)
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
i) Seq (LLVMExpr s arch)
cs
                  Just LLVMExpr s arch
x <- Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LLVMExpr s arch)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch)))
-> Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a b. (a -> b) -> a -> b
$ Int -> Seq (LLVMExpr s arch) -> Maybe (LLVMExpr s arch)
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
i) Seq (LLVMExpr s arch)
xs
                  Just LLVMExpr s arch
y <- Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LLVMExpr s arch)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch)))
-> Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a b. (a -> b) -> a -> b
$ Int -> Seq (LLVMExpr s arch) -> Maybe (LLVMExpr s arch)
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
i) Seq (LLVMExpr s arch)
ys
                  Maybe (LLVMExpr s arch)
mz <- LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Maybe (LLVMExpr s arch))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Maybe (LLVMExpr s arch))
baseSelect LLVMExpr s arch
c LLVMExpr s arch
x LLVMExpr s arch
y
                  Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
-> (LLVMExpr s arch
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Maybe (LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"invalid select operation", Instr -> String
showInstr Instr
instr]) LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (LLVMExpr s arch)
mz

       LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
eltp ([LLVMExpr s arch] -> Seq (LLVMExpr s arch)
forall a. [a] -> Seq a
Seq.fromList [LLVMExpr s arch]
zs))

translateSelect Instr
instr LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f
                  MemType
_ctp LLVMExpr s arch
c
                  (VecType Natural
n MemType
eltp) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
xs) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
ys)
  = do [LLVMExpr s arch]
zs <- [Natural]
-> (Natural
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO [LLVMExpr s arch]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Natural
0..Natural
nNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
-Natural
1] ((Natural
  -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
 -> Generator LLVM s (LLVMState arch) ret IO [LLVMExpr s arch])
-> (Natural
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO [LLVMExpr s arch]
forall a b. (a -> b) -> a -> b
$ \Natural
i ->
               do Just LLVMExpr s arch
x <- Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LLVMExpr s arch)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch)))
-> Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a b. (a -> b) -> a -> b
$ Int -> Seq (LLVMExpr s arch) -> Maybe (LLVMExpr s arch)
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
i) Seq (LLVMExpr s arch)
xs
                  Just LLVMExpr s arch
y <- Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LLVMExpr s arch)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch)))
-> Maybe (LLVMExpr s arch)
-> Generator
     LLVM s (LLVMState arch) ret IO (Maybe (LLVMExpr s arch))
forall a b. (a -> b) -> a -> b
$ Int -> Seq (LLVMExpr s arch) -> Maybe (LLVMExpr s arch)
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
i) Seq (LLVMExpr s arch)
ys
                  Maybe (LLVMExpr s arch)
mz <- LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Maybe (LLVMExpr s arch))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Maybe (LLVMExpr s arch))
baseSelect LLVMExpr s arch
c LLVMExpr s arch
x LLVMExpr s arch
y
                  Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
-> (LLVMExpr s arch
    -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Maybe (LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"invalid select operation", Instr -> String
showInstr Instr
instr]) LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (LLVMExpr s arch)
mz

       LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
eltp ([LLVMExpr s arch] -> Seq (LLVMExpr s arch)
forall a. [a] -> Seq a
Seq.fromList [LLVMExpr s arch]
zs))

translateSelect Instr
_ LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f MemType
_ctp c :: LLVMExpr s arch
c@(LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar -> Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
wc) Expr LLVM s tp
c') MemType
_tp LLVMExpr s arch
x LLVMExpr s arch
y
  = do Maybe (LLVMExpr s arch)
mz <- LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Maybe (LLVMExpr s arch))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Maybe (LLVMExpr s arch))
baseSelect LLVMExpr s arch
c LLVMExpr s arch
x LLVMExpr s arch
y
       case Maybe (LLVMExpr s arch)
mz of
         Just LLVMExpr s arch
z -> LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
z
         Maybe (LLVMExpr s arch)
Nothing ->
           do Expr LLVM s BoolType
c'' <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
callIntToBool NatRepr w
wc Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
c'
              Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO ()
-> Generator LLVM s (LLVMState arch) ret IO ()
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s BoolType
-> Generator ext s t ret m ()
-> Generator ext s t ret m ()
-> Generator ext s t ret m ()
ifte_ Expr LLVM s BoolType
c'' (LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
x) (LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
y)

translateSelect Instr
instr LLVMExpr s arch -> LLVMGenerator s arch ret ()
_ MemType
_ LLVMExpr s arch
_ MemType
_ LLVMExpr s arch
_ LLVMExpr s arch
_ =
   String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO ())
-> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"invalid select operation", Instr -> String
showInstr Instr
instr]


-- | Do the heavy lifting of translating LLVM instructions to crucible code.
generateInstr :: forall s arch ret a.
   (?transOpts :: TranslationOptions) =>
   TypeRepr ret   {- ^ Type of the function return value -} ->
   L.BlockLabel   {- ^ The label of the current LLVM basic block -} ->
   Set L.Ident {- ^ Set of usable identifiers -} ->
   L.Instr        {- ^ The instruction to translate -} ->
   (LLVMExpr s arch -> LLVMGenerator s arch ret ())
     {- ^ A continuation to assign the produced value of this instruction to a register -} ->
   LLVMGenerator s arch ret a
     {- ^ A continuation for translating the remaining statements in this function.
          Straightline instructions should enter this continuation,
          but block-terminating instructions should not. -} ->
   LLVMGenerator s arch ret a
generateInstr :: forall s (arch :: LLVMArch) (ret :: CrucibleType) a.
(?transOpts::TranslationOptions) =>
TypeRepr ret
-> BlockLabel
-> Set Ident
-> Instr
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret a
-> LLVMGenerator s arch ret a
generateInstr TypeRepr ret
retType BlockLabel
lab Set Ident
defSet Instr
instr LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMGenerator s arch ret a
k =
  case Instr
instr of
    -- skip phi instructions, they are handled in definePhiBlock
    L.Phi Type
_ [(Value' BlockLabel, BlockLabel)]
_ -> Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k
    L.Comment String
_ -> Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k
    Instr
L.Unreachable -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError Expr LLVM s (StringType Unicode)
"LLVM unreachable code"

    L.ExtractValue Typed (Value' BlockLabel)
x [Int32]
is -> do
        LLVMExpr s arch
x' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
x
        LLVMExpr s arch
v <- LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> [Int32] -> LLVMGenerator s arch ret (LLVMExpr s arch)
extractValue LLVMExpr s arch
x' [Int32]
is
        LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
v
        Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.InsertValue Typed (Value' BlockLabel)
x Typed (Value' BlockLabel)
v [Int32]
is -> do
        LLVMExpr s arch
x' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
x
        LLVMExpr s arch
v' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
v
        LLVMExpr s arch
y <- LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMExpr s arch
-> LLVMExpr s arch
-> [Int32]
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertValue LLVMExpr s arch
x' LLVMExpr s arch
v' [Int32]
is
        LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
y
        Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.ExtractElt Typed (Value' BlockLabel)
x Value' BlockLabel
i ->
        case Typed (Value' BlockLabel)
x of
          L.Typed (L.Vector Word64
n Type
ty) Value' BlockLabel
x' -> do
            MemType
ty' <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' Type
ty
            LLVMExpr s arch
x'' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue (Natural -> MemType -> MemType
VecType (Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) MemType
ty') Value' BlockLabel
x'
            LLVMExpr s arch
i'  <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue (Natural -> MemType
IntType Natural
64) Value' BlockLabel
i               -- FIXME? this is a bit of a hack, since the llvm-pretty
                                                           -- AST doesn't track the size of the index value
            LLVMExpr s arch
y <- Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
extractElt Instr
instr MemType
ty' (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) LLVMExpr s arch
x'' LLVMExpr s arch
i'
            LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
y
            Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

          Typed (Value' BlockLabel)
_ -> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO a)
-> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"expected vector type in extractelement instruction:", Typed (Value' BlockLabel) -> String
forall a. Show a => a -> String
show Typed (Value' BlockLabel)
x]

    L.InsertElt Typed (Value' BlockLabel)
x Typed (Value' BlockLabel)
v Value' BlockLabel
i ->
        case Typed (Value' BlockLabel)
x of
          L.Typed (L.Vector Word64
n Type
ty) Value' BlockLabel
x' -> do
            MemType
ty' <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' Type
ty
            LLVMExpr s arch
x'' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue (Natural -> MemType -> MemType
VecType (Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) MemType
ty') Value' BlockLabel
x'
            LLVMExpr s arch
v'  <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
v
            LLVMExpr s arch
i'  <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue (Natural -> MemType
IntType Natural
64) Value' BlockLabel
i                -- FIXME? this is a bit of a hack, since the llvm-pretty
                                                            -- AST doesn't track the size of the index value
            LLVMExpr s arch
y <- Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Instr
-> MemType
-> Integer
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
insertElt Instr
instr MemType
ty' (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) LLVMExpr s arch
x'' LLVMExpr s arch
v' LLVMExpr s arch
i'
            LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
y
            Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

          Typed (Value' BlockLabel)
_ -> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO a)
-> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"expected vector type in insertelement instruction:", Typed (Value' BlockLabel) -> String
forall a. Show a => a -> String
show Typed (Value' BlockLabel)
x]

    L.ShuffleVector Typed (Value' BlockLabel)
sV1 Value' BlockLabel
sV2 Typed (Value' BlockLabel)
sIxes ->
      case (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
sV1, Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
sIxes) of
        (L.Vector Word64
m Type
ty, L.Vector Word64
n (L.PrimType (L.Integer Word32
32))) ->
          do MemType
elTy <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' Type
ty
             let inL :: Num b => b
                 inL :: forall b. Num b => b
inL  = Word64 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
m

                 inV :: MemType
inV  = Natural -> MemType -> MemType
VecType Natural
forall b. Num b => b
inL MemType
elTy

                 outL :: Num b => b
                 outL :: forall b. Num b => b
outL = Word64 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n

             LLVMExpr s arch
xv1 <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
inV (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
sV1)
             LLVMExpr s arch
xv2 <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
inV Value' BlockLabel
sV2
             LLVMExpr s arch
xis <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue (Natural -> MemType -> MemType
VecType Natural
forall b. Num b => b
outL (Natural -> MemType
IntType Natural
32)) (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
sIxes)

             case (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
forall b. Num b => b
inL LLVMExpr s arch
xv1, Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
forall b. Num b => b
inL LLVMExpr s arch
xv2, Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
forall b. Num b => b
outL LLVMExpr s arch
xis) of
               (Just Seq (LLVMExpr s arch)
v1, Just Seq (LLVMExpr s arch)
v2, Just Seq (LLVMExpr s arch)
is) ->
                 do let getV :: LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
getV LLVMExpr s arch
x =
                          case LLVMExpr s arch
x of
                            UndefExpr MemType
_ -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ MemType -> LLVMExpr s arch
forall s (arch :: LLVMArch). MemType -> LLVMExpr s arch
UndefExpr MemType
elTy
                            ZeroExpr MemType
_  -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ Seq (LLVMExpr s arch) -> Int -> LLVMExpr s arch
forall a. Seq a -> Int -> a
Seq.index Seq (LLVMExpr s arch)
v1 Int
0
                            BaseExpr (LLVMPointerRepr NatRepr w
_) (BitvectorAsPointerExpr NatRepr w
_ (App (BVLit NatRepr w
_ BV w
i)))
                              | BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
forall b. Num b => b
inL -> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ Seq (LLVMExpr s arch) -> Int -> LLVMExpr s arch
forall a. Seq a -> Int -> a
Seq.index Seq (LLVMExpr s arch)
v1 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
i))
                              | Integer
forall b. Num b => b
inL Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
i Bool -> Bool -> Bool
&& BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
forall b. Num b => b
inL ->
                                  LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ Seq (LLVMExpr s arch) -> Int -> LLVMExpr s arch
forall a. Seq a -> Int -> a
Seq.index Seq (LLVMExpr s arch)
v2 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
forall b. Num b => b
inL))

                            LLVMExpr s arch
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> String
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"[shuffle] Expected literal index values but got", LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x]

                    Seq (LLVMExpr s arch)
is' <- (LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Seq (LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
getV Seq (LLVMExpr s arch)
is
                    LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f (MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
elTy Seq (LLVMExpr s arch)
is')
                    Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

               (Maybe (Seq (LLVMExpr s arch)), Maybe (Seq (LLVMExpr s arch)),
 Maybe (Seq (LLVMExpr s arch)))
_ -> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO a)
-> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"[shuffle] unexpected values:"
                                   , Instr -> String
showInstr Instr
instr
                                   , LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
xv1, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
xv2, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
xis]

        (Type
t1,Type
t2) -> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO a)
-> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"[shuffle] Type error", Type -> String
forall a. Show a => a -> String
show Type
t1, Type -> String
forall a. Show a => a -> String
show Type
t2 ]


    L.Alloca Type
tp Maybe (Typed (Value' BlockLabel))
num Maybe Int
align -> do
      MemType
tp' <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' Type
tp
      let dl :: DataLayout
dl = TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc
      let tp_sz :: Bytes
tp_sz = DataLayout -> MemType -> Bytes
memTypeSize DataLayout
dl MemType
tp'
      let tp_sz' :: Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
tp_sz' = App
  (ExprExt (Expr LLVM s))
  (Expr LLVM s)
  ('BaseToType (BaseBVType (ArchWidth arch)))
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App
   (ExprExt (Expr LLVM s))
   (Expr LLVM s)
   ('BaseToType (BaseBVType (ArchWidth arch)))
 -> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
-> App
     (ExprExt (Expr LLVM s))
     (Expr LLVM s)
     ('BaseToType (BaseBVType (ArchWidth arch)))
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
forall a b. (a -> b) -> a -> b
$ NatRepr (ArchWidth arch)
-> BV (ArchWidth arch)
-> App
     (ExprExt (Expr LLVM s))
     (Expr LLVM s)
     ('BaseToType (BaseBVType (ArchWidth arch)))
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (BV (ArchWidth arch)
 -> App
      (ExprExt (Expr LLVM s))
      (Expr LLVM s)
      ('BaseToType (BaseBVType (ArchWidth arch))))
-> BV (ArchWidth arch)
-> App
     (ExprExt (Expr LLVM s))
     (Expr LLVM s)
     ('BaseToType (BaseBVType (ArchWidth arch)))
forall a b. (a -> b) -> a -> b
$ NatRepr (ArchWidth arch) -> Bytes -> BV (ArchWidth arch)
forall (w :: Natural). NatRepr w -> Bytes -> BV w
G.bytesToBV NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Bytes
tp_sz

      Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
sz <- case Maybe (Typed (Value' BlockLabel))
num of
               Maybe (Typed (Value' BlockLabel))
Nothing -> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
 -> Generator
      LLVM
      s
      (LLVMState arch)
      ret
      IO
      (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))))
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
forall a b. (a -> b) -> a -> b
$ Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
tp_sz'
               Just Typed (Value' BlockLabel)
num' -> do
                  LLVMExpr s arch
n <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
num'
                  case LLVMExpr s arch
n of
                     ZeroExpr MemType
_ -> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
 -> Generator
      LLVM
      s
      (LLVMState arch)
      ret
      IO
      (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))))
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
forall a b. (a -> b) -> a -> b
$ App
  (ExprExt (Expr LLVM s))
  (Expr LLVM s)
  ('BaseToType (BaseBVType (ArchWidth arch)))
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App
   (ExprExt (Expr LLVM s))
   (Expr LLVM s)
   ('BaseToType (BaseBVType (ArchWidth arch)))
 -> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
-> App
     (ExprExt (Expr LLVM s))
     (Expr LLVM s)
     ('BaseToType (BaseBVType (ArchWidth arch)))
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
forall a b. (a -> b) -> a -> b
$ NatRepr (ArchWidth arch)
-> BV (ArchWidth arch)
-> App
     LLVM (Expr LLVM s) ('BaseToType (BaseBVType (ArchWidth arch)))
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth (NatRepr (ArchWidth arch) -> BV (ArchWidth arch)
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth)
                     BaseExpr (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x
                        | Just w :~: ArchWidth arch
Refl <- NatRepr w
-> NatRepr (ArchWidth arch) -> Maybe (w :~: ArchWidth arch)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth ->
                            do Expr LLVM s (BVType w)
x' <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x
                               Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
 -> Generator
      LLVM
      s
      (LLVMState arch)
      ret
      IO
      (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))))
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
forall a b. (a -> b) -> a -> b
$ App
  (ExprExt (Expr LLVM s))
  (Expr LLVM s)
  ('BaseToType (BaseBVType (ArchWidth arch)))
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
forall (tp :: CrucibleType).
App (ExprExt (Expr LLVM s)) (Expr LLVM s) tp -> Expr LLVM s tp
forall (e :: CrucibleType -> Type) (tp :: CrucibleType).
IsExpr e =>
App (ExprExt e) e tp -> e tp
app (App
   (ExprExt (Expr LLVM s))
   (Expr LLVM s)
   ('BaseToType (BaseBVType (ArchWidth arch)))
 -> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
-> App
     (ExprExt (Expr LLVM s))
     (Expr LLVM s)
     ('BaseToType (BaseBVType (ArchWidth arch)))
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
forall a b. (a -> b) -> a -> b
$ NatRepr (ArchWidth arch)
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
-> Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
-> App
     LLVM (Expr LLVM s) ('BaseToType (BaseBVType (ArchWidth arch)))
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVMul NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth Expr LLVM s (BVType w)
Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
x' Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
tp_sz'
                     LLVMExpr s arch
_ -> String
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Generator
      LLVM
      s
      (LLVMState arch)
      ret
      IO
      (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))))
-> String
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch))))
forall a b. (a -> b) -> a -> b
$ String
"Invalid alloca argument: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe (Typed (Value' BlockLabel)) -> String
forall a. Show a => a -> String
show Maybe (Typed (Value' BlockLabel))
num

      -- LLVM documentation regarding `alloca` alignment:
      --
      -- If a constant alignment is specified, the value result of the
      -- allocation is guaranteed to be aligned to at least that
      -- boundary. The alignment may not be greater than 1 << 29. If
      -- not specified, or if zero, the target can choose to align the
      -- allocation on any convenient boundary compatible with the
      -- type.
      Alignment
alignment <-
       case Maybe Int
align of
         Just Int
a | Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
           case Bytes -> Maybe Alignment
toAlignment (Int -> Bytes
forall a. Integral a => a -> Bytes
G.toBytes Int
a) of
             Maybe Alignment
Nothing -> String -> Generator LLVM s (LLVMState arch) ret IO Alignment
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO Alignment)
-> String -> Generator LLVM s (LLVMState arch) ret IO Alignment
forall a b. (a -> b) -> a -> b
$ String
"Invalid alignment value in alloca: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
a
             Just Alignment
al -> Alignment -> Generator LLVM s (LLVMState arch) ret IO Alignment
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Alignment
al
         Maybe Int
_ -> Alignment -> Generator LLVM s (LLVMState arch) ret IO Alignment
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (DataLayout -> MemType -> Alignment
memTypeAlign DataLayout
dl MemType
tp')

      Expr LLVM s (LLVMPointerType (ArchWidth arch))
p <- Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
-> Alignment
-> LLVMGenerator
     s arch ret (Expr LLVM s (LLVMPointerType (ArchWidth arch)))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch) =>
Expr LLVM s (BVType wptr)
-> Alignment
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
callAlloca Expr LLVM s ('BaseToType (BaseBVType (ArchWidth arch)))
sz Alignment
alignment
      LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f (TypeRepr (LLVMPointerType (ArchWidth arch))
-> Expr LLVM s (LLVMPointerType (ArchWidth arch))
-> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr (ArchWidth arch)
-> TypeRepr (LLVMPointerType (ArchWidth arch))
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth) Expr LLVM s (LLVMPointerType (ArchWidth arch))
p)
      Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    -- We don't care if it's atomic, since the symbolic simulator is
    -- effectively single-threaded.
    L.Load Type
tp Typed (Value' BlockLabel)
ptr Maybe AtomicOrdering
_atomic Maybe Int
align -> do
      MemType
resTy <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' Type
tp
      LLVMExpr s arch
ptr' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
ptr
      MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
resTy ((forall {tp :: CrucibleType}.
  TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO a)
 -> Generator LLVM s (LLVMState arch) ret IO a)
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
expectTy -> do
        let a0 :: Alignment
a0 = DataLayout -> MemType -> Alignment
memTypeAlign (TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc) MemType
resTy
        let align' :: Alignment
align' = Alignment -> Maybe Alignment -> Alignment
forall a. a -> Maybe a -> a
fromMaybe Alignment
a0 (Bytes -> Maybe Alignment
toAlignment (Bytes -> Maybe Alignment)
-> (Int -> Bytes) -> Int -> Maybe Alignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bytes
forall a. Integral a => a -> Bytes
G.toBytes (Int -> Maybe Alignment) -> Maybe Int -> Maybe Alignment
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Int
align)
        LLVMExpr s arch
res <- MemType
-> TypeRepr tp
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall (tp :: CrucibleType) s (arch :: LLVMArch)
       (ret :: CrucibleType).
MemType
-> TypeRepr tp
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret (LLVMExpr s arch)
callLoad MemType
resTy TypeRepr tp
expectTy LLVMExpr s arch
ptr' Alignment
align'
        LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
res
        Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    -- We don't care if it's atomic, since the symbolic simulator is
    -- effectively single-threaded.
    L.Store Typed (Value' BlockLabel)
v Typed (Value' BlockLabel)
ptr Maybe AtomicOrdering
_atomic Maybe Int
align -> do
      MemType
vTp <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
v)
      LLVMExpr s arch
ptr' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
ptr
      let a0 :: Alignment
a0 = DataLayout -> MemType -> Alignment
memTypeAlign (TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc) MemType
vTp
      let align' :: Alignment
align' = Alignment -> Maybe Alignment -> Alignment
forall a. a -> Maybe a -> a
fromMaybe Alignment
a0 (Bytes -> Maybe Alignment
toAlignment (Bytes -> Maybe Alignment)
-> (Int -> Bytes) -> Int -> Maybe Alignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bytes
forall a. Integral a => a -> Bytes
G.toBytes (Int -> Maybe Alignment) -> Maybe Int -> Maybe Alignment
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Int
align)
      LLVMExpr s arch
v' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
vTp (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
v)
      MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret ()
callStore MemType
vTp LLVMExpr s arch
ptr' LLVMExpr s arch
v' Alignment
align'
      Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    -- NB We treat every GEP as though it has the "inbounds" flag set;
    --    thus, the calculation of out-of-bounds pointers results in
    --    a runtime error.
    L.GEP Bool
inbounds Type
baseTy Typed (Value' BlockLabel)
basePtr [Typed (Value' BlockLabel)]
elts -> do
      ExceptT
  String
  (Generator LLVM s (LLVMState arch) ret IO)
  (GEPResult (Typed (Value' BlockLabel)))
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Either String (GEPResult (Typed (Value' BlockLabel))))
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (Bool
-> Type
-> Typed (Value' BlockLabel)
-> [Typed (Value' BlockLabel)]
-> ExceptT
     String
     (Generator LLVM s (LLVMState arch) ret IO)
     (GEPResult (Typed (Value' BlockLabel)))
forall (wptr :: Natural) (m :: Type -> Type).
(?lc::TypeContext, MonadError String m, HasPtrWidth wptr) =>
Bool
-> Type
-> Typed (Value' BlockLabel)
-> [Typed (Value' BlockLabel)]
-> m (GEPResult (Typed (Value' BlockLabel)))
translateGEP Bool
inbounds Type
baseTy Typed (Value' BlockLabel)
basePtr [Typed (Value' BlockLabel)]
elts) Generator
  LLVM
  s
  (LLVMState arch)
  ret
  IO
  (Either String (GEPResult (Typed (Value' BlockLabel))))
-> (Either String (GEPResult (Typed (Value' BlockLabel)))
    -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a b.
Generator LLVM s (LLVMState arch) ret IO a
-> (a -> Generator LLVM s (LLVMState arch) ret IO b)
-> Generator LLVM s (LLVMState arch) ret IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left String
err -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO a)
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"Error translating GEP", String
err]
        Right GEPResult (Typed (Value' BlockLabel))
gep ->
          do GEPResult (LLVMExpr s arch)
gep' <- (Typed (Value' BlockLabel)
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> GEPResult (Typed (Value' BlockLabel))
-> Generator
     LLVM s (LLVMState arch) ret IO (GEPResult (LLVMExpr s arch))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> GEPResult a -> f (GEPResult b)
traverse (\Typed (Value' BlockLabel)
v -> Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
v) GEPResult (Typed (Value' BlockLabel))
gep
             LLVMExpr s arch
v    <- Instr
-> GEPResult (LLVMExpr s arch)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType)
       (wptr :: Natural).
(wptr ~ ArchWidth arch) =>
Instr
-> GEPResult (LLVMExpr s arch)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
evalGEP Instr
instr GEPResult (LLVMExpr s arch)
gep'
             LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
v
             Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.Conv ConvOp
op Typed (Value' BlockLabel)
x Type
outty -> do
      do MemType
tp <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
         LLVMExpr s arch
x' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
x)
         MemType
outty' <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' Type
outty
         LLVMExpr s arch
v <- Instr
-> ConvOp
-> MemType
-> LLVMExpr s arch
-> MemType
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
Instr
-> ConvOp
-> MemType
-> LLVMExpr s arch
-> MemType
-> LLVMGenerator s arch ret (LLVMExpr s arch)
translateConversion Instr
instr ConvOp
op MemType
tp LLVMExpr s arch
x' MemType
outty'
         LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
v
         Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.Call Bool
tailcall Type
fnTy Value' BlockLabel
fn [Typed (Value' BlockLabel)]
args ->
      Set Ident
-> Instr
-> Bool
-> Type
-> Value' BlockLabel
-> [Typed (Value' BlockLabel)]
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
Set Ident
-> Instr
-> Bool
-> Type
-> Value' BlockLabel
-> [Typed (Value' BlockLabel)]
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret ()
callFunction Set Ident
defSet Instr
instr Bool
tailcall Type
fnTy Value' BlockLabel
fn [Typed (Value' BlockLabel)]
args LLVMExpr s arch -> Generator LLVM s (LLVMState arch) ret IO ()
LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f Generator LLVM s (LLVMState arch) ret IO ()
-> Generator LLVM s (LLVMState arch) ret IO a
-> Generator LLVM s (LLVMState arch) ret IO a
forall a b.
Generator LLVM s (LLVMState arch) ret IO a
-> Generator LLVM s (LLVMState arch) ret IO b
-> Generator LLVM s (LLVMState arch) ret IO b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.Invoke Type
fnTy Value' BlockLabel
fn [Typed (Value' BlockLabel)]
args BlockLabel
normLabel BlockLabel
_unwindLabel -> do
      do Set Ident
-> Instr
-> Bool
-> Type
-> Value' BlockLabel
-> [Typed (Value' BlockLabel)]
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
Set Ident
-> Instr
-> Bool
-> Type
-> Value' BlockLabel
-> [Typed (Value' BlockLabel)]
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret ()
callFunction Set Ident
defSet Instr
instr Bool
False Type
fnTy Value' BlockLabel
fn [Typed (Value' BlockLabel)]
args LLVMExpr s arch -> Generator LLVM s (LLVMState arch) ret IO ()
LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f
         BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
forall s (arch :: LLVMArch) (ret :: CrucibleType) a.
BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
definePhiBlock BlockLabel
lab BlockLabel
normLabel

    L.CallBr Type
fnTy Value' BlockLabel
fn [Typed (Value' BlockLabel)]
args BlockLabel
normLabel [BlockLabel]
otherLabels -> do
      do Set Ident
-> Instr
-> Bool
-> Type
-> Value' BlockLabel
-> [Typed (Value' BlockLabel)]
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
Set Ident
-> Instr
-> Bool
-> Type
-> Value' BlockLabel
-> [Typed (Value' BlockLabel)]
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret ()
callFunction Set Ident
defSet Instr
instr Bool
False Type
fnTy Value' BlockLabel
fn [Typed (Value' BlockLabel)]
args LLVMExpr s arch -> Generator LLVM s (LLVMState arch) ret IO ()
LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f
         [BlockLabel]
-> (BlockLabel -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [BlockLabel]
otherLabels ((BlockLabel -> Generator LLVM s (LLVMState arch) ret IO ())
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> (BlockLabel -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ \BlockLabel
lab' -> Generator LLVM s (LLVMState arch) ret IO Any
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (BlockLabel -> BlockLabel -> LLVMGenerator s arch ret Any
forall s (arch :: LLVMArch) (ret :: CrucibleType) a.
BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
definePhiBlock BlockLabel
lab BlockLabel
lab')
         BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
forall s (arch :: LLVMArch) (ret :: CrucibleType) a.
BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
definePhiBlock BlockLabel
lab BlockLabel
normLabel

    L.Bit BitOp
op Typed (Value' BlockLabel)
x Value' BlockLabel
y ->
      do MemType
tp <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
         LLVMExpr s arch
x' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
x)
         LLVMExpr s arch
y' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp Value' BlockLabel
y
         LLVMExpr s arch
v  <- BitOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
BitOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
bitop BitOp
op MemType
tp LLVMExpr s arch
x' LLVMExpr s arch
y'
         LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
v
         Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.Arith ArithOp
op Typed (Value' BlockLabel)
x Value' BlockLabel
y ->
      do MemType
tp <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
         LLVMExpr s arch
x' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
x)
         LLVMExpr s arch
y' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp Value' BlockLabel
y
         LLVMExpr s arch
v  <- ArithOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
ArithOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
arithOp ArithOp
op MemType
tp LLVMExpr s arch
x' LLVMExpr s arch
y'
         LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
v
         Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.UnaryArith UnaryArithOp
op Typed (Value' BlockLabel)
x ->
      do MemType
tp <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
         LLVMExpr s arch
x' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
x)
         LLVMExpr s arch
v  <- UnaryArithOp
-> MemType
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
UnaryArithOp
-> MemType
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
unaryArithOp UnaryArithOp
op MemType
tp LLVMExpr s arch
x'
         LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
v
         Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.FCmp FCmpOp
op Typed (Value' BlockLabel)
x Value' BlockLabel
y -> do
           MemType
tp <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
           LLVMExpr s arch
x' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
x)
           LLVMExpr s arch
y' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp Value' BlockLabel
y
           LLVMExpr s arch
cmp <- FCmpOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
FCmpOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
floatingCompare FCmpOp
op MemType
tp LLVMExpr s arch
x' LLVMExpr s arch
y'
           LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
cmp
           Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.ICmp ICmpOp
op Typed (Value' BlockLabel)
x Value' BlockLabel
y -> do
           MemType
tp <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
           LLVMExpr s arch
x' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
x
           LLVMExpr s arch
y' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue (Type -> Value' BlockLabel -> Typed (Value' BlockLabel)
forall a. Type -> a -> Typed a
L.Typed (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x) Value' BlockLabel
y)
           LLVMExpr s arch
cmp <- ICmpOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
ICmpOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
integerCompare ICmpOp
op MemType
tp LLVMExpr s arch
x' LLVMExpr s arch
y'
           LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
cmp
           Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.Select Typed (Value' BlockLabel)
c Typed (Value' BlockLabel)
x Value' BlockLabel
y -> do
         MemType
ctp <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
c)
         LLVMExpr s arch
c'  <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
ctp (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
c)

         MemType
tp  <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
         LLVMExpr s arch
x'  <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
x)
         LLVMExpr s arch
y'  <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp Value' BlockLabel
y

         Instr
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> MemType
-> LLVMExpr s arch
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret ()
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(?lc::TypeContext, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
Instr
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> MemType
-> LLVMExpr s arch
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret ()
translateSelect Instr
instr LLVMExpr s arch -> Generator LLVM s (LLVMState arch) ret IO ()
LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f MemType
ctp LLVMExpr s arch
c' MemType
tp LLVMExpr s arch
x' LLVMExpr s arch
y'
         Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    L.Jump BlockLabel
l' -> BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
forall s (arch :: LLVMArch) (ret :: CrucibleType) a.
BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
definePhiBlock BlockLabel
lab BlockLabel
l'

    L.Br Typed (Value' BlockLabel)
v BlockLabel
l1 BlockLabel
l2 -> do
        LLVMExpr s arch
v' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
v
        Expr LLVM s BoolType
e' <- case LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
v' of
                 Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
e -> NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
callIntToBool NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
e
                 ScalarView s arch
_ -> String
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s BoolType)
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"expected boolean condition on branch"

        Label s
phi1 <- (forall a. Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO (Label s)
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
(forall a. Generator ext s t ret m a)
-> Generator ext s t ret m (Label s)
defineBlockLabel (BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
forall s (arch :: LLVMArch) (ret :: CrucibleType) a.
BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
definePhiBlock BlockLabel
lab BlockLabel
l1)
        Label s
phi2 <- (forall a. Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO (Label s)
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
(forall a. Generator ext s t ret m a)
-> Generator ext s t ret m (Label s)
defineBlockLabel (BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
forall s (arch :: LLVMArch) (ret :: CrucibleType) a.
BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
definePhiBlock BlockLabel
lab BlockLabel
l2)
        Expr LLVM s BoolType
-> Label s -> Label s -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s BoolType
-> Label s -> Label s -> Generator ext s t ret m a
branch Expr LLVM s BoolType
e' Label s
phi1 Label s
phi2

    L.Switch Typed (Value' BlockLabel)
x BlockLabel
def [(Integer, BlockLabel)]
branches -> do
        LLVMExpr s arch
x' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
x
        case LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x' of
          Scalar Proxy# arch
_archProxy (LLVMPointerRepr NatRepr w
w) Expr LLVM s tp
x'' ->
            do Expr LLVM s (BVType w)
bv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x''
               NatRepr w
-> Expr LLVM s (BVType w)
-> BlockLabel
-> BlockLabel
-> [(Integer, BlockLabel)]
-> LLVMGenerator s arch ret a
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType) a.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w)
-> BlockLabel
-> BlockLabel
-> [(Integer, BlockLabel)]
-> LLVMGenerator s arch ret a
buildSwitch NatRepr w
w Expr LLVM s (BVType w)
bv BlockLabel
lab BlockLabel
def [(Integer, BlockLabel)]
branches
          ScalarView s arch
_ -> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO a)
-> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"expected integer value in switch", Instr -> String
showInstr Instr
instr]

    L.Ret Typed (Value' BlockLabel)
v -> do LLVMExpr s arch
v' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
v
                  let ?err = ?err::String -> Generator LLVM s (LLVMState arch) ret IO a
String -> Generator LLVM s (LLVMState arch) ret IO a
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
                  LLVMExpr s arch
-> (forall {tpr :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tpr
    -> Expr LLVM s tpr
    -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a (arch :: LLVMArch) s.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch
-> (forall (tpr :: CrucibleType).
    Proxy# arch -> TypeRepr tpr -> Expr LLVM s tpr -> a)
-> a
unpackOne LLVMExpr s arch
v' ((forall {tpr :: CrucibleType}.
  Proxy# arch
  -> TypeRepr tpr
  -> Expr LLVM s tpr
  -> Generator LLVM s (LLVMState arch) ret IO a)
 -> Generator LLVM s (LLVMState arch) ret IO a)
-> (forall {tpr :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tpr
    -> Expr LLVM s tpr
    -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ \Proxy# arch
_archProxy TypeRepr tpr
retType' Expr LLVM s tpr
ex ->
                     case TypeRepr ret -> TypeRepr tpr -> Maybe (ret :~: tpr)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality TypeRepr ret
retType TypeRepr tpr
retType' of
                        Just ret :~: tpr
Refl -> do
                           Generator LLVM s (LLVMState arch) ret IO ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMGenerator s arch ret ()
callPopFrame
                           Expr LLVM s ret -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (ret :: CrucibleType)
       (t :: Type -> Type) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s ret -> Generator ext s t ret m a
returnFromFunction Expr LLVM s ret
Expr LLVM s tpr
ex
                        Maybe (ret :~: tpr)
Nothing -> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO a)
-> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"unexpected return type", TypeRepr ret -> String
forall a. Show a => a -> String
show TypeRepr ret
retType, TypeRepr tpr -> String
forall a. Show a => a -> String
show TypeRepr tpr
retType']

    Instr
L.RetVoid -> case TypeRepr ret -> TypeRepr 'UnitType -> Maybe (ret :~: 'UnitType)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality TypeRepr ret
retType TypeRepr 'UnitType
UnitRepr of
                    Just ret :~: 'UnitType
Refl -> do
                       Generator LLVM s (LLVMState arch) ret IO ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
LLVMGenerator s arch ret ()
callPopFrame
                       Expr LLVM s ret -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (ret :: CrucibleType)
       (t :: Type -> Type) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s ret -> Generator ext s t ret m a
returnFromFunction (App LLVM (Expr LLVM s) ret -> Expr LLVM s ret
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App App LLVM (Expr LLVM s) ret
App LLVM (Expr LLVM s) 'UnitType
forall ext (f :: CrucibleType -> Type). App ext f 'UnitType
EmptyApp)
                    Maybe (ret :~: 'UnitType)
Nothing -> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO a)
-> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"tried to void return from non-void function", TypeRepr ret -> String
forall a. Show a => a -> String
show TypeRepr ret
retType]

    -- NB, the symbolic simulator is essentially single-threaded, so fence
    -- instructions are no-ops
    L.Fence{} -> Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    -- NB, the symbolic simulator is essentially single-threaded, so cmpxchg
    -- always succeeds if the expected value is found in memory.
    L.CmpXchg Bool
_weak Bool
_volatile Typed (Value' BlockLabel)
ptr Typed (Value' BlockLabel)
compareValue Typed (Value' BlockLabel)
newValue Maybe String
_syncScope AtomicOrdering
_syncOrderSuccess AtomicOrdering
_syncOrderFail ->
      do MemType
resTy <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
compareValue)
         LLVMExpr s arch
ptr' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
ptr
         MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
resTy ((forall {tp :: CrucibleType}.
  TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO a)
 -> Generator LLVM s (LLVMState arch) ret IO a)
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
expectTy ->
           do LLVMExpr s arch
cmpVal <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
resTy (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
compareValue)
              LLVMExpr s arch
newVal <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
resTy (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
newValue)

              let a0 :: Alignment
a0 = DataLayout -> MemType -> Alignment
memTypeAlign (TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc) MemType
resTy
              LLVMExpr s arch
oldVal <- MemType
-> TypeRepr tp
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall (tp :: CrucibleType) s (arch :: LLVMArch)
       (ret :: CrucibleType).
MemType
-> TypeRepr tp
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret (LLVMExpr s arch)
callLoad MemType
resTy TypeRepr tp
expectTy LLVMExpr s arch
ptr' Alignment
a0
              Expr LLVM s BoolType
cmp <- ICmpOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
ICmpOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (Expr LLVM s BoolType)
scalarIntegerCompare ICmpOp
L.Ieq LLVMExpr s arch
oldVal LLVMExpr s arch
cmpVal
              let flag :: LLVMExpr s arch
flag = TypeRepr (LLVMPointerType 1)
-> Expr LLVM s (LLVMPointerType 1) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr 1 -> TypeRepr (LLVMPointerType 1)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1))
                                  (NatRepr 1
-> Expr LLVM s (BVType 1) -> Expr LLVM s (LLVMPointerType 1)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat
                                     (App LLVM (Expr LLVM s) (BVType 1) -> Expr LLVM s (BVType 1)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (NatRepr 1
-> Expr LLVM s BoolType -> App LLVM (Expr LLVM s) (BVType 1)
forall (w :: Natural) (f :: CrucibleType -> Type) ext.
(1 <= w) =>
NatRepr w -> f BoolType -> App ext f ('BaseToType (BaseBVType w))
BoolToBV NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat Expr LLVM s BoolType
cmp)))
              Expr LLVM s BoolType
-> Generator LLVM s (LLVMState arch) ret IO ()
-> Generator LLVM s (LLVMState arch) ret IO ()
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s BoolType
-> Generator ext s t ret m ()
-> Generator ext s t ret m ()
-> Generator ext s t ret m ()
ifte_ Expr LLVM s BoolType
cmp
                -- success case, write the new value
                (MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret ()
callStore MemType
resTy LLVMExpr s arch
ptr' LLVMExpr s arch
newVal Alignment
a0)
                -- failure case, do nothing
                (() -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
              LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f (Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
Seq (MemType, LLVMExpr s arch) -> LLVMExpr s arch
StructExpr ([(MemType, LLVMExpr s arch)] -> Seq (MemType, LLVMExpr s arch)
forall a. [a] -> Seq a
Seq.fromList [(MemType
resTy,LLVMExpr s arch
oldVal),(Natural -> MemType
IntType Natural
1,LLVMExpr s arch
flag)]))
              Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    -- NB, the symbolic simulator is essentially single-threaded, so no special
    -- actions need to be taken to make operations atomic.  We simply execute
    -- their straightforward load/modify/store semantics.
    L.AtomicRW Bool
_volatile AtomicRWOp
op Typed (Value' BlockLabel)
ptr Typed (Value' BlockLabel)
val Maybe String
_syncScope AtomicOrdering
_ordering ->
      do MemType
valTy <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
val)
         LLVMExpr s arch
ptr' <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
ptr
         case MemType
valTy of
           IntType Natural
_ -> () -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
           MemType
_ -> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO ())
-> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
             [String
"Invalid argument type on atomicrw, expected integer type", Typed (Value' BlockLabel) -> String
forall a. Show a => a -> String
show Typed (Value' BlockLabel)
ptr]
         MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
valTy ((forall {tp :: CrucibleType}.
  TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO a)
 -> Generator LLVM s (LLVMState arch) ret IO a)
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
expectTy ->
           do LLVMExpr s arch
val' <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
valTy (Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch))
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
val
              let a0 :: Alignment
a0 = DataLayout -> MemType -> Alignment
memTypeAlign (TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc) MemType
valTy
              LLVMExpr s arch
oldVal <- MemType
-> TypeRepr tp
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall (tp :: CrucibleType) s (arch :: LLVMArch)
       (ret :: CrucibleType).
MemType
-> TypeRepr tp
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret (LLVMExpr s arch)
callLoad MemType
valTy TypeRepr tp
expectTy LLVMExpr s arch
ptr' Alignment
a0
              LLVMExpr s arch
newVal <- AtomicRWOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
AtomicRWOp
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
atomicRWOp AtomicRWOp
op LLVMExpr s arch
oldVal LLVMExpr s arch
val'
              MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> Alignment
-> LLVMGenerator s arch ret ()
callStore MemType
valTy LLVMExpr s arch
ptr' LLVMExpr s arch
newVal Alignment
a0
              LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
oldVal
              Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    -- We translate `freeze` instructions by simply passing the argument value
    -- through unchanged. This doesn't quite adhere to LLVM's own semantics for
    -- this instruction (https://releases.llvm.org/12.0.0/docs/LangRef.html#id323),
    -- which state that if the argument is `undef` or `poison`, then `freeze`
    -- should return an arbitrary value. We don't currently have the ability to
    -- reliably determine whether a given value is `undef` or `poison`, however
    -- (see https://github.com/GaloisInc/crucible/issues/366), so for now we
    -- settle for a less accurate translation of `freeze`.
    L.Freeze Typed (Value' BlockLabel)
x -> do
      MemType
tp' <- Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' (Typed (Value' BlockLabel) -> Type
forall a. Typed a -> Type
L.typedType Typed (Value' BlockLabel)
x)
      LLVMExpr s arch
x'  <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
tp' (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
x)
      LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f LLVMExpr s arch
x'
      Generator LLVM s (LLVMState arch) ret IO a
LLVMGenerator s arch ret a
k

    -- unwind, landingpad and resume are all exception-related, which we don't currently
    -- support
    L.Unwind{} -> Generator LLVM s (LLVMState arch) ret IO a
unsupported
    L.LandingPad{} -> Generator LLVM s (LLVMState arch) ret IO a
unsupported
    L.Resume{} -> Generator LLVM s (LLVMState arch) ret IO a
unsupported

    -- indirect branch could be supported, but requires some nontrivial work to deal
    -- properly with mapping basic-block labels to pointer values.
    L.IndirectBr{} -> Generator LLVM s (LLVMState arch) ret IO a
unsupported

    -- VaArg is uncommonly used and hard to support
    L.VaArg{} -> Generator LLVM s (LLVMState arch) ret IO a
unsupported

 where
 liftMemType' :: Type -> Generator LLVM s (LLVMState arch) ret IO MemType
liftMemType' = (String -> Generator LLVM s (LLVMState arch) ret IO MemType)
-> (MemType -> Generator LLVM s (LLVMState arch) ret IO MemType)
-> Either String MemType
-> Generator LLVM s (LLVMState arch) ret IO MemType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Generator LLVM s (LLVMState arch) ret IO MemType
typeErr MemType -> Generator LLVM s (LLVMState arch) ret IO MemType
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either String MemType
 -> Generator LLVM s (LLVMState arch) ret IO MemType)
-> (Type -> Either String MemType)
-> Type
-> Generator LLVM s (LLVMState arch) ret IO MemType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Either String MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType

 typeErr :: String -> Generator LLVM s (LLVMState arch) ret IO MemType
typeErr String
msg =
    Doc Void
-> [Doc Void] -> Generator LLVM s (LLVMState arch) ret IO MemType
forall a. Doc Void -> [Doc Void] -> a
malformedLLVMModule Doc Void
"Invalid type when translating instruction"
       [ String -> Doc Void
forall a. IsString a => String -> a
fromString (Instr -> String
showInstr Instr
instr)
       , String -> Doc Void
forall a. IsString a => String -> a
fromString String
msg
       ]

 unsupported :: Generator LLVM s (LLVMState arch) ret IO a
unsupported = Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO a)
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (StringType Unicode)
-> Expr LLVM s (StringType Unicode)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (StringType Unicode)
 -> Expr LLVM s (StringType Unicode))
-> App LLVM (Expr LLVM s) (StringType Unicode)
-> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ StringLiteral Unicode
-> App LLVM (Expr LLVM s) (StringType Unicode)
forall (si :: StringInfo) ext (f :: CrucibleType -> Type).
StringLiteral si -> App ext f ('BaseToType (BaseStringType si))
StringLit (StringLiteral Unicode
 -> App LLVM (Expr LLVM s) (StringType Unicode))
-> StringLiteral Unicode
-> App LLVM (Expr LLVM s) (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ Text -> StringLiteral Unicode
UnicodeLiteral (Text -> StringLiteral Unicode) -> Text -> StringLiteral Unicode
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
                 [String] -> String
unwords [String
"unsupported instruction", Instr -> String
showInstr Instr
instr]

arithOp :: (?transOpts :: TranslationOptions) =>
  L.ArithOp ->
  MemType ->
  LLVMExpr s arch ->
  LLVMExpr s arch ->
  LLVMGenerator s arch ret (LLVMExpr s arch)
arithOp :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
ArithOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
arithOp ArithOp
op (VecType Natural
n MemType
tp) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
xs) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
ys) =
  MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
tp (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => Seq (m a) -> m (Seq a)
sequence ((LLVMExpr s arch
 -> LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Seq (LLVMExpr s arch)
-> Seq (LLVMExpr s arch)
-> Seq (Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith (\LLVMExpr s arch
x LLVMExpr s arch
y -> ArithOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
ArithOp
-> MemType
-> LLVMExpr s arch
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
arithOp ArithOp
op MemType
tp LLVMExpr s arch
x LLVMExpr s arch
y) Seq (LLVMExpr s arch)
xs Seq (LLVMExpr s arch)
ys)

arithOp ArithOp
op MemType
_ LLVMExpr s arch
x LLVMExpr s arch
y =
  case (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x, LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
y) of
    (Scalar Proxy# arch
_ ty :: TypeRepr tp
ty@(LLVMPointerRepr NatRepr w
w)  Expr LLVM s tp
x',
     Scalar Proxy# arch
_    (LLVMPointerRepr NatRepr w
w') Expr LLVM s tp
y')
      | Just w :~: ArchWidth arch
Refl <- NatRepr w
-> NatRepr (ArchWidth arch) -> Maybe (w :~: ArchWidth arch)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr (ArchWidth arch)
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth
      , Just w :~: w
Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr w
w' ->
        do Expr LLVM s (LLVMPointerType w)
z <- ArithOp
-> Expr LLVM s (LLVMPointerType w)
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType w))
forall (wptr :: Natural) (arch :: LLVMArch) s
       (ret :: CrucibleType).
(wptr ~ ArchWidth arch, ?transOpts::TranslationOptions) =>
ArithOp
-> Expr LLVM s (LLVMPointerType wptr)
-> Expr LLVM s (LLVMPointerType wptr)
-> LLVMGenerator s arch ret (Expr LLVM s (LLVMPointerType wptr))
pointerOp ArithOp
op Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x' Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
y'
           LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp
ty Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
z)

      | Just w :~: w
Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr w
w' ->
        do Expr LLVM s (BVType w)
xbv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
x'
           Expr LLVM s (BVType w)
ybv <- NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(1 <= w) =>
NatRepr w
-> Expr LLVM s (LLVMPointerType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
pointerAsBitvectorExpr NatRepr w
w Expr LLVM s tp
Expr LLVM s (LLVMPointerType w)
y'
           Expr LLVM s (BVType w)
z   <- ArithOp
-> NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions, 1 <= w) =>
ArithOp
-> NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> LLVMGenerator s arch ret (Expr LLVM s (BVType w))
intop ArithOp
op NatRepr w
w Expr LLVM s (BVType w)
xbv Expr LLVM s (BVType w)
ybv
           LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr (LLVMPointerType w)
-> Expr LLVM s (LLVMPointerType w) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (NatRepr w -> TypeRepr (LLVMPointerType w)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr w
w) (NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
forall (w :: Natural) s.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w) -> Expr LLVM s (LLVMPointerType w)
BitvectorAsPointerExpr NatRepr w
w Expr LLVM s (BVType w)
z))

    (Scalar Proxy# arch
_archProxy (FloatRepr FloatInfoRepr flt
fi) Expr LLVM s tp
x',
     Scalar Proxy# arch
_archPrxy' (FloatRepr FloatInfoRepr flt
fi') Expr LLVM s tp
y')
      | Just flt :~: flt
Refl <- FloatInfoRepr flt -> FloatInfoRepr flt -> Maybe (flt :~: flt)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: FloatInfo) (b :: FloatInfo).
FloatInfoRepr a -> FloatInfoRepr b -> Maybe (a :~: b)
testEquality FloatInfoRepr flt
fi FloatInfoRepr flt
fi' ->
        do Expr LLVM s ('FloatType flt)
ex <- FloatInfoRepr flt
-> Expr LLVM s ('FloatType flt)
-> Expr LLVM s ('FloatType flt)
-> LLVMGenerator s arch ret (Expr LLVM s ('FloatType flt))
forall (fi :: FloatInfo) s (arch :: LLVMArch)
       (ret :: CrucibleType).
FloatInfoRepr fi
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi)
-> LLVMGenerator s arch ret (Expr LLVM s (FloatType fi))
fop FloatInfoRepr flt
fi Expr LLVM s tp
Expr LLVM s ('FloatType flt)
x' Expr LLVM s tp
Expr LLVM s ('FloatType flt)
y'
           LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr ('FloatType flt)
-> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (FloatInfoRepr flt -> TypeRepr ('FloatType flt)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr flt
fi) Expr LLVM s ('FloatType flt)
ex)

    (ScalarView s arch, ScalarView s arch)
_ -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError
           (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString
           (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"binary arithmetic operation on unsupported values",
                         LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
y]

  where
  fop :: FloatInfoRepr fi ->
         Expr LLVM s (FloatType fi) ->
         Expr LLVM s (FloatType fi) ->
         LLVMGenerator s arch ret (Expr LLVM s (FloatType fi))
  fop :: forall (fi :: FloatInfo) s (arch :: LLVMArch)
       (ret :: CrucibleType).
FloatInfoRepr fi
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi)
-> LLVMGenerator s arch ret (Expr LLVM s (FloatType fi))
fop FloatInfoRepr fi
fi Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b =
    case ArithOp
op of
       ArithOp
L.FAdd ->
         Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (FloatType fi)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi)))
-> Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (FloatType fi) -> Expr LLVM s (FloatType fi)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (FloatType fi)
 -> Expr LLVM s (FloatType fi))
-> App LLVM (Expr LLVM s) (FloatType fi)
-> Expr LLVM s (FloatType fi)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr fi
-> RoundingMode
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi)
-> App LLVM (Expr LLVM s) (FloatType fi)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
FloatInfoRepr fi
-> RoundingMode
-> f (FloatType fi)
-> f (FloatType fi)
-> App ext f (FloatType fi)
FloatAdd FloatInfoRepr fi
fi RoundingMode
RNE Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
       ArithOp
L.FSub ->
         Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (FloatType fi)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi)))
-> Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (FloatType fi) -> Expr LLVM s (FloatType fi)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (FloatType fi)
 -> Expr LLVM s (FloatType fi))
-> App LLVM (Expr LLVM s) (FloatType fi)
-> Expr LLVM s (FloatType fi)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr fi
-> RoundingMode
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi)
-> App LLVM (Expr LLVM s) (FloatType fi)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
FloatInfoRepr fi
-> RoundingMode
-> f (FloatType fi)
-> f (FloatType fi)
-> App ext f (FloatType fi)
FloatSub FloatInfoRepr fi
fi RoundingMode
RNE Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
       ArithOp
L.FMul ->
         Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (FloatType fi)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi)))
-> Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (FloatType fi) -> Expr LLVM s (FloatType fi)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (FloatType fi)
 -> Expr LLVM s (FloatType fi))
-> App LLVM (Expr LLVM s) (FloatType fi)
-> Expr LLVM s (FloatType fi)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr fi
-> RoundingMode
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi)
-> App LLVM (Expr LLVM s) (FloatType fi)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
FloatInfoRepr fi
-> RoundingMode
-> f (FloatType fi)
-> f (FloatType fi)
-> App ext f (FloatType fi)
FloatMul FloatInfoRepr fi
fi RoundingMode
RNE Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
       ArithOp
L.FDiv ->
         Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (FloatType fi)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi)))
-> Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (FloatType fi) -> Expr LLVM s (FloatType fi)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (FloatType fi)
 -> Expr LLVM s (FloatType fi))
-> App LLVM (Expr LLVM s) (FloatType fi)
-> Expr LLVM s (FloatType fi)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr fi
-> RoundingMode
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi)
-> App LLVM (Expr LLVM s) (FloatType fi)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
FloatInfoRepr fi
-> RoundingMode
-> f (FloatType fi)
-> f (FloatType fi)
-> App ext f (FloatType fi)
FloatDiv FloatInfoRepr fi
fi RoundingMode
RNE Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
       ArithOp
L.FRem -> do
         Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (FloatType fi)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi)))
-> Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (FloatType fi) -> Expr LLVM s (FloatType fi)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (FloatType fi)
 -> Expr LLVM s (FloatType fi))
-> App LLVM (Expr LLVM s) (FloatType fi)
-> Expr LLVM s (FloatType fi)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr fi
-> Expr LLVM s (FloatType fi)
-> Expr LLVM s (FloatType fi)
-> App LLVM (Expr LLVM s) (FloatType fi)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
FloatInfoRepr fi
-> f (FloatType fi) -> f (FloatType fi) -> App ext f (FloatType fi)
FloatRem FloatInfoRepr fi
fi Expr LLVM s (FloatType fi)
a Expr LLVM s (FloatType fi)
b
       ArithOp
_ -> Expr LLVM s (StringType Unicode)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError
              (Expr LLVM s (StringType Unicode)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi)))
-> Expr LLVM s (StringType Unicode)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString
              (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [ String
"unsupported floating-point arith operation"
                        , ArithOp -> String
forall a. Show a => a -> String
show ArithOp
op, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x, LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
y
                        ]

unaryArithOp :: (?transOpts :: TranslationOptions) =>
  L.UnaryArithOp ->
  MemType ->
  LLVMExpr s arch ->
  LLVMGenerator s arch ret (LLVMExpr s arch)
unaryArithOp :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
UnaryArithOp
-> MemType
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
unaryArithOp UnaryArithOp
op (VecType Natural
n MemType
tp) (Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
forall s (arch :: LLVMArch).
Natural -> LLVMExpr s arch -> Maybe (Seq (LLVMExpr s arch))
explodeVector Natural
n -> Just Seq (LLVMExpr s arch)
xs) =
  MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
forall s (arch :: LLVMArch).
MemType -> Seq (LLVMExpr s arch) -> LLVMExpr s arch
VecExpr MemType
tp (Seq (LLVMExpr s arch) -> LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Generator LLVM s (LLVMState arch) ret IO (Seq (LLVMExpr s arch))
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => Seq (m a) -> m (Seq a)
sequence ((LLVMExpr s arch
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Seq (LLVMExpr s arch)
-> Seq (Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\LLVMExpr s arch
x -> UnaryArithOp
-> MemType
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
UnaryArithOp
-> MemType
-> LLVMExpr s arch
-> LLVMGenerator s arch ret (LLVMExpr s arch)
unaryArithOp UnaryArithOp
op MemType
tp LLVMExpr s arch
x) Seq (LLVMExpr s arch)
xs)

unaryArithOp UnaryArithOp
op MemType
_ LLVMExpr s arch
x =
  case LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
x of
    Scalar Proxy# arch
_archProxy (FloatRepr FloatInfoRepr flt
fi) Expr LLVM s tp
x' ->
        do Expr LLVM s ('FloatType flt)
ex <- FloatInfoRepr flt
-> Expr LLVM s ('FloatType flt)
-> LLVMGenerator s arch ret (Expr LLVM s ('FloatType flt))
forall (fi :: FloatInfo) s (arch :: LLVMArch)
       (ret :: CrucibleType).
FloatInfoRepr fi
-> Expr LLVM s (FloatType fi)
-> LLVMGenerator s arch ret (Expr LLVM s (FloatType fi))
fop FloatInfoRepr flt
fi Expr LLVM s tp
Expr LLVM s ('FloatType flt)
x'
           LLVMExpr s arch
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TypeRepr ('FloatType flt)
-> Expr LLVM s ('FloatType flt) -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr (FloatInfoRepr flt -> TypeRepr ('FloatType flt)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr flt
fi) Expr LLVM s ('FloatType flt)
ex)

    ScalarView s arch
_ -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError
           (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch)
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString
           (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"unary arithmetic operation on unsupported value",
                         LLVMExpr s arch -> String
forall a. Show a => a -> String
show LLVMExpr s arch
x]

  where
  fop :: FloatInfoRepr fi ->
         Expr LLVM s (FloatType fi) ->
         LLVMGenerator s arch ret (Expr LLVM s (FloatType fi))
  fop :: forall (fi :: FloatInfo) s (arch :: LLVMArch)
       (ret :: CrucibleType).
FloatInfoRepr fi
-> Expr LLVM s (FloatType fi)
-> LLVMGenerator s arch ret (Expr LLVM s (FloatType fi))
fop FloatInfoRepr fi
fi Expr LLVM s (FloatType fi)
a =
    case UnaryArithOp
op of
       UnaryArithOp
L.FNeg ->
         Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr LLVM s (FloatType fi)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi)))
-> Expr LLVM s (FloatType fi)
-> Generator
     LLVM s (LLVMState arch) ret IO (Expr LLVM s (FloatType fi))
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (FloatType fi) -> Expr LLVM s (FloatType fi)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (FloatType fi)
 -> Expr LLVM s (FloatType fi))
-> App LLVM (Expr LLVM s) (FloatType fi)
-> Expr LLVM s (FloatType fi)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr fi
-> Expr LLVM s (FloatType fi)
-> App LLVM (Expr LLVM s) (FloatType fi)
forall (fi :: FloatInfo) (f :: CrucibleType -> Type) ext.
FloatInfoRepr fi -> f (FloatType fi) -> App ext f (FloatType fi)
FloatNeg FloatInfoRepr fi
fi Expr LLVM s (FloatType fi)
a

-- | Generate a call to an LLVM function, without any special
--   handling for debug intrinsics or breakpoints.
callOrdinaryFunction ::
   Maybe L.Instr {- ^ The instruction causing this call -} ->
   Bool    {- ^ Is the function a tail call? -} ->
   L.Type  {- ^ type of the function to call -} ->
   L.Value {- ^ function value to call -} ->
   [L.Typed L.Value] {- ^ argument list -} ->
   (LLVMExpr s arch -> LLVMGenerator s arch ret ()) {- ^ assignment continuation for return value -} ->
   LLVMGenerator s arch ret ()
callOrdinaryFunction :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
Maybe Instr
-> Bool
-> Type
-> Value' BlockLabel
-> [Typed (Value' BlockLabel)]
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret ()
callOrdinaryFunction Maybe Instr
instr Bool
_tailCall fnTy :: Type
fnTy@(L.FunTy Type
lretTy [Type]
_largTys Bool
_varargs) Value' BlockLabel
fn [Typed (Value' BlockLabel)]
args LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f = do
  let err :: String -> a
      err :: forall a. String -> a
err = \String
msg -> Doc Void -> [Doc Void] -> a
forall a. Doc Void -> [Doc Void] -> a
malformedLLVMModule Doc Void
"Invalid type in function call" ([Doc Void] -> a) -> [Doc Void] -> a
forall a b. (a -> b) -> a -> b
$
                       [ String -> Doc Void
forall a. IsString a => String -> a
fromString String
msg ]
                       [Doc Void] -> [Doc Void] -> [Doc Void]
forall a. [a] -> [a] -> [a]
++
                       [Doc Void] -> (Instr -> [Doc Void]) -> Maybe Instr -> [Doc Void]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Doc Void -> [Doc Void] -> [Doc Void]
forall a. a -> [a] -> [a]
:[]) (Doc Void -> [Doc Void])
-> (Instr -> Doc Void) -> Instr -> [Doc Void]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc Void
forall a. IsString a => String -> a
fromString (String -> Doc Void) -> (Instr -> String) -> Instr -> Doc Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr -> String
showInstr) Maybe Instr
instr

  MemType
fnTy'  <- (String -> Generator LLVM s (LLVMState arch) ret IO MemType)
-> (MemType -> Generator LLVM s (LLVMState arch) ret IO MemType)
-> Either String MemType
-> Generator LLVM s (LLVMState arch) ret IO MemType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Generator LLVM s (LLVMState arch) ret IO MemType
forall a. String -> a
err MemType -> Generator LLVM s (LLVMState arch) ret IO MemType
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either String MemType
 -> Generator LLVM s (LLVMState arch) ret IO MemType)
-> Either String MemType
-> Generator LLVM s (LLVMState arch) ret IO MemType
forall a b. (a -> b) -> a -> b
$ Type -> Either String MemType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m MemType
liftMemType (Type -> Type
forall ident. Type' ident -> Type' ident
L.PtrTo Type
fnTy)
  RetType
retTy' <- (String -> Generator LLVM s (LLVMState arch) ret IO RetType)
-> (RetType -> Generator LLVM s (LLVMState arch) ret IO RetType)
-> Either String RetType
-> Generator LLVM s (LLVMState arch) ret IO RetType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Generator LLVM s (LLVMState arch) ret IO RetType
forall a. String -> a
err RetType -> Generator LLVM s (LLVMState arch) ret IO RetType
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either String RetType
 -> Generator LLVM s (LLVMState arch) ret IO RetType)
-> Either String RetType
-> Generator LLVM s (LLVMState arch) ret IO RetType
forall a b. (a -> b) -> a -> b
$ Type -> Either String RetType
forall (m :: Type -> Type).
(?lc::TypeContext, MonadError String m) =>
Type -> m RetType
liftRetType Type
lretTy
  LLVMExpr s arch
fn'    <- MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
MemType
-> Value' BlockLabel -> LLVMGenerator s arch ret (LLVMExpr s arch)
transValue MemType
fnTy' Value' BlockLabel
fn
  [LLVMExpr s arch]
args'  <- (Typed (Value' BlockLabel)
 -> Generator LLVM s (LLVMState arch) ret IO (LLVMExpr s arch))
-> [Typed (Value' BlockLabel)]
-> Generator LLVM s (LLVMState arch) ret IO [LLVMExpr s arch]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (\Typed (Value' BlockLabel)
v -> Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
v) [Typed (Value' BlockLabel)]
args

  let ?err = ?err::String -> Generator LLVM s (LLVMState arch) ret IO ()
String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> a
err
  [LLVMExpr s arch]
-> (forall {ctx :: Ctx CrucibleType}.
    Proxy# arch
    -> CtxRepr ctx
    -> Assignment (Expr LLVM s) ctx
    -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall s a (arch :: LLVMArch).
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
[LLVMExpr s arch]
-> (forall (ctx :: Ctx CrucibleType).
    Proxy# arch -> CtxRepr ctx -> Assignment (Expr LLVM s) ctx -> a)
-> a
unpackArgs [LLVMExpr s arch]
args' ((forall {ctx :: Ctx CrucibleType}.
  Proxy# arch
  -> CtxRepr ctx
  -> Assignment (Expr LLVM s) ctx
  -> Generator LLVM s (LLVMState arch) ret IO ())
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> (forall {ctx :: Ctx CrucibleType}.
    Proxy# arch
    -> CtxRepr ctx
    -> Assignment (Expr LLVM s) ctx
    -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ \Proxy# arch
_archProxy CtxRepr ctx
argTypes Assignment (Expr LLVM s) ctx
args'' ->
    RetType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a (wptr :: Natural).
HasPtrWidth wptr =>
RetType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmRetTypeAsRepr RetType
retTy' ((forall {tp :: CrucibleType}.
  TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO ())
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
retTy ->
      case LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar LLVMExpr s arch
fn' of
        Scalar Proxy# arch
_ TypeRepr tp
PtrRepr Expr LLVM s tp
ptr -> do
          GlobalVar Mem
memVar <- Generator LLVM s (LLVMState arch) ret IO (GlobalVar Mem)
forall s (arch :: LLVMArch) (reg :: CrucibleType).
LLVMGenerator s arch reg (GlobalVar Mem)
getMemVar
          Expr LLVM s (FunctionHandleType ctx tp)
v   <- StmtExtension LLVM (Expr LLVM s) (FunctionHandleType ctx tp)
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Expr LLVM s (FunctionHandleType ctx tp))
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
StmtExtension ext (Expr ext s) tp
-> Generator ext s t ret m (Expr ext s tp)
extensionStmt (GlobalVar Mem
-> Maybe Type
-> Expr LLVM s (LLVMPointerType (ArchWidth arch))
-> CtxRepr ctx
-> TypeRepr tp
-> LLVMStmt (Expr LLVM s) (FunctionHandleType ctx tp)
forall (wptr :: Natural) (f :: CrucibleType -> Type)
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
HasPtrWidth wptr =>
GlobalVar Mem
-> Maybe Type
-> f (LLVMPointerType wptr)
-> CtxRepr args
-> TypeRepr ret
-> LLVMStmt f ('FunctionHandleType args ret)
LLVM_LoadHandle GlobalVar Mem
memVar (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
fnTy) Expr LLVM s tp
Expr LLVM s (LLVMPointerType (ArchWidth arch))
ptr CtxRepr ctx
argTypes TypeRepr tp
retTy)
          Expr LLVM s tp
ret <- Expr LLVM s (FunctionHandleType ctx tp)
-> Assignment (Expr LLVM s) ctx
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s tp)
forall (m :: Type -> Type) ext s (args :: Ctx CrucibleType)
       (ret :: CrucibleType) (t :: Type -> Type) (r :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (FunctionHandleType args ret)
-> Assignment (Expr ext s) args
-> Generator ext s t r m (Expr ext s ret)
call Expr LLVM s (FunctionHandleType ctx tp)
v Assignment (Expr LLVM s) ctx
args''
          LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f (TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
forall (tp :: CrucibleType) s (arch :: LLVMArch).
TypeRepr tp -> Expr LLVM s tp -> LLVMExpr s arch
BaseExpr TypeRepr tp
retTy Expr LLVM s tp
ret)
        ScalarView s arch
_ -> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO ())
-> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"unsupported function value", Value' BlockLabel -> String
forall a. Show a => a -> String
show Value' BlockLabel
fn]

callOrdinaryFunction Maybe Instr
instr Bool
_tailCall Type
fnTy Value' BlockLabel
_fn [Typed (Value' BlockLabel)]
_args LLVMExpr s arch -> LLVMGenerator s arch ret ()
_assign_f =
  Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (StringType Unicode)
-> Expr LLVM s (StringType Unicode)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (StringType Unicode)
 -> Expr LLVM s (StringType Unicode))
-> App LLVM (Expr LLVM s) (StringType Unicode)
-> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ StringLiteral Unicode
-> App LLVM (Expr LLVM s) (StringType Unicode)
forall (si :: StringInfo) ext (f :: CrucibleType -> Type).
StringLiteral si -> App ext f ('BaseToType (BaseStringType si))
StringLit (StringLiteral Unicode
 -> App LLVM (Expr LLVM s) (StringType Unicode))
-> StringLiteral Unicode
-> App LLVM (Expr LLVM s) (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ Text -> StringLiteral Unicode
UnicodeLiteral (Text -> StringLiteral Unicode) -> Text -> StringLiteral Unicode
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    [ String
"[callFunction] Unsupported function type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
fnTy ]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String] -> (Instr -> [String]) -> Maybe Instr -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ( (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> (Instr -> String) -> Instr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr -> String
forall a. Show a => a -> String
show) Maybe Instr
instr


-- | Generate a call to an LLVM function, generating special support
-- for debugging intrinsics and breakpoint functions.
callFunction :: forall s arch ret.
   (?transOpts :: TranslationOptions) =>
   Set L.Ident {- ^ Set of usable identifiers -} ->
   L.Instr {- ^ Source instruction of the call -} ->
   Bool    {- ^ Is the function a tail call? -} ->
   L.Type  {- ^ type of the function to call -} ->
   L.Value {- ^ function value to call -} ->
   [L.Typed L.Value] {- ^ argument list -} ->
   (LLVMExpr s arch -> LLVMGenerator s arch ret ()) {- ^ assignment continuation for return value -} ->
   LLVMGenerator s arch ret ()
callFunction :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
(?transOpts::TranslationOptions) =>
Set Ident
-> Instr
-> Bool
-> Type
-> Value' BlockLabel
-> [Typed (Value' BlockLabel)]
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret ()
callFunction Set Ident
defSet Instr
instr Bool
tailCall_ Type
fnTy Value' BlockLabel
fn [Typed (Value' BlockLabel)]
args LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f

     -- Supports LLVM 4-12
     | L.ValSymbol Symbol
"llvm.dbg.declare" <- Value' BlockLabel
fn
     , TranslationOptions -> Bool
debugIntrinsics ?transOpts::TranslationOptions
TranslationOptions
?transOpts =
       do Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
mbArgs <- Set Ident
-> [Typed (Value' BlockLabel)]
-> LLVMGenerator
     s
     arch
     ret
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Set Ident
-> [Typed (Value' BlockLabel)]
-> LLVMGenerator
     s
     arch
     ret
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
dbgArgs Set Ident
defSet [Typed (Value' BlockLabel)]
args
          case Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
mbArgs of
            Right (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar -> Scalar Proxy# arch
_ TypeRepr tp
PtrRepr Expr LLVM s tp
ptr, DILocalVariable
lv, DIExpression
di) ->
              do Expr LLVM s 'UnitType
_ <- StmtExtension LLVM (Expr LLVM s) 'UnitType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s 'UnitType)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
StmtExtension ext (Expr ext s) tp
-> Generator ext s t ret m (Expr ext s tp)
extensionStmt (LLVM_Dbg (Expr LLVM s) (LLVMPointerType (ArchWidth arch))
-> LLVMStmt (Expr LLVM s) 'UnitType
forall (f :: CrucibleType -> Type) (c :: CrucibleType).
LLVM_Dbg f c -> LLVMStmt f 'UnitType
LLVM_Debug (Expr LLVM s (LLVMPointerType (ArchWidth arch))
-> DILocalVariable
-> DIExpression
-> LLVM_Dbg (Expr LLVM s) (LLVMPointerType (ArchWidth arch))
forall (wptr :: Natural) (f :: CrucibleType -> Type).
HasPtrWidth wptr =>
f (LLVMPointerType wptr)
-> DILocalVariable
-> DIExpression
-> LLVM_Dbg f (LLVMPointerType wptr)
LLVM_Dbg_Declare Expr LLVM s tp
Expr LLVM s (LLVMPointerType (ArchWidth arch))
ptr DILocalVariable
lv DIExpression
di))
                 () -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
            Left String
msg -> Text -> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Text -> LLVMGenerator s arch ret ()
addWarning (String -> Text
Text.pack String
msg)
            Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
_ -> Text -> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Text -> LLVMGenerator s arch ret ()
addWarning Text
"Unexpected argument in llvm.dbg.declare"

     -- Supports LLVM 6-12
     | L.ValSymbol Symbol
"llvm.dbg.addr" <- Value' BlockLabel
fn
     , TranslationOptions -> Bool
debugIntrinsics ?transOpts::TranslationOptions
TranslationOptions
?transOpts =
       do Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
mbArgs <- Set Ident
-> [Typed (Value' BlockLabel)]
-> LLVMGenerator
     s
     arch
     ret
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Set Ident
-> [Typed (Value' BlockLabel)]
-> LLVMGenerator
     s
     arch
     ret
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
dbgArgs Set Ident
defSet [Typed (Value' BlockLabel)]
args
          case Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
mbArgs of
            Right (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar -> Scalar Proxy# arch
_ TypeRepr tp
PtrRepr Expr LLVM s tp
ptr, DILocalVariable
lv, DIExpression
di) ->
              do Expr LLVM s 'UnitType
_ <- StmtExtension LLVM (Expr LLVM s) 'UnitType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s 'UnitType)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
StmtExtension ext (Expr ext s) tp
-> Generator ext s t ret m (Expr ext s tp)
extensionStmt (LLVM_Dbg (Expr LLVM s) (LLVMPointerType (ArchWidth arch))
-> LLVMStmt (Expr LLVM s) 'UnitType
forall (f :: CrucibleType -> Type) (c :: CrucibleType).
LLVM_Dbg f c -> LLVMStmt f 'UnitType
LLVM_Debug (Expr LLVM s (LLVMPointerType (ArchWidth arch))
-> DILocalVariable
-> DIExpression
-> LLVM_Dbg (Expr LLVM s) (LLVMPointerType (ArchWidth arch))
forall (wptr :: Natural) (f :: CrucibleType -> Type).
HasPtrWidth wptr =>
f (LLVMPointerType wptr)
-> DILocalVariable
-> DIExpression
-> LLVM_Dbg f (LLVMPointerType wptr)
LLVM_Dbg_Addr Expr LLVM s tp
Expr LLVM s (LLVMPointerType (ArchWidth arch))
ptr DILocalVariable
lv DIExpression
di))
                 () -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
            Left String
msg -> Text -> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Text -> LLVMGenerator s arch ret ()
addWarning (String -> Text
Text.pack String
msg)
            Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
_ -> Text -> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Text -> LLVMGenerator s arch ret ()
addWarning Text
"Unexpected argument in llvm.dbg.addr"

     -- Supports LLVM 6-12 (earlier versions had an extra argument)
     | L.ValSymbol Symbol
"llvm.dbg.value" <- Value' BlockLabel
fn
     , TranslationOptions -> Bool
debugIntrinsics ?transOpts::TranslationOptions
TranslationOptions
?transOpts =
       do Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
mbArgs <- Set Ident
-> [Typed (Value' BlockLabel)]
-> LLVMGenerator
     s
     arch
     ret
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Set Ident
-> [Typed (Value' BlockLabel)]
-> LLVMGenerator
     s
     arch
     ret
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
dbgArgs Set Ident
defSet [Typed (Value' BlockLabel)]
args
          case Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
mbArgs of
            Right (LLVMExpr s arch -> ScalarView s arch
forall (arch :: LLVMArch) s.
(?lc::TypeContext, HasPtrWidth (ArchWidth arch)) =>
LLVMExpr s arch -> ScalarView s arch
asScalar -> Scalar Proxy# arch
_ TypeRepr tp
repr Expr LLVM s tp
val, DILocalVariable
lv, DIExpression
di) ->
              do Expr LLVM s 'UnitType
_ <- StmtExtension LLVM (Expr LLVM s) 'UnitType
-> Generator LLVM s (LLVMState arch) ret IO (Expr LLVM s 'UnitType)
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
StmtExtension ext (Expr ext s) tp
-> Generator ext s t ret m (Expr ext s tp)
extensionStmt (LLVM_Dbg (Expr LLVM s) tp -> LLVMStmt (Expr LLVM s) 'UnitType
forall (f :: CrucibleType -> Type) (c :: CrucibleType).
LLVM_Dbg f c -> LLVMStmt f 'UnitType
LLVM_Debug (TypeRepr tp
-> Expr LLVM s tp
-> DILocalVariable
-> DIExpression
-> LLVM_Dbg (Expr LLVM s) tp
forall (c :: CrucibleType) (f :: CrucibleType -> Type).
TypeRepr c
-> f c -> DILocalVariable -> DIExpression -> LLVM_Dbg f c
LLVM_Dbg_Value TypeRepr tp
repr Expr LLVM s tp
val DILocalVariable
lv DIExpression
di))
                 () -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
            Left String
msg -> Text -> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Text -> LLVMGenerator s arch ret ()
addWarning (String -> Text
Text.pack String
msg)
            Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
_ -> Text -> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Text -> LLVMGenerator s arch ret ()
addWarning Text
"Unexpected argument in llvm.dbg.value"

     -- Skip calls to other debugging intrinsics.
     | L.ValSymbol Symbol
nm <- Value' BlockLabel
fn
     , Symbol
nm Symbol -> [Symbol] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [ Symbol
"llvm.dbg.label"
                 , Symbol
"llvm.dbg.declare"
                 , Symbol
"llvm.dbg.addr"
                 , Symbol
"llvm.dbg.value"
                 , Symbol
"llvm.lifetime.start"
                 , Symbol
"llvm.lifetime.start.p0"
                 , Symbol
"llvm.lifetime.start.p0i8"
                 , Symbol
"llvm.lifetime.end"
                 , Symbol
"llvm.lifetime.end.p0"
                 , Symbol
"llvm.lifetime.end.p0i8"
                 , Symbol
"llvm.invariant.start"
                 , Symbol
"llvm.invariant.start.p0i8"
                 , Symbol
"llvm.invariant.start.p0"
                 , Symbol
"llvm.invariant.end"
                 , Symbol
"llvm.invariant.end.p0i8"
                 , Symbol
"llvm.invariant.end.p0"
                 ] = () -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

     | L.ValSymbol (L.Symbol String
nm) <- Value' BlockLabel
fn
     , String -> Bool
testBreakpointFunction String
nm = do
        [Some (Value s)]
some_val_args <- (Typed (Value' BlockLabel)
 -> Generator LLVM s (LLVMState arch) ret IO (Some (Value s)))
-> [Typed (Value' BlockLabel)]
-> Generator LLVM s (LLVMState arch) ret IO [Some (Value s)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (\Typed (Value' BlockLabel)
tv -> Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (Some (Value s))
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (Some (Value s))
typedValueAsCrucibleValue Typed (Value' BlockLabel)
tv) [Typed (Value' BlockLabel)]
args
        case [Some (Value s)] -> Some (Assignment (Value s))
forall {k} (f :: k -> Type). [Some f] -> Some (Assignment f)
Ctx.fromList [Some (Value s)]
some_val_args of
          Some Assignment (Value s) x
val_args -> do
            Text
-> Assignment (Value s) x
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (args :: Ctx CrucibleType)
       (t :: Type -> Type) (r :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Text -> Assignment (Value s) args -> Generator ext s t r m ()
addBreakpointStmt (String -> Text
Text.pack String
nm) Assignment (Value s) x
val_args

     | Bool
otherwise = Maybe Instr
-> Bool
-> Type
-> Value' BlockLabel
-> [Typed (Value' BlockLabel)]
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Maybe Instr
-> Bool
-> Type
-> Value' BlockLabel
-> [Typed (Value' BlockLabel)]
-> (LLVMExpr s arch -> LLVMGenerator s arch ret ())
-> LLVMGenerator s arch ret ()
callOrdinaryFunction (Instr -> Maybe Instr
forall a. a -> Maybe a
Just Instr
instr) Bool
tailCall_ Type
fnTy Value' BlockLabel
fn [Typed (Value' BlockLabel)]
args LLVMExpr s arch -> Generator LLVM s (LLVMState arch) ret IO ()
LLVMExpr s arch -> LLVMGenerator s arch ret ()
assign_f

-- | Match the arguments used by @dbg.addr@, @dbg.declare@, and @dbg.value@.
dbgArgs ::
  Set L.Ident {- ^ Set of usable identifiers -} ->
  [L.Typed L.Value] {- ^ debug call arguments -} ->
  LLVMGenerator s arch ret (Either String (LLVMExpr s arch, L.DILocalVariable, L.DIExpression))
dbgArgs :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
Set Ident
-> [Typed (Value' BlockLabel)]
-> LLVMGenerator
     s
     arch
     ret
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
dbgArgs Set Ident
defSet [Typed (Value' BlockLabel)]
args =
    case [Typed (Value' BlockLabel)]
args of
      [Typed (Value' BlockLabel)
valArg, Typed (Value' BlockLabel)
lvArg, Typed (Value' BlockLabel)
diArg] ->
        case Typed (Value' BlockLabel)
valArg of
          L.Typed Type
_ (L.ValMd (L.ValMdValue Typed (Value' BlockLabel)
val)) ->
            case Typed (Value' BlockLabel)
lvArg of
              L.Typed Type
_ (L.ValMd (L.ValMdDebugInfo (L.DebugInfoLocalVariable DILocalVariable
lv))) ->
                case Typed (Value' BlockLabel)
diArg of
                  L.Typed Type
_ (L.ValMd (L.ValMdDebugInfo (L.DebugInfoExpression DIExpression
di))) ->
                    let unusableIdents :: Set Ident
unusableIdents = Set Ident -> Set Ident -> Set Ident
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (Typed (Value' BlockLabel) -> Set Ident
useTypedVal Typed (Value' BlockLabel)
val) Set Ident
defSet
                    in if Set Ident -> Bool
forall a. Set a -> Bool
Set.null Set Ident
unusableIdents then
                         do LLVMExpr s arch
v <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue Typed (Value' BlockLabel)
val
                            Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((LLVMExpr s arch, DILocalVariable, DIExpression)
-> Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
forall a b. b -> Either a b
Right (LLVMExpr s arch
v, DILocalVariable
lv, DIExpression
di))
                       else
                         do let msg :: String
msg = [String] -> String
unwords ([String
"dbg intrinsic def/use violation for:"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                       (Ident -> String) -> [Ident] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (Ident -> Doc) -> Ident -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Doc
LPP.ppIdent) (Set Ident -> [Ident]
forall a. Set a -> [a]
Set.toList Set Ident
unusableIdents))
                            Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (String
-> Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
forall a b. a -> Either a b
Left String
msg)
                  Typed (Value' BlockLabel)
_ -> Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (String
-> Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
forall a b. a -> Either a b
Left (String
"dbg: argument 3 expected DIExpression, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Typed (Value' BlockLabel) -> String
forall a. Show a => a -> String
show Typed (Value' BlockLabel)
diArg))
              Typed (Value' BlockLabel)
_ -> Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (String
-> Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
forall a b. a -> Either a b
Left (String
"dbg: argument 2 expected local variable metadata, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Typed (Value' BlockLabel) -> String
forall a. Show a => a -> String
show Typed (Value' BlockLabel)
lvArg))
          Typed (Value' BlockLabel)
_ -> Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (String
-> Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
forall a b. a -> Either a b
Left (String
"dbg: argument 1 expected value metadata, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Typed (Value' BlockLabel) -> String
forall a. Show a => a -> String
show Typed (Value' BlockLabel)
valArg))
      [Typed (Value' BlockLabel)]
_ -> Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
-> Generator
     LLVM
     s
     (LLVMState arch)
     ret
     IO
     (Either String (LLVMExpr s arch, DILocalVariable, DIExpression))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (String
-> Either String (LLVMExpr s arch, DILocalVariable, DIExpression)
forall a b. a -> Either a b
Left (String
"dbg: expected 3 arguments, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Typed (Value' BlockLabel)] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Typed (Value' BlockLabel)]
args)))

typedValueAsCrucibleValue ::
  L.Typed L.Value ->
  LLVMGenerator s arch ret (Some (Value s))
typedValueAsCrucibleValue :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (Some (Value s))
typedValueAsCrucibleValue Typed (Value' BlockLabel)
tv = case Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
L.typedValue Typed (Value' BlockLabel)
tv of
  L.ValIdent Ident
i -> do
    IdentMap s
m <- Getting (IdentMap s) (LLVMState arch s) (IdentMap s)
-> Generator LLVM s (LLVMState arch) ret IO (IdentMap s)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (IdentMap s) (LLVMState arch s) (IdentMap s)
forall (arch :: LLVMArch) s (f :: Type -> Type).
Functor f =>
(IdentMap s -> f (IdentMap s))
-> LLVMState arch s -> f (LLVMState arch s)
identMap
    case Ident
-> IdentMap s -> Maybe (Either (Some (Reg s)) (Some (Atom s)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
i IdentMap s
m of
      Just (Left (Some Reg s x
r)) ->Some (Value s)
-> Generator LLVM s (LLVMState arch) ret IO (Some (Value s))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Some (Value s)
 -> Generator LLVM s (LLVMState arch) ret IO (Some (Value s)))
-> Some (Value s)
-> Generator LLVM s (LLVMState arch) ret IO (Some (Value s))
forall a b. (a -> b) -> a -> b
$ Value s x -> Some (Value s)
forall k (f :: k -> Type) (x :: k). f x -> Some f
Some (Value s x -> Some (Value s)) -> Value s x -> Some (Value s)
forall a b. (a -> b) -> a -> b
$ Reg s x -> Value s x
forall s (tp :: CrucibleType). Reg s tp -> Value s tp
RegValue Reg s x
r
      Just (Right (Some Atom s x
a)) -> Some (Value s)
-> Generator LLVM s (LLVMState arch) ret IO (Some (Value s))
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Some (Value s)
 -> Generator LLVM s (LLVMState arch) ret IO (Some (Value s)))
-> Some (Value s)
-> Generator LLVM s (LLVMState arch) ret IO (Some (Value s))
forall a b. (a -> b) -> a -> b
$ Value s x -> Some (Value s)
forall k (f :: k -> Type) (x :: k). f x -> Some f
Some (Value s x -> Some (Value s)) -> Value s x -> Some (Value s)
forall a b. (a -> b) -> a -> b
$ Atom s x -> Value s x
forall s (tp :: CrucibleType). Atom s tp -> Value s tp
AtomValue Atom s x
a
      Maybe (Either (Some (Reg s)) (Some (Atom s)))
Nothing -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (Some (Value s))
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO (Some (Value s)))
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (Some (Value s))
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$
        String
"Could not find identifier " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
forall a. Show a => a -> String
show Ident
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
  Value' BlockLabel
v -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (Some (Value s))
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO (Some (Value s)))
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO (Some (Value s))
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$
    String
"Unsupported breakpoint parameter: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value' BlockLabel -> String
forall a. Show a => a -> String
show Value' BlockLabel
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."



-- | Build a switch statement by decomposing it into a linear sequence of branches.
--   FIXME? this could be more efficient if we sort the list and do binary search instead...
buildSwitch :: (1 <= w)
            => NatRepr w
            -> Expr LLVM s (BVType w) -- ^ The expression to switch on
            -> L.BlockLabel        -- ^ The label of the current basic block
            -> L.BlockLabel        -- ^ The label of the default basic block if no other branch applies
            -> [(Integer, L.BlockLabel)] -- ^ The switch labels
            -> LLVMGenerator s arch ret a
buildSwitch :: forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType) a.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w)
-> BlockLabel
-> BlockLabel
-> [(Integer, BlockLabel)]
-> LLVMGenerator s arch ret a
buildSwitch NatRepr w
_ Expr LLVM s (BVType w)
_  BlockLabel
curr_lab BlockLabel
def [] =
   BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
forall s (arch :: LLVMArch) (ret :: CrucibleType) a.
BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
definePhiBlock BlockLabel
curr_lab BlockLabel
def
buildSwitch NatRepr w
w Expr LLVM s (BVType w)
ex BlockLabel
curr_lab BlockLabel
def ((Integer
i,BlockLabel
l):[(Integer, BlockLabel)]
bs) = do
   let test :: Expr LLVM s BoolType
test = App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType)
-> App LLVM (Expr LLVM s) BoolType -> Expr LLVM s BoolType
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr LLVM s (BVType w)
-> Expr LLVM s (BVType w)
-> App LLVM (Expr LLVM s) BoolType
forall (tp :: CrucibleType) (f :: CrucibleType -> Type) ext
       (w :: Natural).
(1 <= w, tp ~ BoolType) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f tp
BVEq NatRepr w
w Expr LLVM s (BVType w)
ex (Expr LLVM s (BVType w) -> App LLVM (Expr LLVM s) BoolType)
-> Expr LLVM s (BVType w) -> App LLVM (Expr LLVM s) BoolType
forall a b. (a -> b) -> a -> b
$ App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall ext s (tp :: CrucibleType).
App ext (Expr ext s) tp -> Expr ext s tp
App (App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w))
-> App LLVM (Expr LLVM s) (BVType w) -> Expr LLVM s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> App LLVM (Expr LLVM s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> Type).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
i)
   Label s
t_id <- Generator LLVM s (LLVMState arch) ret IO (Label s)
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
Monad m =>
Generator ext s t ret m (Label s)
newLabel
   Label s
f_id <- Generator LLVM s (LLVMState arch) ret IO (Label s)
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
Monad m =>
Generator ext s t ret m (Label s)
newLabel
   Label s
-> (forall a. Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Label s
-> (forall a. Generator ext s t ret m a)
-> Generator ext s t ret m ()
defineBlock Label s
t_id (BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
forall s (arch :: LLVMArch) (ret :: CrucibleType) a.
BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
definePhiBlock BlockLabel
curr_lab BlockLabel
l)
   Label s
-> (forall a. Generator LLVM s (LLVMState arch) ret IO a)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Label s
-> (forall a. Generator ext s t ret m a)
-> Generator ext s t ret m ()
defineBlock Label s
f_id (NatRepr w
-> Expr LLVM s (BVType w)
-> BlockLabel
-> BlockLabel
-> [(Integer, BlockLabel)]
-> LLVMGenerator s arch ret a
forall (w :: Natural) s (arch :: LLVMArch) (ret :: CrucibleType) a.
(1 <= w) =>
NatRepr w
-> Expr LLVM s (BVType w)
-> BlockLabel
-> BlockLabel
-> [(Integer, BlockLabel)]
-> LLVMGenerator s arch ret a
buildSwitch NatRepr w
w Expr LLVM s (BVType w)
ex BlockLabel
curr_lab BlockLabel
def [(Integer, BlockLabel)]
bs)
   Expr LLVM s BoolType
-> Label s -> Label s -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s BoolType
-> Label s -> Label s -> Generator ext s t ret m a
branch Expr LLVM s BoolType
test Label s
t_id Label s
f_id

-- | Implement the phi-functions along the edge from one LLVM Basic block to another.
definePhiBlock :: L.BlockLabel      -- ^ The LLVM source basic block
               -> L.BlockLabel      -- ^ The LLVM target basic block
               -> LLVMGenerator s arch ret a
definePhiBlock :: forall s (arch :: LLVMArch) (ret :: CrucibleType) a.
BlockLabel -> BlockLabel -> LLVMGenerator s arch ret a
definePhiBlock BlockLabel
l BlockLabel
l' = do
  LLVMBlockInfoMap s
bim <- Getting
  (LLVMBlockInfoMap s) (LLVMState arch s) (LLVMBlockInfoMap s)
-> Generator LLVM s (LLVMState arch) ret IO (LLVMBlockInfoMap s)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
  (LLVMBlockInfoMap s) (LLVMState arch s) (LLVMBlockInfoMap s)
forall (arch :: LLVMArch) s (f :: Type -> Type).
Functor f =>
(LLVMBlockInfoMap s -> f (LLVMBlockInfoMap s))
-> LLVMState arch s -> f (LLVMState arch s)
blockInfoMap
  case BlockLabel -> LLVMBlockInfoMap s -> Maybe (LLVMBlockInfo s)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup BlockLabel
l' LLVMBlockInfoMap s
bim of
    Maybe (LLVMBlockInfo s)
Nothing -> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO a)
-> String -> Generator LLVM s (LLVMState arch) ret IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"label not found in label map:", BlockLabel -> String
forall a. Show a => a -> String
show BlockLabel
l']
    Just LLVMBlockInfo s
bi' -> do
      -- Collect all the relevant phi functions to evaluate
      let phi_funcs :: [(Ident, Type, Value' BlockLabel)]
phi_funcs = [(Ident, Type, Value' BlockLabel)]
-> (Seq (Ident, Type, Value' BlockLabel)
    -> [(Ident, Type, Value' BlockLabel)])
-> Maybe (Seq (Ident, Type, Value' BlockLabel))
-> [(Ident, Type, Value' BlockLabel)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Seq (Ident, Type, Value' BlockLabel)
-> [(Ident, Type, Value' BlockLabel)]
forall a. Seq a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Maybe (Seq (Ident, Type, Value' BlockLabel))
 -> [(Ident, Type, Value' BlockLabel)])
-> Maybe (Seq (Ident, Type, Value' BlockLabel))
-> [(Ident, Type, Value' BlockLabel)]
forall a b. (a -> b) -> a -> b
$ BlockLabel
-> Map BlockLabel (Seq (Ident, Type, Value' BlockLabel))
-> Maybe (Seq (Ident, Type, Value' BlockLabel))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup BlockLabel
l (LLVMBlockInfo s
-> Map BlockLabel (Seq (Ident, Type, Value' BlockLabel))
forall s.
LLVMBlockInfo s
-> Map BlockLabel (Seq (Ident, Type, Value' BlockLabel))
block_phi_map LLVMBlockInfo s
bi')

      -- NOTE: We evaluate all the right-hand sides of the phi nodes BEFORE
      --   we assign the values to their associated registers.  This preserves
      --   the expected semantics that phi functions are evaluated in the context
      --   of the previous basic block, and prevents unintended register shadowing.
      --   Otherwise loop-carried dependencies will sometimes end up with the wrong
      --   values.
      [(Ident, LLVMExpr s arch)]
phiVals <- ((Ident, Type, Value' BlockLabel)
 -> Generator
      LLVM s (LLVMState arch) ret IO (Ident, LLVMExpr s arch))
-> [(Ident, Type, Value' BlockLabel)]
-> Generator
     LLVM s (LLVMState arch) ret IO [(Ident, LLVMExpr s arch)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (Ident, Type, Value' BlockLabel)
-> Generator
     LLVM s (LLVMState arch) ret IO (Ident, LLVMExpr s arch)
forall {arch :: LLVMArch} {a} {s} {ret :: CrucibleType}.
(Assert
   (OrdCond (CmpNat 1 (ArchWidth arch)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 16 (ArchWidth arch)) 'True 'True 'False)
   (TypeError ...),
 ?ptrWidth::NatRepr (ArchWidth arch), ?lc::TypeContext) =>
(a, Type, Value' BlockLabel)
-> Generator LLVM s (LLVMState arch) ret IO (a, LLVMExpr s arch)
evalPhi [(Ident, Type, Value' BlockLabel)]
phi_funcs
      ((Ident, LLVMExpr s arch)
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> [(Ident, LLVMExpr s arch)]
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ident, LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall {arch :: LLVMArch} {s} {ret :: CrucibleType}.
(Assert
   (OrdCond (CmpNat 1 (ArchWidth arch)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 16 (ArchWidth arch)) 'True 'True 'False)
   (TypeError ...),
 ?ptrWidth::NatRepr (ArchWidth arch), ?lc::TypeContext) =>
(Ident, LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO ()
assignPhi [(Ident, LLVMExpr s arch)]
phiVals

      -- Now jump to the target code block
      Label s -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Label s -> Generator ext s t ret m a
jump (LLVMBlockInfo s -> Label s
forall s. LLVMBlockInfo s -> Label s
block_label LLVMBlockInfo s
bi')

 where evalPhi :: (a, Type, Value' BlockLabel)
-> Generator LLVM s (LLVMState arch) ret IO (a, LLVMExpr s arch)
evalPhi (a
ident,Type
tp,Value' BlockLabel
v) = do
           LLVMExpr s arch
t_v <- Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Typed (Value' BlockLabel)
-> LLVMGenerator s arch ret (LLVMExpr s arch)
transTypedValue (Type -> Value' BlockLabel -> Typed (Value' BlockLabel)
forall a. Type -> a -> Typed a
L.Typed Type
tp Value' BlockLabel
v)
           (a, LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO (a, LLVMExpr s arch)
forall a. a -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a
ident,LLVMExpr s arch
t_v)
       assignPhi :: (Ident, LLVMExpr s arch)
-> Generator LLVM s (LLVMState arch) ret IO ()
assignPhi (Ident
ident,LLVMExpr s arch
t_v) = do
           Ident -> LLVMExpr s arch -> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Ident -> LLVMExpr s arch -> LLVMGenerator s arch ret ()
assignLLVMReg Ident
ident LLVMExpr s arch
t_v


-- | Assign a packed LLVM expression into the named LLVM register.
assignLLVMReg
        :: L.Ident
        -> LLVMExpr s arch
        -> LLVMGenerator s arch ret ()
assignLLVMReg :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
Ident -> LLVMExpr s arch -> LLVMGenerator s arch ret ()
assignLLVMReg Ident
ident LLVMExpr s arch
rhs = do
  LLVMState arch s
st <- Generator LLVM s (LLVMState arch) ret IO (LLVMState arch s)
forall s (m :: Type -> Type). MonadState s m => m s
get
  let idMap :: IdentMap s
idMap = LLVMState arch s
stLLVMState arch s
-> Getting (IdentMap s) (LLVMState arch s) (IdentMap s)
-> IdentMap s
forall s a. s -> Getting a s a -> a
^.Getting (IdentMap s) (LLVMState arch s) (IdentMap s)
forall (arch :: LLVMArch) s (f :: Type -> Type).
Functor f =>
(IdentMap s -> f (IdentMap s))
-> LLVMState arch s -> f (LLVMState arch s)
identMap
  case Ident
-> IdentMap s -> Maybe (Either (Some (Reg s)) (Some (Atom s)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
ident IdentMap s
idMap of
    Just (Left Some (Reg s)
lhs) -> do
      Some (Reg s) -> LLVMExpr s arch -> LLVMGenerator s arch ret ()
forall s (arch :: LLVMArch) (ret :: CrucibleType).
Some (Reg s) -> LLVMExpr s arch -> LLVMGenerator s arch ret ()
doAssign Some (Reg s)
lhs LLVMExpr s arch
rhs
    Just (Right Some (Atom s)
_) -> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO ())
-> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ String
"internal: Value cannot be assigned to."
    Maybe (Either (Some (Reg s)) (Some (Atom s)))
Nothing  -> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Generator LLVM s (LLVMState arch) ret IO ())
-> String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"register not found in register map:", Ident -> String
forall a. Show a => a -> String
show Ident
ident]

-- | Given a register and an expression shape, assign the expressions in the right-hand-side
--   into the register left-hand side.
doAssign :: forall s arch ret.
      Some (Reg s)
   -> LLVMExpr s arch -- ^ the RHS values to assign
   -> LLVMGenerator s arch ret ()
doAssign :: forall s (arch :: LLVMArch) (ret :: CrucibleType).
Some (Reg s) -> LLVMExpr s arch -> LLVMGenerator s arch ret ()
doAssign (Some Reg s x
r) (BaseExpr TypeRepr tp
tpr Expr LLVM s tp
ex) =
   case TypeRepr x -> TypeRepr tp -> Maybe (x :~: tp)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality (Reg s x -> TypeRepr x
forall s (tp :: CrucibleType). Reg s tp -> TypeRepr tp
typeOfReg Reg s x
r) TypeRepr tp
tpr of
     Just x :~: tp
Refl -> Reg s x
-> Expr LLVM s x -> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Reg s tp -> Expr ext s tp -> Generator ext s t ret m ()
assignReg Reg s x
r Expr LLVM s x
Expr LLVM s tp
ex
     Maybe (x :~: tp)
Nothing -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"type mismatch when assigning register", Reg s x -> String
forall a. Show a => a -> String
show Reg s x
r, TypeRepr x -> String
forall a. Show a => a -> String
show (Reg s x -> TypeRepr x
forall s (tp :: CrucibleType). Reg s tp -> TypeRepr tp
typeOfReg Reg s x
r) , TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
tpr]
doAssign (Some Reg s x
r) (StructExpr Seq (MemType, LLVMExpr s arch)
vs) = do
   let ?err = ?err::String -> Generator LLVM s (LLVMState arch) ret IO ()
String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
   [LLVMExpr s arch]
-> (forall {ctx :: Ctx CrucibleType}.
    Proxy# arch
    -> CtxRepr ctx
    -> Assignment (Expr LLVM s) ctx
    -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall s a (arch :: LLVMArch).
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
[LLVMExpr s arch]
-> (forall (ctx :: Ctx CrucibleType).
    Proxy# arch -> CtxRepr ctx -> Assignment (Expr LLVM s) ctx -> a)
-> a
unpackArgs (((MemType, LLVMExpr s arch) -> LLVMExpr s arch)
-> [(MemType, LLVMExpr s arch)] -> [LLVMExpr s arch]
forall a b. (a -> b) -> [a] -> [b]
map (MemType, LLVMExpr s arch) -> LLVMExpr s arch
forall a b. (a, b) -> b
snd ([(MemType, LLVMExpr s arch)] -> [LLVMExpr s arch])
-> [(MemType, LLVMExpr s arch)] -> [LLVMExpr s arch]
forall a b. (a -> b) -> a -> b
$ Seq (MemType, LLVMExpr s arch) -> [(MemType, LLVMExpr s arch)]
forall a. Seq a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Seq (MemType, LLVMExpr s arch)
vs) ((forall {ctx :: Ctx CrucibleType}.
  Proxy# arch
  -> CtxRepr ctx
  -> Assignment (Expr LLVM s) ctx
  -> Generator LLVM s (LLVMState arch) ret IO ())
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> (forall {ctx :: Ctx CrucibleType}.
    Proxy# arch
    -> CtxRepr ctx
    -> Assignment (Expr LLVM s) ctx
    -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ \Proxy# arch
_archProxy CtxRepr ctx
ctx Assignment (Expr LLVM s) ctx
asgn ->
     case TypeRepr x
-> TypeRepr ('StructType ctx) -> Maybe (x :~: 'StructType ctx)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality (Reg s x -> TypeRepr x
forall s (tp :: CrucibleType). Reg s tp -> TypeRepr tp
typeOfReg Reg s x
r) (CtxRepr ctx -> TypeRepr ('StructType ctx)
forall (ctx :: Ctx CrucibleType).
CtxRepr ctx -> TypeRepr ('StructType ctx)
StructRepr CtxRepr ctx
ctx) of
       Just x :~: 'StructType ctx
Refl -> Reg s x
-> Expr LLVM s x -> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Reg s tp -> Expr ext s tp -> Generator ext s t ret m ()
assignReg Reg s x
r (CtxRepr ctx
-> Assignment (Expr LLVM s) ctx -> Expr LLVM s ('StructType ctx)
forall (e :: CrucibleType -> Type) (ctx :: Ctx CrucibleType).
IsExpr e =>
CtxRepr ctx -> Assignment e ctx -> e (StructType ctx)
mkStruct CtxRepr ctx
ctx Assignment (Expr LLVM s) ctx
asgn)
       Maybe (x :~: 'StructType ctx)
Nothing -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"type mismatch when assigning structure to register", Reg s x -> String
forall a. Show a => a -> String
show Reg s x
r, TypeRepr ('StructType ctx) -> String
forall a. Show a => a -> String
show (CtxRepr ctx -> TypeRepr ('StructType ctx)
forall (ctx :: Ctx CrucibleType).
CtxRepr ctx -> TypeRepr ('StructType ctx)
StructRepr CtxRepr ctx
ctx)]
doAssign (Some Reg s x
r) (ZeroExpr MemType
tp) = do
  let ?err = ?err::String -> Generator LLVM s (LLVMState arch) ret IO ()
String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
  Proxy# arch
-> MemType
-> (forall {tp :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tp
    -> Expr LLVM s tp
    -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a (arch :: LLVMArch) s.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
Proxy# arch
-> MemType
-> (forall (tp :: CrucibleType).
    Proxy# arch -> TypeRepr tp -> Expr LLVM s tp -> a)
-> a
zeroExpand (Proxy# arch
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# arch) MemType
tp ((forall {tp :: CrucibleType}.
  Proxy# arch
  -> TypeRepr tp
  -> Expr LLVM s tp
  -> Generator LLVM s (LLVMState arch) ret IO ())
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> (forall {tp :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tp
    -> Expr LLVM s tp
    -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ \Proxy# arch
_archProxy (TypeRepr tp
tpr :: TypeRepr t) (Expr LLVM s tp
ex :: Expr LLVM s t) ->
    case TypeRepr x -> TypeRepr tp -> Maybe (x :~: tp)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality (Reg s x -> TypeRepr x
forall s (tp :: CrucibleType). Reg s tp -> TypeRepr tp
typeOfReg Reg s x
r) TypeRepr tp
tpr of
      Just x :~: tp
Refl -> Reg s x
-> Expr LLVM s x -> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Reg s tp -> Expr ext s tp -> Generator ext s t ret m ()
assignReg Reg s x
r Expr LLVM s x
Expr LLVM s tp
ex
      Maybe (x :~: tp)
Nothing -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ String
"type mismatch when assigning zero value"
doAssign (Some Reg s x
r) (UndefExpr MemType
tp) = do
  let ?err = ?err::String -> Generator LLVM s (LLVMState arch) ret IO ()
String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
  Proxy# arch
-> MemType
-> (forall {tp :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tp
    -> Expr LLVM s tp
    -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a (arch :: LLVMArch) s.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
Proxy# arch
-> MemType
-> (forall (tp :: CrucibleType).
    Proxy# arch -> TypeRepr tp -> Expr LLVM s tp -> a)
-> a
undefExpand (Proxy# arch
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# arch) MemType
tp ((forall {tp :: CrucibleType}.
  Proxy# arch
  -> TypeRepr tp
  -> Expr LLVM s tp
  -> Generator LLVM s (LLVMState arch) ret IO ())
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> (forall {tp :: CrucibleType}.
    Proxy# arch
    -> TypeRepr tp
    -> Expr LLVM s tp
    -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ \Proxy# arch
_archProxy (TypeRepr tp
tpr :: TypeRepr t) (Expr LLVM s tp
ex :: Expr LLVM s t) ->
    case TypeRepr x -> TypeRepr tp -> Maybe (x :~: tp)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality (Reg s x -> TypeRepr x
forall s (tp :: CrucibleType). Reg s tp -> TypeRepr tp
typeOfReg Reg s x
r) TypeRepr tp
tpr of
      Just x :~: tp
Refl -> Reg s x
-> Expr LLVM s x -> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Reg s tp -> Expr ext s tp -> Generator ext s t ret m ()
assignReg Reg s x
r Expr LLVM s x
Expr LLVM s tp
ex
      Maybe (x :~: tp)
Nothing -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ String
"type mismatch when assigning undef value"
doAssign (Some Reg s x
r) (VecExpr MemType
tp Seq (LLVMExpr s arch)
vs) = do
  let ?err = ?err::String -> Generator LLVM s (LLVMState arch) ret IO ()
String -> Generator LLVM s (LLVMState arch) ret IO ()
forall a. String -> Generator LLVM s (LLVMState arch) ret IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
  MemType
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a (wptr :: Natural).
HasPtrWidth wptr =>
MemType -> (forall (tp :: CrucibleType). TypeRepr tp -> a) -> a
llvmTypeAsRepr MemType
tp ((forall {tp :: CrucibleType}.
  TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO ())
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
tpr ->
    Proxy# arch
-> TypeRepr tp
-> [LLVMExpr s arch]
-> (Expr LLVM s (VectorType tp)
    -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (tpr :: CrucibleType) s (arch :: LLVMArch) a.
(?err::String -> a, HasPtrWidth (ArchWidth arch)) =>
Proxy# arch
-> TypeRepr tpr
-> [LLVMExpr s arch]
-> (Expr LLVM s (VectorType tpr) -> a)
-> a
unpackVec (Proxy# arch
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# arch) TypeRepr tp
tpr (Seq (LLVMExpr s arch) -> [LLVMExpr s arch]
forall a. Seq a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Seq (LLVMExpr s arch)
vs) ((Expr LLVM s (VectorType tp)
  -> Generator LLVM s (LLVMState arch) ret IO ())
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> (Expr LLVM s (VectorType tp)
    -> Generator LLVM s (LLVMState arch) ret IO ())
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ \Expr LLVM s (VectorType tp)
ex ->
      case TypeRepr x
-> TypeRepr (VectorType tp) -> Maybe (x :~: VectorType tp)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality (Reg s x -> TypeRepr x
forall s (tp :: CrucibleType). Reg s tp -> TypeRepr tp
typeOfReg Reg s x
r) (TypeRepr tp -> TypeRepr (VectorType tp)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr tp
tpr) of
        Just x :~: VectorType tp
Refl -> Reg s x
-> Expr LLVM s x -> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (tp :: CrucibleType)
       (t :: Type -> Type) (ret :: CrucibleType).
(Monad m, IsSyntaxExtension ext) =>
Reg s tp -> Expr ext s tp -> Generator ext s t ret m ()
assignReg Reg s x
r Expr LLVM s x
Expr LLVM s (VectorType tp)
ex
        Maybe (x :~: VectorType tp)
Nothing -> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall (m :: Type -> Type) ext s (t :: Type -> Type)
       (ret :: CrucibleType) a.
(Monad m, IsSyntaxExtension ext) =>
Expr ext s (StringType Unicode) -> Generator ext s t ret m a
reportError (Expr LLVM s (StringType Unicode)
 -> Generator LLVM s (LLVMState arch) ret IO ())
-> Expr LLVM s (StringType Unicode)
-> Generator LLVM s (LLVMState arch) ret IO ()
forall a b. (a -> b) -> a -> b
$ String -> Expr LLVM s (StringType Unicode)
forall a. IsString a => String -> a
fromString (String -> Expr LLVM s (StringType Unicode))
-> String -> Expr LLVM s (StringType Unicode)
forall a b. (a -> b) -> a -> b
$ String
"type mismatch when assigning vector value"