-- |
-- Module           : Lang.Crucible.LLVM.Intrinsics.Libc
-- Description      : Override definitions for C standard library functions
-- Copyright        : (c) Galois, Inc 2015-2019
-- License          : BSD3
-- Maintainer       : Rob Dockins <rdockins@galois.com>
-- Stability        : provisional
------------------------------------------------------------------------

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module Lang.Crucible.LLVM.Intrinsics.Libc where

import           Control.Lens ((^.), _1, _2, _3)
import qualified Codec.Binary.UTF8.Generic as UTF8
import           Control.Monad (when)
import           Control.Monad.IO.Class (MonadIO(..))
import           Control.Monad.State (MonadState(..), StateT(..))
import           Control.Monad.Trans.Class (MonadTrans(..))
import qualified Data.ByteString as BS
import qualified Data.Vector as V
import           System.IO
import qualified GHC.Stack as GHC

import qualified Data.BitVector.Sized as BV
import           Data.Parameterized.Context ( pattern (:>), pattern Empty )
import qualified Data.Parameterized.Context as Ctx

import           What4.Interface
import           What4.ProgramLoc (plSourceLoc)
import qualified What4.SpecialFunctions as W4

import           Lang.Crucible.Backend
import           Lang.Crucible.CFG.Common
import           Lang.Crucible.Types
import           Lang.Crucible.Simulator.ExecutionTree
import           Lang.Crucible.Simulator.OverrideSim
import           Lang.Crucible.Simulator.RegMap
import           Lang.Crucible.Simulator.SimError

import           Lang.Crucible.LLVM.Bytes
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.MalformedLLVMModule
import           Lang.Crucible.LLVM.MemModel
import           Lang.Crucible.LLVM.MemModel.CallStack (CallStack)
import qualified Lang.Crucible.LLVM.MemModel.Type as G
import qualified Lang.Crucible.LLVM.MemModel.Generic as G
import           Lang.Crucible.LLVM.MemModel.Partial
import qualified Lang.Crucible.LLVM.MemModel.Pointer as Ptr
import           Lang.Crucible.LLVM.Printf
import           Lang.Crucible.LLVM.QQ( llvmOvr )
import           Lang.Crucible.LLVM.TypeContext

import           Lang.Crucible.LLVM.Intrinsics.Common
import           Lang.Crucible.LLVM.Intrinsics.Options

-- | All libc overrides.
--
-- This list is useful to other Crucible frontends based on the LLVM memory
-- model (e.g., Macaw).
libc_overrides ::
  ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
  , ?lc :: TypeContext, ?intrinsicsOpts :: IntrinsicsOptions, ?memOpts :: MemOptions ) =>
  [SomeLLVMOverride p sym ext]
libc_overrides :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?intrinsicsOpts::IntrinsicsOptions,
 ?memOpts::MemOptions) =>
[SomeLLVMOverride p sym ext]
libc_overrides =
  [ LLVMOverride p sym ext EmptyCtx UnitType
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext EmptyCtx UnitType
forall sym p ext.
(IsSymInterface sym, ?intrinsicsOpts::IntrinsicsOptions) =>
LLVMOverride p sym ext EmptyCtx UnitType
llvmAbortOverride
  , LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType 32)
   ::> LLVMPointerType wptr)
  UnitType
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType 32)
   ::> LLVMPointerType wptr)
  UnitType
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?intrinsicsOpts::IntrinsicsOptions, ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType 32)
   ::> LLVMPointerType wptr)
  UnitType
llvmAssertRtnOverride
  , LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType 32)
   ::> LLVMPointerType wptr)
  UnitType
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType 32)
   ::> LLVMPointerType wptr)
  UnitType
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?intrinsicsOpts::IntrinsicsOptions, ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType 32)
   ::> LLVMPointerType wptr)
  UnitType
llvmAssertFailOverride
  , LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
llvmMemcpyOverride
  , LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
llvmMemcpyChkOverride
  , LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
llvmMemmoveOverride
  , LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
  (LLVMPointerType wptr)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
  (LLVMPointerType wptr)
forall p sym ext (wptr :: Natural).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
  (LLVMPointerType wptr)
llvmMemsetOverride
  , LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
llvmMemsetChkOverride
  , LLVMOverride
  p sym ext (EmptyCtx ::> BVType wptr) (LLVMPointerType wptr)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p sym ext (EmptyCtx ::> BVType wptr) (LLVMPointerType wptr)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?memOpts::MemOptions) =>
LLVMOverride
  p sym ext (EmptyCtx ::> BVType wptr) (LLVMPointerType wptr)
llvmMallocOverride
  , LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> BVType wptr) ::> BVType wptr)
  (LLVMPointerType wptr)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> BVType wptr) ::> BVType wptr)
  (LLVMPointerType wptr)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> BVType wptr) ::> BVType wptr)
  (LLVMPointerType wptr)
llvmCallocOverride
  , LLVMOverride p sym ext (EmptyCtx ::> LLVMPointerType wptr) UnitType
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> LLVMPointerType wptr) UnitType
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
LLVMOverride p sym ext (EmptyCtx ::> LLVMPointerType wptr) UnitType
llvmFreeOverride
  , LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
  (LLVMPointerType wptr)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
  (LLVMPointerType wptr)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
  (LLVMPointerType wptr)
llvmReallocOverride
  , LLVMOverride
  p sym ext (EmptyCtx ::> LLVMPointerType wptr) (BVType wptr)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p sym ext (EmptyCtx ::> LLVMPointerType wptr) (BVType wptr)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p sym ext (EmptyCtx ::> LLVMPointerType wptr) (BVType wptr)
llvmStrlenOverride
  , LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> LLVMPointerType wptr) ::> VectorType AnyType)
  (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> LLVMPointerType wptr) ::> VectorType AnyType)
  (BVType 32)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> LLVMPointerType wptr) ::> VectorType AnyType)
  (BVType 32)
llvmPrintfOverride
  , LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> BVType 32) ::> LLVMPointerType wptr)
   ::> VectorType AnyType)
  (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> BVType 32) ::> LLVMPointerType wptr)
   ::> VectorType AnyType)
  (BVType 32)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> BVType 32) ::> LLVMPointerType wptr)
   ::> VectorType AnyType)
  (BVType 32)
llvmPrintfChkOverride
  , LLVMOverride
  p sym ext (EmptyCtx ::> LLVMPointerType wptr) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p sym ext (EmptyCtx ::> LLVMPointerType wptr) (BVType 32)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p sym ext (EmptyCtx ::> LLVMPointerType wptr) (BVType 32)
llvmPutsOverride
  , LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmPutCharOverride
  , LLVMOverride p sym ext (EmptyCtx ::> BVType 32) UnitType
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> BVType 32) UnitType
forall sym p ext.
(IsSymInterface sym, ?intrinsicsOpts::IntrinsicsOptions) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) UnitType
llvmExitOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> LLVMPointerType wptr)
  (LLVMPointerType wptr)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> LLVMPointerType wptr)
  (LLVMPointerType wptr)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr) =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> LLVMPointerType wptr)
  (LLVMPointerType wptr)
llvmGetenvOverride
  , LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
forall sym p ext.
(IsSymInterface sym, ?lc::TypeContext) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmHtonlOverride
  , LLVMOverride p sym ext (EmptyCtx ::> BVType 16) (BVType 16)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> BVType 16) (BVType 16)
forall sym p ext.
(IsSymInterface sym, ?lc::TypeContext) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 16) (BVType 16)
llvmHtonsOverride
  , LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
forall sym p ext.
(IsSymInterface sym, ?lc::TypeContext) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmNtohlOverride
  , LLVMOverride p sym ext (EmptyCtx ::> BVType 16) (BVType 16)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> BVType 16) (BVType 16)
forall sym p ext.
(IsSymInterface sym, ?lc::TypeContext) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 16) (BVType 16)
llvmNtohsOverride
  , LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
forall sym p ext.
(IsSymInterface sym, HasLLVMAnn sym) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmAbsOverride
  , LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
forall sym p ext.
(IsSymInterface sym, HasLLVMAnn sym) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmLAbsOverride_32
  , LLVMOverride p sym ext (EmptyCtx ::> BVType 64) (BVType 64)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> BVType 64) (BVType 64)
forall sym p ext.
(IsSymInterface sym, HasLLVMAnn sym) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 64) (BVType 64)
llvmLAbsOverride_64
  , LLVMOverride p sym ext (EmptyCtx ::> BVType 64) (BVType 64)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride p sym ext (EmptyCtx ::> BVType 64) (BVType 64)
forall sym p ext.
(IsSymInterface sym, HasLLVMAnn sym) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 64) (BVType 64)
llvmLLAbsOverride

  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmCeilOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmCeilfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmFloorOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmFloorfOverride
  , LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
   ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
   ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
   ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmFmaOverride
  , LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
   ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
   ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
   ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmFmafOverride
  , LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
llvmIsinfOverride
  , LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
llvm__isinfOverride
  , LLVMOverride
  p sym ext (EmptyCtx ::> FloatType SingleFloat) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p sym ext (EmptyCtx ::> FloatType SingleFloat) (BVType 32)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType SingleFloat) (BVType 32)
llvm__isinffOverride
  , LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
llvmIsnanOverride
  , LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
llvm__isnanOverride
  , LLVMOverride
  p sym ext (EmptyCtx ::> FloatType SingleFloat) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p sym ext (EmptyCtx ::> FloatType SingleFloat) (BVType 32)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType SingleFloat) (BVType 32)
llvm__isnanfOverride
  , LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
llvm__isnandOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmSqrtOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmSqrtfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmSinOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmSinfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmCosOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmCosfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmTanOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmTanfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAsinOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAsinfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAcosOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAcosfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAtanOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAtanfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmSinhOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmSinhfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmCoshOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmCoshfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmTanhOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmTanhfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAsinhOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAsinhfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAcoshOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAcoshfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAtanhOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAtanhfOverride
  , LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmHypotOverride
  , LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmHypotfOverride
  , LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAtan2Override
  , LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAtan2fOverride
  , LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmPowfOverride
  , LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmPowOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmExpOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmExpfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmLogOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmLogfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmExpm1Override
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmExpm1fOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmLog1pOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmLog1pfOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmExp2Override
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmExp2fOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmLog2Override
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmLog2fOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmExp10Override
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmExp10fOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvm__exp10Override
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvm__exp10fOverride
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmLog10Override
  , LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmLog10fOverride

  , LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> LLVMPointerType wptr)
  (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> LLVMPointerType wptr)
  (BVType 32)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> LLVMPointerType wptr)
  (BVType 32)
cxa_atexitOverride
  , LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
   ::> BVType wptr)
  (BVType 32)
-> SomeLLVMOverride p sym ext
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
LLVMOverride p sym ext args ret -> SomeLLVMOverride p sym ext
SomeLLVMOverride LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
   ::> BVType wptr)
  (BVType 32)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
   ::> BVType wptr)
  (BVType 32)
posixMemalignOverride
  ]

------------------------------------------------------------------------
-- ** Declarations


llvmMemcpyOverride
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?memOpts :: MemOptions )
  => LLVMOverride p sym ext
           (EmptyCtx ::> LLVMPointerType wptr
                     ::> LLVMPointerType wptr
                     ::> BVType wptr)
           (LLVMPointerType wptr)
llvmMemcpyOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
llvmMemcpyOverride =
  [llvmOvr| i8* @memcpy( i8*, i8*, size_t ) |]
  (\GlobalVar Mem
memOps Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
args ->
       do sym
sym <- OverrideSim p sym ext rtp args' ret' sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
          RegEntry sym (BVType 1)
volatile <- IO (RegEntry sym (BVType 1))
-> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 1))
forall a. IO a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (RegEntry sym (BVType 1))
 -> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 1)))
-> IO (RegEntry sym (BVType 1))
-> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 1))
forall a b. (a -> b) -> a -> b
$ TypeRepr (BVType 1)
-> RegValue sym (BVType 1) -> RegEntry sym (BVType 1)
forall sym (tp :: CrucibleType).
TypeRepr tp -> RegValue sym tp -> RegEntry sym tp
RegEntry TypeRepr (BVType 1)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr (RegValue sym (BVType 1) -> RegEntry sym (BVType 1))
-> IO (RegValue sym (BVType 1)) -> IO (RegEntry sym (BVType 1))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> NatRepr 1 -> IO (SymBV sym 1)
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero sym
sym NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat
          CurryAssignment
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType 1)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' ())
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType 1)
-> OverrideSim p sym ext rtp args' ret' ()
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType 1)
  f
  x
-> Assignment
     f
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType 1)
-> x
Ctx.uncurryAssignment (GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext rtp args' ret' ()
forall sym (wptr :: Natural) (w :: Natural) p ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType w)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext r args ret ()
callMemcpy GlobalVar Mem
memOps)
                                (Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
args Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
-> RegEntry sym (BVType 1)
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType 1)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
:> RegEntry sym (BVType 1)
volatile)
          LLVMPointer sym wptr
-> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr)
forall a. a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMPointer sym wptr
 -> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr))
-> LLVMPointer sym wptr
-> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr)
forall a b. (a -> b) -> a -> b
$ RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue (RegEntry sym (LLVMPointerType wptr)
 -> RegValue sym (LLVMPointerType wptr))
-> RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall a b. (a -> b) -> a -> b
$ Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (LLVMPointerType wptr))
     (Assignment
        (RegEntry sym)
        (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
         ::> BVType wptr))
     (RegEntry sym (LLVMPointerType wptr))
-> RegEntry sym (LLVMPointerType wptr)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (LLVMPointerType wptr))
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
  (RegEntry sym (LLVMPointerType wptr))
_1 -- return first argument
    )


llvmMemcpyChkOverride
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?memOpts :: MemOptions )
  => LLVMOverride p sym ext
         (EmptyCtx ::> LLVMPointerType wptr
                   ::> LLVMPointerType wptr
                   ::> BVType wptr
                   ::> BVType wptr)
         (LLVMPointerType wptr)
llvmMemcpyChkOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
llvmMemcpyChkOverride =
  [llvmOvr| i8* @__memcpy_chk ( i8*, i8*, size_t, size_t ) |]
  (\GlobalVar Mem
memOps Assignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
args ->
      do let args' :: Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
args' = Assignment (RegEntry sym) EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Empty Assignment (RegEntry sym) EmptyCtx
-> RegEntry sym (LLVMPointerType wptr)
-> Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
:> (Assignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (LLVMPointerType wptr))
     (Assignment
        (RegEntry sym)
        ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
          ::> BVType wptr)
         ::> BVType wptr))
     (RegEntry sym (LLVMPointerType wptr))
-> RegEntry sym (LLVMPointerType wptr)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (LLVMPointerType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
  (RegEntry sym (LLVMPointerType wptr))
_1) Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
-> RegEntry sym (LLVMPointerType wptr)
-> Assignment
     (RegEntry sym)
     ((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
:> (Assignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (LLVMPointerType wptr))
     (Assignment
        (RegEntry sym)
        ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
          ::> BVType wptr)
         ::> BVType wptr))
     (RegEntry sym (LLVMPointerType wptr))
-> RegEntry sym (LLVMPointerType wptr)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (LLVMPointerType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
  (RegEntry sym (LLVMPointerType wptr))
_2) Assignment
  (RegEntry sym)
  ((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
-> RegEntry sym (BVType wptr)
-> Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
      ::> BVType wptr)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
:> (Assignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (BVType wptr))
     (Assignment
        (RegEntry sym)
        ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
          ::> BVType wptr)
         ::> BVType wptr))
     (RegEntry sym (BVType wptr))
-> RegEntry sym (BVType wptr)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (BVType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (BVType wptr))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (BVType wptr))
  (RegEntry sym (BVType wptr))
_3)
         sym
sym <- OverrideSim p sym ext rtp args' ret' sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
         RegEntry sym (BVType 1)
volatile <- IO (RegEntry sym (BVType 1))
-> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 1))
forall a. IO a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (RegEntry sym (BVType 1))
 -> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 1)))
-> IO (RegEntry sym (BVType 1))
-> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 1))
forall a b. (a -> b) -> a -> b
$ TypeRepr (BVType 1)
-> RegValue sym (BVType 1) -> RegEntry sym (BVType 1)
forall sym (tp :: CrucibleType).
TypeRepr tp -> RegValue sym tp -> RegEntry sym tp
RegEntry TypeRepr (BVType 1)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr (RegValue sym (BVType 1) -> RegEntry sym (BVType 1))
-> IO (RegValue sym (BVType 1)) -> IO (RegEntry sym (BVType 1))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> NatRepr 1 -> IO (SymBV sym 1)
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero sym
sym NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat
         CurryAssignment
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType 1)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' ())
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType 1)
-> OverrideSim p sym ext rtp args' ret' ()
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType 1)
  f
  x
-> Assignment
     f
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType 1)
-> x
Ctx.uncurryAssignment (GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext rtp args' ret' ()
forall sym (wptr :: Natural) (w :: Natural) p ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType w)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext r args ret ()
callMemcpy GlobalVar Mem
memOps)
                               (Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
args' Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
-> RegEntry sym (BVType 1)
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType 1)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
:> RegEntry sym (BVType 1)
volatile)
         LLVMPointer sym wptr
-> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr)
forall a. a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMPointer sym wptr
 -> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr))
-> LLVMPointer sym wptr
-> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr)
forall a b. (a -> b) -> a -> b
$ RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue (RegEntry sym (LLVMPointerType wptr)
 -> RegValue sym (LLVMPointerType wptr))
-> RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall a b. (a -> b) -> a -> b
$ Assignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (LLVMPointerType wptr))
     (Assignment
        (RegEntry sym)
        ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
          ::> BVType wptr)
         ::> BVType wptr))
     (RegEntry sym (LLVMPointerType wptr))
-> RegEntry sym (LLVMPointerType wptr)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (LLVMPointerType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
  (RegEntry sym (LLVMPointerType wptr))
_1 -- return first argument
    )

llvmMemmoveOverride
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?memOpts :: MemOptions )
  => LLVMOverride p sym ext
         (EmptyCtx ::> (LLVMPointerType wptr)
                   ::> (LLVMPointerType wptr)
                   ::> BVType wptr)
         (LLVMPointerType wptr)
llvmMemmoveOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
llvmMemmoveOverride =
  [llvmOvr| i8* @memmove( i8*, i8*, size_t ) |]
  (\GlobalVar Mem
memOps Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
args ->
      do sym
sym <- OverrideSim p sym ext rtp args' ret' sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
         RegEntry sym (BVType 1)
volatile <- IO (RegEntry sym (BVType 1))
-> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 1))
forall a. IO a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (TypeRepr (BVType 1)
-> RegValue sym (BVType 1) -> RegEntry sym (BVType 1)
forall sym (tp :: CrucibleType).
TypeRepr tp -> RegValue sym tp -> RegEntry sym tp
RegEntry TypeRepr (BVType 1)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr (RegValue sym (BVType 1) -> RegEntry sym (BVType 1))
-> IO (RegValue sym (BVType 1)) -> IO (RegEntry sym (BVType 1))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> NatRepr 1 -> IO (SymBV sym 1)
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero sym
sym NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat)
         CurryAssignment
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType 1)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' ())
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType 1)
-> OverrideSim p sym ext rtp args' ret' ()
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType wptr)
   ::> BVType 1)
  f
  x
-> Assignment
     f
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType 1)
-> x
Ctx.uncurryAssignment (GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext rtp args' ret' ()
forall sym (wptr :: Natural) (w :: Natural) p ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType w)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext r args ret ()
callMemmove GlobalVar Mem
memOps)
                               (Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
args Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
-> RegEntry sym (BVType 1)
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType wptr)
      ::> BVType 1)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
:> RegEntry sym (BVType 1)
volatile)
         LLVMPointer sym wptr
-> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr)
forall a. a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMPointer sym wptr
 -> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr))
-> LLVMPointer sym wptr
-> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr)
forall a b. (a -> b) -> a -> b
$ RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue (RegEntry sym (LLVMPointerType wptr)
 -> RegValue sym (LLVMPointerType wptr))
-> RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall a b. (a -> b) -> a -> b
$ Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (LLVMPointerType wptr))
     (Assignment
        (RegEntry sym)
        (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
         ::> BVType wptr))
     (RegEntry sym (LLVMPointerType wptr))
-> RegEntry sym (LLVMPointerType wptr)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (LLVMPointerType wptr))
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
  (RegEntry sym (LLVMPointerType wptr))
_1 -- return first argument
    )

llvmMemsetOverride :: forall p sym ext wptr.
     (IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr)
  => LLVMOverride p sym ext
         (EmptyCtx ::> LLVMPointerType wptr
                   ::> BVType 32
                   ::> BVType wptr)
         (LLVMPointerType wptr)
llvmMemsetOverride :: forall p sym ext (wptr :: Natural).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
  (LLVMPointerType wptr)
llvmMemsetOverride =
  [llvmOvr| i8* @memset( i8*, i32, size_t ) |]
  (\GlobalVar Mem
memOps Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
args ->
      do sym
sym <- OverrideSim p sym ext rtp args' ret' sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
         LeqProof 9 wptr
LeqProof <- LeqProof 9 wptr
-> OverrideSim p sym ext rtp args' ret' (LeqProof 9 wptr)
forall a. a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall (m :: Natural) (n :: Natural) (p :: Natural).
LeqProof m n -> LeqProof n p -> LeqProof m p
leqTrans @9 @16 @wptr LeqProof 9 16
forall (m :: Natural) (n :: Natural). (m <= n) => LeqProof m n
LeqProof LeqProof 16 wptr
forall (m :: Natural) (n :: Natural). (m <= n) => LeqProof m n
LeqProof)
         let dest :: RegEntry sym (LLVMPointerType wptr)
dest = Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (LLVMPointerType wptr))
     (Assignment
        (RegEntry sym)
        (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
         ::> BVType wptr))
     (RegEntry sym (LLVMPointerType wptr))
-> RegEntry sym (LLVMPointerType wptr)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (LLVMPointerType wptr))
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
  (RegEntry sym (LLVMPointerType wptr))
_1
         RegEntry sym (BVType 8)
val <- IO (RegEntry sym (BVType 8))
-> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 8))
forall a. IO a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (TypeRepr (BVType 8)
-> RegValue sym (BVType 8) -> RegEntry sym (BVType 8)
forall sym (tp :: CrucibleType).
TypeRepr tp -> RegValue sym tp -> RegEntry sym tp
RegEntry TypeRepr (BVType 8)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr (RegValue sym (BVType 8) -> RegEntry sym (BVType 8))
-> IO (RegValue sym (BVType 8)) -> IO (RegEntry sym (BVType 8))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> NatRepr 8 -> SymBV sym 32 -> IO (SymBV sym 8)
forall (r :: Natural) (w :: Natural).
(1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
forall sym (r :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
bvTrunc sym
sym (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @8) (RegEntry sym (BVType 32) -> RegValue sym (BVType 32)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue (Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (BVType 32))
     (Assignment
        (RegEntry sym)
        (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
         ::> BVType wptr))
     (RegEntry sym (BVType 32))
-> RegEntry sym (BVType 32)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (BVType 32))
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
      ::> BVType wptr))
  (RegEntry sym (BVType 32))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
      ::> BVType wptr))
  (RegEntry sym (BVType 32))
  (RegEntry sym (BVType 32))
_2)))
         let len :: RegEntry sym (BVType wptr)
len = Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (BVType wptr))
     (Assignment
        (RegEntry sym)
        (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
         ::> BVType wptr))
     (RegEntry sym (BVType wptr))
-> RegEntry sym (BVType wptr)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (BVType wptr))
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
      ::> BVType wptr))
  (RegEntry sym (BVType wptr))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
      ::> BVType wptr))
  (RegEntry sym (BVType wptr))
  (RegEntry sym (BVType wptr))
_3
         RegEntry sym (BVType 1)
volatile <- IO (RegEntry sym (BVType 1))
-> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 1))
forall a. IO a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO
            (TypeRepr (BVType 1)
-> RegValue sym (BVType 1) -> RegEntry sym (BVType 1)
forall sym (tp :: CrucibleType).
TypeRepr tp -> RegValue sym tp -> RegEntry sym tp
RegEntry TypeRepr (BVType 1)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr (RegValue sym (BVType 1) -> RegEntry sym (BVType 1))
-> IO (RegValue sym (BVType 1)) -> IO (RegEntry sym (BVType 1))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> NatRepr 1 -> IO (SymBV sym 1)
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero sym
sym NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat)
         GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType 8)
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext rtp args' ret' ()
forall sym (wptr :: Natural) (w :: Natural) p ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType 8)
-> RegEntry sym (BVType w)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext r args ret ()
callMemset GlobalVar Mem
memOps RegEntry sym (LLVMPointerType wptr)
dest RegEntry sym (BVType 8)
val RegEntry sym (BVType wptr)
len RegEntry sym (BVType 1)
volatile
         LLVMPointer sym wptr
-> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr)
forall a. a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue RegEntry sym (LLVMPointerType wptr)
dest)
    )

llvmMemsetChkOverride
  :: (IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr)
  => LLVMOverride p sym ext
         (EmptyCtx ::> LLVMPointerType wptr
                 ::> BVType 32
                 ::> BVType wptr
                 ::> BVType wptr)
         (LLVMPointerType wptr)
llvmMemsetChkOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
  (LLVMPointerType wptr)
llvmMemsetChkOverride =
  [llvmOvr| i8* @__memset_chk( i8*, i32, size_t, size_t ) |]
  (\GlobalVar Mem
memOps Assignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
args ->
      do sym
sym <- OverrideSim p sym ext rtp args' ret' sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
         let dest :: RegEntry sym (LLVMPointerType wptr)
dest = Assignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (LLVMPointerType wptr))
     (Assignment
        (RegEntry sym)
        ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
          ::> BVType wptr)
         ::> BVType wptr))
     (RegEntry sym (LLVMPointerType wptr))
-> RegEntry sym (LLVMPointerType wptr)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (LLVMPointerType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
       ::> BVType wptr)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (LLVMPointerType wptr))
  (RegEntry sym (LLVMPointerType wptr))
_1
         RegEntry sym (BVType 8)
val <- IO (RegEntry sym (BVType 8))
-> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 8))
forall a. IO a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO
              (TypeRepr (BVType 8)
-> RegValue sym (BVType 8) -> RegEntry sym (BVType 8)
forall sym (tp :: CrucibleType).
TypeRepr tp -> RegValue sym tp -> RegEntry sym tp
RegEntry TypeRepr (BVType 8)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr (RegValue sym (BVType 8) -> RegEntry sym (BVType 8))
-> IO (RegValue sym (BVType 8)) -> IO (RegEntry sym (BVType 8))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> NatRepr 8 -> SymBV sym 32 -> IO (SymBV sym 8)
forall (r :: Natural) (w :: Natural).
(1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
forall sym (r :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
bvTrunc sym
sym NatRepr 8
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (RegEntry sym (BVType 32) -> RegValue sym (BVType 32)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue (Assignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (BVType 32))
     (Assignment
        (RegEntry sym)
        ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
          ::> BVType wptr)
         ::> BVType wptr))
     (RegEntry sym (BVType 32))
-> RegEntry sym (BVType 32)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (BVType 32))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (BVType 32))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
       ::> BVType wptr)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (BVType 32))
  (RegEntry sym (BVType 32))
_2)))
         let len :: RegEntry sym (BVType wptr)
len = Assignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
argsAssignment
  (RegEntry sym)
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
    ::> BVType wptr)
   ::> BVType wptr)
-> Getting
     (RegEntry sym (BVType wptr))
     (Assignment
        (RegEntry sym)
        ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
          ::> BVType wptr)
         ::> BVType wptr))
     (RegEntry sym (BVType wptr))
-> RegEntry sym (BVType wptr)
forall s a. s -> Getting a s a -> a
^.Getting
  (RegEntry sym (BVType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (BVType wptr))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
       ::> BVType wptr)
      ::> BVType wptr))
  (Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> BVType 32)
       ::> BVType wptr)
      ::> BVType wptr))
  (RegEntry sym (BVType wptr))
  (RegEntry sym (BVType wptr))
_3
         RegEntry sym (BVType 1)
volatile <- IO (RegEntry sym (BVType 1))
-> OverrideSim p sym ext rtp args' ret' (RegEntry sym (BVType 1))
forall a. IO a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO
            (TypeRepr (BVType 1)
-> RegValue sym (BVType 1) -> RegEntry sym (BVType 1)
forall sym (tp :: CrucibleType).
TypeRepr tp -> RegValue sym tp -> RegEntry sym tp
RegEntry TypeRepr (BVType 1)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr (RegValue sym (BVType 1) -> RegEntry sym (BVType 1))
-> IO (RegValue sym (BVType 1)) -> IO (RegEntry sym (BVType 1))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> NatRepr 1 -> IO (SymBV sym 1)
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero sym
sym NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat)
         GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType 8)
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext rtp args' ret' ()
forall sym (wptr :: Natural) (w :: Natural) p ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType 8)
-> RegEntry sym (BVType w)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext r args ret ()
callMemset GlobalVar Mem
memOps RegEntry sym (LLVMPointerType wptr)
dest RegEntry sym (BVType 8)
val RegEntry sym (BVType wptr)
len RegEntry sym (BVType 1)
volatile
         LLVMPointer sym wptr
-> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr)
forall a. a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue RegEntry sym (LLVMPointerType wptr)
dest)
    )

------------------------------------------------------------------------
-- *** Allocation

llvmCallocOverride
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?lc :: TypeContext, ?memOpts :: MemOptions )
  => LLVMOverride p sym ext
         (EmptyCtx ::> BVType wptr ::> BVType wptr)
         (LLVMPointerType wptr)
llvmCallocOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> BVType wptr) ::> BVType wptr)
  (LLVMPointerType wptr)
llvmCallocOverride =
  let alignment :: Alignment
alignment = DataLayout -> Alignment
maxAlignment (TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc) in
  [llvmOvr| i8* @calloc( size_t, size_t ) |]
  (\GlobalVar Mem
memOps Assignment
  (RegEntry sym) ((EmptyCtx ::> BVType wptr) ::> BVType wptr)
args -> CurryAssignment
  ((EmptyCtx ::> BVType wptr) ::> BVType wptr)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (LLVMPointerType wptr)))
-> Assignment
     (RegEntry sym) ((EmptyCtx ::> BVType wptr) ::> BVType wptr)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (LLVMPointerType wptr))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment ((EmptyCtx ::> BVType wptr) ::> BVType wptr) f x
-> Assignment f ((EmptyCtx ::> BVType wptr) ::> BVType wptr) -> x
Ctx.uncurryAssignment (GlobalVar Mem
-> Alignment
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType wptr)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (LLVMPointerType wptr))
forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> Alignment
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType wptr)
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
callCalloc GlobalVar Mem
memOps Alignment
alignment) Assignment
  (RegEntry sym) ((EmptyCtx ::> BVType wptr) ::> BVType wptr)
args)


llvmReallocOverride
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?lc :: TypeContext, ?memOpts :: MemOptions )
  => LLVMOverride p sym ext
         (EmptyCtx ::> LLVMPointerType wptr ::> BVType wptr)
         (LLVMPointerType wptr)
llvmReallocOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
  (LLVMPointerType wptr)
llvmReallocOverride =
  let alignment :: Alignment
alignment = DataLayout -> Alignment
maxAlignment (TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc) in
  [llvmOvr| i8* @realloc( i8*, size_t ) |]
  (\GlobalVar Mem
memOps Assignment
  (RegEntry sym)
  ((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
args -> CurryAssignment
  ((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (LLVMPointerType wptr)))
-> Assignment
     (RegEntry sym)
     ((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (LLVMPointerType wptr))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr) f x
-> Assignment
     f ((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
-> x
Ctx.uncurryAssignment (GlobalVar Mem
-> Alignment
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType wptr)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (LLVMPointerType wptr))
forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> Alignment
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType wptr)
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
callRealloc GlobalVar Mem
memOps Alignment
alignment) Assignment
  (RegEntry sym)
  ((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
args)

llvmMallocOverride
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?lc :: TypeContext, ?memOpts :: MemOptions )
  => LLVMOverride p sym ext
         (EmptyCtx ::> BVType wptr)
         (LLVMPointerType wptr)
llvmMallocOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?memOpts::MemOptions) =>
LLVMOverride
  p sym ext (EmptyCtx ::> BVType wptr) (LLVMPointerType wptr)
llvmMallocOverride =
  let alignment :: Alignment
alignment = DataLayout -> Alignment
maxAlignment (TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc) in
  [llvmOvr| i8* @malloc( size_t ) |]
  (\GlobalVar Mem
memOps Assignment (RegEntry sym) (EmptyCtx ::> BVType wptr)
args -> CurryAssignment
  (EmptyCtx ::> BVType wptr)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (LLVMPointerType wptr)))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType wptr)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (LLVMPointerType wptr))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType wptr) f x
-> Assignment f (EmptyCtx ::> BVType wptr) -> x
Ctx.uncurryAssignment (GlobalVar Mem
-> Alignment
-> RegEntry sym (BVType wptr)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (LLVMPointerType wptr))
forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> Alignment
-> RegEntry sym (BVType wptr)
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
callMalloc GlobalVar Mem
memOps Alignment
alignment) Assignment (RegEntry sym) (EmptyCtx ::> BVType wptr)
args)

posixMemalignOverride ::
  ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
  , ?lc :: TypeContext, ?memOpts :: MemOptions ) =>
  LLVMOverride p sym ext
      (EmptyCtx ::> LLVMPointerType wptr
                ::> BVType wptr
                ::> BVType wptr)
      (BVType 32)
posixMemalignOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
   ::> BVType wptr)
  (BVType 32)
posixMemalignOverride =
  [llvmOvr| i32 @posix_memalign( i8**, size_t, size_t ) |]
  (\GlobalVar Mem
memOps Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
   ::> BVType wptr)
args -> CurryAssignment
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
   ::> BVType wptr)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment
     (RegEntry sym)
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
      ::> BVType wptr)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
   ::> BVType wptr)
  f
  x
-> Assignment
     f
     (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
      ::> BVType wptr)
-> x
Ctx.uncurryAssignment (GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType wptr)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType wptr)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPosixMemalign GlobalVar Mem
memOps) Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> BVType wptr)
   ::> BVType wptr)
args)


llvmFreeOverride
  :: (IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr)
  => LLVMOverride p sym ext
         (EmptyCtx ::> LLVMPointerType wptr)
         UnitType
llvmFreeOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
LLVMOverride p sym ext (EmptyCtx ::> LLVMPointerType wptr) UnitType
llvmFreeOverride =
  [llvmOvr| void @free( i8* ) |]
  (\GlobalVar Mem
memOps Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
args -> CurryAssignment
  (EmptyCtx ::> LLVMPointerType wptr)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType))
-> Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> LLVMPointerType wptr) f x
-> Assignment f (EmptyCtx ::> LLVMPointerType wptr) -> x
Ctx.uncurryAssignment (GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> OverrideSim p sym ext rtp args' ret' ()
forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> OverrideSim p sym ext r args ret ()
callFree GlobalVar Mem
memOps) Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
args)

------------------------------------------------------------------------
-- *** Strings and I/O

llvmPrintfOverride
  :: ( IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym
     , ?memOpts :: MemOptions )
  => LLVMOverride p sym ext
         (EmptyCtx ::> LLVMPointerType wptr
                   ::> VectorType AnyType)
         (BVType 32)
llvmPrintfOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> LLVMPointerType wptr) ::> VectorType AnyType)
  (BVType 32)
llvmPrintfOverride =
  [llvmOvr| i32 @printf( i8*, ... ) |]
  (\GlobalVar Mem
memOps Assignment
  (RegEntry sym)
  ((EmptyCtx ::> LLVMPointerType wptr) ::> VectorType AnyType)
args -> CurryAssignment
  ((EmptyCtx ::> LLVMPointerType wptr) ::> VectorType AnyType)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment
     (RegEntry sym)
     ((EmptyCtx ::> LLVMPointerType wptr) ::> VectorType AnyType)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((EmptyCtx ::> LLVMPointerType wptr) ::> VectorType AnyType) f x
-> Assignment
     f ((EmptyCtx ::> LLVMPointerType wptr) ::> VectorType AnyType)
-> x
Ctx.uncurryAssignment (GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (VectorType AnyType)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (VectorType AnyType)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPrintf GlobalVar Mem
memOps) Assignment
  (RegEntry sym)
  ((EmptyCtx ::> LLVMPointerType wptr) ::> VectorType AnyType)
args)

llvmPrintfChkOverride
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?memOpts :: MemOptions )
  => LLVMOverride p sym ext
         (EmptyCtx ::> BVType 32
                   ::> LLVMPointerType wptr
                   ::> VectorType AnyType)
         (BVType 32)
llvmPrintfChkOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> BVType 32) ::> LLVMPointerType wptr)
   ::> VectorType AnyType)
  (BVType 32)
llvmPrintfChkOverride =
  [llvmOvr| i32 @__printf_chk( i32, i8*, ... ) |]
  (\GlobalVar Mem
memOps Assignment
  (RegEntry sym)
  (((EmptyCtx ::> BVType 32) ::> LLVMPointerType wptr)
   ::> VectorType AnyType)
args -> CurryAssignment
  (((EmptyCtx ::> BVType 32) ::> LLVMPointerType wptr)
   ::> VectorType AnyType)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment
     (RegEntry sym)
     (((EmptyCtx ::> BVType 32) ::> LLVMPointerType wptr)
      ::> VectorType AnyType)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  (((EmptyCtx ::> BVType 32) ::> LLVMPointerType wptr)
   ::> VectorType AnyType)
  f
  x
-> Assignment
     f
     (((EmptyCtx ::> BVType 32) ::> LLVMPointerType wptr)
      ::> VectorType AnyType)
-> x
Ctx.uncurryAssignment (\RegEntry sym (BVType 32)
_flg -> GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (VectorType AnyType)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (VectorType AnyType)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPrintf GlobalVar Mem
memOps) Assignment
  (RegEntry sym)
  (((EmptyCtx ::> BVType 32) ::> LLVMPointerType wptr)
   ::> VectorType AnyType)
args)


llvmPutCharOverride
  :: (IsSymInterface sym, HasPtrWidth wptr)
  => LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmPutCharOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmPutCharOverride =
  [llvmOvr| i32 @putchar( i32 ) |]
  (\GlobalVar Mem
memOps Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args -> CurryAssignment
  (EmptyCtx ::> BVType 32)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType 32) f x
-> Assignment f (EmptyCtx ::> BVType 32) -> x
Ctx.uncurryAssignment (GlobalVar Mem
-> RegEntry sym (BVType 32)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
GlobalVar Mem
-> RegEntry sym (BVType 32)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPutChar GlobalVar Mem
memOps) Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args)


llvmPutsOverride
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?memOpts :: MemOptions )
  => LLVMOverride p sym ext (EmptyCtx ::> LLVMPointerType wptr) (BVType 32)
llvmPutsOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p sym ext (EmptyCtx ::> LLVMPointerType wptr) (BVType 32)
llvmPutsOverride =
  [llvmOvr| i32 @puts( i8* ) |]
  (\GlobalVar Mem
memOps Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
args -> CurryAssignment
  (EmptyCtx ::> LLVMPointerType wptr)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> LLVMPointerType wptr) f x
-> Assignment f (EmptyCtx ::> LLVMPointerType wptr) -> x
Ctx.uncurryAssignment (GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPuts GlobalVar Mem
memOps) Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
args)

llvmStrlenOverride
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?memOpts :: MemOptions )
  => LLVMOverride p sym ext (EmptyCtx ::> LLVMPointerType wptr) (BVType wptr)
llvmStrlenOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
LLVMOverride
  p sym ext (EmptyCtx ::> LLVMPointerType wptr) (BVType wptr)
llvmStrlenOverride =
  [llvmOvr| size_t @strlen( i8* ) |]
  (\GlobalVar Mem
memOps Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
args -> CurryAssignment
  (EmptyCtx ::> LLVMPointerType wptr)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType wptr)))
-> Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (BVType wptr))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> LLVMPointerType wptr) f x
-> Assignment f (EmptyCtx ::> LLVMPointerType wptr) -> x
Ctx.uncurryAssignment (GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (BVType wptr))
forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType wptr))
callStrlen GlobalVar Mem
memOps) Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
args)

------------------------------------------------------------------------
-- ** Implementations

------------------------------------------------------------------------
-- *** Allocation

callRealloc
  :: ( IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym
     , ?memOpts :: MemOptions )
  => GlobalVar Mem
  -> Alignment
  -> RegEntry sym (LLVMPointerType wptr)
  -> RegEntry sym (BVType wptr)
  -> OverrideSim p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
callRealloc :: forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> Alignment
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType wptr)
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
callRealloc GlobalVar Mem
mvar Alignment
alignment (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
ptr) (RegEntry sym (BVType wptr) -> RegValue sym (BVType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType wptr)
sz) =
  (forall bak.
 IsSymBackend sym bak =>
 bak
 -> OverrideSim
      p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak
  -> OverrideSim
       p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
 -> OverrideSim
      p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> (forall bak.
    IsSymBackend sym bak =>
    bak
    -> OverrideSim
         p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
forall a b. (a -> b) -> a -> b
$ \bak
bak -> do
    let sym :: sym
sym = bak -> sym
forall sym bak. HasSymInterface sym bak => bak -> sym
backendGetSym bak
bak
    SymExpr sym BaseBoolType
szZero  <- IO (SymExpr sym BaseBoolType)
-> OverrideSim p sym ext r args ret (SymExpr sym BaseBoolType)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (sym -> SymExpr sym BaseBoolType -> IO (SymExpr sym BaseBoolType)
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred sym
sym (SymExpr sym BaseBoolType -> IO (SymExpr sym BaseBoolType))
-> IO (SymExpr sym BaseBoolType) -> IO (SymExpr sym BaseBoolType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> SymBV sym wptr -> IO (SymExpr sym BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
sym -> SymBV sym w -> IO (SymExpr sym BaseBoolType)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero sym
sym RegValue sym (BVType wptr)
SymBV sym wptr
sz)
    SymExpr sym BaseBoolType
ptrNull <- IO (SymExpr sym BaseBoolType)
-> OverrideSim p sym ext r args ret (SymExpr sym BaseBoolType)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (sym
-> NatRepr wptr
-> RegValue sym (LLVMPointerType wptr)
-> IO (SymExpr sym BaseBoolType)
forall (w :: Natural) sym.
(1 <= w, IsSymInterface sym) =>
sym -> NatRepr w -> LLVMPtr sym w -> IO (Pred sym)
ptrIsNull sym
sym NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth RegValue sym (LLVMPointerType wptr)
ptr)
    Position
loc <- IO Position -> OverrideSim p sym ext r args ret Position
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (ProgramLoc -> Position
plSourceLoc (ProgramLoc -> Position) -> IO ProgramLoc -> IO Position
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> IO ProgramLoc
forall sym. IsExprBuilder sym => sym -> IO ProgramLoc
getCurrentProgramLoc sym
sym)
    let displayString :: String
displayString = String
"<realloc> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show Position
loc

    RegMap sym EmptyCtx
-> [(SymExpr sym BaseBoolType,
     OverrideSim
       p sym ext r (args <+> EmptyCtx) ret (LLVMPointer sym wptr),
     Maybe Position)]
-> OverrideSim p sym ext r args ret (LLVMPointer sym wptr)
forall p sym ext rtp (args :: Ctx CrucibleType)
       (new_args :: Ctx CrucibleType) (res :: CrucibleType) a.
IsSymInterface sym =>
RegMap sym new_args
-> [(Pred sym, OverrideSim p sym ext rtp (args <+> new_args) res a,
     Maybe Position)]
-> OverrideSim p sym ext rtp args res a
symbolicBranches RegMap sym EmptyCtx
forall sym. RegMap sym EmptyCtx
emptyRegMap
      -- If the pointer is null, behave like malloc
      [ ( SymExpr sym BaseBoolType
ptrNull
        , GlobalVar Mem
-> (RegValue sym Mem
    -> OverrideSim
         p
         sym
         ext
         r
         (args <+> EmptyCtx)
         ret
         (LLVMPointer sym wptr, RegValue sym Mem))
-> OverrideSim
     p sym ext r (args <+> EmptyCtx) ret (LLVMPointer sym wptr)
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType) a.
IsSymInterface sym =>
GlobalVar tp
-> (RegValue sym tp
    -> OverrideSim p sym ext rtp args ret (a, RegValue sym tp))
-> OverrideSim p sym ext rtp args ret a
modifyGlobal GlobalVar Mem
mvar ((RegValue sym Mem
  -> OverrideSim
       p
       sym
       ext
       r
       (args <+> EmptyCtx)
       ret
       (LLVMPointer sym wptr, RegValue sym Mem))
 -> OverrideSim
      p sym ext r (args <+> EmptyCtx) ret (LLVMPointer sym wptr))
-> (RegValue sym Mem
    -> OverrideSim
         p
         sym
         ext
         r
         (args <+> EmptyCtx)
         ret
         (LLVMPointer sym wptr, RegValue sym Mem))
-> OverrideSim
     p sym ext r (args <+> EmptyCtx) ret (LLVMPointer sym wptr)
forall a b. (a -> b) -> a -> b
$ \RegValue sym Mem
mem -> IO (LLVMPointer sym wptr, RegValue sym Mem)
-> OverrideSim
     p
     sym
     ext
     r
     (args <+> EmptyCtx)
     ret
     (LLVMPointer sym wptr, RegValue sym Mem)
forall a. IO a -> OverrideSim p sym ext r (args <+> EmptyCtx) ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (LLVMPointer sym wptr, RegValue sym Mem)
 -> OverrideSim
      p
      sym
      ext
      r
      (args <+> EmptyCtx)
      ret
      (LLVMPointer sym wptr, RegValue sym Mem))
-> IO (LLVMPointer sym wptr, RegValue sym Mem)
-> OverrideSim
     p
     sym
     ext
     r
     (args <+> EmptyCtx)
     ret
     (LLVMPointer sym wptr, RegValue sym Mem)
forall a b. (a -> b) -> a -> b
$ bak
-> AllocType
-> Mutability
-> String
-> MemImpl sym
-> SymBV sym wptr
-> Alignment
-> IO (RegValue sym (LLVMPointerType wptr), MemImpl sym)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> AllocType
-> Mutability
-> String
-> MemImpl sym
-> SymBV sym wptr
-> Alignment
-> IO (LLVMPtr sym wptr, MemImpl sym)
doMalloc bak
bak AllocType
G.HeapAlloc Mutability
G.Mutable String
displayString RegValue sym Mem
MemImpl sym
mem RegValue sym (BVType wptr)
SymBV sym wptr
sz Alignment
alignment
        , Maybe Position
forall a. Maybe a
Nothing
        )

      -- If the size is zero, behave like malloc (of zero bytes) then free
      , (SymExpr sym BaseBoolType
szZero
        , GlobalVar Mem
-> (RegValue sym Mem
    -> OverrideSim
         p
         sym
         ext
         r
         (args <+> EmptyCtx)
         ret
         (LLVMPointer sym wptr, RegValue sym Mem))
-> OverrideSim
     p sym ext r (args <+> EmptyCtx) ret (LLVMPointer sym wptr)
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType) a.
IsSymInterface sym =>
GlobalVar tp
-> (RegValue sym tp
    -> OverrideSim p sym ext rtp args ret (a, RegValue sym tp))
-> OverrideSim p sym ext rtp args ret a
modifyGlobal GlobalVar Mem
mvar ((RegValue sym Mem
  -> OverrideSim
       p
       sym
       ext
       r
       (args <+> EmptyCtx)
       ret
       (LLVMPointer sym wptr, RegValue sym Mem))
 -> OverrideSim
      p sym ext r (args <+> EmptyCtx) ret (LLVMPointer sym wptr))
-> (RegValue sym Mem
    -> OverrideSim
         p
         sym
         ext
         r
         (args <+> EmptyCtx)
         ret
         (LLVMPointer sym wptr, RegValue sym Mem))
-> OverrideSim
     p sym ext r (args <+> EmptyCtx) ret (LLVMPointer sym wptr)
forall a b. (a -> b) -> a -> b
$ \RegValue sym Mem
mem -> IO (LLVMPointer sym wptr, RegValue sym Mem)
-> OverrideSim
     p
     sym
     ext
     r
     (args <+> EmptyCtx)
     ret
     (LLVMPointer sym wptr, RegValue sym Mem)
forall a. IO a -> OverrideSim p sym ext r (args <+> EmptyCtx) ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (LLVMPointer sym wptr, RegValue sym Mem)
 -> OverrideSim
      p
      sym
      ext
      r
      (args <+> EmptyCtx)
      ret
      (LLVMPointer sym wptr, RegValue sym Mem))
-> IO (LLVMPointer sym wptr, RegValue sym Mem)
-> OverrideSim
     p
     sym
     ext
     r
     (args <+> EmptyCtx)
     ret
     (LLVMPointer sym wptr, RegValue sym Mem)
forall a b. (a -> b) -> a -> b
$
             do (LLVMPointer sym wptr
newp, MemImpl sym
mem1) <- bak
-> AllocType
-> Mutability
-> String
-> MemImpl sym
-> SymBV sym wptr
-> Alignment
-> IO (RegValue sym (LLVMPointerType wptr), MemImpl sym)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> AllocType
-> Mutability
-> String
-> MemImpl sym
-> SymBV sym wptr
-> Alignment
-> IO (LLVMPtr sym wptr, MemImpl sym)
doMalloc bak
bak AllocType
G.HeapAlloc Mutability
G.Mutable String
displayString RegValue sym Mem
MemImpl sym
mem RegValue sym (BVType wptr)
SymBV sym wptr
sz Alignment
alignment
                MemImpl sym
mem2 <- bak
-> MemImpl sym
-> RegValue sym (LLVMPointerType wptr)
-> IO (MemImpl sym)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym) =>
bak -> MemImpl sym -> LLVMPtr sym wptr -> IO (MemImpl sym)
doFree bak
bak MemImpl sym
mem1 RegValue sym (LLVMPointerType wptr)
ptr
                (LLVMPointer sym wptr, MemImpl sym)
-> IO (LLVMPointer sym wptr, MemImpl sym)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMPointer sym wptr
newp, MemImpl sym
mem2)
        , Maybe Position
forall a. Maybe a
Nothing
        )

      -- Otherwise, allocate a new region, memcopy `sz` bytes and free the old pointer
      , (sym -> SymExpr sym BaseBoolType
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred sym
sym
        , GlobalVar Mem
-> (RegValue sym Mem
    -> OverrideSim
         p
         sym
         ext
         r
         (args <+> EmptyCtx)
         ret
         (LLVMPointer sym wptr, RegValue sym Mem))
-> OverrideSim
     p sym ext r (args <+> EmptyCtx) ret (LLVMPointer sym wptr)
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType) a.
IsSymInterface sym =>
GlobalVar tp
-> (RegValue sym tp
    -> OverrideSim p sym ext rtp args ret (a, RegValue sym tp))
-> OverrideSim p sym ext rtp args ret a
modifyGlobal GlobalVar Mem
mvar ((RegValue sym Mem
  -> OverrideSim
       p
       sym
       ext
       r
       (args <+> EmptyCtx)
       ret
       (LLVMPointer sym wptr, RegValue sym Mem))
 -> OverrideSim
      p sym ext r (args <+> EmptyCtx) ret (LLVMPointer sym wptr))
-> (RegValue sym Mem
    -> OverrideSim
         p
         sym
         ext
         r
         (args <+> EmptyCtx)
         ret
         (LLVMPointer sym wptr, RegValue sym Mem))
-> OverrideSim
     p sym ext r (args <+> EmptyCtx) ret (LLVMPointer sym wptr)
forall a b. (a -> b) -> a -> b
$ \RegValue sym Mem
mem -> IO (LLVMPointer sym wptr, RegValue sym Mem)
-> OverrideSim
     p
     sym
     ext
     r
     (args <+> EmptyCtx)
     ret
     (LLVMPointer sym wptr, RegValue sym Mem)
forall a. IO a -> OverrideSim p sym ext r (args <+> EmptyCtx) ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (LLVMPointer sym wptr, RegValue sym Mem)
 -> OverrideSim
      p
      sym
      ext
      r
      (args <+> EmptyCtx)
      ret
      (LLVMPointer sym wptr, RegValue sym Mem))
-> IO (LLVMPointer sym wptr, RegValue sym Mem)
-> OverrideSim
     p
     sym
     ext
     r
     (args <+> EmptyCtx)
     ret
     (LLVMPointer sym wptr, RegValue sym Mem)
forall a b. (a -> b) -> a -> b
$
             do (LLVMPointer sym wptr
newp, MemImpl sym
mem1) <- bak
-> AllocType
-> Mutability
-> String
-> MemImpl sym
-> SymBV sym wptr
-> Alignment
-> IO (RegValue sym (LLVMPointerType wptr), MemImpl sym)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> AllocType
-> Mutability
-> String
-> MemImpl sym
-> SymBV sym wptr
-> Alignment
-> IO (LLVMPtr sym wptr, MemImpl sym)
doMalloc bak
bak AllocType
G.HeapAlloc Mutability
G.Mutable String
displayString RegValue sym Mem
MemImpl sym
mem RegValue sym (BVType wptr)
SymBV sym wptr
sz Alignment
alignment
                MemImpl sym
mem2 <- sym
-> MemImpl sym
-> RegValue sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
-> SymBV sym wptr
-> IO (MemImpl sym)
forall sym (wptr :: Natural).
(IsSymInterface sym, HasPtrWidth wptr) =>
sym
-> MemImpl sym
-> LLVMPtr sym wptr
-> LLVMPtr sym wptr
-> SymBV sym wptr
-> IO (MemImpl sym)
uncheckedMemcpy sym
sym MemImpl sym
mem1 RegValue sym (LLVMPointerType wptr)
LLVMPointer sym wptr
newp RegValue sym (LLVMPointerType wptr)
ptr RegValue sym (BVType wptr)
SymBV sym wptr
sz
                MemImpl sym
mem3 <- bak
-> MemImpl sym
-> RegValue sym (LLVMPointerType wptr)
-> IO (MemImpl sym)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym) =>
bak -> MemImpl sym -> LLVMPtr sym wptr -> IO (MemImpl sym)
doFree bak
bak MemImpl sym
mem2 RegValue sym (LLVMPointerType wptr)
ptr
                (LLVMPointer sym wptr, MemImpl sym)
-> IO (LLVMPointer sym wptr, MemImpl sym)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LLVMPointer sym wptr
newp, MemImpl sym
mem3)
        , Maybe Position
forall a. Maybe a
Nothing)
      ]


callPosixMemalign
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?lc :: TypeContext, ?memOpts :: MemOptions )
  => GlobalVar Mem
  -> RegEntry sym (LLVMPointerType wptr)
  -> RegEntry sym (BVType wptr)
  -> RegEntry sym (BVType wptr)
  -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPosixMemalign :: forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?lc::TypeContext, ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType wptr)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPosixMemalign GlobalVar Mem
mvar (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
outPtr) (RegEntry sym (BVType wptr) -> RegValue sym (BVType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType wptr)
align) (RegEntry sym (BVType wptr) -> RegValue sym (BVType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType wptr)
sz) =
  (forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
 -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> (forall bak.
    IsSymBackend sym bak =>
    bak -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
    let sym :: sym
sym = bak -> sym
forall sym bak. HasSymInterface sym bak => bak -> sym
backendGetSym bak
bak in
    case SymExpr sym (BaseBVType wptr) -> Maybe (BV wptr)
forall (w :: Natural). SymExpr sym (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV RegValue sym (BVType wptr)
SymExpr sym (BaseBVType wptr)
align of
      Maybe (BV wptr)
Nothing -> String
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall a. String -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> String
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"posix_memalign: alignment value must be concrete:", Doc Any -> String
forall a. Show a => a -> String
show (SymExpr sym (BaseBVType wptr) -> Doc Any
forall (tp :: BaseType) ann. SymExpr sym tp -> Doc ann
forall (e :: BaseType -> Type) (tp :: BaseType) ann.
IsExpr e =>
e tp -> Doc ann
printSymExpr RegValue sym (BVType wptr)
SymExpr sym (BaseBVType wptr)
align)]
      Just BV wptr
concrete_align ->
        case Bytes -> Maybe Alignment
toAlignment (Integer -> Bytes
forall a. Integral a => a -> Bytes
toBytes (BV wptr -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV wptr
concrete_align)) of
          Maybe Alignment
Nothing -> String
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall a. String -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> String
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"posix_memalign: invalid alignment value:", BV wptr -> String
forall a. Show a => a -> String
show BV wptr
concrete_align]
          Just Alignment
a ->
            let dl :: DataLayout
dl = TypeContext -> DataLayout
llvmDataLayout ?lc::TypeContext
TypeContext
?lc in
            GlobalVar Mem
-> (RegValue sym Mem
    -> OverrideSim
         p sym ext r args ret (RegValue sym (BVType 32), RegValue sym Mem))
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType) a.
IsSymInterface sym =>
GlobalVar tp
-> (RegValue sym tp
    -> OverrideSim p sym ext rtp args ret (a, RegValue sym tp))
-> OverrideSim p sym ext rtp args ret a
modifyGlobal GlobalVar Mem
mvar ((RegValue sym Mem
  -> OverrideSim
       p sym ext r args ret (RegValue sym (BVType 32), RegValue sym Mem))
 -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> (RegValue sym Mem
    -> OverrideSim
         p sym ext r args ret (RegValue sym (BVType 32), RegValue sym Mem))
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall a b. (a -> b) -> a -> b
$ \RegValue sym Mem
mem -> IO (RegValue sym (BVType 32), RegValue sym Mem)
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType 32), RegValue sym Mem)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (RegValue sym (BVType 32), RegValue sym Mem)
 -> OverrideSim
      p sym ext r args ret (RegValue sym (BVType 32), RegValue sym Mem))
-> IO (RegValue sym (BVType 32), RegValue sym Mem)
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType 32), RegValue sym Mem)
forall a b. (a -> b) -> a -> b
$
               do Position
loc <- ProgramLoc -> Position
plSourceLoc (ProgramLoc -> Position) -> IO ProgramLoc -> IO Position
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> IO ProgramLoc
forall sym. IsExprBuilder sym => sym -> IO ProgramLoc
getCurrentProgramLoc sym
sym
                  let displayString :: String
displayString = String
"<posix_memaign> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show Position
loc
                  (LLVMPointer sym wptr
p, MemImpl sym
mem') <- bak
-> AllocType
-> Mutability
-> String
-> MemImpl sym
-> SymExpr sym (BaseBVType wptr)
-> Alignment
-> IO (RegValue sym (LLVMPointerType wptr), MemImpl sym)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> AllocType
-> Mutability
-> String
-> MemImpl sym
-> SymBV sym wptr
-> Alignment
-> IO (LLVMPtr sym wptr, MemImpl sym)
doMalloc bak
bak AllocType
G.HeapAlloc Mutability
G.Mutable String
displayString RegValue sym Mem
MemImpl sym
mem RegValue sym (BVType wptr)
SymExpr sym (BaseBVType wptr)
sz Alignment
a
                  MemImpl sym
mem'' <- bak
-> MemImpl sym
-> RegValue sym (LLVMPointerType wptr)
-> StorageType
-> Alignment
-> LLVMVal sym
-> IO (MemImpl sym)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> MemImpl sym
-> LLVMPtr sym wptr
-> StorageType
-> Alignment
-> LLVMVal sym
-> IO (MemImpl sym)
storeRaw bak
bak MemImpl sym
mem' RegValue sym (LLVMPointerType wptr)
outPtr (Bytes -> StorageType
bitvectorType (DataLayout
dlDataLayout -> Getting Bytes DataLayout Bytes -> Bytes
forall s a. s -> Getting a s a -> a
^.Getting Bytes DataLayout Bytes
Lens' DataLayout Bytes
ptrSize)) (DataLayout
dlDataLayout -> Getting Alignment DataLayout Alignment -> Alignment
forall s a. s -> Getting a s a -> a
^.Getting Alignment DataLayout Alignment
Lens' DataLayout Alignment
ptrAlign) (RegValue sym (LLVMPointerType wptr) -> LLVMVal sym
forall (w :: Natural) sym. (1 <= w) => LLVMPtr sym w -> LLVMVal sym
ptrToPtrVal RegValue sym (LLVMPointerType wptr)
LLVMPointer sym wptr
p)
                  SymExpr sym ('BaseBVType 32)
z <- sym -> NatRepr 32 -> IO (SymExpr sym ('BaseBVType 32))
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero sym
sym NatRepr 32
forall (n :: Natural). KnownNat n => NatRepr n
knownNat
                  (SymExpr sym ('BaseBVType 32), MemImpl sym)
-> IO (SymExpr sym ('BaseBVType 32), MemImpl sym)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SymExpr sym ('BaseBVType 32)
z, MemImpl sym
mem'')

callMalloc
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?memOpts :: MemOptions )
  => GlobalVar Mem
  -> Alignment
  -> RegEntry sym (BVType wptr)
  -> OverrideSim p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
callMalloc :: forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> Alignment
-> RegEntry sym (BVType wptr)
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
callMalloc GlobalVar Mem
mvar Alignment
alignment (RegEntry sym (BVType wptr) -> RegValue sym (BVType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType wptr)
sz) =
  (forall bak.
 IsSymBackend sym bak =>
 bak
 -> OverrideSim
      p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak
  -> OverrideSim
       p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
 -> OverrideSim
      p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> (forall bak.
    IsSymBackend sym bak =>
    bak
    -> OverrideSim
         p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
    GlobalVar Mem
-> (RegValue sym Mem
    -> OverrideSim
         p
         sym
         ext
         r
         args
         ret
         (RegValue sym (LLVMPointerType wptr), RegValue sym Mem))
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType) a.
IsSymInterface sym =>
GlobalVar tp
-> (RegValue sym tp
    -> OverrideSim p sym ext rtp args ret (a, RegValue sym tp))
-> OverrideSim p sym ext rtp args ret a
modifyGlobal GlobalVar Mem
mvar ((RegValue sym Mem
  -> OverrideSim
       p
       sym
       ext
       r
       args
       ret
       (RegValue sym (LLVMPointerType wptr), RegValue sym Mem))
 -> OverrideSim
      p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> (RegValue sym Mem
    -> OverrideSim
         p
         sym
         ext
         r
         args
         ret
         (RegValue sym (LLVMPointerType wptr), RegValue sym Mem))
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
forall a b. (a -> b) -> a -> b
$ \RegValue sym Mem
mem -> IO (RegValue sym (LLVMPointerType wptr), RegValue sym Mem)
-> OverrideSim
     p
     sym
     ext
     r
     args
     ret
     (RegValue sym (LLVMPointerType wptr), RegValue sym Mem)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (RegValue sym (LLVMPointerType wptr), RegValue sym Mem)
 -> OverrideSim
      p
      sym
      ext
      r
      args
      ret
      (RegValue sym (LLVMPointerType wptr), RegValue sym Mem))
-> IO (RegValue sym (LLVMPointerType wptr), RegValue sym Mem)
-> OverrideSim
     p
     sym
     ext
     r
     args
     ret
     (RegValue sym (LLVMPointerType wptr), RegValue sym Mem)
forall a b. (a -> b) -> a -> b
$
      do Position
loc <- ProgramLoc -> Position
plSourceLoc (ProgramLoc -> Position) -> IO ProgramLoc -> IO Position
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> IO ProgramLoc
forall sym. IsExprBuilder sym => sym -> IO ProgramLoc
getCurrentProgramLoc (bak -> sym
forall sym bak. HasSymInterface sym bak => bak -> sym
backendGetSym bak
bak)
         let displayString :: String
displayString = String
"<malloc> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show Position
loc
         bak
-> AllocType
-> Mutability
-> String
-> MemImpl sym
-> SymBV sym wptr
-> Alignment
-> IO (RegValue sym (LLVMPointerType wptr), MemImpl sym)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> AllocType
-> Mutability
-> String
-> MemImpl sym
-> SymBV sym wptr
-> Alignment
-> IO (LLVMPtr sym wptr, MemImpl sym)
doMalloc bak
bak AllocType
G.HeapAlloc Mutability
G.Mutable String
displayString RegValue sym Mem
MemImpl sym
mem RegValue sym (BVType wptr)
SymBV sym wptr
sz Alignment
alignment

callCalloc
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?memOpts :: MemOptions )
  => GlobalVar Mem
  -> Alignment
  -> RegEntry sym (BVType wptr)
  -> RegEntry sym (BVType wptr)
  -> OverrideSim p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
callCalloc :: forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> Alignment
-> RegEntry sym (BVType wptr)
-> RegEntry sym (BVType wptr)
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
callCalloc GlobalVar Mem
mvar Alignment
alignment
           (RegEntry sym (BVType wptr) -> RegValue sym (BVType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType wptr)
sz)
           (RegEntry sym (BVType wptr) -> RegValue sym (BVType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType wptr)
num) =
  (forall bak.
 IsSymBackend sym bak =>
 bak
 -> OverrideSim
      p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak
  -> OverrideSim
       p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
 -> OverrideSim
      p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> (forall bak.
    IsSymBackend sym bak =>
    bak
    -> OverrideSim
         p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
    GlobalVar Mem
-> (RegValue sym Mem
    -> OverrideSim
         p
         sym
         ext
         r
         args
         ret
         (RegValue sym (LLVMPointerType wptr), RegValue sym Mem))
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType) a.
IsSymInterface sym =>
GlobalVar tp
-> (RegValue sym tp
    -> OverrideSim p sym ext rtp args ret (a, RegValue sym tp))
-> OverrideSim p sym ext rtp args ret a
modifyGlobal GlobalVar Mem
mvar ((RegValue sym Mem
  -> OverrideSim
       p
       sym
       ext
       r
       args
       ret
       (RegValue sym (LLVMPointerType wptr), RegValue sym Mem))
 -> OverrideSim
      p sym ext r args ret (RegValue sym (LLVMPointerType wptr)))
-> (RegValue sym Mem
    -> OverrideSim
         p
         sym
         ext
         r
         args
         ret
         (RegValue sym (LLVMPointerType wptr), RegValue sym Mem))
-> OverrideSim
     p sym ext r args ret (RegValue sym (LLVMPointerType wptr))
forall a b. (a -> b) -> a -> b
$ \RegValue sym Mem
mem -> IO (RegValue sym (LLVMPointerType wptr), RegValue sym Mem)
-> OverrideSim
     p
     sym
     ext
     r
     args
     ret
     (RegValue sym (LLVMPointerType wptr), RegValue sym Mem)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (RegValue sym (LLVMPointerType wptr), RegValue sym Mem)
 -> OverrideSim
      p
      sym
      ext
      r
      args
      ret
      (RegValue sym (LLVMPointerType wptr), RegValue sym Mem))
-> IO (RegValue sym (LLVMPointerType wptr), RegValue sym Mem)
-> OverrideSim
     p
     sym
     ext
     r
     args
     ret
     (RegValue sym (LLVMPointerType wptr), RegValue sym Mem)
forall a b. (a -> b) -> a -> b
$
      bak
-> MemImpl sym
-> SymBV sym wptr
-> SymBV sym wptr
-> Alignment
-> IO (RegValue sym (LLVMPointerType wptr), MemImpl sym)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> MemImpl sym
-> SymBV sym wptr
-> SymBV sym wptr
-> Alignment
-> IO (LLVMPtr sym wptr, MemImpl sym)
doCalloc bak
bak RegValue sym Mem
MemImpl sym
mem RegValue sym (BVType wptr)
SymBV sym wptr
sz RegValue sym (BVType wptr)
SymBV sym wptr
num Alignment
alignment

callFree
  :: (IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr)
  => GlobalVar Mem
  -> RegEntry sym (LLVMPointerType wptr)
  -> OverrideSim p sym ext r args ret ()
callFree :: forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> OverrideSim p sym ext r args ret ()
callFree GlobalVar Mem
mvar
           (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
ptr) =
  (forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext r args ret ())
-> OverrideSim p sym ext r args ret ()
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak -> OverrideSim p sym ext r args ret ())
 -> OverrideSim p sym ext r args ret ())
-> (forall bak.
    IsSymBackend sym bak =>
    bak -> OverrideSim p sym ext r args ret ())
-> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
    GlobalVar Mem
-> (RegValue sym Mem
    -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> OverrideSim p sym ext r args ret ()
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType) a.
IsSymInterface sym =>
GlobalVar tp
-> (RegValue sym tp
    -> OverrideSim p sym ext rtp args ret (a, RegValue sym tp))
-> OverrideSim p sym ext rtp args ret a
modifyGlobal GlobalVar Mem
mvar ((RegValue sym Mem
  -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
 -> OverrideSim p sym ext r args ret ())
-> (RegValue sym Mem
    -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ \RegValue sym Mem
mem -> IO ((), RegValue sym Mem)
-> OverrideSim p sym ext r args ret ((), RegValue sym Mem)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ((), RegValue sym Mem)
 -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> IO ((), RegValue sym Mem)
-> OverrideSim p sym ext r args ret ((), RegValue sym Mem)
forall a b. (a -> b) -> a -> b
$
      do MemImpl sym
mem' <- bak
-> MemImpl sym
-> RegValue sym (LLVMPointerType wptr)
-> IO (MemImpl sym)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym) =>
bak -> MemImpl sym -> LLVMPtr sym wptr -> IO (MemImpl sym)
doFree bak
bak RegValue sym Mem
MemImpl sym
mem RegValue sym (LLVMPointerType wptr)
ptr
         ((), MemImpl sym) -> IO ((), MemImpl sym)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((), MemImpl sym
mem')

------------------------------------------------------------------------
-- *** Memory manipulation

callMemcpy
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?memOpts :: MemOptions )
  => GlobalVar Mem
  -> RegEntry sym (LLVMPointerType wptr)
  -> RegEntry sym (LLVMPointerType wptr)
  -> RegEntry sym (BVType w)
  -> RegEntry sym (BVType 1)
  -> OverrideSim p sym ext r args ret ()
callMemcpy :: forall sym (wptr :: Natural) (w :: Natural) p ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType w)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext r args ret ()
callMemcpy GlobalVar Mem
mvar
           (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
dest)
           (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
src)
           (RegEntry (BVRepr NatRepr n
w) RegValue sym (BVType w)
len)
           RegEntry sym (BVType 1)
_volatile =
  (forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext r args ret ())
-> OverrideSim p sym ext r args ret ()
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak -> OverrideSim p sym ext r args ret ())
 -> OverrideSim p sym ext r args ret ())
-> (forall bak.
    IsSymBackend sym bak =>
    bak -> OverrideSim p sym ext r args ret ())
-> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
    GlobalVar Mem
-> (RegValue sym Mem
    -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> OverrideSim p sym ext r args ret ()
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType) a.
IsSymInterface sym =>
GlobalVar tp
-> (RegValue sym tp
    -> OverrideSim p sym ext rtp args ret (a, RegValue sym tp))
-> OverrideSim p sym ext rtp args ret a
modifyGlobal GlobalVar Mem
mvar ((RegValue sym Mem
  -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
 -> OverrideSim p sym ext r args ret ())
-> (RegValue sym Mem
    -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ \RegValue sym Mem
mem -> IO ((), RegValue sym Mem)
-> OverrideSim p sym ext r args ret ((), RegValue sym Mem)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ((), RegValue sym Mem)
 -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> IO ((), RegValue sym Mem)
-> OverrideSim p sym ext r args ret ((), RegValue sym Mem)
forall a b. (a -> b) -> a -> b
$
      do MemImpl sym
mem' <- bak
-> NatRepr n
-> MemImpl sym
-> Bool
-> RegValue sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
-> SymBV sym n
-> IO (MemImpl sym)
forall (w :: Natural) sym bak (wptr :: Natural).
(1 <= w, IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> NatRepr w
-> MemImpl sym
-> Bool
-> LLVMPtr sym wptr
-> LLVMPtr sym wptr
-> SymBV sym w
-> IO (MemImpl sym)
doMemcpy bak
bak NatRepr n
w RegValue sym Mem
MemImpl sym
mem Bool
True RegValue sym (LLVMPointerType wptr)
dest RegValue sym (LLVMPointerType wptr)
src RegValue sym (BVType w)
SymBV sym n
len
         ((), MemImpl sym) -> IO ((), MemImpl sym)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((), MemImpl sym
mem')

-- NB the only difference between memcpy and memove
-- is that memmove does not assert that the memory
-- ranges are disjoint.  The underlying operation
-- works correctly in both cases.
callMemmove
  :: ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr
     , ?memOpts :: MemOptions )
  => GlobalVar Mem
  -> RegEntry sym (LLVMPointerType wptr)
  -> RegEntry sym (LLVMPointerType wptr)
  -> RegEntry sym (BVType w)
  -> RegEntry sym (BVType 1)
  -> OverrideSim p sym ext r args ret ()
callMemmove :: forall sym (wptr :: Natural) (w :: Natural) p ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType w)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext r args ret ()
callMemmove GlobalVar Mem
mvar
           (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
dest)
           (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
src)
           (RegEntry (BVRepr NatRepr n
w) RegValue sym (BVType w)
len)
           RegEntry sym (BVType 1)
_volatile =
  -- FIXME? add assertions about alignment
  (forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext r args ret ())
-> OverrideSim p sym ext r args ret ()
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak -> OverrideSim p sym ext r args ret ())
 -> OverrideSim p sym ext r args ret ())
-> (forall bak.
    IsSymBackend sym bak =>
    bak -> OverrideSim p sym ext r args ret ())
-> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
    GlobalVar Mem
-> (RegValue sym Mem
    -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> OverrideSim p sym ext r args ret ()
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType) a.
IsSymInterface sym =>
GlobalVar tp
-> (RegValue sym tp
    -> OverrideSim p sym ext rtp args ret (a, RegValue sym tp))
-> OverrideSim p sym ext rtp args ret a
modifyGlobal GlobalVar Mem
mvar ((RegValue sym Mem
  -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
 -> OverrideSim p sym ext r args ret ())
-> (RegValue sym Mem
    -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ \RegValue sym Mem
mem -> IO ((), RegValue sym Mem)
-> OverrideSim p sym ext r args ret ((), RegValue sym Mem)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ((), RegValue sym Mem)
 -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> IO ((), RegValue sym Mem)
-> OverrideSim p sym ext r args ret ((), RegValue sym Mem)
forall a b. (a -> b) -> a -> b
$
      do MemImpl sym
mem' <- bak
-> NatRepr n
-> MemImpl sym
-> Bool
-> RegValue sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
-> SymBV sym n
-> IO (MemImpl sym)
forall (w :: Natural) sym bak (wptr :: Natural).
(1 <= w, IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> NatRepr w
-> MemImpl sym
-> Bool
-> LLVMPtr sym wptr
-> LLVMPtr sym wptr
-> SymBV sym w
-> IO (MemImpl sym)
doMemcpy bak
bak NatRepr n
w RegValue sym Mem
MemImpl sym
mem Bool
False RegValue sym (LLVMPointerType wptr)
dest RegValue sym (LLVMPointerType wptr)
src RegValue sym (BVType w)
SymBV sym n
len
         ((), MemImpl sym) -> IO ((), MemImpl sym)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((), MemImpl sym
mem')

callMemset
  :: (IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr)
  => GlobalVar Mem
  -> RegEntry sym (LLVMPointerType wptr)
  -> RegEntry sym (BVType 8)
  -> RegEntry sym (BVType w)
  -> RegEntry sym (BVType 1)
  -> OverrideSim p sym ext r args ret ()
callMemset :: forall sym (wptr :: Natural) (w :: Natural) p ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (BVType 8)
-> RegEntry sym (BVType w)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext r args ret ()
callMemset GlobalVar Mem
mvar
           (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
dest)
           (RegEntry sym (BVType 8) -> RegValue sym (BVType 8)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType 8)
val)
           (RegEntry (BVRepr NatRepr n
w) RegValue sym (BVType w)
len)
           RegEntry sym (BVType 1)
_volatile =
  (forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext r args ret ())
-> OverrideSim p sym ext r args ret ()
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak -> OverrideSim p sym ext r args ret ())
 -> OverrideSim p sym ext r args ret ())
-> (forall bak.
    IsSymBackend sym bak =>
    bak -> OverrideSim p sym ext r args ret ())
-> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
    GlobalVar Mem
-> (RegValue sym Mem
    -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> OverrideSim p sym ext r args ret ()
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType) a.
IsSymInterface sym =>
GlobalVar tp
-> (RegValue sym tp
    -> OverrideSim p sym ext rtp args ret (a, RegValue sym tp))
-> OverrideSim p sym ext rtp args ret a
modifyGlobal GlobalVar Mem
mvar ((RegValue sym Mem
  -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
 -> OverrideSim p sym ext r args ret ())
-> (RegValue sym Mem
    -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ \RegValue sym Mem
mem -> IO ((), RegValue sym Mem)
-> OverrideSim p sym ext r args ret ((), RegValue sym Mem)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ((), RegValue sym Mem)
 -> OverrideSim p sym ext r args ret ((), RegValue sym Mem))
-> IO ((), RegValue sym Mem)
-> OverrideSim p sym ext r args ret ((), RegValue sym Mem)
forall a b. (a -> b) -> a -> b
$
      do MemImpl sym
mem' <- bak
-> NatRepr n
-> MemImpl sym
-> RegValue sym (LLVMPointerType wptr)
-> SymBV sym 8
-> SymBV sym n
-> IO (MemImpl sym)
forall (w :: Natural) sym bak (wptr :: Natural).
(1 <= w, IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym) =>
bak
-> NatRepr w
-> MemImpl sym
-> LLVMPtr sym wptr
-> SymBV sym 8
-> SymBV sym w
-> IO (MemImpl sym)
doMemset bak
bak NatRepr n
w RegValue sym Mem
MemImpl sym
mem RegValue sym (LLVMPointerType wptr)
dest RegValue sym (BVType 8)
SymBV sym 8
val RegValue sym (BVType w)
SymBV sym n
len
         ((), MemImpl sym) -> IO ((), MemImpl sym)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((), MemImpl sym
mem')

------------------------------------------------------------------------
-- *** Strings and I/O

callPutChar
  :: IsSymInterface sym
  => GlobalVar Mem
  -> RegEntry sym (BVType 32)
  -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPutChar :: forall sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
GlobalVar Mem
-> RegEntry sym (BVType 32)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPutChar GlobalVar Mem
_mvar
 (RegEntry sym (BVType 32) -> RegValue sym (BVType 32)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType 32)
ch) = do
    Handle
h <- SimContext p sym ext -> Handle
forall personality sym ext.
SimContext personality sym ext -> Handle
printHandle (SimContext p sym ext -> Handle)
-> OverrideSim p sym ext r args ret (SimContext p sym ext)
-> OverrideSim p sym ext r args ret Handle
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> OverrideSim p sym ext r args ret (SimContext p sym ext)
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret (SimContext p sym ext)
getContext
    let chval :: Char
chval = Char -> (Integer -> Char) -> Maybe Integer -> Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Char
'?' (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger) (BV 32 -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV 32 -> Integer) -> Maybe (BV 32) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> SymExpr sym ('BaseBVType 32) -> Maybe (BV 32)
forall (w :: Natural). SymExpr sym (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV RegValue sym (BVType 32)
SymExpr sym ('BaseBVType 32)
ch)
    IO () -> OverrideSim p sym ext r args ret ()
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> OverrideSim p sym ext r args ret ())
-> IO () -> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ Handle -> Char -> IO ()
hPutChar Handle
h Char
chval
    RegValue sym (BVType 32)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall a. a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. Monad m => a -> m a
return RegValue sym (BVType 32)
ch

callPuts
  :: ( IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym
     , ?memOpts :: MemOptions )
  => GlobalVar Mem
  -> RegEntry sym (LLVMPointerType wptr)
  -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPuts :: forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPuts GlobalVar Mem
mvar
  (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
strPtr) =
    (forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
 -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> (forall bak.
    IsSymBackend sym bak =>
    bak -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall a b. (a -> b) -> a -> b
$ \bak
bak -> do
      MemImpl sym
mem <- GlobalVar Mem
-> OverrideSim p sym ext r args ret (RegValue sym Mem)
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
IsSymInterface sym =>
GlobalVar tp
-> OverrideSim p sym ext rtp args ret (RegValue sym tp)
readGlobal GlobalVar Mem
mvar
      [Word8]
str <- IO [Word8] -> OverrideSim p sym ext r args ret [Word8]
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Word8] -> OverrideSim p sym ext r args ret [Word8])
-> IO [Word8] -> OverrideSim p sym ext r args ret [Word8]
forall a b. (a -> b) -> a -> b
$ bak
-> MemImpl sym
-> RegValue sym (LLVMPointerType wptr)
-> Maybe Int
-> IO [Word8]
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions, HasCallStack) =>
bak -> MemImpl sym -> LLVMPtr sym wptr -> Maybe Int -> IO [Word8]
loadString bak
bak MemImpl sym
mem RegValue sym (LLVMPointerType wptr)
strPtr Maybe Int
forall a. Maybe a
Nothing
      Handle
h <- SimContext p sym ext -> Handle
forall personality sym ext.
SimContext personality sym ext -> Handle
printHandle (SimContext p sym ext -> Handle)
-> OverrideSim p sym ext r args ret (SimContext p sym ext)
-> OverrideSim p sym ext r args ret Handle
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> OverrideSim p sym ext r args ret (SimContext p sym ext)
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret (SimContext p sym ext)
getContext
      IO () -> OverrideSim p sym ext r args ret ()
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> OverrideSim p sym ext r args ret ())
-> IO () -> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
h ([Word8] -> String
forall b s. UTF8Bytes b s => b -> String
UTF8.toString [Word8]
str)
      -- return non-negative value on success
      IO (SymExpr sym ('BaseBVType 32))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType 32))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym ('BaseBVType 32))
 -> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType 32)))
-> IO (SymExpr sym ('BaseBVType 32))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType 32))
forall a b. (a -> b) -> a -> b
$ sym -> NatRepr 32 -> BV 32 -> IO (SymExpr sym ('BaseBVType 32))
forall (w :: Natural).
(1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit (bak -> sym
forall sym bak. HasSymInterface sym bak => bak -> sym
backendGetSym bak
bak) NatRepr 32
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (NatRepr 32 -> BV 32
forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
BV.one NatRepr 32
forall (n :: Natural). KnownNat n => NatRepr n
knownNat)

callStrlen
  :: ( IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym
     , ?memOpts :: MemOptions )
  => GlobalVar Mem
  -> RegEntry sym (LLVMPointerType wptr)
  -> OverrideSim p sym ext r args ret (RegValue sym (BVType wptr))
callStrlen :: forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType wptr))
callStrlen GlobalVar Mem
mvar (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
strPtr) =
  (forall bak.
 IsSymBackend sym bak =>
 bak
 -> OverrideSim p sym ext r args ret (RegValue sym (BVType wptr)))
-> OverrideSim p sym ext r args ret (RegValue sym (BVType wptr))
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak
  -> OverrideSim p sym ext r args ret (RegValue sym (BVType wptr)))
 -> OverrideSim p sym ext r args ret (RegValue sym (BVType wptr)))
-> (forall bak.
    IsSymBackend sym bak =>
    bak
    -> OverrideSim p sym ext r args ret (RegValue sym (BVType wptr)))
-> OverrideSim p sym ext r args ret (RegValue sym (BVType wptr))
forall a b. (a -> b) -> a -> b
$ \bak
bak -> do
    MemImpl sym
mem <- GlobalVar Mem
-> OverrideSim p sym ext r args ret (RegValue sym Mem)
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
IsSymInterface sym =>
GlobalVar tp
-> OverrideSim p sym ext rtp args ret (RegValue sym tp)
readGlobal GlobalVar Mem
mvar
    IO (SymExpr sym ('BaseBVType wptr))
-> OverrideSim
     p sym ext r args ret (SymExpr sym ('BaseBVType wptr))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym ('BaseBVType wptr))
 -> OverrideSim
      p sym ext r args ret (SymExpr sym ('BaseBVType wptr)))
-> IO (SymExpr sym ('BaseBVType wptr))
-> OverrideSim
     p sym ext r args ret (SymExpr sym ('BaseBVType wptr))
forall a b. (a -> b) -> a -> b
$ bak
-> MemImpl sym
-> RegValue sym (LLVMPointerType wptr)
-> IO (SymExpr sym ('BaseBVType wptr))
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak -> MemImpl sym -> LLVMPtr sym wptr -> IO (SymBV sym wptr)
strLen bak
bak MemImpl sym
mem RegValue sym (LLVMPointerType wptr)
strPtr

callAssert
  :: ( IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym
     , ?intrinsicsOpts :: IntrinsicsOptions, ?memOpts :: MemOptions )
  => GlobalVar Mem
  -> Ctx.Assignment (RegEntry sym)
        (EmptyCtx ::> LLVMPointerType wptr
                  ::> LLVMPointerType wptr
                  ::> BVType 32
                  ::> LLVMPointerType wptr)
  -> forall r args reg.
     OverrideSim p sym ext r args reg (RegValue sym UnitType)
callAssert :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?intrinsicsOpts::IntrinsicsOptions, ?memOpts::MemOptions) =>
GlobalVar Mem
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType 32)
      ::> LLVMPointerType wptr)
-> forall r (args :: Ctx CrucibleType) (reg :: CrucibleType).
   OverrideSim p sym ext r args reg (RegValue sym UnitType)
callAssert GlobalVar Mem
mvar (Assignment (RegEntry sym) ctx
Empty :> RegEntry sym tp
_pfn :> RegEntry sym tp
_pfile :> RegEntry sym tp
_pline :> RegEntry sym tp
ptxt ) =
  (forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext r args reg (RegValue sym UnitType))
-> OverrideSim p sym ext r args reg (RegValue sym UnitType)
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak -> OverrideSim p sym ext r args reg (RegValue sym UnitType))
 -> OverrideSim p sym ext r args reg (RegValue sym UnitType))
-> (forall bak.
    IsSymBackend sym bak =>
    bak -> OverrideSim p sym ext r args reg (RegValue sym UnitType))
-> OverrideSim p sym ext r args reg (RegValue sym UnitType)
forall a b. (a -> b) -> a -> b
$ \bak
bak -> do
    let sym :: sym
sym = bak -> sym
forall sym bak. HasSymInterface sym bak => bak -> sym
backendGetSym bak
bak
    Bool
-> OverrideSim p sym ext r args reg ()
-> OverrideSim p sym ext r args reg ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
failUponExit (OverrideSim p sym ext r args reg ()
 -> OverrideSim p sym ext r args reg ())
-> OverrideSim p sym ext r args reg ()
-> OverrideSim p sym ext r args reg ()
forall a b. (a -> b) -> a -> b
$
      do MemImpl sym
mem <- GlobalVar Mem
-> OverrideSim p sym ext r args reg (RegValue sym Mem)
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
IsSymInterface sym =>
GlobalVar tp
-> OverrideSim p sym ext rtp args ret (RegValue sym tp)
readGlobal GlobalVar Mem
mvar
         [Word8]
txt <- IO [Word8] -> OverrideSim p sym ext r args reg [Word8]
forall a. IO a -> OverrideSim p sym ext r args reg a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Word8] -> OverrideSim p sym ext r args reg [Word8])
-> IO [Word8] -> OverrideSim p sym ext r args reg [Word8]
forall a b. (a -> b) -> a -> b
$ bak -> MemImpl sym -> LLVMPtr sym wptr -> Maybe Int -> IO [Word8]
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions, HasCallStack) =>
bak -> MemImpl sym -> LLVMPtr sym wptr -> Maybe Int -> IO [Word8]
loadString bak
bak MemImpl sym
mem (RegEntry sym tp -> RegValue sym tp
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue RegEntry sym tp
ptxt) Maybe Int
forall a. Maybe a
Nothing
         let err :: SimErrorReason
err = String -> String -> SimErrorReason
AssertFailureSimError String
"Call to assert()" ([Word8] -> String
forall b s. UTF8Bytes b s => b -> String
UTF8.toString [Word8]
txt)
         IO () -> OverrideSim p sym ext r args reg ()
forall a. IO a -> OverrideSim p sym ext r args reg a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> OverrideSim p sym ext r args reg ())
-> IO () -> OverrideSim p sym ext r args reg ()
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO ()
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak SimErrorReason
err
    IO () -> OverrideSim p sym ext r args reg ()
forall a. IO a -> OverrideSim p sym ext r args reg a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> OverrideSim p sym ext r args reg ())
-> IO () -> OverrideSim p sym ext r args reg ()
forall a b. (a -> b) -> a -> b
$
      do ProgramLoc
loc <- IO ProgramLoc -> IO ProgramLoc
forall a. IO a -> IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ProgramLoc -> IO ProgramLoc) -> IO ProgramLoc -> IO ProgramLoc
forall a b. (a -> b) -> a -> b
$ sym -> IO ProgramLoc
forall sym. IsExprBuilder sym => sym -> IO ProgramLoc
getCurrentProgramLoc sym
sym
         AbortExecReason -> IO ()
forall a. AbortExecReason -> IO a
abortExecBecause (AbortExecReason -> IO ()) -> AbortExecReason -> IO ()
forall a b. (a -> b) -> a -> b
$ ProgramLoc -> AbortExecReason
EarlyExit ProgramLoc
loc
  where
    failUponExit :: Bool
    failUponExit :: Bool
failUponExit
      = IntrinsicsOptions -> AbnormalExitBehavior
abnormalExitBehavior ?intrinsicsOpts::IntrinsicsOptions
IntrinsicsOptions
?intrinsicsOpts AbnormalExitBehavior -> [AbnormalExitBehavior] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [AbnormalExitBehavior
AlwaysFail, AbnormalExitBehavior
OnlyAssertFail]

callExit :: ( IsSymInterface sym
            , ?intrinsicsOpts :: IntrinsicsOptions )
         => RegEntry sym (BVType 32)
         -> OverrideSim p sym ext r args ret (RegValue sym UnitType)
callExit :: forall sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, ?intrinsicsOpts::IntrinsicsOptions) =>
RegEntry sym (BVType 32)
-> OverrideSim p sym ext r args ret (RegValue sym UnitType)
callExit RegEntry sym (BVType 32)
ec =
  (forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext r args ret (RegValue sym UnitType))
-> OverrideSim p sym ext r args ret (RegValue sym UnitType)
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak -> OverrideSim p sym ext r args ret (RegValue sym UnitType))
 -> OverrideSim p sym ext r args ret (RegValue sym UnitType))
-> (forall bak.
    IsSymBackend sym bak =>
    bak -> OverrideSim p sym ext r args ret (RegValue sym UnitType))
-> OverrideSim p sym ext r args ret (RegValue sym UnitType)
forall a b. (a -> b) -> a -> b
$ \bak
bak -> IO (RegValue sym UnitType)
-> OverrideSim p sym ext r args ret (RegValue sym UnitType)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (RegValue sym UnitType)
 -> OverrideSim p sym ext r args ret (RegValue sym UnitType))
-> IO (RegValue sym UnitType)
-> OverrideSim p sym ext r args ret (RegValue sym UnitType)
forall a b. (a -> b) -> a -> b
$ do
    let sym :: sym
sym = bak -> sym
forall sym bak. HasSymInterface sym bak => bak -> sym
backendGetSym bak
bak
    Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (IntrinsicsOptions -> AbnormalExitBehavior
abnormalExitBehavior ?intrinsicsOpts::IntrinsicsOptions
IntrinsicsOptions
?intrinsicsOpts AbnormalExitBehavior -> AbnormalExitBehavior -> Bool
forall a. Eq a => a -> a -> Bool
== AbnormalExitBehavior
AlwaysFail) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      do SymExpr sym BaseBoolType
cond <- sym
-> SymExpr sym ('BaseBVType 32)
-> SymExpr sym ('BaseBVType 32)
-> IO (SymExpr sym BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymExpr sym BaseBoolType)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq sym
sym (RegEntry sym (BVType 32) -> RegValue sym (BVType 32)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue RegEntry sym (BVType 32)
ec) (SymExpr sym ('BaseBVType 32) -> IO (SymExpr sym BaseBoolType))
-> IO (SymExpr sym ('BaseBVType 32))
-> IO (SymExpr sym BaseBoolType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> NatRepr 32 -> IO (SymExpr sym ('BaseBVType 32))
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero sym
sym NatRepr 32
forall (n :: Natural). KnownNat n => NatRepr n
knownNat
         -- If the argument is non-zero, throw an assertion failure. Otherwise,
         -- simply stop the current thread of execution.
         bak -> SymExpr sym BaseBoolType -> SimErrorReason -> IO ()
forall sym bak.
IsSymBackend sym bak =>
bak -> Pred sym -> SimErrorReason -> IO ()
assert bak
bak SymExpr sym BaseBoolType
cond SimErrorReason
"Call to exit() with non-zero argument"
    ProgramLoc
loc <- sym -> IO ProgramLoc
forall sym. IsExprBuilder sym => sym -> IO ProgramLoc
getCurrentProgramLoc sym
sym
    AbortExecReason -> IO ()
forall a. AbortExecReason -> IO a
abortExecBecause (AbortExecReason -> IO ()) -> AbortExecReason -> IO ()
forall a b. (a -> b) -> a -> b
$ ProgramLoc -> AbortExecReason
EarlyExit ProgramLoc
loc

callPrintf
  :: ( IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym
     , ?memOpts :: MemOptions )
  => GlobalVar Mem
  -> RegEntry sym (LLVMPointerType wptr)
  -> RegEntry sym (VectorType AnyType)
  -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPrintf :: forall sym (wptr :: Natural) p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
GlobalVar Mem
-> RegEntry sym (LLVMPointerType wptr)
-> RegEntry sym (VectorType AnyType)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
callPrintf GlobalVar Mem
mvar
  (RegEntry sym (LLVMPointerType wptr)
-> RegValue sym (LLVMPointerType wptr)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (LLVMPointerType wptr)
strPtr)
  (RegEntry sym (VectorType AnyType)
-> RegValue sym (VectorType AnyType)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (VectorType AnyType)
valist) =
    (forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
 -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> (forall bak.
    IsSymBackend sym bak =>
    bak -> OverrideSim p sym ext r args ret (RegValue sym (BVType 32)))
-> OverrideSim p sym ext r args ret (RegValue sym (BVType 32))
forall a b. (a -> b) -> a -> b
$ \bak
bak -> do
      MemImpl sym
mem <- GlobalVar Mem
-> OverrideSim p sym ext r args ret (RegValue sym Mem)
forall sym (tp :: CrucibleType) p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
IsSymInterface sym =>
GlobalVar tp
-> OverrideSim p sym ext rtp args ret (RegValue sym tp)
readGlobal GlobalVar Mem
mvar
      [Word8]
formatStr <- IO [Word8] -> OverrideSim p sym ext r args ret [Word8]
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Word8] -> OverrideSim p sym ext r args ret [Word8])
-> IO [Word8] -> OverrideSim p sym ext r args ret [Word8]
forall a b. (a -> b) -> a -> b
$ bak
-> MemImpl sym
-> RegValue sym (LLVMPointerType wptr)
-> Maybe Int
-> IO [Word8]
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions, HasCallStack) =>
bak -> MemImpl sym -> LLVMPtr sym wptr -> Maybe Int -> IO [Word8]
loadString bak
bak MemImpl sym
mem RegValue sym (LLVMPointerType wptr)
strPtr Maybe Int
forall a. Maybe a
Nothing
      case [Word8] -> Either String [PrintfDirective]
parseDirectives [Word8]
formatStr of
        Left String
err -> SimErrorReason
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType 32))
forall sym p ext rtp (args :: Ctx CrucibleType)
       (res :: CrucibleType) a.
IsSymInterface sym =>
SimErrorReason -> OverrideSim p sym ext rtp args res a
overrideError (SimErrorReason
 -> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType 32)))
-> SimErrorReason
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType 32))
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError String
"Format string parsing failed" String
err
        Right [PrintfDirective]
ds -> do
          ((ByteString
str, Int
n), MemImpl sym
mem') <- IO ((ByteString, Int), MemImpl sym)
-> OverrideSim
     p sym ext r args ret ((ByteString, Int), MemImpl sym)
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ((ByteString, Int), MemImpl sym)
 -> OverrideSim
      p sym ext r args ret ((ByteString, Int), MemImpl sym))
-> IO ((ByteString, Int), MemImpl sym)
-> OverrideSim
     p sym ext r args ret ((ByteString, Int), MemImpl sym)
forall a b. (a -> b) -> a -> b
$ StateT (MemImpl sym) IO (ByteString, Int)
-> MemImpl sym -> IO ((ByteString, Int), MemImpl sym)
forall s (m :: Type -> Type) a. StateT s m a -> s -> m (a, s)
runStateT (PrintfOperations (StateT (MemImpl sym) IO)
-> [PrintfDirective] -> StateT (MemImpl sym) IO (ByteString, Int)
forall (m :: Type -> Type).
Monad m =>
PrintfOperations m -> [PrintfDirective] -> m (ByteString, Int)
executeDirectives (bak
-> Vector (AnyValue sym)
-> PrintfOperations (StateT (MemImpl sym) IO)
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
bak
-> Vector (AnyValue sym)
-> PrintfOperations (StateT (MemImpl sym) IO)
printfOps bak
bak Vector (AnyValue sym)
RegValue sym (VectorType AnyType)
valist) [PrintfDirective]
ds) MemImpl sym
mem
          GlobalVar Mem
-> RegValue sym Mem -> OverrideSim p sym ext r args ret ()
forall (tp :: CrucibleType) sym p ext rtp
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
GlobalVar tp
-> RegValue sym tp -> OverrideSim p sym ext rtp args ret ()
writeGlobal GlobalVar Mem
mvar RegValue sym Mem
MemImpl sym
mem'
          Handle
h <- SimContext p sym ext -> Handle
forall personality sym ext.
SimContext personality sym ext -> Handle
printHandle (SimContext p sym ext -> Handle)
-> OverrideSim p sym ext r args ret (SimContext p sym ext)
-> OverrideSim p sym ext r args ret Handle
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> OverrideSim p sym ext r args ret (SimContext p sym ext)
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret (SimContext p sym ext)
getContext
          IO () -> OverrideSim p sym ext r args ret ()
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> OverrideSim p sym ext r args ret ())
-> IO () -> OverrideSim p sym ext r args ret ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
BS.hPutStr Handle
h ByteString
str
          IO (SymExpr sym ('BaseBVType 32))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType 32))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym ('BaseBVType 32))
 -> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType 32)))
-> IO (SymExpr sym ('BaseBVType 32))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType 32))
forall a b. (a -> b) -> a -> b
$ sym -> NatRepr 32 -> BV 32 -> IO (SymExpr sym ('BaseBVType 32))
forall (w :: Natural).
(1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit (bak -> sym
forall sym bak. HasSymInterface sym bak => bak -> sym
backendGetSym bak
bak) NatRepr 32
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (NatRepr 32 -> Integer -> BV 32
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr 32
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n))

printfOps :: ( IsSymBackend sym bak, HasLLVMAnn sym, HasPtrWidth wptr
             , ?memOpts :: MemOptions )
          => bak
          -> V.Vector (AnyValue sym)
          -> PrintfOperations (StateT (MemImpl sym) IO)
printfOps :: forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasLLVMAnn sym, HasPtrWidth wptr,
 ?memOpts::MemOptions) =>
bak
-> Vector (AnyValue sym)
-> PrintfOperations (StateT (MemImpl sym) IO)
printfOps bak
bak Vector (AnyValue sym)
valist =
  let sym :: sym
sym = bak -> sym
forall sym bak. HasSymInterface sym bak => bak -> sym
backendGetSym bak
bak in
  PrintfOperations
  { printfUnsupported :: forall a. HasCallStack => String -> StateT (MemImpl sym) IO a
printfUnsupported = \String
x -> IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> StateT (MemImpl sym) IO a)
-> IO a -> StateT (MemImpl sym) IO a
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO a
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
                                   (SimErrorReason -> IO a) -> SimErrorReason -> IO a
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> SimErrorReason
Unsupported CallStack
HasCallStack => CallStack
GHC.callStack String
x

  , printfGetInteger :: Int
-> Bool
-> PrintfLengthModifier
-> StateT (MemImpl sym) IO (Maybe Integer)
printfGetInteger = \Int
i Bool
sgn PrintfLengthModifier
_len ->
     case Vector (AnyValue sym)
valist Vector (AnyValue sym) -> Int -> Maybe (AnyValue sym)
forall a. Vector a -> Int -> Maybe a
V.!? (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) of
       Just (AnyValue (LLVMPointerRepr NatRepr w
w) p :: RegValue sym tp
p@(LLVMPointer SymNat sym
_blk SymBV sym w
bv)) ->
         do SymExpr sym BaseBoolType
isBv <- IO (SymExpr sym BaseBoolType)
-> StateT (MemImpl sym) IO (SymExpr sym BaseBoolType)
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (sym -> LLVMPtr sym w -> IO (SymExpr sym BaseBoolType)
forall sym (w :: Natural).
IsSymInterface sym =>
sym -> LLVMPtr sym w -> IO (Pred sym)
Ptr.ptrIsBv sym
sym RegValue sym tp
LLVMPtr sym w
p)
            IO () -> StateT (MemImpl sym) IO ()
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT (MemImpl sym) IO ())
-> IO () -> StateT (MemImpl sym) IO ()
forall a b. (a -> b) -> a -> b
$ bak -> SymExpr sym BaseBoolType -> SimErrorReason -> IO ()
forall sym bak.
IsSymBackend sym bak =>
bak -> Pred sym -> SimErrorReason -> IO ()
assert bak
bak SymExpr sym BaseBoolType
isBv (SimErrorReason -> IO ()) -> SimErrorReason -> IO ()
forall a b. (a -> b) -> a -> b
$
              String -> String -> SimErrorReason
AssertFailureSimError
               String
"Passed a pointer to printf where a bitvector was expected"
               String
""
            if Bool
sgn then
              Maybe Integer -> StateT (MemImpl sym) IO (Maybe Integer)
forall a. a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Integer -> StateT (MemImpl sym) IO (Maybe Integer))
-> Maybe Integer -> StateT (MemImpl sym) IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> BV w -> Integer
BV.asSigned NatRepr w
w (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> SymBV sym w -> Maybe (BV w)
forall (w :: Natural). SymExpr sym (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV sym w
bv
            else
              Maybe Integer -> StateT (MemImpl sym) IO (Maybe Integer)
forall a. a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Integer -> StateT (MemImpl sym) IO (Maybe Integer))
-> Maybe Integer -> StateT (MemImpl sym) IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> SymBV sym w -> Maybe (BV w)
forall (w :: Natural). SymExpr sym (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV sym w
bv
       Just (AnyValue TypeRepr tp
tpr RegValue sym tp
_) ->
         IO (Maybe Integer) -> StateT (MemImpl sym) IO (Maybe Integer)
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Integer) -> StateT (MemImpl sym) IO (Maybe Integer))
-> IO (Maybe Integer) -> StateT (MemImpl sym) IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO (Maybe Integer)
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
              (SimErrorReason -> IO (Maybe Integer))
-> SimErrorReason -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError
                String
"Type mismatch in printf"
                ([String] -> String
unwords [String
"Expected integer, but got:", TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
tpr])
       Maybe (AnyValue sym)
Nothing ->
         IO (Maybe Integer) -> StateT (MemImpl sym) IO (Maybe Integer)
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Integer) -> StateT (MemImpl sym) IO (Maybe Integer))
-> IO (Maybe Integer) -> StateT (MemImpl sym) IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO (Maybe Integer)
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
              (SimErrorReason -> IO (Maybe Integer))
-> SimErrorReason -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError
               String
"Out-of-bounds argument access in printf"
               ([String] -> String
unwords [String
"Index:", Int -> String
forall a. Show a => a -> String
show Int
i])

  , printfGetFloat :: Int
-> PrintfLengthModifier -> StateT (MemImpl sym) IO (Maybe Rational)
printfGetFloat = \Int
i PrintfLengthModifier
_len ->
     case Vector (AnyValue sym)
valist Vector (AnyValue sym) -> Int -> Maybe (AnyValue sym)
forall a. Vector a -> Int -> Maybe a
V.!? (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) of
       Just (AnyValue (FloatRepr (FloatInfoRepr flt
_fi :: FloatInfoRepr fi)) RegValue sym tp
x) ->
         do SymExpr sym BaseRealType
xr <- IO (SymExpr sym BaseRealType)
-> StateT (MemImpl sym) IO (SymExpr sym BaseRealType)
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym -> SymInterpretedFloat sym fi -> IO (SymReal sym)
iFloatToReal @_ @fi sym
sym RegValue sym tp
SymInterpretedFloat sym flt
x)
            Maybe Rational -> StateT (MemImpl sym) IO (Maybe Rational)
forall a. a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SymExpr sym BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymExpr sym BaseRealType
xr)
       Just (AnyValue TypeRepr tp
tpr RegValue sym tp
_) ->
         IO (Maybe Rational) -> StateT (MemImpl sym) IO (Maybe Rational)
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Rational) -> StateT (MemImpl sym) IO (Maybe Rational))
-> IO (Maybe Rational) -> StateT (MemImpl sym) IO (Maybe Rational)
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO (Maybe Rational)
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
              (SimErrorReason -> IO (Maybe Rational))
-> SimErrorReason -> IO (Maybe Rational)
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError
                String
"Type mismatch in printf."
                ([String] -> String
unwords [String
"Expected floating-point, but got:", TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
tpr])
       Maybe (AnyValue sym)
Nothing ->
         IO (Maybe Rational) -> StateT (MemImpl sym) IO (Maybe Rational)
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Rational) -> StateT (MemImpl sym) IO (Maybe Rational))
-> IO (Maybe Rational) -> StateT (MemImpl sym) IO (Maybe Rational)
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO (Maybe Rational)
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
              (SimErrorReason -> IO (Maybe Rational))
-> SimErrorReason -> IO (Maybe Rational)
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError
                String
"Out-of-bounds argument access in printf:"
                ([String] -> String
unwords [String
"Index:", Int -> String
forall a. Show a => a -> String
show Int
i])

  , printfGetString :: Int -> Maybe Int -> StateT (MemImpl sym) IO [Word8]
printfGetString  = \Int
i Maybe Int
numchars ->
     case Vector (AnyValue sym)
valist Vector (AnyValue sym) -> Int -> Maybe (AnyValue sym)
forall a. Vector a -> Int -> Maybe a
V.!? (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) of
       Just (AnyValue TypeRepr tp
PtrRepr RegValue sym tp
ptr) ->
           do MemImpl sym
mem <- StateT (MemImpl sym) IO (MemImpl sym)
forall s (m :: Type -> Type). MonadState s m => m s
get
              IO [Word8] -> StateT (MemImpl sym) IO [Word8]
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Word8] -> StateT (MemImpl sym) IO [Word8])
-> IO [Word8] -> StateT (MemImpl sym) IO [Word8]
forall a b. (a -> b) -> a -> b
$ bak -> MemImpl sym -> LLVMPtr sym wptr -> Maybe Int -> IO [Word8]
forall sym bak (wptr :: Natural).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions, HasCallStack) =>
bak -> MemImpl sym -> LLVMPtr sym wptr -> Maybe Int -> IO [Word8]
loadString bak
bak MemImpl sym
mem RegValue sym tp
LLVMPtr sym wptr
ptr Maybe Int
numchars
       Just (AnyValue TypeRepr tp
tpr RegValue sym tp
_) ->
         IO [Word8] -> StateT (MemImpl sym) IO [Word8]
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [Word8] -> StateT (MemImpl sym) IO [Word8])
-> IO [Word8] -> StateT (MemImpl sym) IO [Word8]
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO [Word8]
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
              (SimErrorReason -> IO [Word8]) -> SimErrorReason -> IO [Word8]
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError
                String
"Type mismatch in printf."
                ([String] -> String
unwords [String
"Expected char*, but got:", TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
tpr])
       Maybe (AnyValue sym)
Nothing ->
         IO [Word8] -> StateT (MemImpl sym) IO [Word8]
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [Word8] -> StateT (MemImpl sym) IO [Word8])
-> IO [Word8] -> StateT (MemImpl sym) IO [Word8]
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO [Word8]
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
              (SimErrorReason -> IO [Word8]) -> SimErrorReason -> IO [Word8]
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError
                String
"Out-of-bounds argument access in printf:"
                ([String] -> String
unwords [String
"Index:", Int -> String
forall a. Show a => a -> String
show Int
i])

  , printfGetPointer :: Int -> StateT (MemImpl sym) IO String
printfGetPointer = \Int
i ->
     case Vector (AnyValue sym)
valist Vector (AnyValue sym) -> Int -> Maybe (AnyValue sym)
forall a. Vector a -> Int -> Maybe a
V.!? (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) of
       Just (AnyValue TypeRepr tp
PtrRepr RegValue sym tp
ptr) ->
         String -> StateT (MemImpl sym) IO String
forall a. a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> StateT (MemImpl sym) IO String)
-> String -> StateT (MemImpl sym) IO String
forall a b. (a -> b) -> a -> b
$ Doc Any -> String
forall a. Show a => a -> String
show (LLVMPtr sym wptr -> Doc Any
forall sym (wptr :: Natural) ann.
IsExpr (SymExpr sym) =>
LLVMPtr sym wptr -> Doc ann
G.ppPtr RegValue sym tp
LLVMPtr sym wptr
ptr)
       Just (AnyValue TypeRepr tp
tpr RegValue sym tp
_) ->
         IO String -> StateT (MemImpl sym) IO String
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO String -> StateT (MemImpl sym) IO String)
-> IO String -> StateT (MemImpl sym) IO String
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO String
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
              (SimErrorReason -> IO String) -> SimErrorReason -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError
                String
"Type mismatch in printf."
                ([String] -> String
unwords [String
"Expected void*, but got:", TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
tpr])
       Maybe (AnyValue sym)
Nothing ->
         IO String -> StateT (MemImpl sym) IO String
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO String -> StateT (MemImpl sym) IO String)
-> IO String -> StateT (MemImpl sym) IO String
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO String
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
              (SimErrorReason -> IO String) -> SimErrorReason -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError
                String
"Out-of-bounds argument access in printf:"
                ([String] -> String
unwords [String
"Index:", Int -> String
forall a. Show a => a -> String
show Int
i])

  , printfSetInteger :: Int -> PrintfLengthModifier -> Int -> StateT (MemImpl sym) IO ()
printfSetInteger = \Int
i PrintfLengthModifier
len Int
v ->
     case Vector (AnyValue sym)
valist Vector (AnyValue sym) -> Int -> Maybe (AnyValue sym)
forall a. Vector a -> Int -> Maybe a
V.!? (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) of
       Just (AnyValue TypeRepr tp
PtrRepr RegValue sym tp
ptr) ->
         do MemImpl sym
mem <- StateT (MemImpl sym) IO (MemImpl sym)
forall s (m :: Type -> Type). MonadState s m => m s
get
            case PrintfLengthModifier
len of
              PrintfLengthModifier
Len_Byte  -> do
                 let w8 :: NatRepr 8
w8 = NatRepr 8
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 8
                 let tp :: StorageType
tp = Bytes -> StorageType
G.bitvectorType Bytes
1
                 LLVMPointer sym 8
x <- IO (LLVMPtr sym 8) -> StateT (MemImpl sym) IO (LLVMPtr sym 8)
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (sym -> SymExpr sym ('BaseBVType 8) -> IO (LLVMPtr sym 8)
forall sym (w :: Natural).
IsSymInterface sym =>
sym -> SymBV sym w -> IO (LLVMPtr sym w)
llvmPointer_bv sym
sym (SymExpr sym ('BaseBVType 8) -> IO (LLVMPtr sym 8))
-> IO (SymExpr sym ('BaseBVType 8)) -> IO (LLVMPtr sym 8)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> NatRepr 8 -> BV 8 -> IO (SymExpr sym ('BaseBVType 8))
forall (w :: Natural).
(1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr 8
w8 (NatRepr 8 -> Integer -> BV 8
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr 8
w8 (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
v)))
                 MemImpl sym
mem' <- IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym)
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym))
-> IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym)
forall a b. (a -> b) -> a -> b
$ bak
-> MemImpl sym
-> LLVMPtr sym wptr
-> TypeRepr (LLVMPointerType 8)
-> StorageType
-> Alignment
-> LLVMPtr sym 8
-> IO (MemImpl sym)
forall sym bak (wptr :: Natural) (tp :: CrucibleType).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> MemImpl sym
-> LLVMPtr sym wptr
-> TypeRepr tp
-> StorageType
-> Alignment
-> RegValue sym tp
-> IO (MemImpl sym)
doStore bak
bak MemImpl sym
mem RegValue sym tp
LLVMPtr sym wptr
ptr (NatRepr 8 -> TypeRepr (LLVMPointerType 8)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr 8
w8) StorageType
tp Alignment
noAlignment LLVMPtr sym 8
LLVMPointer sym 8
x
                 MemImpl sym -> StateT (MemImpl sym) IO ()
forall s (m :: Type -> Type). MonadState s m => s -> m ()
put MemImpl sym
mem'
              PrintfLengthModifier
Len_Short -> do
                 let w16 :: NatRepr 16
w16 = NatRepr 16
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 16
                 let tp :: StorageType
tp = Bytes -> StorageType
G.bitvectorType Bytes
2
                 LLVMPointer sym 16
x <- IO (LLVMPtr sym 16) -> StateT (MemImpl sym) IO (LLVMPtr sym 16)
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (sym -> SymExpr sym (BaseBVType 16) -> IO (LLVMPtr sym 16)
forall sym (w :: Natural).
IsSymInterface sym =>
sym -> SymBV sym w -> IO (LLVMPtr sym w)
llvmPointer_bv sym
sym (SymExpr sym (BaseBVType 16) -> IO (LLVMPtr sym 16))
-> IO (SymExpr sym (BaseBVType 16)) -> IO (LLVMPtr sym 16)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> NatRepr 16 -> BV 16 -> IO (SymExpr sym (BaseBVType 16))
forall (w :: Natural).
(1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr 16
w16 (NatRepr 16 -> Integer -> BV 16
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr 16
w16 (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
v)))
                 MemImpl sym
mem' <- IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym)
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym))
-> IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym)
forall a b. (a -> b) -> a -> b
$ bak
-> MemImpl sym
-> LLVMPtr sym wptr
-> TypeRepr (LLVMPointerType 16)
-> StorageType
-> Alignment
-> LLVMPtr sym 16
-> IO (MemImpl sym)
forall sym bak (wptr :: Natural) (tp :: CrucibleType).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> MemImpl sym
-> LLVMPtr sym wptr
-> TypeRepr tp
-> StorageType
-> Alignment
-> RegValue sym tp
-> IO (MemImpl sym)
doStore bak
bak MemImpl sym
mem RegValue sym tp
LLVMPtr sym wptr
ptr (NatRepr 16 -> TypeRepr (LLVMPointerType 16)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr 16
w16) StorageType
tp Alignment
noAlignment LLVMPtr sym 16
LLVMPointer sym 16
x
                 MemImpl sym -> StateT (MemImpl sym) IO ()
forall s (m :: Type -> Type). MonadState s m => s -> m ()
put MemImpl sym
mem'
              PrintfLengthModifier
Len_NoMod -> do
                 let w32 :: NatRepr 32
w32  = NatRepr 32
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 32
                 let tp :: StorageType
tp = Bytes -> StorageType
G.bitvectorType Bytes
4
                 LLVMPointer sym 32
x <- IO (LLVMPtr sym 32) -> StateT (MemImpl sym) IO (LLVMPtr sym 32)
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (sym -> SymExpr sym ('BaseBVType 32) -> IO (LLVMPtr sym 32)
forall sym (w :: Natural).
IsSymInterface sym =>
sym -> SymBV sym w -> IO (LLVMPtr sym w)
llvmPointer_bv sym
sym (SymExpr sym ('BaseBVType 32) -> IO (LLVMPtr sym 32))
-> IO (SymExpr sym ('BaseBVType 32)) -> IO (LLVMPtr sym 32)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> NatRepr 32 -> BV 32 -> IO (SymExpr sym ('BaseBVType 32))
forall (w :: Natural).
(1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr 32
w32 (NatRepr 32 -> Integer -> BV 32
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr 32
w32 (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
v)))
                 MemImpl sym
mem' <- IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym)
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym))
-> IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym)
forall a b. (a -> b) -> a -> b
$ bak
-> MemImpl sym
-> LLVMPtr sym wptr
-> TypeRepr (LLVMPointerType 32)
-> StorageType
-> Alignment
-> LLVMPtr sym 32
-> IO (MemImpl sym)
forall sym bak (wptr :: Natural) (tp :: CrucibleType).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> MemImpl sym
-> LLVMPtr sym wptr
-> TypeRepr tp
-> StorageType
-> Alignment
-> RegValue sym tp
-> IO (MemImpl sym)
doStore bak
bak MemImpl sym
mem RegValue sym tp
LLVMPtr sym wptr
ptr (NatRepr 32 -> TypeRepr (LLVMPointerType 32)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr 32
w32) StorageType
tp Alignment
noAlignment LLVMPtr sym 32
LLVMPointer sym 32
x
                 MemImpl sym -> StateT (MemImpl sym) IO ()
forall s (m :: Type -> Type). MonadState s m => s -> m ()
put MemImpl sym
mem'
              PrintfLengthModifier
Len_Long  -> do
                 let w64 :: NatRepr 64
w64 = NatRepr 64
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 64
                 let tp :: StorageType
tp = Bytes -> StorageType
G.bitvectorType Bytes
8
                 LLVMPointer sym 64
x <- IO (LLVMPtr sym 64) -> StateT (MemImpl sym) IO (LLVMPtr sym 64)
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (sym -> SymExpr sym (BaseBVType 64) -> IO (LLVMPtr sym 64)
forall sym (w :: Natural).
IsSymInterface sym =>
sym -> SymBV sym w -> IO (LLVMPtr sym w)
llvmPointer_bv sym
sym (SymExpr sym (BaseBVType 64) -> IO (LLVMPtr sym 64))
-> IO (SymExpr sym (BaseBVType 64)) -> IO (LLVMPtr sym 64)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> NatRepr 64 -> BV 64 -> IO (SymExpr sym (BaseBVType 64))
forall (w :: Natural).
(1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr 64
w64 (NatRepr 64 -> Integer -> BV 64
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr 64
w64 (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
v)))
                 MemImpl sym
mem' <- IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym)
forall a. IO a -> StateT (MemImpl sym) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym))
-> IO (MemImpl sym) -> StateT (MemImpl sym) IO (MemImpl sym)
forall a b. (a -> b) -> a -> b
$ bak
-> MemImpl sym
-> LLVMPtr sym wptr
-> TypeRepr (LLVMPointerType 64)
-> StorageType
-> Alignment
-> LLVMPtr sym 64
-> IO (MemImpl sym)
forall sym bak (wptr :: Natural) (tp :: CrucibleType).
(IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym,
 ?memOpts::MemOptions) =>
bak
-> MemImpl sym
-> LLVMPtr sym wptr
-> TypeRepr tp
-> StorageType
-> Alignment
-> RegValue sym tp
-> IO (MemImpl sym)
doStore bak
bak MemImpl sym
mem RegValue sym tp
LLVMPtr sym wptr
ptr (NatRepr 64 -> TypeRepr (LLVMPointerType 64)
forall (ty :: CrucibleType) (w :: Natural).
(1 <= w, ty ~ LLVMPointerType w) =>
NatRepr w -> TypeRepr ty
LLVMPointerRepr NatRepr 64
w64) StorageType
tp Alignment
noAlignment LLVMPtr sym 64
LLVMPointer sym 64
x
                 MemImpl sym -> StateT (MemImpl sym) IO ()
forall s (m :: Type -> Type). MonadState s m => s -> m ()
put MemImpl sym
mem'
              PrintfLengthModifier
_ ->
                IO () -> StateT (MemImpl sym) IO ()
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> StateT (MemImpl sym) IO ())
-> IO () -> StateT (MemImpl sym) IO ()
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO ()
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
                     (SimErrorReason -> IO ()) -> SimErrorReason -> IO ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> SimErrorReason
Unsupported CallStack
HasCallStack => CallStack
GHC.callStack
                     (String -> SimErrorReason) -> String -> SimErrorReason
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Unsupported size modifier in %n conversion:", PrintfLengthModifier -> String
forall a. Show a => a -> String
show PrintfLengthModifier
len]

       Just (AnyValue TypeRepr tp
tpr RegValue sym tp
_) ->
         IO () -> StateT (MemImpl sym) IO ()
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> StateT (MemImpl sym) IO ())
-> IO () -> StateT (MemImpl sym) IO ()
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO ()
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
              (SimErrorReason -> IO ()) -> SimErrorReason -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError
                String
"Type mismatch in printf."
                ([String] -> String
unwords [String
"Expected void*, but got:", TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
tpr])

       Maybe (AnyValue sym)
Nothing ->
         IO () -> StateT (MemImpl sym) IO ()
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT (MemImpl sym) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> StateT (MemImpl sym) IO ())
-> IO () -> StateT (MemImpl sym) IO ()
forall a b. (a -> b) -> a -> b
$ bak -> SimErrorReason -> IO ()
forall sym bak a.
IsSymBackend sym bak =>
bak -> SimErrorReason -> IO a
addFailedAssertion bak
bak
              (SimErrorReason -> IO ()) -> SimErrorReason -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> SimErrorReason
AssertFailureSimError
                String
"Out-of-bounds argument access in printf:"
                ([String] -> String
unwords [String
"Index:", Int -> String
forall a. Show a => a -> String
show Int
i])
  }

------------------------------------------------------------------------
-- *** Math

llvmCeilOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmCeilOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmCeilOverride =
  [llvmOvr| double @ceil( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callCeil Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmCeilfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmCeilfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmCeilfOverride =
  [llvmOvr| float @ceilf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callCeil Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)


llvmFloorOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmFloorOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmFloorOverride =
  [llvmOvr| double @floor( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callFloor Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmFloorfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmFloorfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmFloorfOverride =
  [llvmOvr| float @floorf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callFloor Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

llvmFmafOverride ::
     forall sym p ext
   . IsSymInterface sym
  => LLVMOverride p sym ext
        (EmptyCtx ::> FloatType SingleFloat
                  ::> FloatType SingleFloat
                  ::> FloatType SingleFloat)
        (FloatType SingleFloat)
llvmFmafOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
   ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmFmafOverride =
  [llvmOvr| float @fmaf( float, float, float ) |]
  (\GlobalVar Mem
_memOps Assignment
  (RegEntry sym)
  (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
   ::> FloatType SingleFloat)
args -> CurryAssignment
  (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
   ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment
     (RegEntry sym)
     (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
      ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
   ::> FloatType SingleFloat)
  f
  x
-> Assignment
     f
     (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
      ::> FloatType SingleFloat)
-> x
Ctx.uncurryAssignment CurryAssignment
  (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
   ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
RegEntry sym (FloatType SingleFloat)
-> RegEntry sym (FloatType SingleFloat)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callFMA Assignment
  (RegEntry sym)
  (((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
   ::> FloatType SingleFloat)
args)

llvmFmaOverride ::
     forall sym p ext
   . IsSymInterface sym
  => LLVMOverride p sym ext
        (EmptyCtx ::> FloatType DoubleFloat
                  ::> FloatType DoubleFloat
                  ::> FloatType DoubleFloat)
        (FloatType DoubleFloat)
llvmFmaOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
   ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmFmaOverride =
  [llvmOvr| double @fma( double, double, double ) |]
  (\GlobalVar Mem
_memOps Assignment
  (RegEntry sym)
  (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
   ::> FloatType DoubleFloat)
args -> CurryAssignment
  (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
   ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment
     (RegEntry sym)
     (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
      ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
   ::> FloatType DoubleFloat)
  f
  x
-> Assignment
     f
     (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
      ::> FloatType DoubleFloat)
-> x
Ctx.uncurryAssignment CurryAssignment
  (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
   ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
RegEntry sym (FloatType DoubleFloat)
-> RegEntry sym (FloatType DoubleFloat)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callFMA Assignment
  (RegEntry sym)
  (((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
   ::> FloatType DoubleFloat)
args)


-- math.h defines isinf() and isnan() as macros, so you might think it unusual
-- to provide function overrides for them. However, if you write, say,
-- (isnan)(x) instead of isnan(x), Clang will compile the former as a direct
-- function call rather than as a macro application. Some experimentation
-- reveals that the isnan function's argument is always a double, so we give its
-- argument the type double here to match this unstated convention. We follow
-- suit similarly with isinf.
--
-- Clang does not yet provide direct function call versions of isfinite() or
-- isnormal(), so we do not provide overrides for them.

llvmIsinfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (BVType 32)
llvmIsinfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
llvmIsinfOverride =
  [llvmOvr| i32 @isinf( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (NatRepr 32
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall (fi :: FloatInfo) (w :: Natural) p sym ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, 1 <= w) =>
NatRepr w
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsinf (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

-- __isinf and __isinff are like the isinf macro, except their arguments are
-- known to be double or float, respectively. They are not mentioned in the
-- POSIX source standard, only the binary standard. See
-- http://refspecs.linux-foundation.org/LSB_4.0.0/LSB-Core-generic/LSB-Core-generic/baselib---isinf.html and
-- http://refspecs.linux-foundation.org/LSB_4.0.0/LSB-Core-generic/LSB-Core-generic/baselib---isinff.html.
llvm__isinfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (BVType 32)
llvm__isinfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
llvm__isinfOverride =
  [llvmOvr| i32 @__isinf( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (NatRepr 32
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall (fi :: FloatInfo) (w :: Natural) p sym ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, 1 <= w) =>
NatRepr w
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsinf (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvm__isinffOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (BVType 32)
llvm__isinffOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType SingleFloat) (BVType 32)
llvm__isinffOverride =
  [llvmOvr| i32 @__isinff( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (NatRepr 32
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall (fi :: FloatInfo) (w :: Natural) p sym ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, 1 <= w) =>
NatRepr w
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsinf (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

llvmIsnanOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (BVType 32)
llvmIsnanOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
llvmIsnanOverride =
  [llvmOvr| i32 @isnan( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (NatRepr 32
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall (fi :: FloatInfo) (w :: Natural) p sym ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, 1 <= w) =>
NatRepr w
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsnan (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

-- __isnan and __isnanf are like the isnan macro, except their arguments are
-- known to be double or float, respectively. They are not mentioned in the
-- POSIX source standard, only the binary standard. See
-- http://refspecs.linux-foundation.org/LSB_4.0.0/LSB-Core-generic/LSB-Core-generic/baselib---isnan.html and
-- http://refspecs.linux-foundation.org/LSB_4.0.0/LSB-Core-generic/LSB-Core-generic/baselib---isnanf.html.
llvm__isnanOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (BVType 32)
llvm__isnanOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
llvm__isnanOverride =
  [llvmOvr| i32 @__isnan( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (NatRepr 32
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall (fi :: FloatInfo) (w :: Natural) p sym ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, 1 <= w) =>
NatRepr w
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsnan (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvm__isnanfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (BVType 32)
llvm__isnanfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType SingleFloat) (BVType 32)
llvm__isnanfOverride =
  [llvmOvr| i32 @__isnanf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (NatRepr 32
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall (fi :: FloatInfo) (w :: Natural) p sym ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, 1 <= w) =>
NatRepr w
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsnan (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- macOS compiles isnan() to __isnand() when the argument is a double.
llvm__isnandOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (BVType 32)
llvm__isnandOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p sym ext (EmptyCtx ::> FloatType DoubleFloat) (BVType 32)
llvm__isnandOverride =
  [llvmOvr| i32 @__isnand( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (NatRepr 32
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall (fi :: FloatInfo) (w :: Natural) p sym ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, 1 <= w) =>
NatRepr w
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsnan (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmSqrtOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmSqrtOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmSqrtOverride =
  [llvmOvr| double @sqrt( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSqrt Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmSqrtfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmSqrtfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmSqrtfOverride =
  [llvmOvr| float @sqrtf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSqrt Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

callSpecialFunction1 ::
  forall fi p sym ext r args ret.
  (IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
  W4.SpecialFunction (EmptyCtx ::> W4.R) ->
  RegEntry sym (FloatType fi) ->
  OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 :: forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
fn (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
x) = do
  sym
sym <- OverrideSim p sym ext r args ret sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
  IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym (SymInterpretedFloatType sym fi))
 -> OverrideSim
      p
      sym
      ext
      r
      args
      ret
      (SymExpr sym (SymInterpretedFloatType sym fi)))
-> IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a b. (a -> b) -> a -> b
$ sym
-> FloatInfoRepr fi
-> SpecialFunction (EmptyCtx ::> R)
-> SymExpr sym (SymInterpretedFloatType sym fi)
-> IO (SymExpr sym (SymInterpretedFloatType sym fi))
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SpecialFunction (EmptyCtx ::> R)
-> SymInterpretedFloat sym fi
-> IO (SymInterpretedFloat sym fi)
forall (fi :: FloatInfo).
sym
-> FloatInfoRepr fi
-> SpecialFunction (EmptyCtx ::> R)
-> SymInterpretedFloat sym fi
-> IO (SymInterpretedFloat sym fi)
iFloatSpecialFunction1 sym
sym (FloatInfoRepr fi
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr :: FloatInfoRepr fi) SpecialFunction (EmptyCtx ::> R)
fn RegValue sym (FloatType fi)
SymExpr sym (SymInterpretedFloatType sym fi)
x

callSpecialFunction2 ::
  forall fi p sym ext r args ret.
  (IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
  W4.SpecialFunction (EmptyCtx ::> W4.R ::> W4.R) ->
  RegEntry sym (FloatType fi) ->
  RegEntry sym (FloatType fi) ->
  OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction2 :: forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction2 SpecialFunction ((EmptyCtx ::> R) ::> R)
fn (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
x) (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
y) = do
  sym
sym <- OverrideSim p sym ext r args ret sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
  IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym (SymInterpretedFloatType sym fi))
 -> OverrideSim
      p
      sym
      ext
      r
      args
      ret
      (SymExpr sym (SymInterpretedFloatType sym fi)))
-> IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a b. (a -> b) -> a -> b
$ sym
-> FloatInfoRepr fi
-> SpecialFunction ((EmptyCtx ::> R) ::> R)
-> SymExpr sym (SymInterpretedFloatType sym fi)
-> SymExpr sym (SymInterpretedFloatType sym fi)
-> IO (SymExpr sym (SymInterpretedFloatType sym fi))
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SpecialFunction ((EmptyCtx ::> R) ::> R)
-> SymInterpretedFloat sym fi
-> SymInterpretedFloat sym fi
-> IO (SymInterpretedFloat sym fi)
forall (fi :: FloatInfo).
sym
-> FloatInfoRepr fi
-> SpecialFunction ((EmptyCtx ::> R) ::> R)
-> SymInterpretedFloat sym fi
-> SymInterpretedFloat sym fi
-> IO (SymInterpretedFloat sym fi)
iFloatSpecialFunction2 sym
sym (FloatInfoRepr fi
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr :: FloatInfoRepr fi) SpecialFunction ((EmptyCtx ::> R) ::> R)
fn RegValue sym (FloatType fi)
SymExpr sym (SymInterpretedFloatType sym fi)
x RegValue sym (FloatType fi)
SymExpr sym (SymInterpretedFloatType sym fi)
y

callCeil ::
  forall fi p sym ext r args ret.
  IsSymInterface sym =>
  RegEntry sym (FloatType fi) ->
  OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callCeil :: forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callCeil (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
x) = do
  sym
sym <- OverrideSim p sym ext r args ret sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
  IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym (SymInterpretedFloatType sym fi))
 -> OverrideSim
      p
      sym
      ext
      r
      args
      ret
      (SymExpr sym (SymInterpretedFloatType sym fi)))
-> IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a b. (a -> b) -> a -> b
$ forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> RoundingMode
-> SymInterpretedFloat sym fi
-> IO (SymInterpretedFloat sym fi)
iFloatRound @_ @fi sym
sym RoundingMode
RTP RegValue sym (FloatType fi)
SymExpr sym (SymInterpretedFloatType sym fi)
x

callFloor ::
  forall fi p sym ext r args ret.
  IsSymInterface sym =>
  RegEntry sym (FloatType fi) ->
  OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callFloor :: forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callFloor (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
x) = do
  sym
sym <- OverrideSim p sym ext r args ret sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
  IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym (SymInterpretedFloatType sym fi))
 -> OverrideSim
      p
      sym
      ext
      r
      args
      ret
      (SymExpr sym (SymInterpretedFloatType sym fi)))
-> IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a b. (a -> b) -> a -> b
$ forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> RoundingMode
-> SymInterpretedFloat sym fi
-> IO (SymInterpretedFloat sym fi)
iFloatRound @_ @fi sym
sym RoundingMode
RTN RegValue sym (FloatType fi)
SymExpr sym (SymInterpretedFloatType sym fi)
x

-- | An implementation of @libc@'s @fma@ function.
callFMA ::
     forall fi p sym ext r args ret
   . IsSymInterface sym
  => RegEntry sym (FloatType fi)
  -> RegEntry sym (FloatType fi)
  -> RegEntry sym (FloatType fi)
  -> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callFMA :: forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callFMA (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
x) (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
y) (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
z) = do
  sym
sym <- OverrideSim p sym ext r args ret sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
  IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym (SymInterpretedFloatType sym fi))
 -> OverrideSim
      p
      sym
      ext
      r
      args
      ret
      (SymExpr sym (SymInterpretedFloatType sym fi)))
-> IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a b. (a -> b) -> a -> b
$ forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> RoundingMode
-> SymInterpretedFloat sym fi
-> SymInterpretedFloat sym fi
-> SymInterpretedFloat sym fi
-> IO (SymInterpretedFloat sym fi)
iFloatFMA @_ @fi sym
sym RoundingMode
defaultRM RegValue sym (FloatType fi)
SymExpr sym (SymInterpretedFloatType sym fi)
x RegValue sym (FloatType fi)
SymExpr sym (SymInterpretedFloatType sym fi)
y RegValue sym (FloatType fi)
SymExpr sym (SymInterpretedFloatType sym fi)
z

-- | An implementation of @libc@'s @isinf@ macro. This returns @1@ when the
-- argument is positive infinity, @-1@ when the argument is negative infinity,
-- and zero otherwise.
callIsinf ::
  forall fi w p sym ext r args ret.
  (IsSymInterface sym, 1 <= w) =>
  NatRepr w ->
  RegEntry sym (FloatType fi) ->
  OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsinf :: forall (fi :: FloatInfo) (w :: Natural) p sym ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, 1 <= w) =>
NatRepr w
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsinf NatRepr w
w (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
x) = do
  sym
sym <- OverrideSim p sym ext r args ret sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
  IO (SymExpr sym ('BaseBVType w))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym ('BaseBVType w))
 -> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w)))
-> IO (SymExpr sym ('BaseBVType w))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w))
forall a b. (a -> b) -> a -> b
$ do
    SymExpr sym BaseBoolType
isInf <- forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym -> SymInterpretedFloat sym fi -> IO (Pred sym)
iFloatIsInf @_ @fi sym
sym RegValue sym (FloatType fi)
SymInterpretedFloat sym fi
x
    SymExpr sym BaseBoolType
isNeg <- forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym -> SymInterpretedFloat sym fi -> IO (Pred sym)
iFloatIsNeg @_ @fi sym
sym RegValue sym (FloatType fi)
SymInterpretedFloat sym fi
x
    SymExpr sym BaseBoolType
isPos <- forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym -> SymInterpretedFloat sym fi -> IO (Pred sym)
iFloatIsPos @_ @fi sym
sym RegValue sym (FloatType fi)
SymInterpretedFloat sym fi
x
    SymExpr sym BaseBoolType
isInfN <- sym
-> SymExpr sym BaseBoolType
-> SymExpr sym BaseBoolType
-> IO (SymExpr sym BaseBoolType)
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred sym
sym SymExpr sym BaseBoolType
isInf SymExpr sym BaseBoolType
isNeg
    SymExpr sym BaseBoolType
isInfP <- sym
-> SymExpr sym BaseBoolType
-> SymExpr sym BaseBoolType
-> IO (SymExpr sym BaseBoolType)
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred sym
sym SymExpr sym BaseBoolType
isInf SymExpr sym BaseBoolType
isPos
    SymExpr sym ('BaseBVType w)
bv1 <- sym -> NatRepr w -> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvOne sym
sym NatRepr w
w
    SymExpr sym ('BaseBVType w)
bvNeg1 <- sym
-> SymExpr sym ('BaseBVType w) -> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
sym -> SymBV sym w -> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymBV sym w)
bvNeg sym
sym SymExpr sym ('BaseBVType w)
bv1
    SymExpr sym ('BaseBVType w)
bv0 <- sym -> NatRepr w -> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero sym
sym NatRepr w
w
    SymExpr sym ('BaseBVType w)
res0 <- sym
-> SymExpr sym BaseBoolType
-> SymExpr sym ('BaseBVType w)
-> SymExpr sym ('BaseBVType w)
-> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
sym
-> SymExpr sym BaseBoolType
-> SymBV sym w
-> SymBV sym w
-> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte sym
sym SymExpr sym BaseBoolType
isInfP SymExpr sym ('BaseBVType w)
bv1 SymExpr sym ('BaseBVType w)
bv0
    sym
-> SymExpr sym BaseBoolType
-> SymExpr sym ('BaseBVType w)
-> SymExpr sym ('BaseBVType w)
-> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
sym
-> SymExpr sym BaseBoolType
-> SymBV sym w
-> SymBV sym w
-> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte sym
sym SymExpr sym BaseBoolType
isInfN SymExpr sym ('BaseBVType w)
bvNeg1 SymExpr sym ('BaseBVType w)
res0

callIsnan ::
  forall fi w p sym ext r args ret.
  (IsSymInterface sym, 1 <= w) =>
  NatRepr w ->
  RegEntry sym (FloatType fi) ->
  OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsnan :: forall (fi :: FloatInfo) (w :: Natural) p sym ext r
       (args :: Ctx CrucibleType) (ret :: CrucibleType).
(IsSymInterface sym, 1 <= w) =>
NatRepr w
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callIsnan NatRepr w
w (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
x) = do
  sym
sym <- OverrideSim p sym ext r args ret sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
  IO (SymExpr sym ('BaseBVType w))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym ('BaseBVType w))
 -> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w)))
-> IO (SymExpr sym ('BaseBVType w))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w))
forall a b. (a -> b) -> a -> b
$ do
    SymExpr sym BaseBoolType
isnan  <- forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym -> SymInterpretedFloat sym fi -> IO (Pred sym)
iFloatIsNaN @_ @fi sym
sym RegValue sym (FloatType fi)
SymInterpretedFloat sym fi
x
    SymExpr sym ('BaseBVType w)
bv1 <- sym -> NatRepr w -> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvOne sym
sym NatRepr w
w
    SymExpr sym ('BaseBVType w)
bv0 <- sym -> NatRepr w -> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero sym
sym NatRepr w
w
    -- isnan() is allowed to return any nonzero value if the argument is NaN, and
    -- out of all the possible nonzero values, `1` is certainly one of them.
    sym
-> SymExpr sym BaseBoolType
-> SymExpr sym ('BaseBVType w)
-> SymExpr sym ('BaseBVType w)
-> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
sym
-> SymExpr sym BaseBoolType
-> SymBV sym w
-> SymBV sym w
-> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte sym
sym SymExpr sym BaseBoolType
isnan SymExpr sym ('BaseBVType w)
bv1 SymExpr sym ('BaseBVType w)
bv0

callSqrt ::
  forall fi p sym ext r args ret.
  IsSymInterface sym =>
  RegEntry sym (FloatType fi) ->
  OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSqrt :: forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
IsSymInterface sym =>
RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSqrt (RegEntry sym (FloatType fi) -> RegValue sym (FloatType fi)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (FloatType fi)
x) = do
  sym
sym <- OverrideSim p sym ext r args ret sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
  IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym (SymInterpretedFloatType sym fi))
 -> OverrideSim
      p
      sym
      ext
      r
      args
      ret
      (SymExpr sym (SymInterpretedFloatType sym fi)))
-> IO (SymExpr sym (SymInterpretedFloatType sym fi))
-> OverrideSim
     p sym ext r args ret (SymExpr sym (SymInterpretedFloatType sym fi))
forall a b. (a -> b) -> a -> b
$ forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> RoundingMode
-> SymInterpretedFloat sym fi
-> IO (SymInterpretedFloat sym fi)
iFloatSqrt @_ @fi sym
sym RoundingMode
defaultRM RegValue sym (FloatType fi)
SymExpr sym (SymInterpretedFloatType sym fi)
x

------------------------------------------------------------------------
-- **** Circular trigonometry functions

-- sin(f)

llvmSinOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmSinOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmSinOverride =
  [llvmOvr| double @sin( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Sin) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmSinfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmSinfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmSinfOverride =
  [llvmOvr| float @sinf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Sin) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- cos(f)

llvmCosOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmCosOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmCosOverride =
  [llvmOvr| double @cos( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Cos) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmCosfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmCosfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmCosfOverride =
  [llvmOvr| float @cosf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Cos) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- tan(f)

llvmTanOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmTanOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmTanOverride =
  [llvmOvr| double @tan( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Tan) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmTanfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmTanfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmTanfOverride =
  [llvmOvr| float @tanf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Tan) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- asin(f)

llvmAsinOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmAsinOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAsinOverride =
  [llvmOvr| double @asin( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arcsin) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmAsinfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmAsinfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAsinfOverride =
  [llvmOvr| float @asinf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arcsin) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- acos(f)

llvmAcosOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmAcosOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAcosOverride =
  [llvmOvr| double @acos( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arccos) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmAcosfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmAcosfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAcosfOverride =
  [llvmOvr| float @acosf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arccos) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- atan(f)

llvmAtanOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmAtanOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAtanOverride =
  [llvmOvr| double @atan( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arctan) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmAtanfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmAtanfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAtanfOverride =
  [llvmOvr| float @atanf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arctan) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

------------------------------------------------------------------------
-- **** Hyperbolic trigonometry functions

-- sinh(f)

llvmSinhOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmSinhOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmSinhOverride =
  [llvmOvr| double @sinh( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Sinh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmSinhfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmSinhfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmSinhfOverride =
  [llvmOvr| float @sinhf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Sinh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- cosh(f)

llvmCoshOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmCoshOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmCoshOverride =
  [llvmOvr| double @cosh( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Cosh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmCoshfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmCoshfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmCoshfOverride =
  [llvmOvr| float @coshf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Cosh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- tanh(f)

llvmTanhOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmTanhOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmTanhOverride =
  [llvmOvr| double @tanh( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Tanh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmTanhfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmTanhfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmTanhfOverride =
  [llvmOvr| float @tanhf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Tanh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- asinh(f)

llvmAsinhOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmAsinhOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAsinhOverride =
  [llvmOvr| double @asinh( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arcsinh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmAsinhfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmAsinhfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAsinhfOverride =
  [llvmOvr| float @asinhf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arcsinh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- acosh(f)

llvmAcoshOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmAcoshOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAcoshOverride =
  [llvmOvr| double @acosh( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arccosh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmAcoshfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmAcoshfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAcoshfOverride =
  [llvmOvr| float @acoshf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arccosh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- atanh(f)

llvmAtanhOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmAtanhOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAtanhOverride =
  [llvmOvr| double @atanh( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arctanh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmAtanhfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmAtanhfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAtanhfOverride =
  [llvmOvr| float @atanhf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Arctanh) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

------------------------------------------------------------------------
-- **** Rectangular to polar coordinate conversion

-- hypot(f)

llvmHypotOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmHypotOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmHypotOverride =
  [llvmOvr| double @hypot( double, double ) |]
  (\GlobalVar Mem
_memOps Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
args -> CurryAssignment
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment
     (RegEntry sym)
     ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  f
  x
-> Assignment
     f ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
-> x
Ctx.uncurryAssignment (SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction2 SpecialFunction ((EmptyCtx ::> R) ::> R)
W4.Hypot) Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
args)

llvmHypotfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmHypotfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmHypotfOverride =
  [llvmOvr| float @hypotf( float, float ) |]
  (\GlobalVar Mem
_memOps Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
args -> CurryAssignment
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment
     (RegEntry sym)
     ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  f
  x
-> Assignment
     f ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
-> x
Ctx.uncurryAssignment (SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction2 SpecialFunction ((EmptyCtx ::> R) ::> R)
W4.Hypot) Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
args)

-- atan2(f)

llvmAtan2Override ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmAtan2Override :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmAtan2Override =
  [llvmOvr| double @atan2( double, double ) |]
  (\GlobalVar Mem
_memOps Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
args -> CurryAssignment
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment
     (RegEntry sym)
     ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  f
  x
-> Assignment
     f ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
-> x
Ctx.uncurryAssignment (SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction2 SpecialFunction ((EmptyCtx ::> R) ::> R)
W4.Arctan2) Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
args)

llvmAtan2fOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmAtan2fOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmAtan2fOverride =
  [llvmOvr| float @atan2f( float, float ) |]
  (\GlobalVar Mem
_memOps Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
args -> CurryAssignment
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment
     (RegEntry sym)
     ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  f
  x
-> Assignment
     f ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
-> x
Ctx.uncurryAssignment (SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction2 SpecialFunction ((EmptyCtx ::> R) ::> R)
W4.Arctan2) Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
args)

------------------------------------------------------------------------
-- **** Exponential and logarithm functions

-- pow(f)

llvmPowfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmPowfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmPowfOverride =
  [llvmOvr| float @powf( float, float ) |]
  (\GlobalVar Mem
_memOps Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
args -> CurryAssignment
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment
     (RegEntry sym)
     ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
  f
  x
-> Assignment
     f ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
-> x
Ctx.uncurryAssignment (SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction2 SpecialFunction ((EmptyCtx ::> R) ::> R)
W4.Pow) Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType SingleFloat) ::> FloatType SingleFloat)
args)

llvmPowOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmPowOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmPowOverride =
  [llvmOvr| double @pow( double, double ) |]
  (\GlobalVar Mem
_memOps Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
args -> CurryAssignment
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment
     (RegEntry sym)
     ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
  f
  x
-> Assignment
     f ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
-> x
Ctx.uncurryAssignment (SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction ((EmptyCtx ::> R) ::> R)
-> RegEntry sym (FloatType fi)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction2 SpecialFunction ((EmptyCtx ::> R) ::> R)
W4.Pow) Assignment
  (RegEntry sym)
  ((EmptyCtx ::> FloatType DoubleFloat) ::> FloatType DoubleFloat)
args)

-- exp(f)

llvmExpOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmExpOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmExpOverride =
  [llvmOvr| double @exp( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Exp) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmExpfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmExpfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmExpfOverride =
  [llvmOvr| float @expf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Exp) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- log(f)

llvmLogOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmLogOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmLogOverride =
  [llvmOvr| double @log( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Log) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmLogfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmLogfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmLogfOverride =
  [llvmOvr| float @logf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Log) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- expm1(f)

llvmExpm1Override ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmExpm1Override :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmExpm1Override =
  [llvmOvr| double @expm1( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Expm1) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmExpm1fOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmExpm1fOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmExpm1fOverride =
  [llvmOvr| float @expm1f( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Expm1) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- log1p(f)

llvmLog1pOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmLog1pOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmLog1pOverride =
  [llvmOvr| double @log1p( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Log1p) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmLog1pfOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmLog1pfOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmLog1pfOverride =
  [llvmOvr| float @log1pf( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Log1p) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

------------------------------------------------------------------------
-- **** Base 2 exponential and logarithm

-- exp2(f)

llvmExp2Override ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmExp2Override :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmExp2Override =
  [llvmOvr| double @exp2( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Exp2) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmExp2fOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmExp2fOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmExp2fOverride =
  [llvmOvr| float @exp2f( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Exp2) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- log2(f)

llvmLog2Override ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmLog2Override :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmLog2Override =
  [llvmOvr| double @log2( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Log2) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmLog2fOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmLog2fOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmLog2fOverride =
  [llvmOvr| float @log2f( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Log2) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

------------------------------------------------------------------------
-- **** Base 10 exponential and logarithm

-- exp10(f)

llvmExp10Override ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmExp10Override :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmExp10Override =
  [llvmOvr| double @exp10( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Exp10) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmExp10fOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmExp10fOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmExp10fOverride =
  [llvmOvr| float @exp10f( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Exp10) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- macOS uses __exp10(f) instead of exp10(f).

llvm__exp10Override ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvm__exp10Override :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvm__exp10Override =
  [llvmOvr| double @__exp10( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Exp10) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvm__exp10fOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvm__exp10fOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvm__exp10fOverride =
  [llvmOvr| float @__exp10f( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Exp10) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

-- log10(f)

llvmLog10Override ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType DoubleFloat)
     (FloatType DoubleFloat)
llvmLog10Override :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType DoubleFloat)
  (FloatType DoubleFloat)
llvmLog10Override =
  [llvmOvr| double @log10( double ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType DoubleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType DoubleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType DoubleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType DoubleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType DoubleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Log10) Assignment (RegEntry sym) (EmptyCtx ::> FloatType DoubleFloat)
args)

llvmLog10fOverride ::
  IsSymInterface sym =>
  LLVMOverride p sym ext
     (EmptyCtx ::> FloatType SingleFloat)
     (FloatType SingleFloat)
llvmLog10fOverride :: forall sym p ext.
IsSymInterface sym =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> FloatType SingleFloat)
  (FloatType SingleFloat)
llvmLog10fOverride =
  [llvmOvr| float @log10f( float ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args -> CurryAssignment
  (EmptyCtx ::> FloatType SingleFloat)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat)))
-> Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> FloatType SingleFloat) f x
-> Assignment f (EmptyCtx ::> FloatType SingleFloat) -> x
Ctx.uncurryAssignment (SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType SingleFloat)
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (FloatType SingleFloat))
forall (fi :: FloatInfo) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, KnownRepr FloatInfoRepr fi) =>
SpecialFunction (EmptyCtx ::> R)
-> RegEntry sym (FloatType fi)
-> OverrideSim p sym ext r args ret (RegValue sym (FloatType fi))
callSpecialFunction1 SpecialFunction (EmptyCtx ::> R)
W4.Log10) Assignment (RegEntry sym) (EmptyCtx ::> FloatType SingleFloat)
args)

------------------------------------------------------------------------
-- *** Other

-- from OSX libc
llvmAssertRtnOverride
  :: ( IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym
     , ?intrinsicsOpts :: IntrinsicsOptions, ?memOpts :: MemOptions )
  => LLVMOverride p sym ext
        (EmptyCtx ::> LLVMPointerType wptr
                  ::> LLVMPointerType wptr
                  ::> BVType 32
                  ::> LLVMPointerType wptr)
        UnitType
llvmAssertRtnOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?intrinsicsOpts::IntrinsicsOptions, ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType 32)
   ::> LLVMPointerType wptr)
  UnitType
llvmAssertRtnOverride =
  [llvmOvr| void @__assert_rtn( i8*, i8*, i32, i8* ) |]
  IsSymInterface sym =>
GlobalVar Mem
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType 32)
      ::> LLVMPointerType wptr)
-> forall rtp (args' :: Ctx CrucibleType) (ret' :: CrucibleType).
   OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
GlobalVar Mem
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType 32)
      ::> LLVMPointerType wptr)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
GlobalVar Mem
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType 32)
      ::> LLVMPointerType wptr)
-> forall rtp (args' :: Ctx CrucibleType) (ret' :: CrucibleType).
   OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?intrinsicsOpts::IntrinsicsOptions, ?memOpts::MemOptions) =>
GlobalVar Mem
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType 32)
      ::> LLVMPointerType wptr)
-> forall r (args :: Ctx CrucibleType) (reg :: CrucibleType).
   OverrideSim p sym ext r args reg (RegValue sym UnitType)
callAssert

-- From glibc
llvmAssertFailOverride
  :: ( IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym
     , ?intrinsicsOpts :: IntrinsicsOptions, ?memOpts :: MemOptions )
  => LLVMOverride p sym ext
        (EmptyCtx ::> LLVMPointerType wptr
                  ::> LLVMPointerType wptr
                  ::> BVType 32
                  ::> LLVMPointerType wptr)
        UnitType
llvmAssertFailOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?intrinsicsOpts::IntrinsicsOptions, ?memOpts::MemOptions) =>
LLVMOverride
  p
  sym
  ext
  ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
    ::> BVType 32)
   ::> LLVMPointerType wptr)
  UnitType
llvmAssertFailOverride =
  [llvmOvr| void @__assert_fail( i8*, i8*, i32, i8* ) |]
  IsSymInterface sym =>
GlobalVar Mem
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType 32)
      ::> LLVMPointerType wptr)
-> forall rtp (args' :: Ctx CrucibleType) (ret' :: CrucibleType).
   OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
GlobalVar Mem
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType 32)
      ::> LLVMPointerType wptr)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
GlobalVar Mem
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType 32)
      ::> LLVMPointerType wptr)
-> forall rtp (args' :: Ctx CrucibleType) (ret' :: CrucibleType).
   OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr, HasLLVMAnn sym,
 ?intrinsicsOpts::IntrinsicsOptions, ?memOpts::MemOptions) =>
GlobalVar Mem
-> Assignment
     (RegEntry sym)
     ((((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
       ::> BVType 32)
      ::> LLVMPointerType wptr)
-> forall r (args :: Ctx CrucibleType) (reg :: CrucibleType).
   OverrideSim p sym ext r args reg (RegValue sym UnitType)
callAssert


llvmAbortOverride
  :: ( IsSymInterface sym
     , ?intrinsicsOpts :: IntrinsicsOptions )
  => LLVMOverride p sym ext EmptyCtx UnitType
llvmAbortOverride :: forall sym p ext.
(IsSymInterface sym, ?intrinsicsOpts::IntrinsicsOptions) =>
LLVMOverride p sym ext EmptyCtx UnitType
llvmAbortOverride =
  [llvmOvr| void @abort() |]
  (\GlobalVar Mem
_ Assignment (RegEntry sym) EmptyCtx
_args ->
     (forall bak.
 IsSymBackend sym bak =>
 bak
 -> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType))
-> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak
  -> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType))
 -> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType))
-> (forall bak.
    IsSymBackend sym bak =>
    bak
    -> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType))
-> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
forall a b. (a -> b) -> a -> b
$ \bak
bak -> IO (RegValue sym UnitType)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
forall a. IO a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (RegValue sym UnitType)
 -> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType))
-> IO (RegValue sym UnitType)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
forall a b. (a -> b) -> a -> b
$ do 
       let sym :: sym
sym = bak -> sym
forall sym bak. HasSymInterface sym bak => bak -> sym
backendGetSym bak
bak
       Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (IntrinsicsOptions -> AbnormalExitBehavior
abnormalExitBehavior ?intrinsicsOpts::IntrinsicsOptions
IntrinsicsOptions
?intrinsicsOpts AbnormalExitBehavior -> AbnormalExitBehavior -> Bool
forall a. Eq a => a -> a -> Bool
== AbnormalExitBehavior
AlwaysFail) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
           let err :: SimErrorReason
err = String -> String -> SimErrorReason
AssertFailureSimError String
"Call to abort" String
"" in
           bak -> Pred sym -> SimErrorReason -> IO ()
forall sym bak.
IsSymBackend sym bak =>
bak -> Pred sym -> SimErrorReason -> IO ()
assert bak
bak (sym -> Pred sym
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred sym
sym) SimErrorReason
err
       ProgramLoc
loc <- sym -> IO ProgramLoc
forall sym. IsExprBuilder sym => sym -> IO ProgramLoc
getCurrentProgramLoc sym
sym
       AbortExecReason -> IO ()
forall a. AbortExecReason -> IO a
abortExecBecause (AbortExecReason -> IO ()) -> AbortExecReason -> IO ()
forall a b. (a -> b) -> a -> b
$ ProgramLoc -> AbortExecReason
EarlyExit ProgramLoc
loc
  )

llvmExitOverride
  :: forall sym p ext
   . ( IsSymInterface sym
     , ?intrinsicsOpts :: IntrinsicsOptions )
  => LLVMOverride p sym ext
         (EmptyCtx ::> BVType 32)
         UnitType
llvmExitOverride :: forall sym p ext.
(IsSymInterface sym, ?intrinsicsOpts::IntrinsicsOptions) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) UnitType
llvmExitOverride =
  [llvmOvr| void @exit( i32 ) |]
  (\GlobalVar Mem
_ Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args -> CurryAssignment
  (EmptyCtx ::> BVType 32)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType 32) f x
-> Assignment f (EmptyCtx ::> BVType 32) -> x
Ctx.uncurryAssignment CurryAssignment
  (EmptyCtx ::> BVType 32)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType))
RegEntry sym (BVType 32)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym UnitType)
forall sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(IsSymInterface sym, ?intrinsicsOpts::IntrinsicsOptions) =>
RegEntry sym (BVType 32)
-> OverrideSim p sym ext r args ret (RegValue sym UnitType)
callExit Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args)

llvmGetenvOverride
  :: (IsSymInterface sym, HasPtrWidth wptr)
  => LLVMOverride p sym ext
        (EmptyCtx ::> LLVMPointerType wptr)
        (LLVMPointerType wptr)
llvmGetenvOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr) =>
LLVMOverride
  p
  sym
  ext
  (EmptyCtx ::> LLVMPointerType wptr)
  (LLVMPointerType wptr)
llvmGetenvOverride =
  [llvmOvr| i8* @getenv( i8* ) |]
  (\GlobalVar Mem
_ Assignment (RegEntry sym) (EmptyCtx ::> LLVMPointerType wptr)
_args -> do
    sym
sym <- OverrideSim p sym ext rtp args' ret' sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
    IO (LLVMPointer sym wptr)
-> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr)
forall a. IO a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (LLVMPointer sym wptr)
 -> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr))
-> IO (LLVMPointer sym wptr)
-> OverrideSim p sym ext rtp args' ret' (LLVMPointer sym wptr)
forall a b. (a -> b) -> a -> b
$ sym -> NatRepr wptr -> IO (RegValue sym (LLVMPointerType wptr))
forall (w :: Natural) sym.
(1 <= w, IsSymInterface sym) =>
sym -> NatRepr w -> IO (LLVMPtr sym w)
mkNullPointer sym
sym NatRepr wptr
forall (w :: Natural) (w' :: Natural).
(HasPtrWidth w, w ~ w') =>
NatRepr w'
PtrWidth)

llvmHtonlOverride ::
  (IsSymInterface sym, ?lc :: TypeContext) =>
  LLVMOverride p sym ext
      (EmptyCtx ::> BVType 32)
      (BVType 32)
llvmHtonlOverride :: forall sym p ext.
(IsSymInterface sym, ?lc::TypeContext) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmHtonlOverride =
  [llvmOvr| i32 @htonl( i32 ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args -> CurryAssignment
  (EmptyCtx ::> BVType 32)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType 32) f x
-> Assignment f (EmptyCtx ::> BVType 32) -> x
Ctx.uncurryAssignment (NatRepr 4
-> RegEntry sym (BVType (4 * 8))
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (BVType (4 * 8)))
forall (width :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= width, IsSymInterface sym, ?lc::TypeContext) =>
NatRepr width
-> RegEntry sym (BVType (width * 8))
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType (width * 8)))
callBSwapIfLittleEndian (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @4)) Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args)

llvmHtonsOverride ::
  (IsSymInterface sym, ?lc :: TypeContext) =>
  LLVMOverride p sym ext
      (EmptyCtx ::> BVType 16)
      (BVType 16)
llvmHtonsOverride :: forall sym p ext.
(IsSymInterface sym, ?lc::TypeContext) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 16) (BVType 16)
llvmHtonsOverride =
  [llvmOvr| i16 @htons( i16 ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> BVType 16)
args -> CurryAssignment
  (EmptyCtx ::> BVType 16)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 16)))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType 16)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 16))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType 16) f x
-> Assignment f (EmptyCtx ::> BVType 16) -> x
Ctx.uncurryAssignment (NatRepr 2
-> RegEntry sym (BVType (2 * 8))
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (BVType (2 * 8)))
forall (width :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= width, IsSymInterface sym, ?lc::TypeContext) =>
NatRepr width
-> RegEntry sym (BVType (width * 8))
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType (width * 8)))
callBSwapIfLittleEndian (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @2)) Assignment (RegEntry sym) (EmptyCtx ::> BVType 16)
args)

llvmNtohlOverride ::
  (IsSymInterface sym, ?lc :: TypeContext) =>
  LLVMOverride p sym ext
      (EmptyCtx ::> BVType 32)
      (BVType 32)
llvmNtohlOverride :: forall sym p ext.
(IsSymInterface sym, ?lc::TypeContext) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmNtohlOverride =
  [llvmOvr| i32 @ntohl( i32 ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args -> CurryAssignment
  (EmptyCtx ::> BVType 32)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType 32) f x
-> Assignment f (EmptyCtx ::> BVType 32) -> x
Ctx.uncurryAssignment (NatRepr 4
-> RegEntry sym (BVType (4 * 8))
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (BVType (4 * 8)))
forall (width :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= width, IsSymInterface sym, ?lc::TypeContext) =>
NatRepr width
-> RegEntry sym (BVType (width * 8))
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType (width * 8)))
callBSwapIfLittleEndian (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @4)) Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args)

llvmNtohsOverride ::
  (IsSymInterface sym, ?lc :: TypeContext) =>
  LLVMOverride p sym ext
      (EmptyCtx ::> BVType 16)
      (BVType 16)
llvmNtohsOverride :: forall sym p ext.
(IsSymInterface sym, ?lc::TypeContext) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 16) (BVType 16)
llvmNtohsOverride =
  [llvmOvr| i16 @ntohs( i16 ) |]
  (\GlobalVar Mem
_memOps Assignment (RegEntry sym) (EmptyCtx ::> BVType 16)
args -> CurryAssignment
  (EmptyCtx ::> BVType 16)
  (RegEntry sym)
  (OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 16)))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType 16)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 16))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType 16) f x
-> Assignment f (EmptyCtx ::> BVType 16) -> x
Ctx.uncurryAssignment (NatRepr 2
-> RegEntry sym (BVType (2 * 8))
-> OverrideSim
     p sym ext rtp args' ret' (RegValue sym (BVType (2 * 8)))
forall (width :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= width, IsSymInterface sym, ?lc::TypeContext) =>
NatRepr width
-> RegEntry sym (BVType (width * 8))
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType (width * 8)))
callBSwapIfLittleEndian (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @2)) Assignment (RegEntry sym) (EmptyCtx ::> BVType 16)
args)

llvmAbsOverride ::
  (IsSymInterface sym, HasLLVMAnn sym) =>
  LLVMOverride p sym ext
      (EmptyCtx ::> BVType 32)
      (BVType 32)
llvmAbsOverride :: forall sym p ext.
(IsSymInterface sym, HasLLVMAnn sym) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmAbsOverride =
  [llvmOvr| i32 @abs( i32 ) |]
  (\GlobalVar Mem
mvar Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args ->
     do CallStack
callStack <- GlobalVar Mem -> OverrideSim p sym ext rtp args' ret' CallStack
forall p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
GlobalVar Mem -> OverrideSim p sym ext r args ret CallStack
callStackFromMemVar' GlobalVar Mem
mvar
        CurryAssignment
  (EmptyCtx ::> BVType 32)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (SymExpr sym ('BaseBVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
-> OverrideSim
     p sym ext rtp args' ret' (SymExpr sym ('BaseBVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType 32) f x
-> Assignment f (EmptyCtx ::> BVType 32) -> x
Ctx.uncurryAssignment (CallStack
-> NatRepr 32
-> RegEntry sym (BVType 32)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall (w :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
CallStack
-> NatRepr w
-> RegEntry sym (BVType w)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callLibcAbs CallStack
callStack (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)) Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args)

-- @labs@ uses `long` as its argument and result type, so we need two overrides
-- for @labs@. See Note [Overrides involving (unsigned) long] in
-- Lang.Crucible.LLVM.Intrinsics.
llvmLAbsOverride_32 ::
  (IsSymInterface sym, HasLLVMAnn sym) =>
  LLVMOverride p sym ext
      (EmptyCtx ::> BVType 32)
      (BVType 32)
llvmLAbsOverride_32 :: forall sym p ext.
(IsSymInterface sym, HasLLVMAnn sym) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 32) (BVType 32)
llvmLAbsOverride_32 =
  [llvmOvr| i32 @labs( i32 ) |]
  (\GlobalVar Mem
mvar Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args ->
     do CallStack
callStack <- GlobalVar Mem -> OverrideSim p sym ext rtp args' ret' CallStack
forall p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
GlobalVar Mem -> OverrideSim p sym ext r args ret CallStack
callStackFromMemVar' GlobalVar Mem
mvar
        CurryAssignment
  (EmptyCtx ::> BVType 32)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (SymExpr sym ('BaseBVType 32)))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
-> OverrideSim
     p sym ext rtp args' ret' (SymExpr sym ('BaseBVType 32))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType 32) f x
-> Assignment f (EmptyCtx ::> BVType 32) -> x
Ctx.uncurryAssignment (CallStack
-> NatRepr 32
-> RegEntry sym (BVType 32)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 32))
forall (w :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
CallStack
-> NatRepr w
-> RegEntry sym (BVType w)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callLibcAbs CallStack
callStack (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @32)) Assignment (RegEntry sym) (EmptyCtx ::> BVType 32)
args)

llvmLAbsOverride_64 ::
  (IsSymInterface sym, HasLLVMAnn sym) =>
  LLVMOverride p sym ext
      (EmptyCtx ::> BVType 64)
      (BVType 64)
llvmLAbsOverride_64 :: forall sym p ext.
(IsSymInterface sym, HasLLVMAnn sym) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 64) (BVType 64)
llvmLAbsOverride_64 =
  [llvmOvr| i64 @labs( i64 ) |]
  (\GlobalVar Mem
mvar Assignment (RegEntry sym) (EmptyCtx ::> BVType 64)
args ->
     do CallStack
callStack <- GlobalVar Mem -> OverrideSim p sym ext rtp args' ret' CallStack
forall p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
GlobalVar Mem -> OverrideSim p sym ext r args ret CallStack
callStackFromMemVar' GlobalVar Mem
mvar
        CurryAssignment
  (EmptyCtx ::> BVType 64)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (SymExpr sym (BaseBVType 64)))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType 64)
-> OverrideSim
     p sym ext rtp args' ret' (SymExpr sym (BaseBVType 64))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType 64) f x
-> Assignment f (EmptyCtx ::> BVType 64) -> x
Ctx.uncurryAssignment (CallStack
-> NatRepr 64
-> RegEntry sym (BVType 64)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 64))
forall (w :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
CallStack
-> NatRepr w
-> RegEntry sym (BVType w)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callLibcAbs CallStack
callStack (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @64)) Assignment (RegEntry sym) (EmptyCtx ::> BVType 64)
args)

llvmLLAbsOverride ::
  (IsSymInterface sym, HasLLVMAnn sym) =>
  LLVMOverride p sym ext
      (EmptyCtx ::> BVType 64)
      (BVType 64)
llvmLLAbsOverride :: forall sym p ext.
(IsSymInterface sym, HasLLVMAnn sym) =>
LLVMOverride p sym ext (EmptyCtx ::> BVType 64) (BVType 64)
llvmLLAbsOverride =
  [llvmOvr| i64 @llabs( i64 ) |]
  (\GlobalVar Mem
mvar Assignment (RegEntry sym) (EmptyCtx ::> BVType 64)
args ->
     do CallStack
callStack <- GlobalVar Mem -> OverrideSim p sym ext rtp args' ret' CallStack
forall p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
GlobalVar Mem -> OverrideSim p sym ext r args ret CallStack
callStackFromMemVar' GlobalVar Mem
mvar
        CurryAssignment
  (EmptyCtx ::> BVType 64)
  (RegEntry sym)
  (OverrideSim
     p sym ext rtp args' ret' (SymExpr sym (BaseBVType 64)))
-> Assignment (RegEntry sym) (EmptyCtx ::> BVType 64)
-> OverrideSim
     p sym ext rtp args' ret' (SymExpr sym (BaseBVType 64))
forall k (ctx :: Ctx k) (f :: k -> Type) x.
CurryAssignmentClass ctx =>
CurryAssignment ctx f x -> Assignment f ctx -> x
forall (f :: CrucibleType -> Type) x.
CurryAssignment (EmptyCtx ::> BVType 64) f x
-> Assignment f (EmptyCtx ::> BVType 64) -> x
Ctx.uncurryAssignment (CallStack
-> NatRepr 64
-> RegEntry sym (BVType 64)
-> OverrideSim p sym ext rtp args' ret' (RegValue sym (BVType 64))
forall (w :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
CallStack
-> NatRepr w
-> RegEntry sym (BVType w)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callLibcAbs CallStack
callStack (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @64)) Assignment (RegEntry sym) (EmptyCtx ::> BVType 64)
args)

callBSwap ::
  (1 <= width, IsSymInterface sym) =>
  NatRepr width ->
  RegEntry sym (BVType (width * 8)) ->
  OverrideSim p sym ext r args ret (RegValue sym (BVType (width * 8)))
callBSwap :: forall (width :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= width, IsSymInterface sym) =>
NatRepr width
-> RegEntry sym (BVType (width * 8))
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType (width * 8)))
callBSwap NatRepr width
widthRepr (RegEntry sym (BVType (width * 8))
-> RegValue sym (BVType (width * 8))
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType (width * 8))
vec) = do
  sym
sym <- OverrideSim p sym ext r args ret sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
  IO (SymExpr sym ('BaseBVType (width * 8)))
-> OverrideSim
     p sym ext r args ret (SymExpr sym ('BaseBVType (width * 8)))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym ('BaseBVType (width * 8)))
 -> OverrideSim
      p sym ext r args ret (SymExpr sym ('BaseBVType (width * 8))))
-> IO (SymExpr sym ('BaseBVType (width * 8)))
-> OverrideSim
     p sym ext r args ret (SymExpr sym ('BaseBVType (width * 8)))
forall a b. (a -> b) -> a -> b
$ sym
-> NatRepr width
-> SymExpr sym ('BaseBVType (width * 8))
-> IO (SymExpr sym ('BaseBVType (width * 8)))
forall sym (n :: Natural).
(1 <= n, IsExprBuilder sym) =>
sym -> NatRepr n -> SymBV sym (n * 8) -> IO (SymBV sym (n * 8))
bvSwap sym
sym NatRepr width
widthRepr RegValue sym (BVType (width * 8))
SymExpr sym ('BaseBVType (width * 8))
vec

-- | This determines under what circumstances @callAbs@ should check if its
-- argument is equal to the smallest signed integer of a particular size
-- (e.g., @INT_MIN@), and if it is equal to that value, what kind of error
-- should be reported.
data CheckAbsIntMin
  = LibcAbsIntMinUB
    -- ^ For the @abs@, @labs@, and @llabs@ functions, always check if the
    --   argument is equal to @INT_MIN@. If so, report it as undefined
    --   behavior per the C standard.
  | LLVMAbsIntMinPoison Bool
    -- ^ For the @llvm.abs.*@ family of LLVM intrinsics, check if the argument
    --   is equal to @INT_MIN@ only when the 'Bool' argument is 'True'. If it
    --   is 'True' and the argument is equal to @INT_MIN@, return poison.

-- | The workhorse for the @abs@, @labs@, and @llabs@ functions, as well as the
-- @llvm.abs.*@ family of overloaded intrinsics.
callAbs ::
  forall w p sym ext r args ret.
  (1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
  CallStack ->
  CheckAbsIntMin ->
  NatRepr w ->
  RegEntry sym (BVType w) ->
  OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callAbs :: forall (w :: Natural) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
CallStack
-> CheckAbsIntMin
-> NatRepr w
-> RegEntry sym (BVType w)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callAbs CallStack
callStack CheckAbsIntMin
checkIntMin NatRepr w
widthRepr (RegEntry sym (BVType w) -> RegValue sym (BVType w)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType w)
src) = do
  sym
sym <- OverrideSim p sym ext r args ret sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
  (forall bak.
 IsSymBackend sym bak =>
 bak
 -> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w)))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w))
forall sym p ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType) a.
(forall bak.
 IsSymBackend sym bak =>
 bak -> OverrideSim p sym ext rtp args ret a)
-> OverrideSim p sym ext rtp args ret a
ovrWithBackend ((forall bak.
  IsSymBackend sym bak =>
  bak
  -> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w)))
 -> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w)))
-> (forall bak.
    IsSymBackend sym bak =>
    bak
    -> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w)))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w))
forall a b. (a -> b) -> a -> b
$ \bak
bak -> IO (SymExpr sym ('BaseBVType w))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w))
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym ('BaseBVType w))
 -> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w)))
-> IO (SymExpr sym ('BaseBVType w))
-> OverrideSim p sym ext r args ret (SymExpr sym ('BaseBVType w))
forall a b. (a -> b) -> a -> b
$ do
    SymExpr sym ('BaseBVType w)
bvIntMin    <- sym -> NatRepr w -> BV w -> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr w
widthRepr (NatRepr w -> BV w
forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
BV.minSigned NatRepr w
widthRepr)
    SymExpr sym BaseBoolType
isNotIntMin <- sym -> SymExpr sym BaseBoolType -> IO (SymExpr sym BaseBoolType)
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred sym
sym (SymExpr sym BaseBoolType -> IO (SymExpr sym BaseBoolType))
-> IO (SymExpr sym BaseBoolType) -> IO (SymExpr sym BaseBoolType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym
-> SymExpr sym ('BaseBVType w)
-> SymExpr sym ('BaseBVType w)
-> IO (SymExpr sym BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymExpr sym BaseBoolType)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq sym
sym RegValue sym (BVType w)
SymExpr sym ('BaseBVType w)
src SymExpr sym ('BaseBVType w)
bvIntMin

    Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
shouldCheckIntMin (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      SymExpr sym BaseBoolType
isNotIntMinUB <- sym
-> CallStack
-> UndefinedBehavior (RegValue' sym)
-> SymExpr sym BaseBoolType
-> IO (SymExpr sym BaseBoolType)
forall sym.
(IsSymInterface sym, HasLLVMAnn sym) =>
sym
-> CallStack
-> UndefinedBehavior (RegValue' sym)
-> Pred sym
-> IO (Pred sym)
annotateUB sym
sym CallStack
callStack UndefinedBehavior (RegValue' sym)
ub SymExpr sym BaseBoolType
isNotIntMin
      let err :: SimErrorReason
err = String -> String -> SimErrorReason
AssertFailureSimError String
"Undefined behavior encountered" (String -> SimErrorReason) -> String -> SimErrorReason
forall a b. (a -> b) -> a -> b
$
                Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ UndefinedBehavior (RegValue' sym) -> Doc Any
forall (e :: CrucibleType -> Type) ann.
UndefinedBehavior e -> Doc ann
UB.explain UndefinedBehavior (RegValue' sym)
ub
      bak -> SymExpr sym BaseBoolType -> SimErrorReason -> IO ()
forall sym bak.
IsSymBackend sym bak =>
bak -> Pred sym -> SimErrorReason -> IO ()
assert bak
bak SymExpr sym BaseBoolType
isNotIntMinUB SimErrorReason
err

    SymExpr sym BaseBoolType
isSrcNegative <- sym -> SymExpr sym ('BaseBVType w) -> IO (SymExpr sym BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
sym -> SymBV sym w -> IO (SymExpr sym BaseBoolType)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNeg sym
sym RegValue sym (BVType w)
SymExpr sym ('BaseBVType w)
src
    SymExpr sym ('BaseBVType w)
srcNegated    <- sym
-> SymExpr sym ('BaseBVType w) -> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
sym -> SymBV sym w -> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymBV sym w)
bvNeg sym
sym RegValue sym (BVType w)
SymExpr sym ('BaseBVType w)
src
    sym
-> SymExpr sym BaseBoolType
-> SymExpr sym ('BaseBVType w)
-> SymExpr sym ('BaseBVType w)
-> IO (SymExpr sym ('BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
sym
-> SymExpr sym BaseBoolType
-> SymBV sym w
-> SymBV sym w
-> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte sym
sym SymExpr sym BaseBoolType
isSrcNegative SymExpr sym ('BaseBVType w)
srcNegated RegValue sym (BVType w)
SymExpr sym ('BaseBVType w)
src
    where
      shouldCheckIntMin :: Bool
      shouldCheckIntMin :: Bool
shouldCheckIntMin =
        case CheckAbsIntMin
checkIntMin of
          CheckAbsIntMin
LibcAbsIntMinUB                 -> Bool
True
          LLVMAbsIntMinPoison Bool
shouldCheck -> Bool
shouldCheck

      ub :: UB.UndefinedBehavior (RegValue' sym)
      ub :: UndefinedBehavior (RegValue' sym)
ub = case CheckAbsIntMin
checkIntMin of
             CheckAbsIntMin
LibcAbsIntMinUB ->
               RegValue' sym (BVType w) -> UndefinedBehavior (RegValue' sym)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> UndefinedBehavior e
UB.AbsIntMin (RegValue' sym (BVType w) -> UndefinedBehavior (RegValue' sym))
-> RegValue' sym (BVType w) -> UndefinedBehavior (RegValue' sym)
forall a b. (a -> b) -> a -> b
$ RegValue sym (BVType w) -> RegValue' sym (BVType w)
forall sym (tp :: CrucibleType).
RegValue sym tp -> RegValue' sym tp
RV RegValue sym (BVType w)
src
             LLVMAbsIntMinPoison{} ->
               Poison (RegValue' sym) -> UndefinedBehavior (RegValue' sym)
forall (e :: CrucibleType -> Type). Poison e -> UndefinedBehavior e
UB.PoisonValueCreated (Poison (RegValue' sym) -> UndefinedBehavior (RegValue' sym))
-> Poison (RegValue' sym) -> UndefinedBehavior (RegValue' sym)
forall a b. (a -> b) -> a -> b
$ RegValue' sym (BVType w) -> Poison (RegValue' sym)
forall (w :: Natural) (e :: CrucibleType -> Type).
(1 <= w) =>
e (BVType w) -> Poison e
Poison.LLVMAbsIntMin (RegValue' sym (BVType w) -> Poison (RegValue' sym))
-> RegValue' sym (BVType w) -> Poison (RegValue' sym)
forall a b. (a -> b) -> a -> b
$ RegValue sym (BVType w) -> RegValue' sym (BVType w)
forall sym (tp :: CrucibleType).
RegValue sym tp -> RegValue' sym tp
RV RegValue sym (BVType w)
src

callLibcAbs ::
  (1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
  CallStack ->
  NatRepr w ->
  RegEntry sym (BVType w) ->
  OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callLibcAbs :: forall (w :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
CallStack
-> NatRepr w
-> RegEntry sym (BVType w)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callLibcAbs CallStack
callStack = CallStack
-> CheckAbsIntMin
-> NatRepr w
-> RegEntry sym (BVType w)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
forall (w :: Natural) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
CallStack
-> CheckAbsIntMin
-> NatRepr w
-> RegEntry sym (BVType w)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callAbs CallStack
callStack CheckAbsIntMin
LibcAbsIntMinUB

callLLVMAbs ::
  (1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
  CallStack ->
  NatRepr w ->
  RegEntry sym (BVType w) ->
  RegEntry sym (BVType 1) ->
  OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callLLVMAbs :: forall (w :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
CallStack
-> NatRepr w
-> RegEntry sym (BVType w)
-> RegEntry sym (BVType 1)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callLLVMAbs CallStack
callStack NatRepr w
widthRepr RegEntry sym (BVType w)
src (RegEntry sym (BVType 1) -> RegValue sym (BVType 1)
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue -> RegValue sym (BVType 1)
isIntMinPoison) = do
  Bool
shouldCheckIntMin <- IO Bool -> OverrideSim p sym ext r args ret Bool
forall a. IO a -> OverrideSim p sym ext r args ret a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> OverrideSim p sym ext r args ret Bool)
-> IO Bool -> OverrideSim p sym ext r args ret Bool
forall a b. (a -> b) -> a -> b
$
    -- Per https://releases.llvm.org/12.0.0/docs/LangRef.html#id451, the second
    -- argument must be a constant.
    case SymExpr sym ('BaseBVType 1) -> Maybe (BV 1)
forall (w :: Natural). SymExpr sym (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV RegValue sym (BVType 1)
SymExpr sym ('BaseBVType 1)
isIntMinPoison of
      Just BV 1
bv -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BV 1
bv BV 1 -> BV 1 -> Bool
forall a. Eq a => a -> a -> Bool
/= NatRepr 1 -> BV 1
forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1))
      Maybe (BV 1)
Nothing -> Doc Void -> [Doc Void] -> IO Bool
forall a. Doc Void -> [Doc Void] -> a
malformedLLVMModule
                   Doc Void
"Call to llvm.abs.* with non-constant second argument"
                   [SymExpr sym ('BaseBVType 1) -> Doc Void
forall (tp :: BaseType) ann. SymExpr sym tp -> Doc ann
forall (e :: BaseType -> Type) (tp :: BaseType) ann.
IsExpr e =>
e tp -> Doc ann
printSymExpr RegValue sym (BVType 1)
SymExpr sym ('BaseBVType 1)
isIntMinPoison]
  CallStack
-> CheckAbsIntMin
-> NatRepr w
-> RegEntry sym (BVType w)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
forall (w :: Natural) p sym ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= w, IsSymInterface sym, HasLLVMAnn sym) =>
CallStack
-> CheckAbsIntMin
-> NatRepr w
-> RegEntry sym (BVType w)
-> OverrideSim p sym ext r args ret (RegValue sym (BVType w))
callAbs CallStack
callStack (Bool -> CheckAbsIntMin
LLVMAbsIntMinPoison Bool
shouldCheckIntMin) NatRepr w
widthRepr RegEntry sym (BVType w)
src

-- | If the data layout is little-endian, run 'callBSwap' on the input.
-- Otherwise, return the input unchanged. This is the workhorse for the
-- @hton{s,l}@ and @ntoh{s,l}@ overrides.
callBSwapIfLittleEndian ::
  (1 <= width, IsSymInterface sym, ?lc :: TypeContext) =>
  NatRepr width ->
  RegEntry sym (BVType (width * 8)) ->
  OverrideSim p sym ext r args ret (RegValue sym (BVType (width * 8)))
callBSwapIfLittleEndian :: forall (width :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= width, IsSymInterface sym, ?lc::TypeContext) =>
NatRepr width
-> RegEntry sym (BVType (width * 8))
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType (width * 8)))
callBSwapIfLittleEndian NatRepr width
widthRepr RegEntry sym (BVType (width * 8))
vec =
  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
BigEndian    -> RegValue sym (BVType (width * 8))
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType (width * 8)))
forall a. a -> OverrideSim p sym ext r args ret a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (RegEntry sym (BVType (width * 8))
-> RegValue sym (BVType (width * 8))
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue RegEntry sym (BVType (width * 8))
vec)
    EndianForm
LittleEndian -> NatRepr width
-> RegEntry sym (BVType (width * 8))
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType (width * 8)))
forall (width :: Natural) sym p ext r (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
(1 <= width, IsSymInterface sym) =>
NatRepr width
-> RegEntry sym (BVType (width * 8))
-> OverrideSim
     p sym ext r args ret (RegValue sym (BVType (width * 8)))
callBSwap NatRepr width
widthRepr RegEntry sym (BVType (width * 8))
vec

----------------------------------------------------------------------------
-- atexit stuff

cxa_atexitOverride
  :: (IsSymInterface sym, HasPtrWidth wptr)
  => LLVMOverride p sym ext
        (EmptyCtx ::> LLVMPointerType wptr ::> LLVMPointerType wptr ::> LLVMPointerType wptr)
        (BVType 32)
cxa_atexitOverride :: forall sym (wptr :: Natural) p ext.
(IsSymInterface sym, HasPtrWidth wptr) =>
LLVMOverride
  p
  sym
  ext
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> LLVMPointerType wptr)
  (BVType 32)
cxa_atexitOverride =
  [llvmOvr| i32 @__cxa_atexit( void (i8*)*, i8*, i8* ) |]
  (\GlobalVar Mem
_ Assignment
  (RegEntry sym)
  (((EmptyCtx ::> LLVMPointerType wptr) ::> LLVMPointerType wptr)
   ::> LLVMPointerType wptr)
_args -> do
    sym
sym <- OverrideSim p sym ext rtp args' ret' sym
forall p sym ext rtp (args :: Ctx CrucibleType)
       (ret :: CrucibleType).
OverrideSim p sym ext rtp args ret sym
getSymInterface
    IO (SymExpr sym ('BaseBVType 32))
-> OverrideSim
     p sym ext rtp args' ret' (SymExpr sym ('BaseBVType 32))
forall a. IO a -> OverrideSim p sym ext rtp args' ret' a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SymExpr sym ('BaseBVType 32))
 -> OverrideSim
      p sym ext rtp args' ret' (SymExpr sym ('BaseBVType 32)))
-> IO (SymExpr sym ('BaseBVType 32))
-> OverrideSim
     p sym ext rtp args' ret' (SymExpr sym ('BaseBVType 32))
forall a b. (a -> b) -> a -> b
$ sym -> NatRepr 32 -> IO (SymExpr sym ('BaseBVType 32))
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero sym
sym NatRepr 32
forall (n :: Natural). KnownNat n => NatRepr n
knownNat)

----------------------------------------------------------------------------

-- | IEEE 754 declares 'RNE' to be the default rounding mode, and most @libc@
-- implementations agree with this in practice. The only places where we do not
-- use this as the default are operations that specifically require the behavior
-- of a particular rounding mode, such as @ceil@ or @floor@.
defaultRM :: RoundingMode
defaultRM :: RoundingMode
defaultRM = RoundingMode
RNE