{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fprint-explicit-kinds -Wall #-}
module Lang.Crucible.Simulator.Operations
(
continue
, jumpToBlock
, conditionalBranch
, variantCases
, returnValue
, callFunction
, tailCallFunction
, runOverride
, runAbortHandler
, runErrorHandler
, runGenericErrorHandler
, performIntraFrameMerge
, performIntraFrameSplit
, performFunctionCall
, performTailCall
, performReturn
, performControlTransfer
, resumeFrame
, resumeValueFromValueAbort
, overrideSymbolicBranch
, ResolvedCall(..)
, UnresolvableFunction(..)
, resolveCall
, resolvedCallName
, abortExecAndLog
, abortExec
, defaultAbortHandler
, pushCallFrame
, replaceTailFrame
, isSingleCont
, unwindContext
, extractCurrentPath
, asContFrame
, forgetPostdomFrame
) where
import Prelude hiding (pred)
import qualified Control.Exception as Ex
import Control.Lens
import Control.Monad (when, void)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (ReaderT(..), withReaderT)
import Control.Monad.Trans.Class (MonadTrans(..))
import Data.Maybe (fromMaybe)
import Data.List (isPrefixOf)
import qualified Data.Parameterized.Context as Ctx
import Data.Parameterized.Some
import qualified Data.Vector as V
import Data.Type.Equality hiding (sym)
import System.IO
import qualified Prettyprinter as PP
import What4.Config
import What4.Interface
import What4.FunctionName
import What4.ProgramLoc
import Lang.Crucible.Backend
import Lang.Crucible.CFG.Core
import Lang.Crucible.CFG.Extension
import Lang.Crucible.FunctionHandle
import Lang.Crucible.Panic(panic)
import Lang.Crucible.Simulator.CallFrame
import Lang.Crucible.Simulator.ExecutionTree
import Lang.Crucible.Simulator.GlobalState
import Lang.Crucible.Simulator.Intrinsics
import Lang.Crucible.Simulator.RegMap
import Lang.Crucible.Simulator.SimError
mergeGlobalPair ::
MuxFn p v ->
MuxFn p (SymGlobalState sym) ->
MuxFn p (GlobalPair sym v)
mergeGlobalPair :: forall p v sym.
MuxFn p v
-> MuxFn p (SymGlobalState sym) -> MuxFn p (GlobalPair sym v)
mergeGlobalPair MuxFn p v
merge_fn MuxFn p (SymGlobalState sym)
global_fn p
c GlobalPair sym v
x GlobalPair sym v
y =
v -> SymGlobalState sym -> GlobalPair sym v
forall sym v. v -> SymGlobalState sym -> GlobalPair sym v
GlobalPair (v -> SymGlobalState sym -> GlobalPair sym v)
-> IO v -> IO (SymGlobalState sym -> GlobalPair sym v)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MuxFn p v
merge_fn p
c (GlobalPair sym v
xGlobalPair sym v -> Getting v (GlobalPair sym v) v -> v
forall s a. s -> Getting a s a -> a
^.Getting v (GlobalPair sym v) v
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue) (GlobalPair sym v
yGlobalPair sym v -> Getting v (GlobalPair sym v) v -> v
forall s a. s -> Getting a s a -> a
^.Getting v (GlobalPair sym v) v
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue)
IO (SymGlobalState sym -> GlobalPair sym v)
-> IO (SymGlobalState sym) -> IO (GlobalPair sym v)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> MuxFn p (SymGlobalState sym)
global_fn p
c (GlobalPair sym v
xGlobalPair sym v
-> Getting
(SymGlobalState sym) (GlobalPair sym v) (SymGlobalState sym)
-> SymGlobalState sym
forall s a. s -> Getting a s a -> a
^.Getting
(SymGlobalState sym) (GlobalPair sym v) (SymGlobalState sym)
forall sym u (f :: Type -> Type).
Functor f =>
(SymGlobalState sym -> f (SymGlobalState sym))
-> GlobalPair sym u -> f (GlobalPair sym u)
gpGlobals) (GlobalPair sym v
yGlobalPair sym v
-> Getting
(SymGlobalState sym) (GlobalPair sym v) (SymGlobalState sym)
-> SymGlobalState sym
forall s a. s -> Getting a s a -> a
^.Getting
(SymGlobalState sym) (GlobalPair sym v) (SymGlobalState sym)
forall sym u (f :: Type -> Type).
Functor f =>
(SymGlobalState sym -> f (SymGlobalState sym))
-> GlobalPair sym u -> f (GlobalPair sym u)
gpGlobals)
mergeAbortedResult ::
ProgramLoc ->
Pred sym ->
AbortedResult sym ext ->
AbortedResult sym ext ->
AbortedResult sym ext
mergeAbortedResult :: forall sym ext.
ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
mergeAbortedResult ProgramLoc
_ Pred sym
_ (AbortedExit ExitCode
ec) AbortedResult sym ext
_ = ExitCode -> AbortedResult sym ext
forall sym ext. ExitCode -> AbortedResult sym ext
AbortedExit ExitCode
ec
mergeAbortedResult ProgramLoc
_ Pred sym
_ AbortedResult sym ext
_ (AbortedExit ExitCode
ec) = ExitCode -> AbortedResult sym ext
forall sym ext. ExitCode -> AbortedResult sym ext
AbortedExit ExitCode
ec
mergeAbortedResult ProgramLoc
loc Pred sym
pred AbortedResult sym ext
q AbortedResult sym ext
r = ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
forall sym ext.
ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
AbortedBranch ProgramLoc
loc Pred sym
pred AbortedResult sym ext
q AbortedResult sym ext
r
mergePartialAndAbortedResult ::
IsExprBuilder sym =>
sym ->
ProgramLoc ->
Pred sym ->
PartialResult sym ext v ->
AbortedResult sym ext ->
IO (PartialResult sym ext v)
mergePartialAndAbortedResult :: forall sym ext v.
IsExprBuilder sym =>
sym
-> ProgramLoc
-> Pred sym
-> PartialResult sym ext v
-> AbortedResult sym ext
-> IO (PartialResult sym ext v)
mergePartialAndAbortedResult sym
sym ProgramLoc
loc Pred sym
pred PartialResult sym ext v
ar AbortedResult sym ext
r = do
case PartialResult sym ext v
ar of
TotalRes GlobalPair sym v
gp -> PartialResult sym ext v -> IO (PartialResult sym ext v)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (PartialResult sym ext v -> IO (PartialResult sym ext v))
-> PartialResult sym ext v -> IO (PartialResult sym ext v)
forall a b. (a -> b) -> a -> b
$! ProgramLoc
-> Pred sym
-> GlobalPair sym v
-> AbortedResult sym ext
-> PartialResult sym ext v
forall sym ext v.
ProgramLoc
-> Pred sym
-> GlobalPair sym v
-> AbortedResult sym ext
-> PartialResult sym ext v
PartialRes ProgramLoc
loc Pred sym
pred GlobalPair sym v
gp AbortedResult sym ext
r
PartialRes ProgramLoc
loc' Pred sym
d GlobalPair sym v
gp AbortedResult sym ext
q ->
do Pred sym
e <- sym -> Pred sym -> Pred sym -> IO (Pred sym)
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred sym
sym Pred sym
pred Pred sym
d
PartialResult sym ext v -> IO (PartialResult sym ext v)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (PartialResult sym ext v -> IO (PartialResult sym ext v))
-> PartialResult sym ext v -> IO (PartialResult sym ext v)
forall a b. (a -> b) -> a -> b
$! ProgramLoc
-> Pred sym
-> GlobalPair sym v
-> AbortedResult sym ext
-> PartialResult sym ext v
forall sym ext v.
ProgramLoc
-> Pred sym
-> GlobalPair sym v
-> AbortedResult sym ext
-> PartialResult sym ext v
PartialRes ProgramLoc
loc' Pred sym
e GlobalPair sym v
gp (ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
forall sym ext.
ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
mergeAbortedResult ProgramLoc
loc Pred sym
pred AbortedResult sym ext
q AbortedResult sym ext
r)
mergeCrucibleFrame ::
IsSymInterface sym =>
sym ->
IntrinsicTypes sym ->
CrucibleBranchTarget f args ->
MuxFn (Pred sym) (SimFrame sym ext f args)
mergeCrucibleFrame :: forall sym f (args :: Maybe (Ctx CrucibleType)) ext.
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> CrucibleBranchTarget f args
-> MuxFn (Pred sym) (SimFrame sym ext f args)
mergeCrucibleFrame sym
sym IntrinsicTypes sym
muxFns CrucibleBranchTarget f args
tgt Pred sym
p SimFrame sym ext f args
x0 SimFrame sym ext f args
y0 =
case CrucibleBranchTarget f args
tgt of
BlockTarget BlockID blocks args1
_b_id -> do
let x :: CallFrame sym ext blocks r args1
x = SimFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args1)
-> CallFrame sym ext blocks r args1
forall sym ext (b :: Ctx (Ctx CrucibleType)) (r :: CrucibleType)
(a :: Ctx CrucibleType).
SimFrame sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a)
-> CallFrame sym ext b r a
fromCallFrame SimFrame sym ext f args
SimFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args1)
x0
let y :: CallFrame sym ext blocks r args1
y = SimFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args1)
-> CallFrame sym ext blocks r args1
forall sym ext (b :: Ctx (Ctx CrucibleType)) (r :: CrucibleType)
(a :: Ctx CrucibleType).
SimFrame sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a)
-> CallFrame sym ext b r a
fromCallFrame SimFrame sym ext f args
SimFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args1)
y0
RegMap sym args1
z <- sym -> IntrinsicTypes sym -> MuxFn (Pred sym) (RegMap sym args1)
forall sym (ctx :: Ctx CrucibleType).
IsSymInterface sym =>
sym -> IntrinsicTypes sym -> MuxFn (Pred sym) (RegMap sym ctx)
mergeRegs sym
sym IntrinsicTypes sym
muxFns Pred sym
p (CallFrame sym ext blocks r args1
xCallFrame sym ext blocks r args1
-> Getting
(RegMap sym args1)
(CallFrame sym ext blocks r args1)
(RegMap sym args1)
-> RegMap sym args1
forall s a. s -> Getting a s a -> a
^.Getting
(RegMap sym args1)
(CallFrame sym ext blocks r args1)
(RegMap sym args1)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (args :: Ctx CrucibleType)
(f :: Type -> Type).
Functor f =>
(RegMap sym args -> f (RegMap sym args))
-> CallFrame sym ext blocks ret args
-> f (CallFrame sym ext blocks ret args)
frameRegs) (CallFrame sym ext blocks r args1
yCallFrame sym ext blocks r args1
-> Getting
(RegMap sym args1)
(CallFrame sym ext blocks r args1)
(RegMap sym args1)
-> RegMap sym args1
forall s a. s -> Getting a s a -> a
^.Getting
(RegMap sym args1)
(CallFrame sym ext blocks r args1)
(RegMap sym args1)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (args :: Ctx CrucibleType)
(f :: Type -> Type).
Functor f =>
(RegMap sym args -> f (RegMap sym args))
-> CallFrame sym ext blocks ret args
-> f (CallFrame sym ext blocks ret args)
frameRegs)
SimFrame sym ext f args -> IO (SimFrame sym ext f args)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (SimFrame sym ext f args -> IO (SimFrame sym ext f args))
-> SimFrame sym ext f args -> IO (SimFrame sym ext f args)
forall a b. (a -> b) -> a -> b
$! CallFrame sym ext blocks r args1
-> SimFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args1)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (args1 :: Ctx CrucibleType).
CallFrame sym ext blocks ret args1
-> SimFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) args1)
MF (CallFrame sym ext blocks r args1
x CallFrame sym ext blocks r args1
-> (CallFrame sym ext blocks r args1
-> CallFrame sym ext blocks r args1)
-> CallFrame sym ext blocks r args1
forall a b. a -> (a -> b) -> b
& (RegMap sym args1 -> Identity (RegMap sym args1))
-> CallFrame sym ext blocks r args1
-> Identity (CallFrame sym ext blocks r args1)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (args :: Ctx CrucibleType)
(f :: Type -> Type).
Functor f =>
(RegMap sym args -> f (RegMap sym args))
-> CallFrame sym ext blocks ret args
-> f (CallFrame sym ext blocks ret args)
frameRegs ((RegMap sym args1 -> Identity (RegMap sym args1))
-> CallFrame sym ext blocks r args1
-> Identity (CallFrame sym ext blocks r args1))
-> RegMap sym args1
-> CallFrame sym ext blocks r args1
-> CallFrame sym ext blocks r args1
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RegMap sym args1
z)
CrucibleBranchTarget f args
ReturnTarget -> do
let x :: RegEntry sym (FrameRetType f)
x = SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
-> RegEntry sym (FrameRetType f)
forall sym ext f.
SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
-> RegEntry sym (FrameRetType f)
fromReturnFrame SimFrame sym ext f args
SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
x0
let y :: RegEntry sym (FrameRetType f)
y = SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
-> RegEntry sym (FrameRetType f)
forall sym ext f.
SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
-> RegEntry sym (FrameRetType f)
fromReturnFrame SimFrame sym ext f args
SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
y0
FunctionName
-> RegEntry sym (FrameRetType f)
-> SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
forall sym l ext.
FunctionName
-> RegEntry sym (FrameRetType l)
-> SimFrame sym ext l ('Nothing @(Ctx CrucibleType))
RF (SimFrame sym ext f args
x0SimFrame sym ext f args
-> Getting FunctionName (SimFrame sym ext f args) FunctionName
-> FunctionName
forall s a. s -> Getting a s a -> a
^.Getting FunctionName (SimFrame sym ext f args) FunctionName
forall sym ext f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(FunctionName -> f2 FunctionName)
-> SimFrame sym ext f1 a -> f2 (SimFrame sym ext f1 a)
frameFunctionName) (RegEntry sym (FrameRetType f) -> SimFrame sym ext f args)
-> IO (RegEntry sym (FrameRetType f))
-> IO (SimFrame sym ext f args)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> IntrinsicTypes sym
-> MuxFn (Pred sym) (RegEntry sym (FrameRetType f))
forall sym (tp :: CrucibleType).
IsSymInterface sym =>
sym -> IntrinsicTypes sym -> MuxFn (Pred sym) (RegEntry sym tp)
muxRegEntry sym
sym IntrinsicTypes sym
muxFns Pred sym
p RegEntry sym (FrameRetType f)
x RegEntry sym (FrameRetType f)
y
mergePartialResult ::
IsSymInterface sym =>
SimState p sym ext root f args ->
CrucibleBranchTarget f args ->
MuxFn (Pred sym) (PartialResultFrame sym ext f args)
mergePartialResult :: forall sym p ext root f (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
SimState p sym ext root f args
-> CrucibleBranchTarget f args
-> MuxFn (Pred sym) (PartialResultFrame sym ext f args)
mergePartialResult SimState p sym ext root f args
s CrucibleBranchTarget f args
tgt Pred sym
pred PartialResultFrame sym ext f args
x PartialResultFrame sym ext f args
y =
let sym :: sym
sym = SimState p sym ext root f args
sSimState p sym ext root f args
-> Getting sym (SimState p sym ext root f args) sym -> sym
forall s a. s -> Getting a s a -> a
^.Getting sym (SimState p sym ext root f args) sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
iteFns :: IntrinsicTypes sym
iteFns = SimState p sym ext root f args
sSimState p sym ext root f args
-> Getting
(IntrinsicTypes sym)
(SimState p sym ext root f args)
(IntrinsicTypes sym)
-> IntrinsicTypes sym
forall s a. s -> Getting a s a -> a
^.Getting
(IntrinsicTypes sym)
(SimState p sym ext root f args)
(IntrinsicTypes sym)
forall p sym ext r f1 (args :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(IntrinsicTypes sym -> f2 (IntrinsicTypes sym))
-> SimState p sym ext r f1 args
-> f2 (SimState p sym ext r f1 args)
stateIntrinsicTypes
merge_val :: MuxFn (Pred sym) (SimFrame sym ext f args)
merge_val = sym
-> IntrinsicTypes sym
-> CrucibleBranchTarget f args
-> MuxFn (Pred sym) (SimFrame sym ext f args)
forall sym f (args :: Maybe (Ctx CrucibleType)) ext.
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> CrucibleBranchTarget f args
-> MuxFn (Pred sym) (SimFrame sym ext f args)
mergeCrucibleFrame sym
sym IntrinsicTypes sym
iteFns CrucibleBranchTarget f args
tgt
merge_fn :: MuxFn (Pred sym) (GlobalPair sym (SimFrame sym ext f args))
merge_fn = MuxFn (Pred sym) (SimFrame sym ext f args)
-> MuxFn (Pred sym) (SymGlobalState sym)
-> MuxFn (Pred sym) (GlobalPair sym (SimFrame sym ext f args))
forall p v sym.
MuxFn p v
-> MuxFn p (SymGlobalState sym) -> MuxFn p (GlobalPair sym v)
mergeGlobalPair MuxFn (Pred sym) (SimFrame sym ext f args)
merge_val (sym -> IntrinsicTypes sym -> MuxFn (Pred sym) (SymGlobalState sym)
forall sym.
IsSymInterface sym =>
sym -> IntrinsicTypes sym -> MuxFn (Pred sym) (SymGlobalState sym)
globalMuxFn sym
sym IntrinsicTypes sym
iteFns)
in
case PartialResultFrame sym ext f args
x of
TotalRes GlobalPair sym (SimFrame sym ext f args)
cx ->
case PartialResultFrame sym ext f args
y of
TotalRes GlobalPair sym (SimFrame sym ext f args)
cy ->
GlobalPair sym (SimFrame sym ext f args)
-> PartialResultFrame sym ext f args
forall sym ext v. GlobalPair sym v -> PartialResult sym ext v
TotalRes (GlobalPair sym (SimFrame sym ext f args)
-> PartialResultFrame sym ext f args)
-> IO (GlobalPair sym (SimFrame sym ext f args))
-> IO (PartialResultFrame sym ext f args)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MuxFn (Pred sym) (GlobalPair sym (SimFrame sym ext f args))
merge_fn Pred sym
pred GlobalPair sym (SimFrame sym ext f args)
cx GlobalPair sym (SimFrame sym ext f args)
cy
PartialRes ProgramLoc
loc Pred sym
py GlobalPair sym (SimFrame sym ext f args)
cy AbortedResult sym ext
fy ->
ProgramLoc
-> Pred sym
-> GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext
-> PartialResultFrame sym ext f args
forall sym ext v.
ProgramLoc
-> Pred sym
-> GlobalPair sym v
-> AbortedResult sym ext
-> PartialResult sym ext v
PartialRes ProgramLoc
loc (Pred sym
-> GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext
-> PartialResultFrame sym ext f args)
-> IO (Pred sym)
-> IO
(GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext -> PartialResultFrame sym ext f args)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Pred sym -> Pred sym -> IO (Pred sym)
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred sym
sym Pred sym
pred Pred sym
py
IO
(GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext -> PartialResultFrame sym ext f args)
-> IO (GlobalPair sym (SimFrame sym ext f args))
-> IO (AbortedResult sym ext -> PartialResultFrame sym ext f args)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> MuxFn (Pred sym) (GlobalPair sym (SimFrame sym ext f args))
merge_fn Pred sym
pred GlobalPair sym (SimFrame sym ext f args)
cx GlobalPair sym (SimFrame sym ext f args)
cy
IO (AbortedResult sym ext -> PartialResultFrame sym ext f args)
-> IO (AbortedResult sym ext)
-> IO (PartialResultFrame sym ext f args)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> AbortedResult sym ext -> IO (AbortedResult sym ext)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure AbortedResult sym ext
fy
PartialRes ProgramLoc
loc Pred sym
px GlobalPair sym (SimFrame sym ext f args)
cx AbortedResult sym ext
fx ->
case PartialResultFrame sym ext f args
y of
TotalRes GlobalPair sym (SimFrame sym ext f args)
cy ->
do Pred sym
pc <- sym -> Pred sym -> IO (Pred sym)
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred sym
sym Pred sym
pred
ProgramLoc
-> Pred sym
-> GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext
-> PartialResultFrame sym ext f args
forall sym ext v.
ProgramLoc
-> Pred sym
-> GlobalPair sym v
-> AbortedResult sym ext
-> PartialResult sym ext v
PartialRes ProgramLoc
loc (Pred sym
-> GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext
-> PartialResultFrame sym ext f args)
-> IO (Pred sym)
-> IO
(GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext -> PartialResultFrame sym ext f args)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Pred sym -> Pred sym -> IO (Pred sym)
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred sym
sym Pred sym
pc Pred sym
px
IO
(GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext -> PartialResultFrame sym ext f args)
-> IO (GlobalPair sym (SimFrame sym ext f args))
-> IO (AbortedResult sym ext -> PartialResultFrame sym ext f args)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> MuxFn (Pred sym) (GlobalPair sym (SimFrame sym ext f args))
merge_fn Pred sym
pred GlobalPair sym (SimFrame sym ext f args)
cx GlobalPair sym (SimFrame sym ext f args)
cy
IO (AbortedResult sym ext -> PartialResultFrame sym ext f args)
-> IO (AbortedResult sym ext)
-> IO (PartialResultFrame sym ext f args)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> AbortedResult sym ext -> IO (AbortedResult sym ext)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure AbortedResult sym ext
fx
PartialRes ProgramLoc
loc' Pred sym
py GlobalPair sym (SimFrame sym ext f args)
cy AbortedResult sym ext
fy ->
ProgramLoc
-> Pred sym
-> GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext
-> PartialResultFrame sym ext f args
forall sym ext v.
ProgramLoc
-> Pred sym
-> GlobalPair sym v
-> AbortedResult sym ext
-> PartialResult sym ext v
PartialRes ProgramLoc
loc' (Pred sym
-> GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext
-> PartialResultFrame sym ext f args)
-> IO (Pred sym)
-> IO
(GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext -> PartialResultFrame sym ext f args)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred sym
sym Pred sym
pred Pred sym
px Pred sym
py
IO
(GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext -> PartialResultFrame sym ext f args)
-> IO (GlobalPair sym (SimFrame sym ext f args))
-> IO (AbortedResult sym ext -> PartialResultFrame sym ext f args)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> MuxFn (Pred sym) (GlobalPair sym (SimFrame sym ext f args))
merge_fn Pred sym
pred GlobalPair sym (SimFrame sym ext f args)
cx GlobalPair sym (SimFrame sym ext f args)
cy
IO (AbortedResult sym ext -> PartialResultFrame sym ext f args)
-> IO (AbortedResult sym ext)
-> IO (PartialResultFrame sym ext f args)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> AbortedResult sym ext -> IO (AbortedResult sym ext)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
forall sym ext.
ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
AbortedBranch ProgramLoc
loc' Pred sym
pred AbortedResult sym ext
fx AbortedResult sym ext
fy)
forgetPostdomFrame ::
PausedFrame p sym ext rtp g ->
PausedFrame p sym ext rtp g
forgetPostdomFrame :: forall p sym ext rtp g.
PausedFrame p sym ext rtp g -> PausedFrame p sym ext rtp g
forgetPostdomFrame (PausedFrame PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args)
frm ControlResumption p sym ext rtp g
cont Maybe ProgramLoc
loc) = PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args)
-> ControlResumption p sym ext rtp g
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp g
forall p sym ext rtp f (old_args :: Ctx CrucibleType).
PartialResultFrame sym ext f ('Just @(Ctx CrucibleType) old_args)
-> ControlResumption p sym ext rtp f
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp f
PausedFrame PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args)
frm (ControlResumption p sym ext rtp g
-> ControlResumption p sym ext rtp g
forall {p} {sym} {ext} {rtp} {f}.
ControlResumption p sym ext rtp f
-> ControlResumption p sym ext rtp f
f ControlResumption p sym ext rtp g
cont) Maybe ProgramLoc
loc
where
f :: ControlResumption p sym ext rtp f
-> ControlResumption p sym ext rtp f
f (CheckMergeResumption ResolvedJump sym blocks
jmp) = ResolvedJump sym blocks
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType).
ResolvedJump sym blocks
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
ContinueResumption ResolvedJump sym blocks
jmp
f ControlResumption p sym ext rtp f
x = ControlResumption p sym ext rtp f
x
pushPausedFrame ::
IsSymInterface sym =>
PausedFrame p sym ext rtp g ->
ReaderT (SimState p sym ext rtp f ma) IO (PausedFrame p sym ext rtp g)
pushPausedFrame :: forall sym p ext rtp g f (ma :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
PausedFrame p sym ext rtp g
-> ReaderT
(SimState p sym ext rtp f ma) IO (PausedFrame p sym ext rtp g)
pushPausedFrame (PausedFrame PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args)
frm ControlResumption p sym ext rtp g
res Maybe ProgramLoc
loc) =
do sym
sym <- Getting sym (SimState p sym ext rtp f ma) sym
-> ReaderT (SimState p sym ext rtp f ma) IO sym
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting sym (SimState p sym ext rtp f ma) sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
IntrinsicTypes sym
iTypes <- Getting
(IntrinsicTypes sym)
(SimState p sym ext rtp f ma)
(IntrinsicTypes sym)
-> ReaderT (SimState p sym ext rtp f ma) IO (IntrinsicTypes sym)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(IntrinsicTypes sym)
(SimState p sym ext rtp f ma)
(IntrinsicTypes sym)
forall p sym ext r f1 (args :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(IntrinsicTypes sym -> f2 (IntrinsicTypes sym))
-> SimState p sym ext r f1 args
-> f2 (SimState p sym ext r f1 args)
stateIntrinsicTypes
PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args)
frm' <- IO
(PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
-> ReaderT
(SimState p sym ext rtp f ma)
IO
(PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (SimState p sym ext rtp f ma) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args)
frm PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args)
-> (PartialResultFrame
sym ext g ('Just @(Ctx CrucibleType) old_args)
-> IO
(PartialResultFrame
sym ext g ('Just @(Ctx CrucibleType) old_args)))
-> IO
(PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
forall a b. a -> (a -> b) -> b
& LensLike
@Type
IO
(PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
(PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
(SymGlobalState sym)
(SymGlobalState sym)
-> LensLike
@Type
IO
(PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
(PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
(SymGlobalState sym)
(SymGlobalState sym)
forall (f :: Type -> Type) s t a b.
LensLike @Type f s t a b -> LensLike @Type f s t a b
traverseOf ((GlobalPair
sym (SimFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
-> IO
(GlobalPair
sym (SimFrame sym ext g ('Just @(Ctx CrucibleType) old_args))))
-> PartialResultFrame
sym ext g ('Just @(Ctx CrucibleType) old_args)
-> IO
(PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue((GlobalPair
sym (SimFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
-> IO
(GlobalPair
sym (SimFrame sym ext g ('Just @(Ctx CrucibleType) old_args))))
-> PartialResultFrame
sym ext g ('Just @(Ctx CrucibleType) old_args)
-> IO
(PartialResultFrame
sym ext g ('Just @(Ctx CrucibleType) old_args)))
-> ((SymGlobalState sym -> IO (SymGlobalState sym))
-> GlobalPair
sym (SimFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
-> IO
(GlobalPair
sym (SimFrame sym ext g ('Just @(Ctx CrucibleType) old_args))))
-> LensLike
@Type
IO
(PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
(PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
(SymGlobalState sym)
(SymGlobalState sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SymGlobalState sym -> IO (SymGlobalState sym))
-> GlobalPair
sym (SimFrame sym ext g ('Just @(Ctx CrucibleType) old_args))
-> IO
(GlobalPair
sym (SimFrame sym ext g ('Just @(Ctx CrucibleType) old_args)))
forall sym u (f :: Type -> Type).
Functor f =>
(SymGlobalState sym -> f (SymGlobalState sym))
-> GlobalPair sym u -> f (GlobalPair sym u)
gpGlobals) (sym
-> IntrinsicTypes sym
-> SymGlobalState sym
-> IO (SymGlobalState sym)
forall sym.
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> SymGlobalState sym
-> IO (SymGlobalState sym)
globalPushBranch sym
sym IntrinsicTypes sym
iTypes))
ControlResumption p sym ext rtp g
res' <- IO (ControlResumption p sym ext rtp g)
-> ReaderT
(SimState p sym ext rtp f ma)
IO
(ControlResumption p sym ext rtp g)
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (SimState p sym ext rtp f ma) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (sym
-> IntrinsicTypes sym
-> ControlResumption p sym ext rtp g
-> IO (ControlResumption p sym ext rtp g)
forall sym p ext rtp g.
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> ControlResumption p sym ext rtp g
-> IO (ControlResumption p sym ext rtp g)
pushControlResumption sym
sym IntrinsicTypes sym
iTypes ControlResumption p sym ext rtp g
res)
PausedFrame p sym ext rtp g
-> ReaderT
(SimState p sym ext rtp f ma) IO (PausedFrame p sym ext rtp g)
forall a. a -> ReaderT (SimState p sym ext rtp f ma) IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args)
-> ControlResumption p sym ext rtp g
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp g
forall p sym ext rtp f (old_args :: Ctx CrucibleType).
PartialResultFrame sym ext f ('Just @(Ctx CrucibleType) old_args)
-> ControlResumption p sym ext rtp f
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp f
PausedFrame PartialResultFrame sym ext g ('Just @(Ctx CrucibleType) old_args)
frm' ControlResumption p sym ext rtp g
res' Maybe ProgramLoc
loc)
pushControlResumption ::
IsSymInterface sym =>
sym ->
IntrinsicTypes sym ->
ControlResumption p sym ext rtp g ->
IO (ControlResumption p sym ext rtp g)
pushControlResumption :: forall sym p ext rtp g.
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> ControlResumption p sym ext rtp g
-> IO (ControlResumption p sym ext rtp g)
pushControlResumption sym
sym IntrinsicTypes sym
iTypes ControlResumption p sym ext rtp g
res =
case ControlResumption p sym ext rtp g
res of
ContinueResumption ResolvedJump sym blocks
jmp ->
ResolvedJump sym blocks -> ControlResumption p sym ext rtp g
ResolvedJump sym blocks
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType).
ResolvedJump sym blocks
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
ContinueResumption (ResolvedJump sym blocks -> ControlResumption p sym ext rtp g)
-> IO (ResolvedJump sym blocks)
-> IO (ControlResumption p sym ext rtp g)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> IntrinsicTypes sym
-> ResolvedJump sym blocks
-> IO (ResolvedJump sym blocks)
forall sym (branches :: Ctx (Ctx CrucibleType)).
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> ResolvedJump sym branches
-> IO (ResolvedJump sym branches)
pushResolvedJump sym
sym IntrinsicTypes sym
iTypes ResolvedJump sym blocks
jmp
CheckMergeResumption ResolvedJump sym blocks
jmp ->
ResolvedJump sym blocks -> ControlResumption p sym ext rtp g
ResolvedJump sym blocks
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType).
ResolvedJump sym blocks
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
CheckMergeResumption (ResolvedJump sym blocks -> ControlResumption p sym ext rtp g)
-> IO (ResolvedJump sym blocks)
-> IO (ControlResumption p sym ext rtp g)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> IntrinsicTypes sym
-> ResolvedJump sym blocks
-> IO (ResolvedJump sym blocks)
forall sym (branches :: Ctx (Ctx CrucibleType)).
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> ResolvedJump sym branches
-> IO (ResolvedJump sym branches)
pushResolvedJump sym
sym IntrinsicTypes sym
iTypes ResolvedJump sym blocks
jmp
SwitchResumption [(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
ps ->
[(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
-> ControlResumption p sym ext rtp g
[(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType).
[(Pred sym, ResolvedJump sym blocks)]
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
SwitchResumption ([(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
-> ControlResumption p sym ext rtp g)
-> IO [(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
-> IO (ControlResumption p sym ext rtp g)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (((SymExpr sym BaseBoolType, ResolvedJump sym blocks)
-> IO (SymExpr sym BaseBoolType, ResolvedJump sym blocks))
-> [(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
-> IO [(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse(((SymExpr sym BaseBoolType, ResolvedJump sym blocks)
-> IO (SymExpr sym BaseBoolType, ResolvedJump sym blocks))
-> [(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
-> IO [(SymExpr sym BaseBoolType, ResolvedJump sym blocks)])
-> ((ResolvedJump sym blocks -> IO (ResolvedJump sym blocks))
-> (SymExpr sym BaseBoolType, ResolvedJump sym blocks)
-> IO (SymExpr sym BaseBoolType, ResolvedJump sym blocks))
-> (ResolvedJump sym blocks -> IO (ResolvedJump sym blocks))
-> [(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
-> IO [(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ResolvedJump sym blocks -> IO (ResolvedJump sym blocks))
-> (SymExpr sym BaseBoolType, ResolvedJump sym blocks)
-> IO (SymExpr sym BaseBoolType, ResolvedJump sym blocks)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
(SymExpr sym BaseBoolType, ResolvedJump sym blocks)
(SymExpr sym BaseBoolType, ResolvedJump sym blocks)
(ResolvedJump sym blocks)
(ResolvedJump sym blocks)
_2) (sym
-> IntrinsicTypes sym
-> ResolvedJump sym blocks
-> IO (ResolvedJump sym blocks)
forall sym (branches :: Ctx (Ctx CrucibleType)).
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> ResolvedJump sym branches
-> IO (ResolvedJump sym branches)
pushResolvedJump sym
sym IntrinsicTypes sym
iTypes) [(SymExpr sym BaseBoolType, ResolvedJump sym blocks)]
ps
OverrideResumption ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
k RegMap sym args
args ->
ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> RegMap sym args
-> ControlResumption p sym ext rtp (OverrideLang r)
forall p sym ext rtp (r :: CrucibleType)
(args :: Ctx CrucibleType).
ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> RegMap sym args
-> ControlResumption p sym ext rtp (OverrideLang r)
OverrideResumption ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
k (RegMap sym args -> ControlResumption p sym ext rtp g)
-> IO (RegMap sym args) -> IO (ControlResumption p sym ext rtp g)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> IntrinsicTypes sym -> RegMap sym args -> IO (RegMap sym args)
forall sym (ctx :: Ctx CrucibleType).
IsSymInterface sym =>
sym -> IntrinsicTypes sym -> RegMap sym ctx -> IO (RegMap sym ctx)
pushBranchRegs sym
sym IntrinsicTypes sym
iTypes RegMap sym args
args
pushResolvedJump ::
IsSymInterface sym =>
sym ->
IntrinsicTypes sym ->
ResolvedJump sym branches ->
IO (ResolvedJump sym branches)
pushResolvedJump :: forall sym (branches :: Ctx (Ctx CrucibleType)).
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> ResolvedJump sym branches
-> IO (ResolvedJump sym branches)
pushResolvedJump sym
sym IntrinsicTypes sym
iTypes (ResolvedJump BlockID branches args
block_id RegMap sym args
args) =
BlockID branches args
-> RegMap sym args -> ResolvedJump sym branches
forall sym (blocks :: Ctx (Ctx CrucibleType))
(args :: Ctx CrucibleType).
BlockID blocks args -> RegMap sym args -> ResolvedJump sym blocks
ResolvedJump BlockID branches args
block_id (RegMap sym args -> ResolvedJump sym branches)
-> IO (RegMap sym args) -> IO (ResolvedJump sym branches)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> IntrinsicTypes sym -> RegMap sym args -> IO (RegMap sym args)
forall sym (ctx :: Ctx CrucibleType).
IsSymInterface sym =>
sym -> IntrinsicTypes sym -> RegMap sym ctx -> IO (RegMap sym ctx)
pushBranchRegs sym
sym IntrinsicTypes sym
iTypes RegMap sym args
args
abortCrucibleFrame ::
IsSymInterface sym =>
sym ->
IntrinsicTypes sym ->
CrucibleBranchTarget f a' ->
SimFrame sym ext f a' ->
IO (SimFrame sym ext f a')
abortCrucibleFrame :: forall sym f (a' :: Maybe (Ctx CrucibleType)) ext.
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> CrucibleBranchTarget f a'
-> SimFrame sym ext f a'
-> IO (SimFrame sym ext f a')
abortCrucibleFrame sym
sym IntrinsicTypes sym
intrinsicFns (BlockTarget BlockID blocks args1
_) (MF CallFrame sym ext blocks ret args1
x') =
do RegMap sym args1
r' <- sym
-> IntrinsicTypes sym -> RegMap sym args1 -> IO (RegMap sym args1)
forall sym (ctx :: Ctx CrucibleType).
IsSymInterface sym =>
sym -> IntrinsicTypes sym -> RegMap sym ctx -> IO (RegMap sym ctx)
abortBranchRegs sym
sym IntrinsicTypes sym
intrinsicFns (CallFrame sym ext blocks ret args1
x'CallFrame sym ext blocks ret args1
-> Getting
(RegMap sym args1)
(CallFrame sym ext blocks ret args1)
(RegMap sym args1)
-> RegMap sym args1
forall s a. s -> Getting a s a -> a
^.Getting
(RegMap sym args1)
(CallFrame sym ext blocks ret args1)
(RegMap sym args1)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (args :: Ctx CrucibleType)
(f :: Type -> Type).
Functor f =>
(RegMap sym args -> f (RegMap sym args))
-> CallFrame sym ext blocks ret args
-> f (CallFrame sym ext blocks ret args)
frameRegs)
SimFrame sym ext f a' -> IO (SimFrame sym ext f a')
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SimFrame sym ext f a' -> IO (SimFrame sym ext f a'))
-> SimFrame sym ext f a' -> IO (SimFrame sym ext f a')
forall a b. (a -> b) -> a -> b
$! CallFrame sym ext blocks ret args1
-> SimFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) args1)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (args1 :: Ctx CrucibleType).
CallFrame sym ext blocks ret args1
-> SimFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) args1)
MF (CallFrame sym ext blocks ret args1
x' CallFrame sym ext blocks ret args1
-> (CallFrame sym ext blocks ret args1
-> CallFrame sym ext blocks ret args1)
-> CallFrame sym ext blocks ret args1
forall a b. a -> (a -> b) -> b
& (RegMap sym args1 -> Identity (RegMap sym args1))
-> CallFrame sym ext blocks ret args1
-> Identity (CallFrame sym ext blocks ret args1)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (args :: Ctx CrucibleType)
(f :: Type -> Type).
Functor f =>
(RegMap sym args -> f (RegMap sym args))
-> CallFrame sym ext blocks ret args
-> f (CallFrame sym ext blocks ret args)
frameRegs ((RegMap sym args1 -> Identity (RegMap sym args1))
-> CallFrame sym ext blocks ret args1
-> Identity (CallFrame sym ext blocks ret args1))
-> RegMap sym args1
-> CallFrame sym ext blocks ret args1
-> CallFrame sym ext blocks ret args1
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RegMap sym args1
r')
abortCrucibleFrame sym
sym IntrinsicTypes sym
intrinsicFns CrucibleBranchTarget f a'
ReturnTarget (RF FunctionName
nm RegEntry sym (FrameRetType f)
x') =
FunctionName
-> RegEntry sym (FrameRetType f)
-> SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
forall sym l ext.
FunctionName
-> RegEntry sym (FrameRetType l)
-> SimFrame sym ext l ('Nothing @(Ctx CrucibleType))
RF FunctionName
nm (RegEntry sym (FrameRetType f) -> SimFrame sym ext f a')
-> IO (RegEntry sym (FrameRetType f)) -> IO (SimFrame sym ext f a')
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> IntrinsicTypes sym
-> RegEntry sym (FrameRetType f)
-> IO (RegEntry sym (FrameRetType f))
forall sym (tp :: CrucibleType).
IsSymInterface sym =>
sym
-> IntrinsicTypes sym -> RegEntry sym tp -> IO (RegEntry sym tp)
abortBranchRegEntry sym
sym IntrinsicTypes sym
intrinsicFns RegEntry sym (FrameRetType f)
x'
abortPartialResult ::
IsSymInterface sym =>
SimState p sym ext r f args ->
CrucibleBranchTarget f a' ->
PartialResultFrame sym ext f a' ->
IO (PartialResultFrame sym ext f a')
abortPartialResult :: forall sym p ext r f (args :: Maybe (Ctx CrucibleType))
(a' :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
SimState p sym ext r f args
-> CrucibleBranchTarget f a'
-> PartialResultFrame sym ext f a'
-> IO (PartialResultFrame sym ext f a')
abortPartialResult SimState p sym ext r f args
s CrucibleBranchTarget f a'
tgt PartialResultFrame sym ext f a'
pr =
let sym :: sym
sym = SimState p sym ext r f args
sSimState p sym ext r f args
-> Getting sym (SimState p sym ext r f args) sym -> sym
forall s a. s -> Getting a s a -> a
^.Getting sym (SimState p sym ext r f args) sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
muxFns :: IntrinsicTypes sym
muxFns = SimState p sym ext r f args
sSimState p sym ext r f args
-> Getting
(IntrinsicTypes sym)
(SimState p sym ext r f args)
(IntrinsicTypes sym)
-> IntrinsicTypes sym
forall s a. s -> Getting a s a -> a
^.Getting
(IntrinsicTypes sym)
(SimState p sym ext r f args)
(IntrinsicTypes sym)
forall p sym ext r f1 (args :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(IntrinsicTypes sym -> f2 (IntrinsicTypes sym))
-> SimState p sym ext r f1 args
-> f2 (SimState p sym ext r f1 args)
stateIntrinsicTypes
abtGp :: GlobalPair sym (SimFrame sym ext f a')
-> IO (GlobalPair sym (SimFrame sym ext f a'))
abtGp (GlobalPair SimFrame sym ext f a'
v SymGlobalState sym
g) = SimFrame sym ext f a'
-> SymGlobalState sym -> GlobalPair sym (SimFrame sym ext f a')
forall sym v. v -> SymGlobalState sym -> GlobalPair sym v
GlobalPair (SimFrame sym ext f a'
-> SymGlobalState sym -> GlobalPair sym (SimFrame sym ext f a'))
-> IO (SimFrame sym ext f a')
-> IO
(SymGlobalState sym -> GlobalPair sym (SimFrame sym ext f a'))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> IntrinsicTypes sym
-> CrucibleBranchTarget f a'
-> SimFrame sym ext f a'
-> IO (SimFrame sym ext f a')
forall sym f (a' :: Maybe (Ctx CrucibleType)) ext.
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> CrucibleBranchTarget f a'
-> SimFrame sym ext f a'
-> IO (SimFrame sym ext f a')
abortCrucibleFrame sym
sym IntrinsicTypes sym
muxFns CrucibleBranchTarget f a'
tgt SimFrame sym ext f a'
v
IO (SymGlobalState sym -> GlobalPair sym (SimFrame sym ext f a'))
-> IO (SymGlobalState sym)
-> IO (GlobalPair sym (SimFrame sym ext f a'))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> sym
-> IntrinsicTypes sym
-> SymGlobalState sym
-> IO (SymGlobalState sym)
forall sym.
IsSymInterface sym =>
sym
-> IntrinsicTypes sym
-> SymGlobalState sym
-> IO (SymGlobalState sym)
globalAbortBranch sym
sym IntrinsicTypes sym
muxFns SymGlobalState sym
g
in (GlobalPair sym (SimFrame sym ext f a')
-> IO (GlobalPair sym (SimFrame sym ext f a')))
-> PartialResultFrame sym ext f a'
-> IO (PartialResultFrame sym ext f a')
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue GlobalPair sym (SimFrame sym ext f a')
-> IO (GlobalPair sym (SimFrame sym ext f a'))
abtGp PartialResultFrame sym ext f a'
pr
data UnresolvableFunction where
UnresolvableFunction ::
!(ProgramLoc) ->
[SomeFrame (SimFrame sym ext)] ->
!(FnHandle args ret) ->
UnresolvableFunction
instance Ex.Exception UnresolvableFunction
instance Show UnresolvableFunction where
show :: UnresolvableFunction -> String
show (UnresolvableFunction ProgramLoc
loc [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack FnHandle args ret
h) =
let name :: String
name = FunctionName -> String
forall a. Show a => a -> String
show (FunctionName -> String) -> FunctionName -> String
forall a b. (a -> b) -> a -> b
$ FnHandle args ret -> FunctionName
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FnHandle args ret -> FunctionName
handleName FnHandle args ret
h
in [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
if String
"llvm" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name
then [ String
"Encountered unresolved LLVM intrinsic '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
, String
"Please report this on the following issue:"
, String
"https://github.com/GaloisInc/crucible/issues/73"
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ Doc (Any @Type) -> String
forall a. Show a => a -> String
show ([SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> Doc (Any @Type)
forall sym ext ann.
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> Doc ann
ppExceptionContext [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack) ]
else [ String
"Could not resolve function: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
, String
"Called at: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Doc (Any @Type) -> String
forall a. Show a => a -> String
show (Position -> Doc (Any @Type)
forall a ann. Pretty a => a -> Doc ann
forall ann. Position -> Doc ann
PP.pretty (ProgramLoc -> Position
plSourceLoc ProgramLoc
loc))
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ Doc (Any @Type) -> String
forall a. Show a => a -> String
show ([SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> Doc (Any @Type)
forall sym ext ann.
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> Doc ann
ppExceptionContext [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack) ]
packVarargs ::
CtxRepr addlArgs ->
RegMap sym (args <+> addlArgs) ->
RegMap sym (args ::> VectorType AnyType)
packVarargs :: forall (addlArgs :: Ctx CrucibleType) sym
(args :: Ctx CrucibleType).
CtxRepr addlArgs
-> RegMap sym ((<+>) @CrucibleType args addlArgs)
-> RegMap sym ((::>) @CrucibleType args (VectorType AnyType))
packVarargs = Vector (AnyValue sym)
-> Assignment @CrucibleType TypeRepr addlArgs
-> RegMap sym ((<+>) @CrucibleType args addlArgs)
-> RegMap sym (('::>) @CrucibleType args (VectorType AnyType))
forall sym (addlArgs :: Ctx CrucibleType)
(args :: Ctx CrucibleType).
Vector (AnyValue sym)
-> CtxRepr addlArgs
-> RegMap sym ((<+>) @CrucibleType args addlArgs)
-> RegMap sym ((::>) @CrucibleType args (VectorType AnyType))
go Vector (AnyValue sym)
forall a. Monoid a => a
mempty
where
go ::
V.Vector (AnyValue sym) ->
CtxRepr addlArgs ->
RegMap sym (args <+> addlArgs) ->
RegMap sym (args ::> VectorType AnyType)
go :: forall sym (addlArgs :: Ctx CrucibleType)
(args :: Ctx CrucibleType).
Vector (AnyValue sym)
-> CtxRepr addlArgs
-> RegMap sym ((<+>) @CrucibleType args addlArgs)
-> RegMap sym ((::>) @CrucibleType args (VectorType AnyType))
go Vector (AnyValue sym)
v (Assignment @CrucibleType TypeRepr ctx
addl Ctx.:> TypeRepr tp
tp) (RegMap sym ((<+>) @CrucibleType args addlArgs)
-> (RegMap sym ((<+>) @CrucibleType args ctx), RegEntry sym tp)
RegMap sym ((::>) @CrucibleType ((<+>) @CrucibleType args ctx) tp)
-> (RegMap sym ((<+>) @CrucibleType args ctx), RegEntry sym tp)
forall sym (ctx :: Ctx CrucibleType) (tp :: CrucibleType).
RegMap sym ((::>) @CrucibleType ctx tp)
-> (RegMap sym ctx, RegEntry sym tp)
unconsReg -> (RegMap sym ((<+>) @CrucibleType args ctx)
args, RegEntry sym tp
x)) =
Vector (AnyValue sym)
-> Assignment @CrucibleType TypeRepr ctx
-> RegMap sym ((<+>) @CrucibleType args ctx)
-> RegMap sym ((::>) @CrucibleType args (VectorType AnyType))
forall sym (addlArgs :: Ctx CrucibleType)
(args :: Ctx CrucibleType).
Vector (AnyValue sym)
-> CtxRepr addlArgs
-> RegMap sym ((<+>) @CrucibleType args addlArgs)
-> RegMap sym ((::>) @CrucibleType args (VectorType AnyType))
go (AnyValue sym -> Vector (AnyValue sym) -> Vector (AnyValue sym)
forall a. a -> Vector a -> Vector a
V.cons (TypeRepr tp -> RegValue sym tp -> AnyValue sym
forall (tp :: CrucibleType) sym.
TypeRepr tp -> RegValue sym tp -> AnyValue sym
AnyValue TypeRepr tp
tp (RegEntry sym tp -> RegValue sym tp
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue RegEntry sym tp
x)) Vector (AnyValue sym)
v) Assignment @CrucibleType TypeRepr ctx
addl RegMap sym ((<+>) @CrucibleType args ctx)
args
go Vector (AnyValue sym)
v Assignment @CrucibleType TypeRepr addlArgs
Ctx.Empty RegMap sym ((<+>) @CrucibleType args addlArgs)
args =
TypeRepr (VectorType AnyType)
-> RegValue sym (VectorType AnyType)
-> RegMap sym args
-> RegMap sym ((::>) @CrucibleType args (VectorType AnyType))
forall (tp :: CrucibleType) sym (ctx :: Ctx CrucibleType).
TypeRepr tp
-> RegValue sym tp
-> RegMap sym ctx
-> RegMap sym ((::>) @CrucibleType ctx tp)
assignReg TypeRepr (VectorType AnyType)
forall k (f :: k -> Type) (ctx :: k). KnownRepr @k f ctx => f ctx
knownRepr Vector (AnyValue sym)
RegValue sym (VectorType AnyType)
v RegMap sym args
RegMap sym ((<+>) @CrucibleType args addlArgs)
args
resolveCall ::
FunctionBindings p sym ext ->
FnVal sym args ret ->
RegMap sym args ->
ProgramLoc ->
[SomeFrame (SimFrame sym ext)] ->
ResolvedCall p sym ext ret
resolveCall :: forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
FunctionBindings p sym ext
-> FnVal sym args ret
-> RegMap sym args
-> ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ResolvedCall p sym ext ret
resolveCall FunctionBindings p sym ext
bindings FnVal sym args ret
c0 RegMap sym args
args ProgramLoc
loc [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack =
case FnVal sym args ret
c0 of
ClosureFnVal FnVal sym ((::>) @CrucibleType args tp) ret
c TypeRepr tp
tp RegValue sym tp
v -> do
FunctionBindings p sym ext
-> FnVal sym ((::>) @CrucibleType args tp) ret
-> RegMap sym ((::>) @CrucibleType args tp)
-> ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ResolvedCall p sym ext ret
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
FunctionBindings p sym ext
-> FnVal sym args ret
-> RegMap sym args
-> ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ResolvedCall p sym ext ret
resolveCall FunctionBindings p sym ext
bindings FnVal sym ((::>) @CrucibleType args tp) ret
c (TypeRepr tp
-> RegValue sym tp
-> RegMap sym args
-> RegMap sym ((::>) @CrucibleType args tp)
forall (tp :: CrucibleType) sym (ctx :: Ctx CrucibleType).
TypeRepr tp
-> RegValue sym tp
-> RegMap sym ctx
-> RegMap sym ((::>) @CrucibleType ctx tp)
assignReg TypeRepr tp
tp RegValue sym tp
v RegMap sym args
args) ProgramLoc
loc [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack
VarargsFnVal FnHandle ((::>) @CrucibleType args1 (VectorType AnyType)) ret
h CtxRepr addlArgs
addlTypes ->
FunctionBindings p sym ext
-> FnVal sym ((::>) @CrucibleType args1 (VectorType AnyType)) ret
-> RegMap sym ((::>) @CrucibleType args1 (VectorType AnyType))
-> ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ResolvedCall p sym ext ret
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
FunctionBindings p sym ext
-> FnVal sym args ret
-> RegMap sym args
-> ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ResolvedCall p sym ext ret
resolveCall FunctionBindings p sym ext
bindings (FnHandle ((::>) @CrucibleType args1 (VectorType AnyType)) ret
-> FnVal sym ((::>) @CrucibleType args1 (VectorType AnyType)) ret
forall (args :: Ctx CrucibleType) (res :: CrucibleType) sym.
FnHandle args res -> FnVal sym args res
HandleFnVal FnHandle ((::>) @CrucibleType args1 (VectorType AnyType)) ret
h) (CtxRepr addlArgs
-> RegMap sym ((<+>) @CrucibleType args1 addlArgs)
-> RegMap sym ((::>) @CrucibleType args1 (VectorType AnyType))
forall (addlArgs :: Ctx CrucibleType) sym
(args :: Ctx CrucibleType).
CtxRepr addlArgs
-> RegMap sym ((<+>) @CrucibleType args addlArgs)
-> RegMap sym ((::>) @CrucibleType args (VectorType AnyType))
packVarargs CtxRepr addlArgs
addlTypes RegMap sym args
RegMap sym ((<+>) @CrucibleType args1 addlArgs)
args) ProgramLoc
loc [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack
HandleFnVal FnHandle args ret
h -> do
case FnHandle args ret
-> FnHandleMap (FnState p sym ext)
-> Maybe (FnState p sym ext args ret)
forall (args :: Ctx CrucibleType) (ret :: CrucibleType)
(f :: Ctx CrucibleType -> CrucibleType -> Type).
FnHandle args ret -> FnHandleMap f -> Maybe (f args ret)
lookupHandleMap FnHandle args ret
h (FunctionBindings p sym ext -> FnHandleMap (FnState p sym ext)
forall p sym ext.
FunctionBindings p sym ext -> FnHandleMap (FnState p sym ext)
fnBindings FunctionBindings p sym ext
bindings) of
Maybe (FnState p sym ext args ret)
Nothing -> UnresolvableFunction -> ResolvedCall p sym ext ret
forall a e. Exception e => e -> a
Ex.throw (ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> FnHandle args ret
-> UnresolvableFunction
forall sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> FnHandle args ret
-> UnresolvableFunction
UnresolvableFunction ProgramLoc
loc [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack FnHandle args ret
h)
Just (UseOverride Override p sym ext args ret
o) -> do
let f :: OverrideFrame sym ret args
f = OverrideFrame { _override :: FunctionName
_override = Override p sym ext args ret -> FunctionName
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
Override p sym ext args ret -> FunctionName
overrideName Override p sym ext args ret
o
, _overrideHandle :: SomeHandle
_overrideHandle = FnHandle args ret -> SomeHandle
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FnHandle args ret -> SomeHandle
SomeHandle FnHandle args ret
h
, _overrideRegMap :: RegMap sym args
_overrideRegMap = RegMap sym args
args
}
in Override p sym ext args ret
-> OverrideFrame sym ret args -> ResolvedCall p sym ext ret
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
Override p sym ext args ret
-> OverrideFrame sym ret args -> ResolvedCall p sym ext ret
OverrideCall Override p sym ext args ret
o OverrideFrame sym ret args
f
Just (UseCFG CFG ext blocks args ret
g CFGPostdom blocks
pdInfo) -> do
BlockID blocks args
-> CallFrame sym ext blocks ret args -> ResolvedCall p sym ext ret
forall (blocks :: Ctx (Ctx CrucibleType))
(args :: Ctx CrucibleType) sym ext (ret :: CrucibleType) p.
BlockID blocks args
-> CallFrame sym ext blocks ret args -> ResolvedCall p sym ext ret
CrucibleCall (CFG ext blocks args ret -> BlockID blocks args
forall ext (blocks :: Ctx (Ctx CrucibleType))
(init :: Ctx CrucibleType) (ret :: CrucibleType).
CFG ext blocks init ret -> BlockID blocks init
cfgEntryBlockID CFG ext blocks args ret
g) (CFG ext blocks args ret
-> CFGPostdom blocks
-> RegMap sym args
-> CallFrame sym ext blocks ret args
forall ext (blocks :: Ctx (Ctx CrucibleType))
(init :: Ctx CrucibleType) (ret :: CrucibleType) sym.
CFG ext blocks init ret
-> CFGPostdom blocks
-> RegMap sym init
-> CallFrame sym ext blocks ret init
mkCallFrame CFG ext blocks args ret
g CFGPostdom blocks
pdInfo RegMap sym args
args)
resolvedCallName :: ResolvedCall p sym ext ret -> FunctionName
resolvedCallName :: forall p sym ext (ret :: CrucibleType).
ResolvedCall p sym ext ret -> FunctionName
resolvedCallName (OverrideCall Override p sym ext args ret
_ OverrideFrame sym ret args
f) = OverrideFrame sym ret args
fOverrideFrame sym ret args
-> Getting FunctionName (OverrideFrame sym ret args) FunctionName
-> FunctionName
forall s a. s -> Getting a s a -> a
^.Getting FunctionName (OverrideFrame sym ret args) FunctionName
forall sym (ret :: CrucibleType) (args :: Ctx CrucibleType)
(f :: Type -> Type).
Functor f =>
(FunctionName -> f FunctionName)
-> OverrideFrame sym ret args -> f (OverrideFrame sym ret args)
override
resolvedCallName (CrucibleCall BlockID blocks args
_ CallFrame sym ext blocks ret args
f) = case CallFrame sym ext blocks ret args -> SomeHandle
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (ctx :: Ctx CrucibleType).
CallFrame sym ext blocks ret ctx -> SomeHandle
frameHandle CallFrame sym ext blocks ret args
f of SomeHandle FnHandle args ret
h -> FnHandle args ret -> FunctionName
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FnHandle args ret -> FunctionName
handleName FnHandle args ret
h
runOverride ::
Override p sym ext args ret ->
ExecCont p sym ext rtp (OverrideLang ret) ('Just args)
runOverride :: forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType)
rtp.
Override p sym ext args ret
-> ExecCont
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
runOverride Override p sym ext args ret
o = (SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
-> IO (ExecState p sym ext rtp))
-> ReaderT
(SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT (ExecState p sym ext rtp -> IO (ExecState p sym ext rtp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext rtp -> IO (ExecState p sym ext rtp))
-> (SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
-> ExecState p sym ext rtp)
-> SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
-> IO (ExecState p sym ext rtp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Override p sym ext args ret
-> SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
-> ExecState p sym ext rtp
forall p sym ext rtp (args :: Ctx CrucibleType)
(ret :: CrucibleType).
Override p sym ext args ret
-> SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
-> ExecState p sym ext rtp
OverrideState Override p sym ext args ret
o)
continue :: RunningStateInfo blocks a -> ExecCont p sym ext rtp (CrucibleLang blocks r) ('Just a)
continue :: forall (blocks :: Ctx (Ctx CrucibleType)) (a :: Ctx CrucibleType) p
sym ext rtp (r :: CrucibleType).
RunningStateInfo blocks a
-> ExecCont
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
continue RunningStateInfo blocks a
rtgt = (SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> IO (ExecState p sym ext rtp))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) a))
IO
(ExecState p sym ext rtp)
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT (ExecState p sym ext rtp -> IO (ExecState p sym ext rtp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext rtp -> IO (ExecState p sym ext rtp))
-> (SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> ExecState p sym ext rtp)
-> SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> IO (ExecState p sym ext rtp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunningStateInfo blocks a
-> SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> ExecState p sym ext rtp
forall p sym ext rtp (blocks :: Ctx (Ctx CrucibleType))
(r :: CrucibleType) (args :: Ctx CrucibleType).
RunningStateInfo blocks args
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args)
-> ExecState p sym ext rtp
RunningState RunningStateInfo blocks a
rtgt)
runAbortHandler ::
AbortExecReason ->
SimState p sym ext rtp f args ->
IO (ExecState p sym ext rtp)
runAbortHandler :: forall p sym ext rtp f (args :: Maybe (Ctx CrucibleType)).
AbortExecReason
-> SimState p sym ext rtp f args -> IO (ExecState p sym ext rtp)
runAbortHandler AbortExecReason
rsn SimState p sym ext rtp f args
s = ExecState p sym ext rtp -> IO (ExecState p sym ext rtp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (AbortExecReason
-> SimState p sym ext rtp f args -> ExecState p sym ext rtp
forall p sym ext rtp f (a :: Maybe (Ctx CrucibleType)).
AbortExecReason
-> SimState p sym ext rtp f a -> ExecState p sym ext rtp
AbortState AbortExecReason
rsn SimState p sym ext rtp f args
s)
runErrorHandler ::
SimErrorReason ->
SimState p sym ext rtp f args ->
IO (ExecState p sym ext rtp)
runErrorHandler :: forall p sym ext rtp f (args :: Maybe (Ctx CrucibleType)).
SimErrorReason
-> SimState p sym ext rtp f args -> IO (ExecState p sym ext rtp)
runErrorHandler SimErrorReason
msg SimState p sym ext rtp f args
st =
let ctx :: SimContext p sym ext
ctx = SimState p sym ext rtp f args
stSimState p sym ext rtp f args
-> Getting
(SimContext p sym ext)
(SimState p sym ext rtp f args)
(SimContext p sym ext)
-> SimContext p sym ext
forall s a. s -> Getting a s a -> a
^.Getting
(SimContext p sym ext)
(SimState p sym ext rtp f args)
(SimContext p sym ext)
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(SimContext p sym ext -> f2 (SimContext p sym ext))
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateContext
sym :: sym
sym = SimContext p sym ext
ctxSimContext p sym ext
-> Getting sym (SimContext p sym ext) sym -> sym
forall s a. s -> Getting a s a -> a
^.Getting sym (SimContext p sym ext) sym
forall p sym ext (f :: Type -> Type).
(Contravariant f, Functor f) =>
(sym -> f sym) -> SimContext p sym ext -> f (SimContext p sym ext)
ctxSymInterface
in SimContext p sym ext
-> (forall {bak}.
IsSymBackend sym bak =>
bak -> IO (ExecState p sym ext rtp))
-> IO (ExecState p sym ext rtp)
forall personality sym ext a.
SimContext personality sym ext
-> (forall bak. IsSymBackend sym bak => bak -> a) -> a
withBackend SimContext p sym ext
ctx ((forall {bak}.
IsSymBackend sym bak =>
bak -> IO (ExecState p sym ext rtp))
-> IO (ExecState p sym ext rtp))
-> (forall {bak}.
IsSymBackend sym bak =>
bak -> IO (ExecState p sym ext rtp))
-> IO (ExecState p sym ext rtp)
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
do ProgramLoc
loc <- sym -> IO ProgramLoc
forall sym. IsExprBuilder sym => sym -> IO ProgramLoc
getCurrentProgramLoc sym
sym
let err :: SimError
err = ProgramLoc -> SimErrorReason -> SimError
SimError ProgramLoc
loc SimErrorReason
msg
bak -> Assertion sym -> IO ()
forall sym bak.
IsSymBackend sym bak =>
bak -> Assertion sym -> IO ()
addProofObligation bak
bak (SymExpr sym BaseBoolType -> SimError -> Assertion sym
forall pred msg. pred -> msg -> LabeledPred pred msg
LabeledPred (sym -> SymExpr sym BaseBoolType
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred sym
sym) SimError
err)
ExecState p sym ext rtp -> IO (ExecState p sym ext rtp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (AbortExecReason
-> SimState p sym ext rtp f args -> ExecState p sym ext rtp
forall p sym ext rtp f (a :: Maybe (Ctx CrucibleType)).
AbortExecReason
-> SimState p sym ext rtp f a -> ExecState p sym ext rtp
AbortState (SimError -> AbortExecReason
AssertionFailure SimError
err) SimState p sym ext rtp f args
st)
runGenericErrorHandler ::
String ->
SimState p sym ext rtp f args ->
IO (ExecState p sym ext rtp)
runGenericErrorHandler :: forall p sym ext rtp f (args :: Maybe (Ctx CrucibleType)).
String
-> SimState p sym ext rtp f args -> IO (ExecState p sym ext rtp)
runGenericErrorHandler String
msg SimState p sym ext rtp f args
st = SimErrorReason
-> SimState p sym ext rtp f args -> IO (ExecState p sym ext rtp)
forall p sym ext rtp f (args :: Maybe (Ctx CrucibleType)).
SimErrorReason
-> SimState p sym ext rtp f args -> IO (ExecState p sym ext rtp)
runErrorHandler (String -> SimErrorReason
GenericSimError String
msg) SimState p sym ext rtp f args
st
jumpToBlock ::
IsSymInterface sym =>
ResolvedJump sym blocks ->
ExecCont p sym ext rtp (CrucibleLang blocks r) ('Just a)
jumpToBlock :: forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType) (a :: Ctx CrucibleType).
IsSymInterface sym =>
ResolvedJump sym blocks
-> ExecCont
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
jumpToBlock ResolvedJump sym blocks
jmp = (SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> IO (ExecState p sym ext rtp))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) a))
IO
(ExecState p sym ext rtp)
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> IO (ExecState p sym ext rtp))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) a))
IO
(ExecState p sym ext rtp))
-> (SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> IO (ExecState p sym ext rtp))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) a))
IO
(ExecState p sym ext rtp)
forall a b. (a -> b) -> a -> b
$ ExecState p sym ext rtp -> IO (ExecState p sym ext rtp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext rtp -> IO (ExecState p sym ext rtp))
-> (SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> ExecState p sym ext rtp)
-> SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> IO (ExecState p sym ext rtp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlResumption p sym ext rtp (CrucibleLang blocks r)
-> SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> ExecState p sym ext rtp
forall p sym ext rtp f (a :: Ctx CrucibleType).
ControlResumption p sym ext rtp f
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> ExecState p sym ext rtp
ControlTransferState (ResolvedJump sym blocks
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType).
ResolvedJump sym blocks
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
CheckMergeResumption ResolvedJump sym blocks
jmp)
{-# INLINE jumpToBlock #-}
performControlTransfer ::
IsSymInterface sym =>
ControlResumption p sym ext rtp f ->
ExecCont p sym ext rtp f ('Just a)
performControlTransfer :: forall sym p ext rtp f (a :: Ctx CrucibleType).
IsSymInterface sym =>
ControlResumption p sym ext rtp f
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) a)
performControlTransfer ControlResumption p sym ext rtp f
res =
case ControlResumption p sym ext rtp f
res of
ContinueResumption (ResolvedJump BlockID blocks args
block_id RegMap sym args
args) ->
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) a)
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((CallFrame sym ext blocks r a
-> Identity (CallFrame sym ext blocks r args))
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args))
(CallFrame sym ext blocks r a
-> Identity (CallFrame sym ext blocks r args))
-> SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args))
forall p sym ext rtp (blocks :: Ctx (Ctx CrucibleType))
(r :: CrucibleType) (a :: Ctx CrucibleType)
(a' :: Ctx CrucibleType) (f :: Type -> Type).
Functor f =>
(CallFrame sym ext blocks r a -> f (CallFrame sym ext blocks r a'))
-> SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> f (SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) a'))
stateCrucibleFrame ((CallFrame sym ext blocks r a
-> Identity (CallFrame sym ext blocks r args))
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args)))
-> (CallFrame sym ext blocks r a
-> CallFrame sym ext blocks r args)
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ BlockID blocks args
-> RegMap sym args
-> CallFrame sym ext blocks r a
-> CallFrame sym ext blocks r args
forall (blocks :: Ctx (Ctx CrucibleType))
(args :: Ctx CrucibleType) sym ext (ret :: CrucibleType)
(ctx :: Ctx CrucibleType).
BlockID blocks args
-> RegMap sym args
-> CallFrame sym ext blocks ret ctx
-> CallFrame sym ext blocks ret args
setFrameBlock BlockID blocks args
block_id RegMap sym args
args)
(RunningStateInfo blocks args
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
forall (blocks :: Ctx (Ctx CrucibleType)) (a :: Ctx CrucibleType) p
sym ext rtp (r :: CrucibleType).
RunningStateInfo blocks a
-> ExecCont
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
continue (BlockID blocks args -> RunningStateInfo blocks args
forall (blocks :: Ctx (Ctx CrucibleType))
(args :: Ctx CrucibleType).
BlockID blocks args -> RunningStateInfo blocks args
RunBlockStart BlockID blocks args
block_id))
CheckMergeResumption (ResolvedJump BlockID blocks args
block_id RegMap sym args
args) ->
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) a)
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((CallFrame sym ext blocks r a
-> Identity (CallFrame sym ext blocks r args))
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args))
(CallFrame sym ext blocks r a
-> Identity (CallFrame sym ext blocks r args))
-> SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args))
forall p sym ext rtp (blocks :: Ctx (Ctx CrucibleType))
(r :: CrucibleType) (a :: Ctx CrucibleType)
(a' :: Ctx CrucibleType) (f :: Type -> Type).
Functor f =>
(CallFrame sym ext blocks r a -> f (CallFrame sym ext blocks r a'))
-> SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> f (SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) a'))
stateCrucibleFrame ((CallFrame sym ext blocks r a
-> Identity (CallFrame sym ext blocks r args))
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args)))
-> (CallFrame sym ext blocks r a
-> CallFrame sym ext blocks r args)
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ BlockID blocks args
-> RegMap sym args
-> CallFrame sym ext blocks r a
-> CallFrame sym ext blocks r args
forall (blocks :: Ctx (Ctx CrucibleType))
(args :: Ctx CrucibleType) sym ext (ret :: CrucibleType)
(ctx :: Ctx CrucibleType).
BlockID blocks args
-> RegMap sym args
-> CallFrame sym ext blocks ret ctx
-> CallFrame sym ext blocks ret args
setFrameBlock BlockID blocks args
block_id RegMap sym args
args)
(CrucibleBranchTarget
(CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args)
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
forall f (args :: Maybe (Ctx CrucibleType)) p sym ext root.
CrucibleBranchTarget f args -> ExecCont p sym ext root f args
checkForIntraFrameMerge (BlockID blocks args
-> CrucibleBranchTarget
(CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args)
forall (blocks :: Ctx (Ctx CrucibleType))
(args1 :: Ctx CrucibleType) (r :: CrucibleType).
BlockID blocks args1
-> CrucibleBranchTarget
(CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args1)
BlockTarget BlockID blocks args
block_id))
SwitchResumption [(Pred sym, ResolvedJump sym blocks)]
cs ->
[(Pred sym, ResolvedJump sym blocks)]
-> ExecCont
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType) (ctx :: Ctx CrucibleType).
IsSymInterface sym =>
[(Pred sym, ResolvedJump sym blocks)]
-> ExecCont
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)
variantCases [(Pred sym, ResolvedJump sym blocks)]
cs
OverrideResumption ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
k RegMap sym args
args ->
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args))
-> ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) a)
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((OverrideFrame sym r a -> Identity (OverrideFrame sym r args))
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(OverrideFrame sym r a -> Identity (OverrideFrame sym r args))
-> SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args))
forall p sym ext q (r :: CrucibleType) (a :: Ctx CrucibleType)
(a' :: Ctx CrucibleType) (f :: Type -> Type).
Functor f =>
(OverrideFrame sym r a -> f (OverrideFrame sym r a'))
-> SimState
p sym ext q (OverrideLang r) ('Just @(Ctx CrucibleType) a)
-> f (SimState
p sym ext q (OverrideLang r) ('Just @(Ctx CrucibleType) a'))
stateOverrideFrame((OverrideFrame sym r a -> Identity (OverrideFrame sym r args))
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> ((RegMap sym a -> Identity (RegMap sym args))
-> OverrideFrame sym r a -> Identity (OverrideFrame sym r args))
-> (RegMap sym a -> Identity (RegMap sym args))
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(RegMap sym a -> Identity (RegMap sym args))
-> OverrideFrame sym r a -> Identity (OverrideFrame sym r args)
forall sym (ret :: CrucibleType) (args :: Ctx CrucibleType)
(args' :: Ctx CrucibleType) (f :: Type -> Type).
Functor f =>
(RegMap sym args -> f (RegMap sym args'))
-> OverrideFrame sym ret args -> f (OverrideFrame sym ret args')
overrideRegMap ((RegMap sym a -> Identity (RegMap sym args))
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> Identity
(SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> RegMap sym args
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RegMap sym args
args)
ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
k
conditionalBranch ::
(IsSymInterface sym, IsSyntaxExtension ext) =>
Pred sym ->
ResolvedJump sym blocks ->
ResolvedJump sym blocks ->
ExecCont p sym ext rtp (CrucibleLang blocks ret) ('Just ctx)
conditionalBranch :: forall sym ext (blocks :: Ctx (Ctx CrucibleType)) p rtp
(ret :: CrucibleType) (ctx :: Ctx CrucibleType).
(IsSymInterface sym, IsSyntaxExtension ext) =>
Pred sym
-> ResolvedJump sym blocks
-> ResolvedJump sym blocks
-> ExecCont
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)
conditionalBranch Pred sym
p ResolvedJump sym blocks
xjmp ResolvedJump sym blocks
yjmp = do
TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
top_frame <- Getting
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx))
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx))
IO
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view ((ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)))
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree((ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)))
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)))
-> ((TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)))
-> ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)))
-> Getting
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx))
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)))
-> ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx))
forall p sym ext root f1 (args :: Maybe (Ctx CrucibleType))
(args' :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(TopFrame sym ext f1 args -> f2 (TopFrame sym ext f1 args'))
-> ActiveTree p sym ext root f1 args
-> f2 (ActiveTree p sym ext root f1 args')
actFrame)
Some CrucibleBranchTarget (CrucibleLang blocks ret) x
pd <- Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx))
IO
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
forall a.
a
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx))
IO
a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
top_frameTopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
-> Getting
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
-> Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret))
forall s a. s -> Getting a s a -> a
^.(CallFrame sym ext blocks ret ctx
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
(CallFrame sym ext blocks ret ctx))
-> TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(r :: CrucibleType) (args :: Ctx CrucibleType)
(args' :: Ctx CrucibleType) (f :: Type -> Type).
Functor f =>
(CallFrame sym ext blocks r args
-> f (CallFrame sym ext blocks r args'))
-> TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args)
-> f (TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args'))
crucibleTopFrame((CallFrame sym ext blocks ret ctx
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
(CallFrame sym ext blocks ret ctx))
-> TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)))
-> ((Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret))
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret))))
-> CallFrame sym ext blocks ret ctx
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
(CallFrame sym ext blocks ret ctx))
-> Getting
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
(TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx))
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret))
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret))))
-> CallFrame sym ext blocks ret ctx
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret)))
(CallFrame sym ext blocks ret ctx)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (ctx :: Ctx CrucibleType)
(f :: Type -> Type).
Functor f =>
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret))
-> f (Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret))))
-> CallFrame sym ext blocks ret ctx
-> f (CallFrame sym ext blocks ret ctx)
framePostdom)
PausedFrame p sym ext rtp (CrucibleLang blocks ret)
x_frame <- ResolvedJump sym blocks
-> TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
-> CrucibleBranchTarget (CrucibleLang blocks ret) x
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx))
IO
(PausedFrame p sym ext rtp (CrucibleLang blocks ret))
forall sym (b :: Ctx (Ctx CrucibleType)) ext (r :: CrucibleType)
(a :: Ctx CrucibleType) (pd_args :: Maybe (Ctx CrucibleType)) p rtp
(z :: CrucibleType) (dc_args :: Ctx CrucibleType) rtp'.
ResolvedJump sym b
-> GlobalPair
sym
(SimFrame sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a))
-> CrucibleBranchTarget (CrucibleLang b r) pd_args
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang b z)
('Just @(Ctx CrucibleType) dc_args))
IO
(PausedFrame p sym ext rtp' (CrucibleLang b r))
cruciblePausedFrame ResolvedJump sym blocks
xjmp TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
top_frame CrucibleBranchTarget (CrucibleLang blocks ret) x
pd
PausedFrame p sym ext rtp (CrucibleLang blocks ret)
y_frame <- ResolvedJump sym blocks
-> TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
-> CrucibleBranchTarget (CrucibleLang blocks ret) x
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx))
IO
(PausedFrame p sym ext rtp (CrucibleLang blocks ret))
forall sym (b :: Ctx (Ctx CrucibleType)) ext (r :: CrucibleType)
(a :: Ctx CrucibleType) (pd_args :: Maybe (Ctx CrucibleType)) p rtp
(z :: CrucibleType) (dc_args :: Ctx CrucibleType) rtp'.
ResolvedJump sym b
-> GlobalPair
sym
(SimFrame sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a))
-> CrucibleBranchTarget (CrucibleLang b r) pd_args
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang b z)
('Just @(Ctx CrucibleType) dc_args))
IO
(PausedFrame p sym ext rtp' (CrucibleLang b r))
cruciblePausedFrame ResolvedJump sym blocks
yjmp TopFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) ctx)
top_frame CrucibleBranchTarget (CrucibleLang blocks ret) x
pd
Pred sym
-> PausedFrame p sym ext rtp (CrucibleLang blocks ret)
-> PausedFrame p sym ext rtp (CrucibleLang blocks ret)
-> CrucibleBranchTarget (CrucibleLang blocks ret) x
-> ExecCont
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ctx)
forall sym p ext rtp f (args :: Maybe (Ctx CrucibleType))
(dc_args :: Ctx CrucibleType).
IsSymInterface sym =>
Pred sym
-> PausedFrame p sym ext rtp f
-> PausedFrame p sym ext rtp f
-> CrucibleBranchTarget f args
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
intra_branch Pred sym
p PausedFrame p sym ext rtp (CrucibleLang blocks ret)
x_frame PausedFrame p sym ext rtp (CrucibleLang blocks ret)
y_frame CrucibleBranchTarget (CrucibleLang blocks ret) x
pd
variantCases ::
IsSymInterface sym =>
[(Pred sym, ResolvedJump sym blocks)] ->
ExecCont p sym ext rtp (CrucibleLang blocks r) ('Just ctx)
variantCases :: forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType) (ctx :: Ctx CrucibleType).
IsSymInterface sym =>
[(Pred sym, ResolvedJump sym blocks)]
-> ExecCont
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)
variantCases [] =
do CallFrame sym ext blocks r ctx
fm <- Getting
(CallFrame sym ext blocks r ctx)
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
(CallFrame sym ext blocks r ctx)
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
IO
(CallFrame sym ext blocks r ctx)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(CallFrame sym ext blocks r ctx)
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
(CallFrame sym ext blocks r ctx)
forall p sym ext rtp (blocks :: Ctx (Ctx CrucibleType))
(r :: CrucibleType) (a :: Ctx CrucibleType)
(a' :: Ctx CrucibleType) (f :: Type -> Type).
Functor f =>
(CallFrame sym ext blocks r a -> f (CallFrame sym ext blocks r a'))
-> SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> f (SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) a'))
stateCrucibleFrame
let loc :: ProgramLoc
loc = CallFrame sym ext blocks r ctx -> ProgramLoc
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (ctx :: Ctx CrucibleType).
CallFrame sym ext blocks ret ctx -> ProgramLoc
frameProgramLoc CallFrame sym ext blocks r ctx
fm
let rsn :: AbortExecReason
rsn = ProgramLoc -> AbortExecReason
VariantOptionsExhausted ProgramLoc
loc
AbortExecReason
-> ExecCont
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)
forall sym p ext rtp f (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
AbortExecReason -> ExecCont p sym ext rtp f args
abortExec AbortExecReason
rsn
variantCases ((Pred sym
p,ResolvedJump sym blocks
jmp) : [(Pred sym, ResolvedJump sym blocks)]
cs) =
do TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
top_frame <- Getting
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
IO
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view ((ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)))
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree((ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)))
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)))
-> ((TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)))
-> ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)))
-> Getting
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)))
-> ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
forall p sym ext root f1 (args :: Maybe (Ctx CrucibleType))
(args' :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(TopFrame sym ext f1 args -> f2 (TopFrame sym ext f1 args'))
-> ActiveTree p sym ext root f1 args
-> f2 (ActiveTree p sym ext root f1 args')
actFrame)
Some CrucibleBranchTarget (CrucibleLang blocks r) x
pd <- Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
IO
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
forall a.
a
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
IO
a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
top_frameTopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
-> Getting
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
-> Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r))
forall s a. s -> Getting a s a -> a
^.(CallFrame sym ext blocks r ctx
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
(CallFrame sym ext blocks r ctx))
-> TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(r :: CrucibleType) (args :: Ctx CrucibleType)
(args' :: Ctx CrucibleType) (f :: Type -> Type).
Functor f =>
(CallFrame sym ext blocks r args
-> f (CallFrame sym ext blocks r args'))
-> TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args)
-> f (TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args'))
crucibleTopFrame((CallFrame sym ext blocks r ctx
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
(CallFrame sym ext blocks r ctx))
-> TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)))
-> ((Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r))
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r))))
-> CallFrame sym ext blocks r ctx
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
(CallFrame sym ext blocks r ctx))
-> Getting
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
(TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx))
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r))
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r))))
-> CallFrame sym ext blocks r ctx
-> Const
@Type
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks r)))
(CallFrame sym ext blocks r ctx)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (ctx :: Ctx CrucibleType)
(f :: Type -> Type).
Functor f =>
(Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret))
-> f (Some
@(Maybe (Ctx CrucibleType))
(CrucibleBranchTarget (CrucibleLang blocks ret))))
-> CallFrame sym ext blocks ret ctx
-> f (CallFrame sym ext blocks ret ctx)
framePostdom)
PausedFrame p sym ext rtp (CrucibleLang blocks r)
x_frame <- ResolvedJump sym blocks
-> TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
-> CrucibleBranchTarget (CrucibleLang blocks r) x
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx))
IO
(PausedFrame p sym ext rtp (CrucibleLang blocks r))
forall sym (b :: Ctx (Ctx CrucibleType)) ext (r :: CrucibleType)
(a :: Ctx CrucibleType) (pd_args :: Maybe (Ctx CrucibleType)) p rtp
(z :: CrucibleType) (dc_args :: Ctx CrucibleType) rtp'.
ResolvedJump sym b
-> GlobalPair
sym
(SimFrame sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a))
-> CrucibleBranchTarget (CrucibleLang b r) pd_args
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang b z)
('Just @(Ctx CrucibleType) dc_args))
IO
(PausedFrame p sym ext rtp' (CrucibleLang b r))
cruciblePausedFrame ResolvedJump sym blocks
jmp TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
top_frame CrucibleBranchTarget (CrucibleLang blocks r) x
pd
let y_frame :: PausedFrame p sym ext rtp (CrucibleLang blocks r)
y_frame = PartialResultFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp (CrucibleLang blocks r)
forall p sym ext rtp f (old_args :: Ctx CrucibleType).
PartialResultFrame sym ext f ('Just @(Ctx CrucibleType) old_args)
-> ControlResumption p sym ext rtp f
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp f
PausedFrame (TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
-> PartialResultFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
forall sym ext v. GlobalPair sym v -> PartialResult sym ext v
TotalRes TopFrame
sym ext (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) ctx)
top_frame) ([(Pred sym, ResolvedJump sym blocks)]
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType).
[(Pred sym, ResolvedJump sym blocks)]
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
SwitchResumption [(Pred sym, ResolvedJump sym blocks)]
cs) Maybe ProgramLoc
forall a. Maybe a
Nothing
Pred sym
-> PausedFrame p sym ext rtp (CrucibleLang blocks r)
-> PausedFrame p sym ext rtp (CrucibleLang blocks r)
-> CrucibleBranchTarget (CrucibleLang blocks r) x
-> ExecCont
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ctx)
forall sym p ext rtp f (args :: Maybe (Ctx CrucibleType))
(dc_args :: Ctx CrucibleType).
IsSymInterface sym =>
Pred sym
-> PausedFrame p sym ext rtp f
-> PausedFrame p sym ext rtp f
-> CrucibleBranchTarget f args
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
intra_branch Pred sym
p PausedFrame p sym ext rtp (CrucibleLang blocks r)
x_frame PausedFrame p sym ext rtp (CrucibleLang blocks r)
y_frame CrucibleBranchTarget (CrucibleLang blocks r) x
pd
returnValue :: forall p sym ext rtp f args.
RegEntry sym (FrameRetType f) ->
ExecCont p sym ext rtp f args
returnValue :: forall p sym ext rtp f (args :: Maybe (Ctx CrucibleType)).
RegEntry sym (FrameRetType f) -> ExecCont p sym ext rtp f args
returnValue RegEntry sym (FrameRetType f)
arg =
do FunctionName
nm <- Getting FunctionName (SimState p sym ext rtp f args) FunctionName
-> ReaderT (SimState p sym ext rtp f args) IO FunctionName
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view ((ActiveTree p sym ext rtp f args
-> Const @Type FunctionName (ActiveTree p sym ext rtp f args))
-> SimState p sym ext rtp f args
-> Const @Type FunctionName (SimState p sym ext rtp f args)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree((ActiveTree p sym ext rtp f args
-> Const @Type FunctionName (ActiveTree p sym ext rtp f args))
-> SimState p sym ext rtp f args
-> Const @Type FunctionName (SimState p sym ext rtp f args))
-> ((FunctionName -> Const @Type FunctionName FunctionName)
-> ActiveTree p sym ext rtp f args
-> Const @Type FunctionName (ActiveTree p sym ext rtp f args))
-> Getting
FunctionName (SimState p sym ext rtp f args) FunctionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TopFrame sym ext f args
-> Const @Type FunctionName (TopFrame sym ext f args))
-> ActiveTree p sym ext rtp f args
-> Const @Type FunctionName (ActiveTree p sym ext rtp f args)
forall p sym ext root f1 (args :: Maybe (Ctx CrucibleType))
(args' :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(TopFrame sym ext f1 args -> f2 (TopFrame sym ext f1 args'))
-> ActiveTree p sym ext root f1 args
-> f2 (ActiveTree p sym ext root f1 args')
actFrame((TopFrame sym ext f args
-> Const @Type FunctionName (TopFrame sym ext f args))
-> ActiveTree p sym ext rtp f args
-> Const @Type FunctionName (ActiveTree p sym ext rtp f args))
-> ((FunctionName -> Const @Type FunctionName FunctionName)
-> TopFrame sym ext f args
-> Const @Type FunctionName (TopFrame sym ext f args))
-> (FunctionName -> Const @Type FunctionName FunctionName)
-> ActiveTree p sym ext rtp f args
-> Const @Type FunctionName (ActiveTree p sym ext rtp f args)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimFrame sym ext f args
-> Const @Type FunctionName (SimFrame sym ext f args))
-> TopFrame sym ext f args
-> Const @Type FunctionName (TopFrame sym ext f args)
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue((SimFrame sym ext f args
-> Const @Type FunctionName (SimFrame sym ext f args))
-> TopFrame sym ext f args
-> Const @Type FunctionName (TopFrame sym ext f args))
-> ((FunctionName -> Const @Type FunctionName FunctionName)
-> SimFrame sym ext f args
-> Const @Type FunctionName (SimFrame sym ext f args))
-> (FunctionName -> Const @Type FunctionName FunctionName)
-> TopFrame sym ext f args
-> Const @Type FunctionName (TopFrame sym ext f args)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FunctionName -> Const @Type FunctionName FunctionName)
-> SimFrame sym ext f args
-> Const @Type FunctionName (SimFrame sym ext f args)
forall sym ext f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(FunctionName -> f2 FunctionName)
-> SimFrame sym ext f1 a -> f2 (SimFrame sym ext f1 a)
frameFunctionName)
(SimState p sym ext rtp f args
-> SimState p sym ext rtp f ('Nothing @(Ctx CrucibleType)))
-> ReaderT
(SimState p sym ext rtp f ('Nothing @(Ctx CrucibleType)))
IO
(ExecState p sym ext rtp)
-> ExecCont p sym ext rtp f args
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext rtp f args
-> Identity
(ActiveTree p sym ext rtp f ('Nothing @(Ctx CrucibleType))))
-> SimState p sym ext rtp f args
-> Identity
(SimState p sym ext rtp f ('Nothing @(Ctx CrucibleType)))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree((ActiveTree p sym ext rtp f args
-> Identity
(ActiveTree p sym ext rtp f ('Nothing @(Ctx CrucibleType))))
-> SimState p sym ext rtp f args
-> Identity
(SimState p sym ext rtp f ('Nothing @(Ctx CrucibleType))))
-> ((SimFrame sym ext f args
-> Identity (SimFrame sym ext f ('Nothing @(Ctx CrucibleType))))
-> ActiveTree p sym ext rtp f args
-> Identity
(ActiveTree p sym ext rtp f ('Nothing @(Ctx CrucibleType))))
-> (SimFrame sym ext f args
-> Identity (SimFrame sym ext f ('Nothing @(Ctx CrucibleType))))
-> SimState p sym ext rtp f args
-> Identity
(SimState p sym ext rtp f ('Nothing @(Ctx CrucibleType)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TopFrame sym ext f args
-> Identity (TopFrame sym ext f ('Nothing @(Ctx CrucibleType))))
-> ActiveTree p sym ext rtp f args
-> Identity
(ActiveTree p sym ext rtp f ('Nothing @(Ctx CrucibleType)))
forall p sym ext root f1 (args :: Maybe (Ctx CrucibleType))
(args' :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(TopFrame sym ext f1 args -> f2 (TopFrame sym ext f1 args'))
-> ActiveTree p sym ext root f1 args
-> f2 (ActiveTree p sym ext root f1 args')
actFrame((TopFrame sym ext f args
-> Identity (TopFrame sym ext f ('Nothing @(Ctx CrucibleType))))
-> ActiveTree p sym ext rtp f args
-> Identity
(ActiveTree p sym ext rtp f ('Nothing @(Ctx CrucibleType))))
-> ((SimFrame sym ext f args
-> Identity (SimFrame sym ext f ('Nothing @(Ctx CrucibleType))))
-> TopFrame sym ext f args
-> Identity (TopFrame sym ext f ('Nothing @(Ctx CrucibleType))))
-> (SimFrame sym ext f args
-> Identity (SimFrame sym ext f ('Nothing @(Ctx CrucibleType))))
-> ActiveTree p sym ext rtp f args
-> Identity
(ActiveTree p sym ext rtp f ('Nothing @(Ctx CrucibleType)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimFrame sym ext f args
-> Identity (SimFrame sym ext f ('Nothing @(Ctx CrucibleType))))
-> TopFrame sym ext f args
-> Identity (TopFrame sym ext f ('Nothing @(Ctx CrucibleType)))
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue ((SimFrame sym ext f args
-> Identity (SimFrame sym ext f ('Nothing @(Ctx CrucibleType))))
-> SimState p sym ext rtp f args
-> Identity
(SimState p sym ext rtp f ('Nothing @(Ctx CrucibleType))))
-> SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
-> SimState p sym ext rtp f args
-> SimState p sym ext rtp f ('Nothing @(Ctx CrucibleType))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FunctionName
-> RegEntry sym (FrameRetType f)
-> SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
forall sym l ext.
FunctionName
-> RegEntry sym (FrameRetType l)
-> SimFrame sym ext l ('Nothing @(Ctx CrucibleType))
RF FunctionName
nm RegEntry sym (FrameRetType f)
arg)
(CrucibleBranchTarget f ('Nothing @(Ctx CrucibleType))
-> ReaderT
(SimState p sym ext rtp f ('Nothing @(Ctx CrucibleType)))
IO
(ExecState p sym ext rtp)
forall f (args :: Maybe (Ctx CrucibleType)) p sym ext root.
CrucibleBranchTarget f args -> ExecCont p sym ext root f args
checkForIntraFrameMerge CrucibleBranchTarget f ('Nothing @(Ctx CrucibleType))
forall f. CrucibleBranchTarget f ('Nothing @(Ctx CrucibleType))
ReturnTarget)
callFunction ::
IsExprBuilder sym =>
FnVal sym args ret ->
RegMap sym args ->
ReturnHandler ret p sym ext rtp f a ->
ProgramLoc ->
ExecCont p sym ext rtp f a
callFunction :: forall sym (args :: Ctx CrucibleType) (ret :: CrucibleType) p ext
rtp f (a :: Maybe (Ctx CrucibleType)).
IsExprBuilder sym =>
FnVal sym args ret
-> RegMap sym args
-> ReturnHandler ret p sym ext rtp f a
-> ProgramLoc
-> ExecCont p sym ext rtp f a
callFunction FnVal sym args ret
fn RegMap sym args
args ReturnHandler ret p sym ext rtp f a
retHandler ProgramLoc
loc =
do FunctionBindings p sym ext
bindings <- Getting
(FunctionBindings p sym ext)
(SimState p sym ext rtp f a)
(FunctionBindings p sym ext)
-> ReaderT
(SimState p sym ext rtp f a) IO (FunctionBindings p sym ext)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view ((SimContext p sym ext
-> Const @Type (FunctionBindings p sym ext) (SimContext p sym ext))
-> SimState p sym ext rtp f a
-> Const
@Type (FunctionBindings p sym ext) (SimState p sym ext rtp f a)
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(SimContext p sym ext -> f2 (SimContext p sym ext))
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateContext((SimContext p sym ext
-> Const @Type (FunctionBindings p sym ext) (SimContext p sym ext))
-> SimState p sym ext rtp f a
-> Const
@Type (FunctionBindings p sym ext) (SimState p sym ext rtp f a))
-> ((FunctionBindings p sym ext
-> Const
@Type (FunctionBindings p sym ext) (FunctionBindings p sym ext))
-> SimContext p sym ext
-> Const @Type (FunctionBindings p sym ext) (SimContext p sym ext))
-> Getting
(FunctionBindings p sym ext)
(SimState p sym ext rtp f a)
(FunctionBindings p sym ext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FunctionBindings p sym ext
-> Const
@Type (FunctionBindings p sym ext) (FunctionBindings p sym ext))
-> SimContext p sym ext
-> Const @Type (FunctionBindings p sym ext) (SimContext p sym ext)
forall p sym ext (f :: Type -> Type).
Functor f =>
(FunctionBindings p sym ext -> f (FunctionBindings p sym ext))
-> SimContext p sym ext -> f (SimContext p sym ext)
functionBindings)
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack <- Getting
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(SimState p sym ext rtp f a)
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ReaderT
(SimState p sym ext rtp f a)
IO
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view ((ActiveTree p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(ActiveTree p sym ext rtp f a))
-> SimState p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(SimState p sym ext rtp f a)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(ActiveTree p sym ext rtp f a))
-> SimState p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(SimState p sym ext rtp f a))
-> (([SomeFrame
@Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)])
-> ActiveTree p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(ActiveTree p sym ext rtp f a))
-> Getting
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(SimState p sym ext rtp f a)
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveTree p sym ext rtp f a
-> [SomeFrame
@Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)])
-> ([SomeFrame
@Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)])
-> ActiveTree p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(ActiveTree p sym ext rtp f a)
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' @Type @Type p f s a
to ActiveTree p sym ext rtp f a
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
forall ctx sym ext root a (args :: Maybe (Ctx CrucibleType)).
ActiveTree ctx sym ext root a args
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
activeFrames)
let rcall :: ResolvedCall p sym ext ret
rcall = FunctionBindings p sym ext
-> FnVal sym args ret
-> RegMap sym args
-> ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ResolvedCall p sym ext ret
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
FunctionBindings p sym ext
-> FnVal sym args ret
-> RegMap sym args
-> ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ResolvedCall p sym ext ret
resolveCall FunctionBindings p sym ext
bindings FnVal sym args ret
fn RegMap sym args
args ProgramLoc
loc [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack
(SimState p sym ext rtp f a -> IO (ExecState p sym ext rtp))
-> ExecCont p sym ext rtp f a
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((SimState p sym ext rtp f a -> IO (ExecState p sym ext rtp))
-> ExecCont p sym ext rtp f a)
-> (SimState p sym ext rtp f a -> IO (ExecState p sym ext rtp))
-> ExecCont p sym ext rtp f a
forall a b. (a -> b) -> a -> b
$ ExecState p sym ext rtp -> IO (ExecState p sym ext rtp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext rtp -> IO (ExecState p sym ext rtp))
-> (SimState p sym ext rtp f a -> ExecState p sym ext rtp)
-> SimState p sym ext rtp f a
-> IO (ExecState p sym ext rtp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReturnHandler ret p sym ext rtp f a
-> ResolvedCall p sym ext ret
-> SimState p sym ext rtp f a
-> ExecState p sym ext rtp
forall p sym ext rtp f (a :: Maybe (Ctx CrucibleType))
(ret :: CrucibleType).
ReturnHandler ret p sym ext rtp f a
-> ResolvedCall p sym ext ret
-> SimState p sym ext rtp f a
-> ExecState p sym ext rtp
CallState ReturnHandler ret p sym ext rtp f a
retHandler ResolvedCall p sym ext ret
rcall
tailCallFunction ::
FrameRetType f ~ ret =>
FnVal sym args ret ->
RegMap sym args ->
ValueFromValue p sym ext rtp ret ->
ProgramLoc ->
ExecCont p sym ext rtp f a
tailCallFunction :: forall f (ret :: CrucibleType) sym (args :: Ctx CrucibleType) p ext
rtp (a :: Maybe (Ctx CrucibleType)).
((FrameRetType f :: CrucibleType) ~ (ret :: CrucibleType)) =>
FnVal sym args ret
-> RegMap sym args
-> ValueFromValue p sym ext rtp ret
-> ProgramLoc
-> ExecCont p sym ext rtp f a
tailCallFunction FnVal sym args ret
fn RegMap sym args
args ValueFromValue p sym ext rtp ret
vfv ProgramLoc
loc =
do FunctionBindings p sym ext
bindings <- Getting
(FunctionBindings p sym ext)
(SimState p sym ext rtp f a)
(FunctionBindings p sym ext)
-> ReaderT
(SimState p sym ext rtp f a) IO (FunctionBindings p sym ext)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view ((SimContext p sym ext
-> Const @Type (FunctionBindings p sym ext) (SimContext p sym ext))
-> SimState p sym ext rtp f a
-> Const
@Type (FunctionBindings p sym ext) (SimState p sym ext rtp f a)
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(SimContext p sym ext -> f2 (SimContext p sym ext))
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateContext((SimContext p sym ext
-> Const @Type (FunctionBindings p sym ext) (SimContext p sym ext))
-> SimState p sym ext rtp f a
-> Const
@Type (FunctionBindings p sym ext) (SimState p sym ext rtp f a))
-> ((FunctionBindings p sym ext
-> Const
@Type (FunctionBindings p sym ext) (FunctionBindings p sym ext))
-> SimContext p sym ext
-> Const @Type (FunctionBindings p sym ext) (SimContext p sym ext))
-> Getting
(FunctionBindings p sym ext)
(SimState p sym ext rtp f a)
(FunctionBindings p sym ext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FunctionBindings p sym ext
-> Const
@Type (FunctionBindings p sym ext) (FunctionBindings p sym ext))
-> SimContext p sym ext
-> Const @Type (FunctionBindings p sym ext) (SimContext p sym ext)
forall p sym ext (f :: Type -> Type).
Functor f =>
(FunctionBindings p sym ext -> f (FunctionBindings p sym ext))
-> SimContext p sym ext -> f (SimContext p sym ext)
functionBindings)
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack <- Getting
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(SimState p sym ext rtp f a)
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ReaderT
(SimState p sym ext rtp f a)
IO
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view ((ActiveTree p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(ActiveTree p sym ext rtp f a))
-> SimState p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(SimState p sym ext rtp f a)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(ActiveTree p sym ext rtp f a))
-> SimState p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(SimState p sym ext rtp f a))
-> (([SomeFrame
@Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)])
-> ActiveTree p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(ActiveTree p sym ext rtp f a))
-> Getting
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(SimState p sym ext rtp f a)
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveTree p sym ext rtp f a
-> [SomeFrame
@Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)])
-> ([SomeFrame
@Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)])
-> ActiveTree p sym ext rtp f a
-> Const
@Type
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
(ActiveTree p sym ext rtp f a)
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' @Type @Type p f s a
to ActiveTree p sym ext rtp f a
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
forall ctx sym ext root a (args :: Maybe (Ctx CrucibleType)).
ActiveTree ctx sym ext root a args
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
activeFrames)
let rcall :: ResolvedCall p sym ext ret
rcall = FunctionBindings p sym ext
-> FnVal sym args ret
-> RegMap sym args
-> ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ResolvedCall p sym ext ret
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType).
FunctionBindings p sym ext
-> FnVal sym args ret
-> RegMap sym args
-> ProgramLoc
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> ResolvedCall p sym ext ret
resolveCall FunctionBindings p sym ext
bindings FnVal sym args ret
fn RegMap sym args
args ProgramLoc
loc [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
callStack
(SimState p sym ext rtp f a -> IO (ExecState p sym ext rtp))
-> ExecCont p sym ext rtp f a
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((SimState p sym ext rtp f a -> IO (ExecState p sym ext rtp))
-> ExecCont p sym ext rtp f a)
-> (SimState p sym ext rtp f a -> IO (ExecState p sym ext rtp))
-> ExecCont p sym ext rtp f a
forall a b. (a -> b) -> a -> b
$ ExecState p sym ext rtp -> IO (ExecState p sym ext rtp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext rtp -> IO (ExecState p sym ext rtp))
-> (SimState p sym ext rtp f a -> ExecState p sym ext rtp)
-> SimState p sym ext rtp f a
-> IO (ExecState p sym ext rtp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueFromValue p sym ext rtp ret
-> ResolvedCall p sym ext ret
-> SimState p sym ext rtp f a
-> ExecState p sym ext rtp
forall p sym ext rtp f (a :: Maybe (Ctx CrucibleType))
(ret :: CrucibleType).
ValueFromValue p sym ext rtp ret
-> ResolvedCall p sym ext ret
-> SimState p sym ext rtp f a
-> ExecState p sym ext rtp
TailCallState ValueFromValue p sym ext rtp ret
vfv ResolvedCall p sym ext ret
rcall
checkForIntraFrameMerge ::
CrucibleBranchTarget f args
->
ExecCont p sym ext root f args
checkForIntraFrameMerge :: forall f (args :: Maybe (Ctx CrucibleType)) p sym ext root.
CrucibleBranchTarget f args -> ExecCont p sym ext root f args
checkForIntraFrameMerge CrucibleBranchTarget f args
tgt =
(SimState p sym ext root f args -> IO (ExecState p sym ext root))
-> ReaderT
(SimState p sym ext root f args) IO (ExecState p sym ext root)
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((SimState p sym ext root f args -> IO (ExecState p sym ext root))
-> ReaderT
(SimState p sym ext root f args) IO (ExecState p sym ext root))
-> (SimState p sym ext root f args
-> IO (ExecState p sym ext root))
-> ReaderT
(SimState p sym ext root f args) IO (ExecState p sym ext root)
forall a b. (a -> b) -> a -> b
$ ExecState p sym ext root -> IO (ExecState p sym ext root)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext root -> IO (ExecState p sym ext root))
-> (SimState p sym ext root f args -> ExecState p sym ext root)
-> SimState p sym ext root f args
-> IO (ExecState p sym ext root)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CrucibleBranchTarget f args
-> SimState p sym ext root f args -> ExecState p sym ext root
forall p sym ext rtp f (args :: Maybe (Ctx CrucibleType)).
CrucibleBranchTarget f args
-> SimState p sym ext rtp f args -> ExecState p sym ext rtp
BranchMergeState CrucibleBranchTarget f args
tgt
assumeInNewFrame ::
IsSymBackend sym bak =>
bak ->
Assumption sym ->
IO FrameIdentifier
assumeInNewFrame :: forall sym bak.
IsSymBackend sym bak =>
bak -> Assumption sym -> IO FrameIdentifier
assumeInNewFrame bak
bak Assumption sym
asm =
do FrameIdentifier
frm <- bak -> IO FrameIdentifier
forall sym bak. IsSymBackend sym bak => bak -> IO FrameIdentifier
pushAssumptionFrame bak
bak
forall e a. Exception e => IO a -> IO (Either e a)
Ex.try @Ex.SomeException (bak -> Assumption sym -> IO ()
forall sym bak.
IsSymBackend sym bak =>
bak -> Assumption sym -> IO ()
addAssumption bak
bak Assumption sym
asm) IO (Either SomeException ())
-> (Either SomeException () -> IO FrameIdentifier)
-> IO FrameIdentifier
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left SomeException
ex ->
do IO (CrucibleAssumptions (SymExpr sym)) -> IO ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (IO (CrucibleAssumptions (SymExpr sym)) -> IO ())
-> IO (CrucibleAssumptions (SymExpr sym)) -> IO ()
forall a b. (a -> b) -> a -> b
$ bak -> FrameIdentifier -> IO (CrucibleAssumptions (SymExpr sym))
forall sym bak.
IsSymBackend sym bak =>
bak -> FrameIdentifier -> IO (Assumptions sym)
popAssumptionFrame bak
bak FrameIdentifier
frm
SomeException -> IO FrameIdentifier
forall a e. Exception e => e -> a
Ex.throw SomeException
ex
Right () -> FrameIdentifier -> IO FrameIdentifier
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return FrameIdentifier
frm
performIntraFrameMerge ::
IsSymInterface sym =>
CrucibleBranchTarget f args
->
ExecCont p sym ext root f args
performIntraFrameMerge :: forall sym f (args :: Maybe (Ctx CrucibleType)) p ext root.
IsSymInterface sym =>
CrucibleBranchTarget f args -> ExecCont p sym ext root f args
performIntraFrameMerge CrucibleBranchTarget f args
tgt = do
ActiveTree ValueFromFrame p sym ext root f
ctx0 PartialResultFrame sym ext f args
er <- Getting
(ActiveTree p sym ext root f args)
(SimState p sym ext root f args)
(ActiveTree p sym ext root f args)
-> ReaderT
(SimState p sym ext root f args)
IO
(ActiveTree p sym ext root f args)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext root f args)
(SimState p sym ext root f args)
(ActiveTree p sym ext root f args)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
SimContext p sym ext
simCtx <- Getting
(SimContext p sym ext)
(SimState p sym ext root f args)
(SimContext p sym ext)
-> ReaderT
(SimState p sym ext root f args) IO (SimContext p sym ext)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(SimContext p sym ext)
(SimState p sym ext root f args)
(SimContext p sym ext)
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(SimContext p sym ext -> f2 (SimContext p sym ext))
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateContext
sym
sym <- Getting sym (SimState p sym ext root f args) sym
-> ReaderT (SimState p sym ext root f args) IO sym
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting sym (SimState p sym ext root f args) sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
SimContext p sym ext
-> (forall {bak}.
IsSymBackend sym bak =>
bak -> ExecCont p sym ext root f args)
-> ExecCont p sym ext root f args
forall personality sym ext a.
SimContext personality sym ext
-> (forall bak. IsSymBackend sym bak => bak -> a) -> a
withBackend SimContext p sym ext
simCtx ((forall {bak}.
IsSymBackend sym bak =>
bak -> ExecCont p sym ext root f args)
-> ExecCont p sym ext root f args)
-> (forall {bak}.
IsSymBackend sym bak =>
bak -> ExecCont p sym ext root f args)
-> ExecCont p sym ext root f args
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
case ValueFromFrame p sym ext root f
ctx0 of
VFFBranch ValueFromFrame p sym ext root f
ctx FrameIdentifier
assume_frame ProgramLoc
loc Pred sym
pred VFFOtherPath p sym ext root f args
other_branch CrucibleBranchTarget f args
tgt'
| Just (:~:) @(Maybe (Ctx CrucibleType)) args args
Refl <- CrucibleBranchTarget f args
-> CrucibleBranchTarget f args
-> Maybe ((:~:) @(Maybe (Ctx CrucibleType)) args args)
forall (a :: Maybe (Ctx CrucibleType))
(b :: Maybe (Ctx CrucibleType)).
CrucibleBranchTarget f a
-> CrucibleBranchTarget f b
-> Maybe ((:~:) @(Maybe (Ctx CrucibleType)) a b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality @k f =>
f a -> f b -> Maybe ((:~:) @k a b)
testEquality CrucibleBranchTarget f args
tgt CrucibleBranchTarget f args
tgt' ->
case VFFOtherPath p sym ext root f args
other_branch of
VFFActivePath PausedFrame p sym ext root f
next ->
do CrucibleAssumptions (SymExpr sym)
pathAssumes <- IO (CrucibleAssumptions (SymExpr sym))
-> ReaderT
(SimState p sym ext root f args)
IO
(CrucibleAssumptions (SymExpr sym))
forall a. IO a -> ReaderT (SimState p sym ext root f args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (CrucibleAssumptions (SymExpr sym))
-> ReaderT
(SimState p sym ext root f args)
IO
(CrucibleAssumptions (SymExpr sym)))
-> IO (CrucibleAssumptions (SymExpr sym))
-> ReaderT
(SimState p sym ext root f args)
IO
(CrucibleAssumptions (SymExpr sym))
forall a b. (a -> b) -> a -> b
$ bak -> FrameIdentifier -> IO (CrucibleAssumptions (SymExpr sym))
forall sym bak.
IsSymBackend sym bak =>
bak -> FrameIdentifier -> IO (Assumptions sym)
popAssumptionFrame bak
bak FrameIdentifier
assume_frame
Pred sym
pnot <- IO (Pred sym)
-> ReaderT (SimState p sym ext root f args) IO (Pred sym)
forall a. IO a -> ReaderT (SimState p sym ext root f args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Pred sym)
-> ReaderT (SimState p sym ext root f args) IO (Pred sym))
-> IO (Pred sym)
-> ReaderT (SimState p sym ext root f args) IO (Pred sym)
forall a b. (a -> b) -> a -> b
$ sym -> Pred sym -> IO (Pred sym)
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred sym
sym Pred sym
pred
FrameIdentifier
new_assume_frame <-
IO FrameIdentifier
-> ReaderT (SimState p sym ext root f args) IO FrameIdentifier
forall a. IO a -> ReaderT (SimState p sym ext root f args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO FrameIdentifier
-> ReaderT (SimState p sym ext root f args) IO FrameIdentifier)
-> IO FrameIdentifier
-> ReaderT (SimState p sym ext root f args) IO FrameIdentifier
forall a b. (a -> b) -> a -> b
$ bak -> Assumption sym -> IO FrameIdentifier
forall sym bak.
IsSymBackend sym bak =>
bak -> Assumption sym -> IO FrameIdentifier
assumeInNewFrame bak
bak (ProgramLoc -> Maybe ProgramLoc -> Pred sym -> Assumption sym
forall (e :: BaseType -> Type).
ProgramLoc
-> Maybe ProgramLoc -> e BaseBoolType -> CrucibleAssumption e
BranchCondition ProgramLoc
loc (PausedFrame p sym ext root f -> Maybe ProgramLoc
forall p sym ext rtp f.
PausedFrame p sym ext rtp f -> Maybe ProgramLoc
pausedLoc PausedFrame p sym ext root f
next) Pred sym
pnot)
let new_other :: VFFOtherPath p sym ext root f args
new_other = CrucibleAssumptions (SymExpr sym)
-> PartialResultFrame sym ext f args
-> VFFOtherPath p sym ext root f args
forall p sym ext ret f (args :: Maybe (Ctx CrucibleType)).
Assumptions sym
-> PartialResultFrame sym ext f args
-> VFFOtherPath p sym ext ret f args
VFFCompletePath CrucibleAssumptions (SymExpr sym)
pathAssumes PartialResultFrame sym ext f args
er
PausedFrame p sym ext root f
-> ValueFromFrame p sym ext root f
-> ExecCont p sym ext root f args
forall sym p ext rtp f g (ba :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
PausedFrame p sym ext rtp f
-> ValueFromFrame p sym ext rtp f -> ExecCont p sym ext rtp g ba
resumeFrame PausedFrame p sym ext root f
next (ValueFromFrame p sym ext root f
-> FrameIdentifier
-> ProgramLoc
-> Pred sym
-> VFFOtherPath p sym ext root f args
-> CrucibleBranchTarget f args
-> ValueFromFrame p sym ext root f
forall p sym ext ret f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext ret f
-> FrameIdentifier
-> ProgramLoc
-> Pred sym
-> VFFOtherPath p sym ext ret f args
-> CrucibleBranchTarget f args
-> ValueFromFrame p sym ext ret f
VFFBranch ValueFromFrame p sym ext root f
ctx FrameIdentifier
new_assume_frame ProgramLoc
loc Pred sym
pnot VFFOtherPath p sym ext root f args
new_other CrucibleBranchTarget f args
tgt)
VFFCompletePath CrucibleAssumptions (SymExpr sym)
otherAssumes PartialResultFrame sym ext f args
other ->
do PartialResultFrame sym ext f args
ar <- (SimState p sym ext root f args
-> IO (PartialResultFrame sym ext f args))
-> ReaderT
(SimState p sym ext root f args)
IO
(PartialResultFrame sym ext f args)
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((SimState p sym ext root f args
-> IO (PartialResultFrame sym ext f args))
-> ReaderT
(SimState p sym ext root f args)
IO
(PartialResultFrame sym ext f args))
-> (SimState p sym ext root f args
-> IO (PartialResultFrame sym ext f args))
-> ReaderT
(SimState p sym ext root f args)
IO
(PartialResultFrame sym ext f args)
forall a b. (a -> b) -> a -> b
$ \SimState p sym ext root f args
s ->
SimState p sym ext root f args
-> CrucibleBranchTarget f args
-> MuxFn (Pred sym) (PartialResultFrame sym ext f args)
forall sym p ext root f (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
SimState p sym ext root f args
-> CrucibleBranchTarget f args
-> MuxFn (Pred sym) (PartialResultFrame sym ext f args)
mergePartialResult SimState p sym ext root f args
s CrucibleBranchTarget f args
tgt Pred sym
pred PartialResultFrame sym ext f args
er PartialResultFrame sym ext f args
PartialResultFrame sym ext f args
other
CrucibleAssumptions (SymExpr sym)
pathAssumes <- IO (CrucibleAssumptions (SymExpr sym))
-> ReaderT
(SimState p sym ext root f args)
IO
(CrucibleAssumptions (SymExpr sym))
forall a. IO a -> ReaderT (SimState p sym ext root f args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (CrucibleAssumptions (SymExpr sym))
-> ReaderT
(SimState p sym ext root f args)
IO
(CrucibleAssumptions (SymExpr sym)))
-> IO (CrucibleAssumptions (SymExpr sym))
-> ReaderT
(SimState p sym ext root f args)
IO
(CrucibleAssumptions (SymExpr sym))
forall a b. (a -> b) -> a -> b
$ bak -> FrameIdentifier -> IO (CrucibleAssumptions (SymExpr sym))
forall sym bak.
IsSymBackend sym bak =>
bak -> FrameIdentifier -> IO (Assumptions sym)
popAssumptionFrame bak
bak FrameIdentifier
assume_frame
IO () -> ReaderT (SimState p sym ext root f args) IO ()
forall a. IO a -> ReaderT (SimState p sym ext root f args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (SimState p sym ext root f args) IO ())
-> IO () -> ReaderT (SimState p sym ext root f args) IO ()
forall a b. (a -> b) -> a -> b
$ bak -> CrucibleAssumptions (SymExpr sym) -> IO ()
forall sym bak.
IsSymBackend sym bak =>
bak -> Assumptions sym -> IO ()
addAssumptions bak
bak
(CrucibleAssumptions (SymExpr sym) -> IO ())
-> IO (CrucibleAssumptions (SymExpr sym)) -> IO ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym
-> Pred sym
-> CrucibleAssumptions (SymExpr sym)
-> CrucibleAssumptions (SymExpr sym)
-> IO (CrucibleAssumptions (SymExpr sym))
forall sym.
IsExprBuilder sym =>
sym
-> Pred sym
-> Assumptions sym
-> Assumptions sym
-> IO (Assumptions sym)
mergeAssumptions sym
sym Pred sym
pred CrucibleAssumptions (SymExpr sym)
pathAssumes CrucibleAssumptions (SymExpr sym)
otherAssumes
(SimState p sym ext root f args -> SimState p sym ext root f args)
-> ExecCont p sym ext root f args -> ExecCont p sym ext root f args
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext root f args
-> Identity (ActiveTree p sym ext root f args))
-> SimState p sym ext root f args
-> Identity (SimState p sym ext root f args)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext root f args
-> Identity (ActiveTree p sym ext root f args))
-> SimState p sym ext root f args
-> Identity (SimState p sym ext root f args))
-> ActiveTree p sym ext root f args
-> SimState p sym ext root f args
-> SimState p sym ext root f args
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree ValueFromFrame p sym ext root f
ctx PartialResultFrame sym ext f args
ar)
(CrucibleBranchTarget f args -> ExecCont p sym ext root f args
forall f (args :: Maybe (Ctx CrucibleType)) p sym ext root.
CrucibleBranchTarget f args -> ExecCont p sym ext root f args
checkForIntraFrameMerge CrucibleBranchTarget f args
tgt)
VFFPartial ValueFromFrame p sym ext root f
ctx ProgramLoc
loc Pred sym
pred AbortedResult sym ext
ar PendingPartialMerges
needsAborting ->
do PartialResultFrame sym ext f args
er' <- case PendingPartialMerges
needsAborting of
PendingPartialMerges
NoNeedToAbort -> PartialResultFrame sym ext f args
-> ReaderT
(SimState p sym ext root f args)
IO
(PartialResultFrame sym ext f args)
forall a. a -> ReaderT (SimState p sym ext root f args) IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PartialResultFrame sym ext f args
er
PendingPartialMerges
NeedsToBeAborted -> (SimState p sym ext root f args
-> IO (PartialResultFrame sym ext f args))
-> ReaderT
(SimState p sym ext root f args)
IO
(PartialResultFrame sym ext f args)
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((SimState p sym ext root f args
-> IO (PartialResultFrame sym ext f args))
-> ReaderT
(SimState p sym ext root f args)
IO
(PartialResultFrame sym ext f args))
-> (SimState p sym ext root f args
-> IO (PartialResultFrame sym ext f args))
-> ReaderT
(SimState p sym ext root f args)
IO
(PartialResultFrame sym ext f args)
forall a b. (a -> b) -> a -> b
$ \SimState p sym ext root f args
s -> SimState p sym ext root f args
-> CrucibleBranchTarget f args
-> PartialResultFrame sym ext f args
-> IO (PartialResultFrame sym ext f args)
forall sym p ext r f (args :: Maybe (Ctx CrucibleType))
(a' :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
SimState p sym ext r f args
-> CrucibleBranchTarget f a'
-> PartialResultFrame sym ext f a'
-> IO (PartialResultFrame sym ext f a')
abortPartialResult SimState p sym ext root f args
s CrucibleBranchTarget f args
tgt PartialResultFrame sym ext f args
er
PartialResultFrame sym ext f args
er'' <- IO (PartialResultFrame sym ext f args)
-> ReaderT
(SimState p sym ext root f args)
IO
(PartialResultFrame sym ext f args)
forall a. IO a -> ReaderT (SimState p sym ext root f args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (PartialResultFrame sym ext f args)
-> ReaderT
(SimState p sym ext root f args)
IO
(PartialResultFrame sym ext f args))
-> IO (PartialResultFrame sym ext f args)
-> ReaderT
(SimState p sym ext root f args)
IO
(PartialResultFrame sym ext f args)
forall a b. (a -> b) -> a -> b
$
sym
-> ProgramLoc
-> Pred sym
-> PartialResultFrame sym ext f args
-> AbortedResult sym ext
-> IO (PartialResultFrame sym ext f args)
forall sym ext v.
IsExprBuilder sym =>
sym
-> ProgramLoc
-> Pred sym
-> PartialResult sym ext v
-> AbortedResult sym ext
-> IO (PartialResult sym ext v)
mergePartialAndAbortedResult sym
sym ProgramLoc
loc Pred sym
pred PartialResultFrame sym ext f args
er' AbortedResult sym ext
ar
(SimState p sym ext root f args -> SimState p sym ext root f args)
-> ExecCont p sym ext root f args -> ExecCont p sym ext root f args
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext root f args
-> Identity (ActiveTree p sym ext root f args))
-> SimState p sym ext root f args
-> Identity (SimState p sym ext root f args)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext root f args
-> Identity (ActiveTree p sym ext root f args))
-> SimState p sym ext root f args
-> Identity (SimState p sym ext root f args))
-> ActiveTree p sym ext root f args
-> SimState p sym ext root f args
-> SimState p sym ext root f args
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree ValueFromFrame p sym ext root f
ctx PartialResultFrame sym ext f args
er'')
(CrucibleBranchTarget f args -> ExecCont p sym ext root f args
forall f (args :: Maybe (Ctx CrucibleType)) p sym ext root.
CrucibleBranchTarget f args -> ExecCont p sym ext root f args
checkForIntraFrameMerge CrucibleBranchTarget f args
tgt)
ValueFromFrame p sym ext root f
_ -> case CrucibleBranchTarget f args
tgt of
BlockTarget BlockID blocks args1
bid ->
RunningStateInfo blocks args1
-> ExecCont
p
sym
ext
root
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) args1)
forall (blocks :: Ctx (Ctx CrucibleType)) (a :: Ctx CrucibleType) p
sym ext rtp (r :: CrucibleType).
RunningStateInfo blocks a
-> ExecCont
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
continue (BlockID blocks args1 -> RunningStateInfo blocks args1
forall (blocks :: Ctx (Ctx CrucibleType))
(args :: Ctx CrucibleType).
BlockID blocks args -> RunningStateInfo blocks args
RunPostBranchMerge BlockID blocks args1
bid)
CrucibleBranchTarget f args
ReturnTarget ->
FunctionName
-> ValueFromValue p sym ext root (FrameRetType f)
-> RegEntry sym (FrameRetType f)
-> ExecCont p sym ext root f args
forall sym p ext r (ret :: CrucibleType) f
(a :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
FunctionName
-> ValueFromValue p sym ext r ret
-> RegEntry sym ret
-> ExecCont p sym ext r f a
handleSimReturn
(PartialResultFrame sym ext f args
erPartialResultFrame sym ext f args
-> Getting
FunctionName (PartialResultFrame sym ext f args) FunctionName
-> FunctionName
forall s a. s -> Getting a s a -> a
^.(GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type FunctionName (GlobalPair sym (SimFrame sym ext f args)))
-> PartialResultFrame sym ext f args
-> Const @Type FunctionName (PartialResultFrame sym ext f args)
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue((GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type FunctionName (GlobalPair sym (SimFrame sym ext f args)))
-> PartialResultFrame sym ext f args
-> Const @Type FunctionName (PartialResultFrame sym ext f args))
-> ((FunctionName -> Const @Type FunctionName FunctionName)
-> GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type FunctionName (GlobalPair sym (SimFrame sym ext f args)))
-> Getting
FunctionName (PartialResultFrame sym ext f args) FunctionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimFrame sym ext f args
-> Const @Type FunctionName (SimFrame sym ext f args))
-> GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type FunctionName (GlobalPair sym (SimFrame sym ext f args))
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue((SimFrame sym ext f args
-> Const @Type FunctionName (SimFrame sym ext f args))
-> GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type FunctionName (GlobalPair sym (SimFrame sym ext f args)))
-> ((FunctionName -> Const @Type FunctionName FunctionName)
-> SimFrame sym ext f args
-> Const @Type FunctionName (SimFrame sym ext f args))
-> (FunctionName -> Const @Type FunctionName FunctionName)
-> GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type FunctionName (GlobalPair sym (SimFrame sym ext f args))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FunctionName -> Const @Type FunctionName FunctionName)
-> SimFrame sym ext f args
-> Const @Type FunctionName (SimFrame sym ext f args)
forall sym ext f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(FunctionName -> f2 FunctionName)
-> SimFrame sym ext f1 a -> f2 (SimFrame sym ext f1 a)
frameFunctionName)
(ValueFromFrame p sym ext root f
-> ValueFromValue p sym ext root (FrameRetType f)
forall ctx sym ext root f.
ValueFromFrame ctx sym ext root f
-> ValueFromValue ctx sym ext root (FrameRetType f)
returnContext ValueFromFrame p sym ext root f
ctx0)
(PartialResultFrame sym ext f args
erPartialResultFrame sym ext f args
-> Getting
(RegEntry sym (FrameRetType f))
(PartialResultFrame sym ext f args)
(RegEntry sym (FrameRetType f))
-> RegEntry sym (FrameRetType f)
forall s a. s -> Getting a s a -> a
^.(GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type
(RegEntry sym (FrameRetType f))
(GlobalPair sym (SimFrame sym ext f args)))
-> PartialResultFrame sym ext f args
-> Const
@Type
(RegEntry sym (FrameRetType f))
(PartialResultFrame sym ext f args)
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue((GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type
(RegEntry sym (FrameRetType f))
(GlobalPair sym (SimFrame sym ext f args)))
-> PartialResultFrame sym ext f args
-> Const
@Type
(RegEntry sym (FrameRetType f))
(PartialResultFrame sym ext f args))
-> ((RegEntry sym (FrameRetType f)
-> Const
@Type
(RegEntry sym (FrameRetType f))
(RegEntry sym (FrameRetType f)))
-> GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type
(RegEntry sym (FrameRetType f))
(GlobalPair sym (SimFrame sym ext f args)))
-> Getting
(RegEntry sym (FrameRetType f))
(PartialResultFrame sym ext f args)
(RegEntry sym (FrameRetType f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimFrame sym ext f args
-> Const
@Type (RegEntry sym (FrameRetType f)) (SimFrame sym ext f args))
-> GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type
(RegEntry sym (FrameRetType f))
(GlobalPair sym (SimFrame sym ext f args))
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue((SimFrame sym ext f args
-> Const
@Type (RegEntry sym (FrameRetType f)) (SimFrame sym ext f args))
-> GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type
(RegEntry sym (FrameRetType f))
(GlobalPair sym (SimFrame sym ext f args)))
-> ((RegEntry sym (FrameRetType f)
-> Const
@Type
(RegEntry sym (FrameRetType f))
(RegEntry sym (FrameRetType f)))
-> SimFrame sym ext f args
-> Const
@Type (RegEntry sym (FrameRetType f)) (SimFrame sym ext f args))
-> (RegEntry sym (FrameRetType f)
-> Const
@Type
(RegEntry sym (FrameRetType f))
(RegEntry sym (FrameRetType f)))
-> GlobalPair sym (SimFrame sym ext f args)
-> Const
@Type
(RegEntry sym (FrameRetType f))
(GlobalPair sym (SimFrame sym ext f args))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
-> RegEntry sym (FrameRetType f))
-> Optic'
@Type
@Type
((->) @LiftedRep @LiftedRep)
(Const @Type (RegEntry sym (FrameRetType f)))
(SimFrame sym ext f ('Nothing @(Ctx CrucibleType)))
(RegEntry sym (FrameRetType f))
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' @Type @Type p f s a
to SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
-> RegEntry sym (FrameRetType f)
forall sym ext f.
SimFrame sym ext f ('Nothing @(Ctx CrucibleType))
-> RegEntry sym (FrameRetType f)
fromReturnFrame)
defaultAbortHandler :: IsSymInterface sym => AbortHandler p sym ext rtp
defaultAbortHandler :: forall sym p ext rtp.
IsSymInterface sym =>
AbortHandler p sym ext rtp
defaultAbortHandler = (forall l (args :: Maybe (Ctx CrucibleType)).
AbortExecReason -> ExecCont p sym ext rtp l args)
-> AbortHandler p sym ext rtp
forall p sym ext rtp.
(forall l (args :: Maybe (Ctx CrucibleType)).
AbortExecReason -> ExecCont p sym ext rtp l args)
-> AbortHandler p sym ext rtp
AH AbortExecReason -> ExecCont p sym ext rtp l args
forall l (args :: Maybe (Ctx CrucibleType)).
AbortExecReason -> ExecCont p sym ext rtp l args
forall sym p ext rtp f (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
AbortExecReason -> ExecCont p sym ext rtp f args
abortExecAndLog
abortExecAndLog ::
IsSymInterface sym =>
AbortExecReason ->
ExecCont p sym ext rtp f args
abortExecAndLog :: forall sym p ext rtp f (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
AbortExecReason -> ExecCont p sym ext rtp f args
abortExecAndLog AbortExecReason
rsn = do
ActiveTree p sym ext rtp f args
t <- Getting
(ActiveTree p sym ext rtp f args)
(SimState p sym ext rtp f args)
(ActiveTree p sym ext rtp f args)
-> ReaderT
(SimState p sym ext rtp f args)
IO
(ActiveTree p sym ext rtp f args)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext rtp f args)
(SimState p sym ext rtp f args)
(ActiveTree p sym ext rtp f args)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
Config
cfg <- Getting Config (SimState p sym ext rtp f args) Config
-> ReaderT (SimState p sym ext rtp f args) IO Config
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting Config (SimState p sym ext rtp f args) Config
forall p sym ext r f1 (args :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(Config -> f2 Config)
-> SimState p sym ext r f1 args
-> f2 (SimState p sym ext r f1 args)
stateConfiguration
SimContext p sym ext
ctx <- Getting
(SimContext p sym ext)
(SimState p sym ext rtp f args)
(SimContext p sym ext)
-> ReaderT
(SimState p sym ext rtp f args) IO (SimContext p sym ext)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(SimContext p sym ext)
(SimState p sym ext rtp f args)
(SimContext p sym ext)
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(SimContext p sym ext -> f2 (SimContext p sym ext))
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateContext
Integer
v <- IO Integer -> ReaderT (SimState p sym ext rtp f args) IO Integer
forall a. IO a -> ReaderT (SimState p sym ext rtp f args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (OptionSetting BaseIntegerType -> IO Integer
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
getOpt (OptionSetting BaseIntegerType -> IO Integer)
-> IO (OptionSetting BaseIntegerType) -> IO Integer
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConfigOption BaseIntegerType
-> Config -> IO (OptionSetting BaseIntegerType)
forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
getOptionSetting ConfigOption BaseIntegerType
verbosity Config
cfg)
Bool
-> ReaderT (SimState p sym ext rtp f args) IO ()
-> ReaderT (SimState p sym ext rtp f args) IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
3) (ReaderT (SimState p sym ext rtp f args) IO ()
-> ReaderT (SimState p sym ext rtp f args) IO ())
-> ReaderT (SimState p sym ext rtp f args) IO ()
-> ReaderT (SimState p sym ext rtp f args) IO ()
forall a b. (a -> b) -> a -> b
$ do
let frames :: [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
frames = ActiveTree p sym ext rtp f args
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
forall ctx sym ext root a (args :: Maybe (Ctx CrucibleType)).
ActiveTree ctx sym ext root a args
-> [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
activeFrames ActiveTree p sym ext rtp f args
t
let msg :: Doc (Any @Type)
msg = [Doc (Any @Type)] -> Doc (Any @Type)
forall ann. [Doc ann] -> Doc ann
PP.vcat [ AbortExecReason -> Doc (Any @Type)
forall ann. AbortExecReason -> Doc ann
ppAbortExecReason AbortExecReason
rsn
, Int -> Doc (Any @Type) -> Doc (Any @Type)
forall ann. Int -> Doc ann -> Doc ann
PP.indent Int
2 ([SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> Doc (Any @Type)
forall sym ext ann.
[SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
-> Doc ann
ppExceptionContext [SomeFrame @Type @(Maybe (Ctx CrucibleType)) (SimFrame sym ext)]
frames) ]
IO () -> ReaderT (SimState p sym ext rtp f args) IO ()
forall a. IO a -> ReaderT (SimState p sym ext rtp f args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> Doc (Any @Type) -> IO ()
forall a. Show a => Handle -> a -> IO ()
hPrint (SimContext p sym ext -> Handle
forall personality sym ext.
SimContext personality sym ext -> Handle
printHandle SimContext p sym ext
ctx) Doc (Any @Type)
msg)
AbortExecReason -> ExecCont p sym ext rtp f args
forall sym p ext rtp f (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
AbortExecReason -> ExecCont p sym ext rtp f args
abortExec AbortExecReason
rsn
abortExec ::
IsSymInterface sym =>
AbortExecReason ->
ExecCont p sym ext rtp f args
abortExec :: forall sym p ext rtp f (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
AbortExecReason -> ExecCont p sym ext rtp f args
abortExec AbortExecReason
rsn = do
ActiveTree ValueFromFrame p sym ext rtp f
ctx PartialResultFrame sym ext f args
ar0 <- Getting
(ActiveTree p sym ext rtp f args)
(SimState p sym ext rtp f args)
(ActiveTree p sym ext rtp f args)
-> ReaderT
(SimState p sym ext rtp f args)
IO
(ActiveTree p sym ext rtp f args)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext rtp f args)
(SimState p sym ext rtp f args)
(ActiveTree p sym ext rtp f args)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
ValueFromFrame p sym ext rtp f
-> AbortedResult sym ext -> ExecCont p sym ext rtp f args
forall sym p ext r f g (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
ValueFromFrame p sym ext r f
-> AbortedResult sym ext -> ExecCont p sym ext r g args
resumeValueFromFrameAbort ValueFromFrame p sym ext rtp f
ctx (AbortedResult sym ext -> ExecCont p sym ext rtp f args)
-> AbortedResult sym ext -> ExecCont p sym ext rtp f args
forall a b. (a -> b) -> a -> b
$
case PartialResultFrame sym ext f args
ar0 of
TotalRes GlobalPair sym (SimFrame sym ext f args)
e -> AbortExecReason
-> GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext
forall sym ext l (args :: Maybe (Ctx CrucibleType)).
AbortExecReason
-> GlobalPair sym (SimFrame sym ext l args)
-> AbortedResult sym ext
AbortedExec AbortExecReason
rsn GlobalPair sym (SimFrame sym ext f args)
e
PartialRes ProgramLoc
loc Pred sym
pred GlobalPair sym (SimFrame sym ext f args)
ex AbortedResult sym ext
ar1 ->
ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
forall sym ext.
ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
AbortedBranch ProgramLoc
loc Pred sym
pred (AbortExecReason
-> GlobalPair sym (SimFrame sym ext f args)
-> AbortedResult sym ext
forall sym ext l (args :: Maybe (Ctx CrucibleType)).
AbortExecReason
-> GlobalPair sym (SimFrame sym ext l args)
-> AbortedResult sym ext
AbortedExec AbortExecReason
rsn GlobalPair sym (SimFrame sym ext f args)
ex) AbortedResult sym ext
ar1
resumeValueFromFrameAbort ::
IsSymInterface sym =>
ValueFromFrame p sym ext r f ->
AbortedResult sym ext ->
ExecCont p sym ext r g args
resumeValueFromFrameAbort :: forall sym p ext r f g (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
ValueFromFrame p sym ext r f
-> AbortedResult sym ext -> ExecCont p sym ext r g args
resumeValueFromFrameAbort ValueFromFrame p sym ext r f
ctx0 AbortedResult sym ext
ar0 = do
SimContext p sym ext
simCtx <- Getting
(SimContext p sym ext)
(SimState p sym ext r g args)
(SimContext p sym ext)
-> ReaderT (SimState p sym ext r g args) IO (SimContext p sym ext)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(SimContext p sym ext)
(SimState p sym ext r g args)
(SimContext p sym ext)
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(SimContext p sym ext -> f2 (SimContext p sym ext))
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateContext
sym
sym <- Getting sym (SimState p sym ext r g args) sym
-> ReaderT (SimState p sym ext r g args) IO sym
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting sym (SimState p sym ext r g args) sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
SimContext p sym ext
-> (forall {bak}.
IsSymBackend sym bak =>
bak -> ExecCont p sym ext r g args)
-> ExecCont p sym ext r g args
forall personality sym ext a.
SimContext personality sym ext
-> (forall bak. IsSymBackend sym bak => bak -> a) -> a
withBackend SimContext p sym ext
simCtx ((forall {bak}.
IsSymBackend sym bak =>
bak -> ExecCont p sym ext r g args)
-> ExecCont p sym ext r g args)
-> (forall {bak}.
IsSymBackend sym bak =>
bak -> ExecCont p sym ext r g args)
-> ExecCont p sym ext r g args
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
case ValueFromFrame p sym ext r f
ctx0 of
VFFBranch ValueFromFrame p sym ext r f
ctx FrameIdentifier
assume_frame ProgramLoc
loc Pred sym
pred VFFOtherPath p sym ext r f args
other_branch CrucibleBranchTarget f args
tgt ->
do Pred sym
pnot <- IO (Pred sym)
-> ReaderT (SimState p sym ext r g args) IO (Pred sym)
forall a. IO a -> ReaderT (SimState p sym ext r g args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Pred sym)
-> ReaderT (SimState p sym ext r g args) IO (Pred sym))
-> IO (Pred sym)
-> ReaderT (SimState p sym ext r g args) IO (Pred sym)
forall a b. (a -> b) -> a -> b
$ sym -> Pred sym -> IO (Pred sym)
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred sym
sym Pred sym
pred
let nextCtx :: ValueFromFrame p sym ext r f
nextCtx = ValueFromFrame p sym ext r f
-> ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> PendingPartialMerges
-> ValueFromFrame p sym ext r f
forall p sym ext ret f.
ValueFromFrame p sym ext ret f
-> ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> PendingPartialMerges
-> ValueFromFrame p sym ext ret f
VFFPartial ValueFromFrame p sym ext r f
ctx ProgramLoc
loc Pred sym
pnot AbortedResult sym ext
ar0 PendingPartialMerges
NeedsToBeAborted
CrucibleAssumptions (SymExpr sym)
_assumes <- IO (CrucibleAssumptions (SymExpr sym))
-> ReaderT
(SimState p sym ext r g args)
IO
(CrucibleAssumptions (SymExpr sym))
forall a. IO a -> ReaderT (SimState p sym ext r g args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (CrucibleAssumptions (SymExpr sym))
-> ReaderT
(SimState p sym ext r g args)
IO
(CrucibleAssumptions (SymExpr sym)))
-> IO (CrucibleAssumptions (SymExpr sym))
-> ReaderT
(SimState p sym ext r g args)
IO
(CrucibleAssumptions (SymExpr sym))
forall a b. (a -> b) -> a -> b
$ bak -> FrameIdentifier -> IO (CrucibleAssumptions (SymExpr sym))
forall sym bak.
IsSymBackend sym bak =>
bak -> FrameIdentifier -> IO (Assumptions sym)
popAssumptionFrame bak
bak FrameIdentifier
assume_frame
case VFFOtherPath p sym ext r f args
other_branch of
VFFActivePath PausedFrame p sym ext r f
n ->
do IO () -> ReaderT (SimState p sym ext r g args) IO ()
forall a. IO a -> ReaderT (SimState p sym ext r g args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (SimState p sym ext r g args) IO ())
-> IO () -> ReaderT (SimState p sym ext r g args) IO ()
forall a b. (a -> b) -> a -> b
$ bak -> Assumption sym -> IO ()
forall sym bak.
IsSymBackend sym bak =>
bak -> Assumption sym -> IO ()
addAssumption bak
bak (ProgramLoc -> Maybe ProgramLoc -> Pred sym -> Assumption sym
forall (e :: BaseType -> Type).
ProgramLoc
-> Maybe ProgramLoc -> e BaseBoolType -> CrucibleAssumption e
BranchCondition ProgramLoc
loc (PausedFrame p sym ext r f -> Maybe ProgramLoc
forall p sym ext rtp f.
PausedFrame p sym ext rtp f -> Maybe ProgramLoc
pausedLoc PausedFrame p sym ext r f
n) Pred sym
pnot)
PausedFrame p sym ext r f
-> ValueFromFrame p sym ext r f -> ExecCont p sym ext r g args
forall sym p ext rtp f g (ba :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
PausedFrame p sym ext rtp f
-> ValueFromFrame p sym ext rtp f -> ExecCont p sym ext rtp g ba
resumeFrame PausedFrame p sym ext r f
n ValueFromFrame p sym ext r f
nextCtx
VFFCompletePath CrucibleAssumptions (SymExpr sym)
otherAssumes PartialResultFrame sym ext f args
er ->
do
IO () -> ReaderT (SimState p sym ext r g args) IO ()
forall a. IO a -> ReaderT (SimState p sym ext r g args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (SimState p sym ext r g args) IO ())
-> IO () -> ReaderT (SimState p sym ext r g args) IO ()
forall a b. (a -> b) -> a -> b
$ bak -> CrucibleAssumptions (SymExpr sym) -> IO ()
forall sym bak.
IsSymBackend sym bak =>
bak -> Assumptions sym -> IO ()
addAssumptions bak
bak CrucibleAssumptions (SymExpr sym)
otherAssumes
(SimState p sym ext r g args -> SimState p sym ext r f args)
-> ReaderT (SimState p sym ext r f args) IO (ExecState p sym ext r)
-> ExecCont p sym ext r g args
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext r g args
-> Identity (ActiveTree p sym ext r f args))
-> SimState p sym ext r g args
-> Identity (SimState p sym ext r f args)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext r g args
-> Identity (ActiveTree p sym ext r f args))
-> SimState p sym ext r g args
-> Identity (SimState p sym ext r f args))
-> ActiveTree p sym ext r f args
-> SimState p sym ext r g args
-> SimState p sym ext r f args
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueFromFrame p sym ext r f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext r f args
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree ValueFromFrame p sym ext r f
nextCtx PartialResultFrame sym ext f args
er)
(CrucibleBranchTarget f args
-> ReaderT (SimState p sym ext r f args) IO (ExecState p sym ext r)
forall f (args :: Maybe (Ctx CrucibleType)) p sym ext root.
CrucibleBranchTarget f args -> ExecCont p sym ext root f args
checkForIntraFrameMerge CrucibleBranchTarget f args
tgt)
VFFPartial ValueFromFrame p sym ext r f
ctx ProgramLoc
loc Pred sym
pred AbortedResult sym ext
ay PendingPartialMerges
_ ->
ValueFromFrame p sym ext r f
-> AbortedResult sym ext -> ExecCont p sym ext r g args
forall sym p ext r f g (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
ValueFromFrame p sym ext r f
-> AbortedResult sym ext -> ExecCont p sym ext r g args
resumeValueFromFrameAbort ValueFromFrame p sym ext r f
ctx (AbortedResult sym ext -> ExecCont p sym ext r g args)
-> AbortedResult sym ext -> ExecCont p sym ext r g args
forall a b. (a -> b) -> a -> b
$ ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
forall sym ext.
ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
AbortedBranch ProgramLoc
loc Pred sym
pred AbortedResult sym ext
ar0 AbortedResult sym ext
ay
VFFEnd ValueFromValue p sym ext r (FrameRetType f)
ctx ->
(SimState p sym ext r g args -> IO (ExecState p sym ext r))
-> ExecCont p sym ext r g args
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((SimState p sym ext r g args -> IO (ExecState p sym ext r))
-> ExecCont p sym ext r g args)
-> (SimState p sym ext r g args -> IO (ExecState p sym ext r))
-> ExecCont p sym ext r g args
forall a b. (a -> b) -> a -> b
$ ExecState p sym ext r -> IO (ExecState p sym ext r)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext r -> IO (ExecState p sym ext r))
-> (SimState p sym ext r g args -> ExecState p sym ext r)
-> SimState p sym ext r g args
-> IO (ExecState p sym ext r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueFromValue p sym ext r (FrameRetType f)
-> AbortedResult sym ext
-> SimState p sym ext r g args
-> ExecState p sym ext r
forall p sym ext rtp f (a :: Maybe (Ctx CrucibleType))
(r :: CrucibleType).
ValueFromValue p sym ext rtp r
-> AbortedResult sym ext
-> SimState p sym ext rtp f a
-> ExecState p sym ext rtp
UnwindCallState ValueFromValue p sym ext r (FrameRetType f)
ctx AbortedResult sym ext
ar0
resumeValueFromValueAbort ::
IsSymInterface sym =>
ValueFromValue p sym ext r ret' ->
AbortedResult sym ext ->
ExecCont p sym ext r f a
resumeValueFromValueAbort :: forall sym p ext r (ret' :: CrucibleType) f
(a :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
ValueFromValue p sym ext r ret'
-> AbortedResult sym ext -> ExecCont p sym ext r f a
resumeValueFromValueAbort ValueFromValue p sym ext r ret'
ctx0 AbortedResult sym ext
ar0 =
case ValueFromValue p sym ext r ret'
ctx0 of
VFVCall ValueFromFrame p sym ext r caller
ctx SimFrame sym ext caller args
frm ReturnHandler ret' p sym ext r caller args
_rh ->
do ActiveTree ValueFromFrame p sym ext r f
_oldFrm PartialResultFrame sym ext f a
er <- Getting
(ActiveTree p sym ext r f a)
(SimState p sym ext r f a)
(ActiveTree p sym ext r f a)
-> ReaderT
(SimState p sym ext r f a) IO (ActiveTree p sym ext r f a)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext r f a)
(SimState p sym ext r f a)
(ActiveTree p sym ext r f a)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
(SimState p sym ext r f a -> SimState p sym ext r caller args)
-> ReaderT
(SimState p sym ext r caller args) IO (ExecState p sym ext r)
-> ExecCont p sym ext r f a
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext r f a
-> Identity (ActiveTree p sym ext r caller args))
-> SimState p sym ext r f a
-> Identity (SimState p sym ext r caller args)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext r f a
-> Identity (ActiveTree p sym ext r caller args))
-> SimState p sym ext r f a
-> Identity (SimState p sym ext r caller args))
-> ActiveTree p sym ext r caller args
-> SimState p sym ext r f a
-> SimState p sym ext r caller args
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueFromFrame p sym ext r caller
-> PartialResultFrame sym ext caller args
-> ActiveTree p sym ext r caller args
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree ValueFromFrame p sym ext r caller
ctx (PartialResultFrame sym ext f a
er PartialResultFrame sym ext f a
-> (PartialResultFrame sym ext f a
-> PartialResultFrame sym ext caller args)
-> PartialResultFrame sym ext caller args
forall a b. a -> (a -> b) -> b
& (GlobalPair sym (SimFrame sym ext f a)
-> Identity (GlobalPair sym (SimFrame sym ext caller args)))
-> PartialResultFrame sym ext f a
-> Identity (PartialResultFrame sym ext caller args)
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue((GlobalPair sym (SimFrame sym ext f a)
-> Identity (GlobalPair sym (SimFrame sym ext caller args)))
-> PartialResultFrame sym ext f a
-> Identity (PartialResultFrame sym ext caller args))
-> ((SimFrame sym ext f a
-> Identity (SimFrame sym ext caller args))
-> GlobalPair sym (SimFrame sym ext f a)
-> Identity (GlobalPair sym (SimFrame sym ext caller args)))
-> (SimFrame sym ext f a
-> Identity (SimFrame sym ext caller args))
-> PartialResultFrame sym ext f a
-> Identity (PartialResultFrame sym ext caller args)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimFrame sym ext f a -> Identity (SimFrame sym ext caller args))
-> GlobalPair sym (SimFrame sym ext f a)
-> Identity (GlobalPair sym (SimFrame sym ext caller args))
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue ((SimFrame sym ext f a -> Identity (SimFrame sym ext caller args))
-> PartialResultFrame sym ext f a
-> Identity (PartialResultFrame sym ext caller args))
-> SimFrame sym ext caller args
-> PartialResultFrame sym ext f a
-> PartialResultFrame sym ext caller args
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SimFrame sym ext caller args
frm))
(ValueFromFrame p sym ext r caller
-> AbortedResult sym ext
-> ReaderT
(SimState p sym ext r caller args) IO (ExecState p sym ext r)
forall sym p ext r f g (args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
ValueFromFrame p sym ext r f
-> AbortedResult sym ext -> ExecCont p sym ext r g args
resumeValueFromFrameAbort ValueFromFrame p sym ext r caller
ctx AbortedResult sym ext
ar0)
VFVPartial ValueFromValue p sym ext r ret'
ctx ProgramLoc
loc Pred sym
pred AbortedResult sym ext
ay -> do
ValueFromValue p sym ext r ret'
-> AbortedResult sym ext -> ExecCont p sym ext r f a
forall sym p ext r (ret' :: CrucibleType) f
(a :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
ValueFromValue p sym ext r ret'
-> AbortedResult sym ext -> ExecCont p sym ext r f a
resumeValueFromValueAbort ValueFromValue p sym ext r ret'
ctx (ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
forall sym ext.
ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> AbortedResult sym ext
-> AbortedResult sym ext
AbortedBranch ProgramLoc
loc Pred sym
pred AbortedResult sym ext
ar0 AbortedResult sym ext
ay)
ValueFromValue p sym ext r ret'
VFVEnd ->
do SimContext p sym ext
res <- Getting
(SimContext p sym ext)
(SimState p sym ext (RegEntry sym ret') f a)
(SimContext p sym ext)
-> ReaderT (SimState p sym ext r f a) IO (SimContext p sym ext)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(SimContext p sym ext)
(SimState p sym ext (RegEntry sym ret') f a)
(SimContext p sym ext)
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(SimContext p sym ext -> f2 (SimContext p sym ext))
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateContext
ExecState p sym ext r -> ExecCont p sym ext r f a
forall a. a -> ReaderT (SimState p sym ext r f a) IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext r -> ExecCont p sym ext r f a)
-> ExecState p sym ext r -> ExecCont p sym ext r f a
forall a b. (a -> b) -> a -> b
$! ExecResult p sym ext r -> ExecState p sym ext r
forall p sym ext rtp.
ExecResult p sym ext rtp -> ExecState p sym ext rtp
ResultState (ExecResult p sym ext r -> ExecState p sym ext r)
-> ExecResult p sym ext r -> ExecState p sym ext r
forall a b. (a -> b) -> a -> b
$ SimContext p sym ext
-> AbortedResult sym ext -> ExecResult p sym ext r
forall p sym ext r.
SimContext p sym ext
-> AbortedResult sym ext -> ExecResult p sym ext r
AbortedResult SimContext p sym ext
res AbortedResult sym ext
ar0
resumeFrame ::
IsSymInterface sym =>
PausedFrame p sym ext rtp f ->
ValueFromFrame p sym ext rtp f ->
ExecCont p sym ext rtp g ba
resumeFrame :: forall sym p ext rtp f g (ba :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
PausedFrame p sym ext rtp f
-> ValueFromFrame p sym ext rtp f -> ExecCont p sym ext rtp g ba
resumeFrame (PausedFrame PartialResultFrame sym ext f ('Just @(Ctx CrucibleType) old_args)
frm ControlResumption p sym ext rtp f
cont Maybe ProgramLoc
toLoc) ValueFromFrame p sym ext rtp f
ctx =
do case Maybe ProgramLoc
toLoc of
Maybe ProgramLoc
Nothing -> () -> ReaderT (SimState p sym ext rtp g ba) IO ()
forall a. a -> ReaderT (SimState p sym ext rtp g ba) IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
Just ProgramLoc
l ->
do sym
sym <- Getting sym (SimState p sym ext rtp g ba) sym
-> ReaderT (SimState p sym ext rtp g ba) IO sym
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting sym (SimState p sym ext rtp g ba) sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
IO () -> ReaderT (SimState p sym ext rtp g ba) IO ()
forall a. IO a -> ReaderT (SimState p sym ext rtp g ba) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (SimState p sym ext rtp g ba) IO ())
-> IO () -> ReaderT (SimState p sym ext rtp g ba) IO ()
forall a b. (a -> b) -> a -> b
$ sym -> ProgramLoc -> IO ()
forall sym. IsExprBuilder sym => sym -> ProgramLoc -> IO ()
setCurrentProgramLoc sym
sym ProgramLoc
l
(SimState p sym ext rtp g ba
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args))
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args))
IO
(ExecState p sym ext rtp)
-> ExecCont p sym ext rtp g ba
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext rtp g ba
-> Identity
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)))
-> SimState p sym ext rtp g ba
-> Identity
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext rtp g ba
-> Identity
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)))
-> SimState p sym ext rtp g ba
-> Identity
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)))
-> ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)
-> SimState p sym ext rtp g ba
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueFromFrame p sym ext rtp f
-> PartialResultFrame
sym ext f ('Just @(Ctx CrucibleType) old_args)
-> ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree ValueFromFrame p sym ext rtp f
ctx PartialResultFrame sym ext f ('Just @(Ctx CrucibleType) old_args)
frm)
((SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)
-> IO (ExecState p sym ext rtp))
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args))
IO
(ExecState p sym ext rtp)
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)
-> IO (ExecState p sym ext rtp))
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args))
IO
(ExecState p sym ext rtp))
-> (SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)
-> IO (ExecState p sym ext rtp))
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args))
IO
(ExecState p sym ext rtp)
forall a b. (a -> b) -> a -> b
$ ExecState p sym ext rtp -> IO (ExecState p sym ext rtp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext rtp -> IO (ExecState p sym ext rtp))
-> (SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)
-> ExecState p sym ext rtp)
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)
-> IO (ExecState p sym ext rtp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlResumption p sym ext rtp f
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) old_args)
-> ExecState p sym ext rtp
forall p sym ext rtp f (a :: Ctx CrucibleType).
ControlResumption p sym ext rtp f
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) a)
-> ExecState p sym ext rtp
ControlTransferState ControlResumption p sym ext rtp f
cont)
{-# INLINABLE resumeFrame #-}
handleSimReturn ::
IsSymInterface sym =>
FunctionName ->
ValueFromValue p sym ext r ret ->
RegEntry sym ret ->
ExecCont p sym ext r f a
handleSimReturn :: forall sym p ext r (ret :: CrucibleType) f
(a :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
FunctionName
-> ValueFromValue p sym ext r ret
-> RegEntry sym ret
-> ExecCont p sym ext r f a
handleSimReturn FunctionName
fnName ValueFromValue p sym ext r ret
vfv RegEntry sym ret
return_value =
(SimState p sym ext r f a -> IO (ExecState p sym ext r))
-> ReaderT (SimState p sym ext r f a) IO (ExecState p sym ext r)
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((SimState p sym ext r f a -> IO (ExecState p sym ext r))
-> ReaderT (SimState p sym ext r f a) IO (ExecState p sym ext r))
-> (SimState p sym ext r f a -> IO (ExecState p sym ext r))
-> ReaderT (SimState p sym ext r f a) IO (ExecState p sym ext r)
forall a b. (a -> b) -> a -> b
$ ExecState p sym ext r -> IO (ExecState p sym ext r)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext r -> IO (ExecState p sym ext r))
-> (SimState p sym ext r f a -> ExecState p sym ext r)
-> SimState p sym ext r f a
-> IO (ExecState p sym ext r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName
-> ValueFromValue p sym ext r ret
-> RegEntry sym ret
-> SimState p sym ext r f a
-> ExecState p sym ext r
forall p sym ext rtp f (a :: Maybe (Ctx CrucibleType))
(ret :: CrucibleType).
FunctionName
-> ValueFromValue p sym ext rtp ret
-> RegEntry sym ret
-> SimState p sym ext rtp f a
-> ExecState p sym ext rtp
ReturnState FunctionName
fnName ValueFromValue p sym ext r ret
vfv RegEntry sym ret
return_value
performReturn ::
IsSymInterface sym =>
FunctionName ->
ValueFromValue p sym ext r ret ->
RegEntry sym ret ->
ExecCont p sym ext r f a
performReturn :: forall sym p ext r (ret :: CrucibleType) f
(a :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
FunctionName
-> ValueFromValue p sym ext r ret
-> RegEntry sym ret
-> ExecCont p sym ext r f a
performReturn FunctionName
fnName ValueFromValue p sym ext r ret
ctx0 RegEntry sym ret
v = do
case ValueFromValue p sym ext r ret
ctx0 of
VFVCall ValueFromFrame p sym ext r caller
ctx (MF CallFrame sym ext blocks ret args1
f) (ReturnToCrucible TypeRepr ret
tpr StmtSeq ext blocks r ((::>) @CrucibleType ctx ret)
rest) ->
do ActiveTree ValueFromFrame p sym ext r f
_oldctx PartialResultFrame sym ext f a
pres <- Getting
(ActiveTree p sym ext r f a)
(SimState p sym ext r f a)
(ActiveTree p sym ext r f a)
-> ReaderT
(SimState p sym ext r f a) IO (ActiveTree p sym ext r f a)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext r f a)
(SimState p sym ext r f a)
(ActiveTree p sym ext r f a)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
let f' :: CallFrame sym ext blocks r ((::>) @CrucibleType ctx ret)
f' = TypeRepr ret
-> RegValue sym ret
-> StmtSeq ext blocks r ((::>) @CrucibleType ctx ret)
-> CallFrame sym ext blocks r ctx
-> CallFrame sym ext blocks r ((::>) @CrucibleType ctx ret)
forall (tp :: CrucibleType) sym ext
(blocks :: Ctx (Ctx CrucibleType)) (ret :: CrucibleType)
(ctx :: Ctx CrucibleType).
TypeRepr tp
-> RegValue sym tp
-> StmtSeq ext blocks ret ((::>) @CrucibleType ctx tp)
-> CallFrame sym ext blocks ret ctx
-> CallFrame sym ext blocks ret ((::>) @CrucibleType ctx tp)
extendFrame TypeRepr ret
tpr (RegEntry sym ret -> RegValue sym ret
forall sym (tp :: CrucibleType). RegEntry sym tp -> RegValue sym tp
regValue RegEntry sym ret
v) StmtSeq ext blocks r ((::>) @CrucibleType ctx ret)
rest CallFrame sym ext blocks ret args1
CallFrame sym ext blocks r ctx
f
(SimState p sym ext r f a
-> SimState
p
sym
ext
r
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret)))
-> ReaderT
(SimState
p
sym
ext
r
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret)))
IO
(ExecState p sym ext r)
-> ExecCont p sym ext r f a
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext r f a
-> Identity
(ActiveTree
p
sym
ext
r
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))))
-> SimState p sym ext r f a
-> Identity
(SimState
p
sym
ext
r
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret)))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext r f a
-> Identity
(ActiveTree
p
sym
ext
r
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))))
-> SimState p sym ext r f a
-> Identity
(SimState
p
sym
ext
r
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))))
-> ActiveTree
p
sym
ext
r
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))
-> SimState p sym ext r f a
-> SimState
p
sym
ext
r
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueFromFrame p sym ext r caller
-> PartialResultFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))
-> ActiveTree
p
sym
ext
r
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree ValueFromFrame p sym ext r caller
ctx (PartialResultFrame sym ext f a
pres PartialResultFrame sym ext f a
-> (PartialResultFrame sym ext f a
-> PartialResultFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret)))
-> PartialResultFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))
forall a b. a -> (a -> b) -> b
& (GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym
(SimFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret)))))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret)))
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue ((GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym
(SimFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret)))))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))))
-> ((SimFrame sym ext f a
-> Identity
(SimFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))))
-> GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym
(SimFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret)))))
-> (SimFrame sym ext f a
-> Identity
(SimFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimFrame sym ext f a
-> Identity
(SimFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))))
-> GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym
(SimFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))))
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue ((SimFrame sym ext f a
-> Identity
(SimFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))))
-> SimFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))
-> PartialResultFrame sym ext f a
-> PartialResultFrame
sym
ext
caller
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CallFrame sym ext blocks r ((::>) @CrucibleType ctx ret)
-> SimFrame
sym
ext
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (args1 :: Ctx CrucibleType).
CallFrame sym ext blocks ret args1
-> SimFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) args1)
MF CallFrame sym ext blocks r ((::>) @CrucibleType ctx ret)
f'))
(RunningStateInfo blocks ((::>) @CrucibleType ctx ret)
-> ExecCont
p
sym
ext
r
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) ((::>) @CrucibleType ctx ret))
forall (blocks :: Ctx (Ctx CrucibleType)) (a :: Ctx CrucibleType) p
sym ext rtp (r :: CrucibleType).
RunningStateInfo blocks a
-> ExecCont
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
continue (FunctionName
-> RunningStateInfo blocks ((::>) @CrucibleType ctx ret)
forall (blocks :: Ctx (Ctx CrucibleType))
(args :: Ctx CrucibleType).
FunctionName -> RunningStateInfo blocks args
RunReturnFrom FunctionName
fnName))
VFVCall ValueFromFrame p sym ext r caller
ctx SimFrame sym ext caller args
_ ReturnHandler ret p sym ext r caller args
TailReturnToCrucible ->
do ActiveTree ValueFromFrame p sym ext r f
_oldctx PartialResultFrame sym ext f a
pres <- Getting
(ActiveTree p sym ext r f a)
(SimState p sym ext r f a)
(ActiveTree p sym ext r f a)
-> ReaderT
(SimState p sym ext r f a) IO (ActiveTree p sym ext r f a)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext r f a)
(SimState p sym ext r f a)
(ActiveTree p sym ext r f a)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
(SimState p sym ext r f a
-> SimState p sym ext r caller ('Nothing @(Ctx CrucibleType)))
-> ReaderT
(SimState p sym ext r caller ('Nothing @(Ctx CrucibleType)))
IO
(ExecState p sym ext r)
-> ExecCont p sym ext r f a
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext r f a
-> Identity
(ActiveTree p sym ext r caller ('Nothing @(Ctx CrucibleType))))
-> SimState p sym ext r f a
-> Identity
(SimState p sym ext r caller ('Nothing @(Ctx CrucibleType)))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext r f a
-> Identity
(ActiveTree p sym ext r caller ('Nothing @(Ctx CrucibleType))))
-> SimState p sym ext r f a
-> Identity
(SimState p sym ext r caller ('Nothing @(Ctx CrucibleType))))
-> ActiveTree p sym ext r caller ('Nothing @(Ctx CrucibleType))
-> SimState p sym ext r f a
-> SimState p sym ext r caller ('Nothing @(Ctx CrucibleType))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueFromFrame p sym ext r caller
-> PartialResultFrame sym ext caller ('Nothing @(Ctx CrucibleType))
-> ActiveTree p sym ext r caller ('Nothing @(Ctx CrucibleType))
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree ValueFromFrame p sym ext r caller
ctx (PartialResultFrame sym ext f a
pres PartialResultFrame sym ext f a
-> (PartialResultFrame sym ext f a
-> PartialResultFrame
sym ext caller ('Nothing @(Ctx CrucibleType)))
-> PartialResultFrame sym ext caller ('Nothing @(Ctx CrucibleType))
forall a b. a -> (a -> b) -> b
& (GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym (SimFrame sym ext caller ('Nothing @(Ctx CrucibleType)))))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame sym ext caller ('Nothing @(Ctx CrucibleType)))
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue ((GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym (SimFrame sym ext caller ('Nothing @(Ctx CrucibleType)))))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame sym ext caller ('Nothing @(Ctx CrucibleType))))
-> ((SimFrame sym ext f a
-> Identity
(SimFrame sym ext caller ('Nothing @(Ctx CrucibleType))))
-> GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym (SimFrame sym ext caller ('Nothing @(Ctx CrucibleType)))))
-> (SimFrame sym ext f a
-> Identity
(SimFrame sym ext caller ('Nothing @(Ctx CrucibleType))))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame sym ext caller ('Nothing @(Ctx CrucibleType)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimFrame sym ext f a
-> Identity
(SimFrame sym ext caller ('Nothing @(Ctx CrucibleType))))
-> GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym (SimFrame sym ext caller ('Nothing @(Ctx CrucibleType))))
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue ((SimFrame sym ext f a
-> Identity
(SimFrame sym ext caller ('Nothing @(Ctx CrucibleType))))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame sym ext caller ('Nothing @(Ctx CrucibleType))))
-> SimFrame sym ext caller ('Nothing @(Ctx CrucibleType))
-> PartialResultFrame sym ext f a
-> PartialResultFrame sym ext caller ('Nothing @(Ctx CrucibleType))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FunctionName
-> RegEntry sym (FrameRetType caller)
-> SimFrame sym ext caller ('Nothing @(Ctx CrucibleType))
forall sym l ext.
FunctionName
-> RegEntry sym (FrameRetType l)
-> SimFrame sym ext l ('Nothing @(Ctx CrucibleType))
RF FunctionName
fnName RegEntry sym ret
RegEntry sym (FrameRetType caller)
v))
(RegEntry sym (FrameRetType caller)
-> ReaderT
(SimState p sym ext r caller ('Nothing @(Ctx CrucibleType)))
IO
(ExecState p sym ext r)
forall p sym ext rtp f (args :: Maybe (Ctx CrucibleType)).
RegEntry sym (FrameRetType f) -> ExecCont p sym ext rtp f args
returnValue RegEntry sym ret
RegEntry sym (FrameRetType caller)
v)
VFVCall ValueFromFrame p sym ext r caller
ctx (OF OverrideFrame sym ret args1
f) (ReturnToOverride RegEntry sym ret
-> SimState
p sym ext r (OverrideLang r) ('Just @(Ctx CrucibleType) args1)
-> IO (ExecState p sym ext r)
k) ->
do ActiveTree ValueFromFrame p sym ext r f
_oldctx PartialResultFrame sym ext f a
pres <- Getting
(ActiveTree p sym ext r f a)
(SimState p sym ext r f a)
(ActiveTree p sym ext r f a)
-> ReaderT
(SimState p sym ext r f a) IO (ActiveTree p sym ext r f a)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext r f a)
(SimState p sym ext r f a)
(ActiveTree p sym ext r f a)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
(SimState p sym ext r f a
-> SimState p sym ext r caller ('Just @(Ctx CrucibleType) args1))
-> ReaderT
(SimState p sym ext r caller ('Just @(Ctx CrucibleType) args1))
IO
(ExecState p sym ext r)
-> ExecCont p sym ext r f a
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext r f a
-> Identity
(ActiveTree p sym ext r caller ('Just @(Ctx CrucibleType) args1)))
-> SimState p sym ext r f a
-> Identity
(SimState p sym ext r caller ('Just @(Ctx CrucibleType) args1))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext r f a
-> Identity
(ActiveTree p sym ext r caller ('Just @(Ctx CrucibleType) args1)))
-> SimState p sym ext r f a
-> Identity
(SimState p sym ext r caller ('Just @(Ctx CrucibleType) args1)))
-> ActiveTree p sym ext r caller ('Just @(Ctx CrucibleType) args1)
-> SimState p sym ext r f a
-> SimState p sym ext r caller ('Just @(Ctx CrucibleType) args1)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueFromFrame p sym ext r caller
-> PartialResultFrame
sym ext caller ('Just @(Ctx CrucibleType) args1)
-> ActiveTree p sym ext r caller ('Just @(Ctx CrucibleType) args1)
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree ValueFromFrame p sym ext r caller
ctx (PartialResultFrame sym ext f a
pres PartialResultFrame sym ext f a
-> (PartialResultFrame sym ext f a
-> PartialResultFrame
sym ext caller ('Just @(Ctx CrucibleType) args1))
-> PartialResultFrame
sym ext caller ('Just @(Ctx CrucibleType) args1)
forall a b. a -> (a -> b) -> b
& (GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym (SimFrame sym ext caller ('Just @(Ctx CrucibleType) args1))))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame
sym ext caller ('Just @(Ctx CrucibleType) args1))
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue ((GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym (SimFrame sym ext caller ('Just @(Ctx CrucibleType) args1))))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame
sym ext caller ('Just @(Ctx CrucibleType) args1)))
-> ((SimFrame sym ext f a
-> Identity
(SimFrame sym ext caller ('Just @(Ctx CrucibleType) args1)))
-> GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym (SimFrame sym ext caller ('Just @(Ctx CrucibleType) args1))))
-> (SimFrame sym ext f a
-> Identity
(SimFrame sym ext caller ('Just @(Ctx CrucibleType) args1)))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame
sym ext caller ('Just @(Ctx CrucibleType) args1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimFrame sym ext f a
-> Identity
(SimFrame sym ext caller ('Just @(Ctx CrucibleType) args1)))
-> GlobalPair sym (SimFrame sym ext f a)
-> Identity
(GlobalPair
sym (SimFrame sym ext caller ('Just @(Ctx CrucibleType) args1)))
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue ((SimFrame sym ext f a
-> Identity
(SimFrame sym ext caller ('Just @(Ctx CrucibleType) args1)))
-> PartialResultFrame sym ext f a
-> Identity
(PartialResultFrame
sym ext caller ('Just @(Ctx CrucibleType) args1)))
-> SimFrame sym ext caller ('Just @(Ctx CrucibleType) args1)
-> PartialResultFrame sym ext f a
-> PartialResultFrame
sym ext caller ('Just @(Ctx CrucibleType) args1)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OverrideFrame sym ret args1
-> SimFrame
sym ext (OverrideLang ret) ('Just @(Ctx CrucibleType) args1)
forall sym (ret :: CrucibleType) (args1 :: Ctx CrucibleType) ext.
OverrideFrame sym ret args1
-> SimFrame
sym ext (OverrideLang ret) ('Just @(Ctx CrucibleType) args1)
OF OverrideFrame sym ret args1
f))
((SimState p sym ext r caller ('Just @(Ctx CrucibleType) args1)
-> IO (ExecState p sym ext r))
-> ReaderT
(SimState p sym ext r caller ('Just @(Ctx CrucibleType) args1))
IO
(ExecState p sym ext r)
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT (RegEntry sym ret
-> SimState
p sym ext r (OverrideLang r) ('Just @(Ctx CrucibleType) args1)
-> IO (ExecState p sym ext r)
k RegEntry sym ret
v))
VFVPartial ValueFromValue p sym ext r ret
ctx ProgramLoc
loc Pred sym
pred AbortedResult sym ext
r ->
do sym
sym <- Getting sym (SimState p sym ext r f a) sym
-> ReaderT (SimState p sym ext r f a) IO sym
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting sym (SimState p sym ext r f a) sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
ActiveTree ValueFromFrame p sym ext r f
oldctx PartialResultFrame sym ext f a
pres <- Getting
(ActiveTree p sym ext r f a)
(SimState p sym ext r f a)
(ActiveTree p sym ext r f a)
-> ReaderT
(SimState p sym ext r f a) IO (ActiveTree p sym ext r f a)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext r f a)
(SimState p sym ext r f a)
(ActiveTree p sym ext r f a)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
PartialResultFrame sym ext f a
newPres <- IO (PartialResultFrame sym ext f a)
-> ReaderT
(SimState p sym ext r f a) IO (PartialResultFrame sym ext f a)
forall a. IO a -> ReaderT (SimState p sym ext r f a) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (PartialResultFrame sym ext f a)
-> ReaderT
(SimState p sym ext r f a) IO (PartialResultFrame sym ext f a))
-> IO (PartialResultFrame sym ext f a)
-> ReaderT
(SimState p sym ext r f a) IO (PartialResultFrame sym ext f a)
forall a b. (a -> b) -> a -> b
$
sym
-> ProgramLoc
-> Pred sym
-> PartialResultFrame sym ext f a
-> AbortedResult sym ext
-> IO (PartialResultFrame sym ext f a)
forall sym ext v.
IsExprBuilder sym =>
sym
-> ProgramLoc
-> Pred sym
-> PartialResult sym ext v
-> AbortedResult sym ext
-> IO (PartialResult sym ext v)
mergePartialAndAbortedResult sym
sym ProgramLoc
loc Pred sym
pred PartialResultFrame sym ext f a
pres AbortedResult sym ext
r
(SimState p sym ext r f a -> SimState p sym ext r f a)
-> ExecCont p sym ext r f a -> ExecCont p sym ext r f a
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext r f a
-> Identity (ActiveTree p sym ext r f a))
-> SimState p sym ext r f a -> Identity (SimState p sym ext r f a)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext r f a
-> Identity (ActiveTree p sym ext r f a))
-> SimState p sym ext r f a -> Identity (SimState p sym ext r f a))
-> ActiveTree p sym ext r f a
-> SimState p sym ext r f a
-> SimState p sym ext r f a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueFromFrame p sym ext r f
-> PartialResultFrame sym ext f a -> ActiveTree p sym ext r f a
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree ValueFromFrame p sym ext r f
oldctx PartialResultFrame sym ext f a
newPres)
(FunctionName
-> ValueFromValue p sym ext r ret
-> RegEntry sym ret
-> ExecCont p sym ext r f a
forall sym p ext r (ret :: CrucibleType) f
(a :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
FunctionName
-> ValueFromValue p sym ext r ret
-> RegEntry sym ret
-> ExecCont p sym ext r f a
performReturn FunctionName
fnName ValueFromValue p sym ext r ret
ctx RegEntry sym ret
v)
ValueFromValue p sym ext r ret
VFVEnd ->
do SimContext p sym ext
simctx <- Getting
(SimContext p sym ext)
(SimState p sym ext (RegEntry sym ret) f a)
(SimContext p sym ext)
-> ReaderT (SimState p sym ext r f a) IO (SimContext p sym ext)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(SimContext p sym ext)
(SimState p sym ext (RegEntry sym ret) f a)
(SimContext p sym ext)
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(SimContext p sym ext -> f2 (SimContext p sym ext))
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateContext
ActiveTree ValueFromFrame p sym ext (RegEntry sym ret) f
_oldctx PartialResultFrame sym ext f a
pres <- Getting
(ActiveTree p sym ext (RegEntry sym ret) f a)
(SimState p sym ext (RegEntry sym ret) f a)
(ActiveTree p sym ext (RegEntry sym ret) f a)
-> ReaderT
(SimState p sym ext r f a)
IO
(ActiveTree p sym ext (RegEntry sym ret) f a)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext (RegEntry sym ret) f a)
(SimState p sym ext (RegEntry sym ret) f a)
(ActiveTree p sym ext (RegEntry sym ret) f a)
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
ExecState p sym ext r -> ExecCont p sym ext r f a
forall a. a -> ReaderT (SimState p sym ext r f a) IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext r -> ExecCont p sym ext r f a)
-> ExecState p sym ext r -> ExecCont p sym ext r f a
forall a b. (a -> b) -> a -> b
$! ExecResult p sym ext r -> ExecState p sym ext r
forall p sym ext rtp.
ExecResult p sym ext rtp -> ExecState p sym ext rtp
ResultState (ExecResult p sym ext r -> ExecState p sym ext r)
-> ExecResult p sym ext r -> ExecState p sym ext r
forall a b. (a -> b) -> a -> b
$ SimContext p sym ext
-> PartialResult sym ext r -> ExecResult p sym ext r
forall p sym ext r.
SimContext p sym ext
-> PartialResult sym ext r -> ExecResult p sym ext r
FinishedResult SimContext p sym ext
simctx (PartialResultFrame sym ext f a
pres PartialResultFrame sym ext f a
-> (PartialResultFrame sym ext f a -> PartialResult sym ext r)
-> PartialResult sym ext r
forall a b. a -> (a -> b) -> b
& (GlobalPair sym (SimFrame sym ext f a)
-> Identity (GlobalPair sym r))
-> PartialResultFrame sym ext f a
-> Identity (PartialResult sym ext r)
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue ((GlobalPair sym (SimFrame sym ext f a)
-> Identity (GlobalPair sym r))
-> PartialResultFrame sym ext f a
-> Identity (PartialResult sym ext r))
-> ((SimFrame sym ext f a -> Identity r)
-> GlobalPair sym (SimFrame sym ext f a)
-> Identity (GlobalPair sym r))
-> (SimFrame sym ext f a -> Identity r)
-> PartialResultFrame sym ext f a
-> Identity (PartialResult sym ext r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimFrame sym ext f a -> Identity r)
-> GlobalPair sym (SimFrame sym ext f a)
-> Identity (GlobalPair sym r)
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue ((SimFrame sym ext f a -> Identity r)
-> PartialResultFrame sym ext f a
-> Identity (PartialResult sym ext r))
-> r -> PartialResultFrame sym ext f a -> PartialResult sym ext r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ r
RegEntry sym ret
v)
cruciblePausedFrame ::
ResolvedJump sym b ->
GlobalPair sym (SimFrame sym ext (CrucibleLang b r) ('Just a)) ->
CrucibleBranchTarget (CrucibleLang b r) pd_args ->
ReaderT (SimState p sym ext rtp (CrucibleLang b z) ('Just dc_args)) IO
(PausedFrame p sym ext rtp' (CrucibleLang b r))
cruciblePausedFrame :: forall sym (b :: Ctx (Ctx CrucibleType)) ext (r :: CrucibleType)
(a :: Ctx CrucibleType) (pd_args :: Maybe (Ctx CrucibleType)) p rtp
(z :: CrucibleType) (dc_args :: Ctx CrucibleType) rtp'.
ResolvedJump sym b
-> GlobalPair
sym
(SimFrame sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a))
-> CrucibleBranchTarget (CrucibleLang b r) pd_args
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang b z)
('Just @(Ctx CrucibleType) dc_args))
IO
(PausedFrame p sym ext rtp' (CrucibleLang b r))
cruciblePausedFrame jmp :: ResolvedJump sym b
jmp@(ResolvedJump BlockID b args
x_id RegMap sym args
_) GlobalPair
sym
(SimFrame sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a))
top_frame CrucibleBranchTarget (CrucibleLang b r) pd_args
pd =
do let res :: ControlResumption p sym ext rtp' (CrucibleLang b r)
res = case CrucibleBranchTarget (CrucibleLang b r) pd_args
-> CrucibleBranchTarget
(CrucibleLang b r) ('Just @(Ctx CrucibleType) args)
-> Maybe
((:~:)
@(Maybe (Ctx CrucibleType))
pd_args
('Just @(Ctx CrucibleType) args))
forall (a :: Maybe (Ctx CrucibleType))
(b :: Maybe (Ctx CrucibleType)).
CrucibleBranchTarget (CrucibleLang b r) a
-> CrucibleBranchTarget (CrucibleLang b r) b
-> Maybe ((:~:) @(Maybe (Ctx CrucibleType)) a b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality @k f =>
f a -> f b -> Maybe ((:~:) @k a b)
testEquality CrucibleBranchTarget (CrucibleLang b r) pd_args
pd (BlockID b args
-> CrucibleBranchTarget
(CrucibleLang b r) ('Just @(Ctx CrucibleType) args)
forall (blocks :: Ctx (Ctx CrucibleType))
(args1 :: Ctx CrucibleType) (r :: CrucibleType).
BlockID blocks args1
-> CrucibleBranchTarget
(CrucibleLang blocks r) ('Just @(Ctx CrucibleType) args1)
BlockTarget BlockID b args
x_id) of
Just (:~:)
@(Maybe (Ctx CrucibleType))
pd_args
('Just @(Ctx CrucibleType) args)
Refl -> ResolvedJump sym b
-> ControlResumption p sym ext rtp' (CrucibleLang b r)
forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType).
ResolvedJump sym blocks
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
CheckMergeResumption ResolvedJump sym b
jmp
Maybe
((:~:)
@(Maybe (Ctx CrucibleType))
pd_args
('Just @(Ctx CrucibleType) args))
Nothing -> ResolvedJump sym b
-> ControlResumption p sym ext rtp' (CrucibleLang b r)
forall sym (blocks :: Ctx (Ctx CrucibleType)) p ext rtp
(r :: CrucibleType).
ResolvedJump sym blocks
-> ControlResumption p sym ext rtp (CrucibleLang blocks r)
ContinueResumption ResolvedJump sym b
jmp
ProgramLoc
loc <- BlockID b args
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang b z)
('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc
forall (b :: Ctx (Ctx CrucibleType)) (y :: Ctx CrucibleType) p sym
ext r (a :: CrucibleType) (dc_args :: Ctx CrucibleType).
BlockID b y
-> ReaderT
(SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc
getTgtLoc BlockID b args
x_id
PausedFrame p sym ext rtp' (CrucibleLang b r)
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang b z)
('Just @(Ctx CrucibleType) dc_args))
IO
(PausedFrame p sym ext rtp' (CrucibleLang b r))
forall a.
a
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang b z)
('Just @(Ctx CrucibleType) dc_args))
IO
a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (PausedFrame p sym ext rtp' (CrucibleLang b r)
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang b z)
('Just @(Ctx CrucibleType) dc_args))
IO
(PausedFrame p sym ext rtp' (CrucibleLang b r)))
-> PausedFrame p sym ext rtp' (CrucibleLang b r)
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang b z)
('Just @(Ctx CrucibleType) dc_args))
IO
(PausedFrame p sym ext rtp' (CrucibleLang b r))
forall a b. (a -> b) -> a -> b
$ PartialResultFrame
sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a)
-> ControlResumption p sym ext rtp' (CrucibleLang b r)
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp' (CrucibleLang b r)
forall p sym ext rtp f (old_args :: Ctx CrucibleType).
PartialResultFrame sym ext f ('Just @(Ctx CrucibleType) old_args)
-> ControlResumption p sym ext rtp f
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp f
PausedFrame (GlobalPair
sym
(SimFrame sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a))
-> PartialResultFrame
sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a)
forall sym ext v. GlobalPair sym v -> PartialResult sym ext v
TotalRes GlobalPair
sym
(SimFrame sym ext (CrucibleLang b r) ('Just @(Ctx CrucibleType) a))
top_frame) ControlResumption p sym ext rtp' (CrucibleLang b r)
res (ProgramLoc -> Maybe ProgramLoc
forall a. a -> Maybe a
Just ProgramLoc
loc)
overrideSymbolicBranch ::
IsSymInterface sym =>
Pred sym ->
RegMap sym then_args ->
ExecCont p sym ext rtp (OverrideLang r) ('Just then_args) ->
Maybe Position ->
RegMap sym else_args ->
ExecCont p sym ext rtp (OverrideLang r) ('Just else_args) ->
Maybe Position ->
ExecCont p sym ext rtp (OverrideLang r) ('Just args)
overrideSymbolicBranch :: forall sym (then_args :: Ctx CrucibleType) p ext rtp
(r :: CrucibleType) (else_args :: Ctx CrucibleType)
(args :: Ctx CrucibleType).
IsSymInterface sym =>
Pred sym
-> RegMap sym then_args
-> ExecCont
p
sym
ext
rtp
(OverrideLang r)
('Just @(Ctx CrucibleType) then_args)
-> Maybe Position
-> RegMap sym else_args
-> ExecCont
p
sym
ext
rtp
(OverrideLang r)
('Just @(Ctx CrucibleType) else_args)
-> Maybe Position
-> ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
overrideSymbolicBranch Pred sym
p RegMap sym then_args
thn_args ExecCont
p
sym
ext
rtp
(OverrideLang r)
('Just @(Ctx CrucibleType) then_args)
thn Maybe Position
thn_pos RegMap sym else_args
els_args ExecCont
p
sym
ext
rtp
(OverrideLang r)
('Just @(Ctx CrucibleType) else_args)
els Maybe Position
els_pos =
do TopFrame sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
top_frm <- Getting
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
-> ReaderT
(SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args))
IO
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view ((ActiveTree
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(ActiveTree
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree((ActiveTree
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(ActiveTree
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> ((TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> ActiveTree
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(ActiveTree
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> Getting
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(SimState
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TopFrame sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> ActiveTree
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
(ActiveTree
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args))
forall p sym ext root f1 (args :: Maybe (Ctx CrucibleType))
(args' :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(TopFrame sym ext f1 args -> f2 (TopFrame sym ext f1 args'))
-> ActiveTree p sym ext root f1 args
-> f2 (ActiveTree p sym ext root f1 args')
actFrame)
let fnm :: FunctionName
fnm = TopFrame sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
top_frmTopFrame sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Getting
FunctionName
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
FunctionName
-> FunctionName
forall s a. s -> Getting a s a -> a
^.(SimFrame sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
FunctionName
(SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
FunctionName
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue((SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
FunctionName
(SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
FunctionName
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> ((FunctionName -> Const @Type FunctionName FunctionName)
-> SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
FunctionName
(SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> Getting
FunctionName
(TopFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
FunctionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(OverrideFrame sym r args
-> Const @Type FunctionName (OverrideFrame sym r args))
-> SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
FunctionName
(SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
forall sym ext (r :: CrucibleType) (args :: Ctx CrucibleType)
(r' :: CrucibleType) (args' :: Ctx CrucibleType)
(f :: Type -> Type).
Functor f =>
(OverrideFrame sym r args -> f (OverrideFrame sym r' args'))
-> SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> f (SimFrame
sym ext (OverrideLang r') ('Just @(Ctx CrucibleType) args'))
overrideSimFrame((OverrideFrame sym r args
-> Const @Type FunctionName (OverrideFrame sym r args))
-> SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
FunctionName
(SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)))
-> ((FunctionName -> Const @Type FunctionName FunctionName)
-> OverrideFrame sym r args
-> Const @Type FunctionName (OverrideFrame sym r args))
-> (FunctionName -> Const @Type FunctionName FunctionName)
-> SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> Const
@Type
FunctionName
(SimFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FunctionName -> Const @Type FunctionName FunctionName)
-> OverrideFrame sym r args
-> Const @Type FunctionName (OverrideFrame sym r args)
forall sym (ret :: CrucibleType) (args :: Ctx CrucibleType)
(f :: Type -> Type).
Functor f =>
(FunctionName -> f FunctionName)
-> OverrideFrame sym ret args -> f (OverrideFrame sym ret args)
override
let thn_loc :: Maybe ProgramLoc
thn_loc = FunctionName -> Position -> ProgramLoc
mkProgramLoc FunctionName
fnm (Position -> ProgramLoc) -> Maybe Position -> Maybe ProgramLoc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Position
thn_pos
let els_loc :: Maybe ProgramLoc
els_loc = FunctionName -> Position -> ProgramLoc
mkProgramLoc FunctionName
fnm (Position -> ProgramLoc) -> Maybe Position -> Maybe ProgramLoc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Position
els_pos
let thn_frm :: PausedFrame p sym ext rtp (OverrideLang r)
thn_frm = PartialResultFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> ControlResumption p sym ext rtp (OverrideLang r)
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp (OverrideLang r)
forall p sym ext rtp f (old_args :: Ctx CrucibleType).
PartialResultFrame sym ext f ('Just @(Ctx CrucibleType) old_args)
-> ControlResumption p sym ext rtp f
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp f
PausedFrame (TopFrame sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> PartialResultFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
forall sym ext v. GlobalPair sym v -> PartialResult sym ext v
TotalRes TopFrame sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
top_frm) (ExecCont
p
sym
ext
rtp
(OverrideLang r)
('Just @(Ctx CrucibleType) then_args)
-> RegMap sym then_args
-> ControlResumption p sym ext rtp (OverrideLang r)
forall p sym ext rtp (r :: CrucibleType)
(args :: Ctx CrucibleType).
ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> RegMap sym args
-> ControlResumption p sym ext rtp (OverrideLang r)
OverrideResumption ExecCont
p
sym
ext
rtp
(OverrideLang r)
('Just @(Ctx CrucibleType) then_args)
thn RegMap sym then_args
thn_args) Maybe ProgramLoc
thn_loc
let els_frm :: PausedFrame p sym ext rtp (OverrideLang r)
els_frm = PartialResultFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> ControlResumption p sym ext rtp (OverrideLang r)
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp (OverrideLang r)
forall p sym ext rtp f (old_args :: Ctx CrucibleType).
PartialResultFrame sym ext f ('Just @(Ctx CrucibleType) old_args)
-> ControlResumption p sym ext rtp f
-> Maybe ProgramLoc
-> PausedFrame p sym ext rtp f
PausedFrame (TopFrame sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> PartialResultFrame
sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
forall sym ext v. GlobalPair sym v -> PartialResult sym ext v
TotalRes TopFrame sym ext (OverrideLang r) ('Just @(Ctx CrucibleType) args)
top_frm) (ExecCont
p
sym
ext
rtp
(OverrideLang r)
('Just @(Ctx CrucibleType) else_args)
-> RegMap sym else_args
-> ControlResumption p sym ext rtp (OverrideLang r)
forall p sym ext rtp (r :: CrucibleType)
(args :: Ctx CrucibleType).
ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
-> RegMap sym args
-> ControlResumption p sym ext rtp (OverrideLang r)
OverrideResumption ExecCont
p
sym
ext
rtp
(OverrideLang r)
('Just @(Ctx CrucibleType) else_args)
els RegMap sym else_args
els_args) Maybe ProgramLoc
els_loc
Pred sym
-> PausedFrame p sym ext rtp (OverrideLang r)
-> PausedFrame p sym ext rtp (OverrideLang r)
-> CrucibleBranchTarget
(OverrideLang r) ('Nothing @(Ctx CrucibleType))
-> ExecCont
p sym ext rtp (OverrideLang r) ('Just @(Ctx CrucibleType) args)
forall sym p ext rtp f (args :: Maybe (Ctx CrucibleType))
(dc_args :: Ctx CrucibleType).
IsSymInterface sym =>
Pred sym
-> PausedFrame p sym ext rtp f
-> PausedFrame p sym ext rtp f
-> CrucibleBranchTarget f args
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
intra_branch Pred sym
p PausedFrame p sym ext rtp (OverrideLang r)
thn_frm PausedFrame p sym ext rtp (OverrideLang r)
els_frm CrucibleBranchTarget
(OverrideLang r) ('Nothing @(Ctx CrucibleType))
forall f. CrucibleBranchTarget f ('Nothing @(Ctx CrucibleType))
ReturnTarget
getTgtLoc ::
BlockID b y ->
ReaderT (SimState p sym ext r (CrucibleLang b a) ('Just dc_args)) IO ProgramLoc
getTgtLoc :: forall (b :: Ctx (Ctx CrucibleType)) (y :: Ctx CrucibleType) p sym
ext r (a :: CrucibleType) (dc_args :: Ctx CrucibleType).
BlockID b y
-> ReaderT
(SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc
getTgtLoc (BlockID Index @(Ctx CrucibleType) b y
i) =
do Assignment @(Ctx CrucibleType) (Block ext b a) b
blocks <- Getting
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
(SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args))
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
-> ReaderT
(SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args))
IO
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view ((CallFrame sym ext b a dc_args
-> Const
@Type
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
(CallFrame sym ext b a dc_args))
-> SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args)
-> Const
@Type
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
(SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args))
forall p sym ext rtp (blocks :: Ctx (Ctx CrucibleType))
(r :: CrucibleType) (a :: Ctx CrucibleType)
(a' :: Ctx CrucibleType) (f :: Type -> Type).
Functor f =>
(CallFrame sym ext blocks r a -> f (CallFrame sym ext blocks r a'))
-> SimState
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
-> f (SimState
p
sym
ext
rtp
(CrucibleLang blocks r)
('Just @(Ctx CrucibleType) a'))
stateCrucibleFrame ((CallFrame sym ext b a dc_args
-> Const
@Type
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
(CallFrame sym ext b a dc_args))
-> SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args)
-> Const
@Type
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
(SimState
p
sym
ext
r
(CrucibleLang b a)
('Just @(Ctx CrucibleType) dc_args)))
-> ((Assignment @(Ctx CrucibleType) (Block ext b a) b
-> Const
@Type
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
(Assignment @(Ctx CrucibleType) (Block ext b a) b))
-> CallFrame sym ext b a dc_args
-> Const
@Type
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
(CallFrame sym ext b a dc_args))
-> Getting
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
(SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args))
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CallFrame sym ext b a dc_args
-> Assignment @(Ctx CrucibleType) (Block ext b a) b)
-> (Assignment @(Ctx CrucibleType) (Block ext b a) b
-> Const
@Type
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
(Assignment @(Ctx CrucibleType) (Block ext b a) b))
-> CallFrame sym ext b a dc_args
-> Const
@Type
(Assignment @(Ctx CrucibleType) (Block ext b a) b)
(CallFrame sym ext b a dc_args)
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' @Type @Type p f s a
to CallFrame sym ext b a dc_args
-> Assignment @(Ctx CrucibleType) (Block ext b a) b
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (ctx :: Ctx CrucibleType).
CallFrame sym ext blocks ret ctx -> BlockMap ext blocks ret
frameBlockMap)
ProgramLoc
-> ReaderT
(SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc
forall a.
a
-> ReaderT
(SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args))
IO
a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ProgramLoc
-> ReaderT
(SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc)
-> ProgramLoc
-> ReaderT
(SimState
p sym ext r (CrucibleLang b a) ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc
forall a b. (a -> b) -> a -> b
$ Block ext b a y -> ProgramLoc
forall ext (blocks :: Ctx (Ctx CrucibleType)) (ret :: CrucibleType)
(ctx :: Ctx CrucibleType).
Block ext blocks ret ctx -> ProgramLoc
blockLoc (Assignment @(Ctx CrucibleType) (Block ext b a) b
blocks Assignment @(Ctx CrucibleType) (Block ext b a) b
-> Index @(Ctx CrucibleType) b y -> Block ext b a y
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment @k f ctx -> Index @k ctx tp -> f tp
Ctx.! Index @(Ctx CrucibleType) b y
i)
asContFrame ::
ActiveTree p sym ext ret f args ->
ValueFromFrame p sym ext ret f
asContFrame :: forall p sym ext ret f (args :: Maybe (Ctx CrucibleType)).
ActiveTree p sym ext ret f args -> ValueFromFrame p sym ext ret f
asContFrame (ActiveTree ValueFromFrame p sym ext ret f
ctx PartialResultFrame sym ext f args
active_res) =
case PartialResultFrame sym ext f args
active_res of
TotalRes{} -> ValueFromFrame p sym ext ret f
ctx
PartialRes ProgramLoc
loc Pred sym
pred GlobalPair sym (SimFrame sym ext f args)
_ex AbortedResult sym ext
ar -> ValueFromFrame p sym ext ret f
-> ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> PendingPartialMerges
-> ValueFromFrame p sym ext ret f
forall p sym ext ret f.
ValueFromFrame p sym ext ret f
-> ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> PendingPartialMerges
-> ValueFromFrame p sym ext ret f
VFFPartial ValueFromFrame p sym ext ret f
ctx ProgramLoc
loc Pred sym
pred AbortedResult sym ext
ar PendingPartialMerges
NoNeedToAbort
predEqConst :: IsExprBuilder sym => sym -> Pred sym -> Bool -> IO (Pred sym)
predEqConst :: forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Bool -> IO (Pred sym)
predEqConst sym
_ Pred sym
p Bool
True = Pred sym -> IO (Pred sym)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred sym
p
predEqConst sym
sym Pred sym
p Bool
False = sym -> Pred sym -> IO (Pred sym)
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred sym
sym Pred sym
p
intra_branch ::
IsSymInterface sym =>
Pred sym
->
PausedFrame p sym ext rtp f
->
PausedFrame p sym ext rtp f
->
CrucibleBranchTarget f (args :: Maybe (Ctx CrucibleType))
->
ExecCont p sym ext rtp f ('Just dc_args)
intra_branch :: forall sym p ext rtp f (args :: Maybe (Ctx CrucibleType))
(dc_args :: Ctx CrucibleType).
IsSymInterface sym =>
Pred sym
-> PausedFrame p sym ext rtp f
-> PausedFrame p sym ext rtp f
-> CrucibleBranchTarget f args
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
intra_branch Pred sym
p PausedFrame p sym ext rtp f
t_label PausedFrame p sym ext rtp f
f_label CrucibleBranchTarget f args
tgt = do
ValueFromFrame p sym ext rtp f
ctx <- ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
-> ValueFromFrame p sym ext rtp f
forall p sym ext ret f (args :: Maybe (Ctx CrucibleType)).
ActiveTree p sym ext ret f args -> ValueFromFrame p sym ext ret f
asContFrame (ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
-> ValueFromFrame p sym ext rtp f)
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(ValueFromFrame p sym ext rtp f)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
SimContext p sym ext
simCtx <- Getting
(SimContext p sym ext)
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(SimContext p sym ext)
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(SimContext p sym ext)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(SimContext p sym ext)
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(SimContext p sym ext)
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(SimContext p sym ext -> f2 (SimContext p sym ext))
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateContext
sym
sym <- Getting
sym
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
sym
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
sym
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
sym
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
SimContext p sym ext
-> (forall {bak}.
IsSymBackend sym bak =>
bak
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
forall personality sym ext a.
SimContext personality sym ext
-> (forall bak. IsSymBackend sym bak => bak -> a) -> a
withBackend SimContext p sym ext
simCtx ((forall {bak}.
IsSymBackend sym bak =>
bak
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
-> (forall {bak}.
IsSymBackend sym bak =>
bak
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
case Pred sym -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred sym
p of
Maybe Bool
Nothing ->
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
-> IO (ExecState p sym ext rtp))
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
-> IO (ExecState p sym ext rtp))
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
-> (SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
-> IO (ExecState p sym ext rtp))
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
forall a b. (a -> b) -> a -> b
$ ExecState p sym ext rtp -> IO (ExecState p sym ext rtp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecState p sym ext rtp -> IO (ExecState p sym ext rtp))
-> (SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
-> ExecState p sym ext rtp)
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
-> IO (ExecState p sym ext rtp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pred sym
-> PausedFrame p sym ext rtp f
-> PausedFrame p sym ext rtp f
-> CrucibleBranchTarget f args
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
-> ExecState p sym ext rtp
forall p sym ext rtp f (args :: Ctx CrucibleType)
(postdom_args :: Maybe (Ctx CrucibleType)).
Pred sym
-> PausedFrame p sym ext rtp f
-> PausedFrame p sym ext rtp f
-> CrucibleBranchTarget f postdom_args
-> SimState p sym ext rtp f ('Just @(Ctx CrucibleType) args)
-> ExecState p sym ext rtp
SymbolicBranchState Pred sym
p PausedFrame p sym ext rtp f
t_label PausedFrame p sym ext rtp f
f_label CrucibleBranchTarget f args
tgt
Just Bool
chosen_branch ->
do Pred sym
p' <- IO (Pred sym)
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(Pred sym)
forall a.
IO a
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Pred sym)
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(Pred sym))
-> IO (Pred sym)
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(Pred sym)
forall a b. (a -> b) -> a -> b
$ sym -> Pred sym -> Bool -> IO (Pred sym)
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Bool -> IO (Pred sym)
predEqConst sym
sym Pred sym
p Bool
chosen_branch
let a_frame :: PausedFrame p sym ext rtp f
a_frame = if Bool
chosen_branch then PausedFrame p sym ext rtp f
t_label else PausedFrame p sym ext rtp f
f_label
ProgramLoc
loc <- IO ProgramLoc
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc
forall a.
IO a
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ProgramLoc
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc)
-> IO ProgramLoc
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc
forall a b. (a -> b) -> a -> b
$ sym -> IO ProgramLoc
forall sym. IsExprBuilder sym => sym -> IO ProgramLoc
getCurrentProgramLoc sym
sym
IO ()
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
()
forall a.
IO a
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
())
-> IO ()
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
()
forall a b. (a -> b) -> a -> b
$ bak -> Assumption sym -> IO ()
forall sym bak.
IsSymBackend sym bak =>
bak -> Assumption sym -> IO ()
addAssumption bak
bak (ProgramLoc -> Maybe ProgramLoc -> Pred sym -> Assumption sym
forall (e :: BaseType -> Type).
ProgramLoc
-> Maybe ProgramLoc -> e BaseBoolType -> CrucibleAssumption e
BranchCondition ProgramLoc
loc (PausedFrame p sym ext rtp f -> Maybe ProgramLoc
forall p sym ext rtp f.
PausedFrame p sym ext rtp f -> Maybe ProgramLoc
pausedLoc PausedFrame p sym ext rtp f
a_frame) Pred sym
p')
PausedFrame p sym ext rtp f
-> ValueFromFrame p sym ext rtp f
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
forall sym p ext rtp f g (ba :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
PausedFrame p sym ext rtp f
-> ValueFromFrame p sym ext rtp f -> ExecCont p sym ext rtp g ba
resumeFrame PausedFrame p sym ext rtp f
a_frame ValueFromFrame p sym ext rtp f
ctx
{-# INLINABLE intra_branch #-}
performIntraFrameSplit ::
IsSymInterface sym =>
Pred sym
->
PausedFrame p sym ext rtp f
->
PausedFrame p sym ext rtp f
->
CrucibleBranchTarget f (args :: Maybe (Ctx CrucibleType))
->
ExecCont p sym ext rtp f ('Just dc_args)
performIntraFrameSplit :: forall sym p ext rtp f (args :: Maybe (Ctx CrucibleType))
(dc_args :: Ctx CrucibleType).
IsSymInterface sym =>
Pred sym
-> PausedFrame p sym ext rtp f
-> PausedFrame p sym ext rtp f
-> CrucibleBranchTarget f args
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
performIntraFrameSplit Pred sym
p PausedFrame p sym ext rtp f
a_frame PausedFrame p sym ext rtp f
o_frame CrucibleBranchTarget f args
tgt =
do ValueFromFrame p sym ext rtp f
ctx <- ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
-> ValueFromFrame p sym ext rtp f
forall p sym ext ret f (args :: Maybe (Ctx CrucibleType)).
ActiveTree p sym ext ret f args -> ValueFromFrame p sym ext ret f
asContFrame (ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
-> ValueFromFrame p sym ext rtp f)
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(ValueFromFrame p sym ext rtp f)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(ActiveTree p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree
SimContext p sym ext
simCtx <- Getting
(SimContext p sym ext)
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(SimContext p sym ext)
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(SimContext p sym ext)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(SimContext p sym ext)
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
(SimContext p sym ext)
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(SimContext p sym ext -> f2 (SimContext p sym ext))
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateContext
sym
sym <- Getting
sym
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
sym
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
sym
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
sym
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
ProgramLoc
loc <- IO ProgramLoc
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc
forall a.
IO a
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ProgramLoc
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc)
-> IO ProgramLoc
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
ProgramLoc
forall a b. (a -> b) -> a -> b
$ sym -> IO ProgramLoc
forall sym. IsExprBuilder sym => sym -> IO ProgramLoc
getCurrentProgramLoc sym
sym
PausedFrame p sym ext rtp f
a_frame' <- PausedFrame p sym ext rtp f
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(PausedFrame p sym ext rtp f)
forall sym p ext rtp g f (ma :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
PausedFrame p sym ext rtp g
-> ReaderT
(SimState p sym ext rtp f ma) IO (PausedFrame p sym ext rtp g)
pushPausedFrame PausedFrame p sym ext rtp f
a_frame
PausedFrame p sym ext rtp f
o_frame' <- PausedFrame p sym ext rtp f
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
(PausedFrame p sym ext rtp f)
forall sym p ext rtp g f (ma :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
PausedFrame p sym ext rtp g
-> ReaderT
(SimState p sym ext rtp f ma) IO (PausedFrame p sym ext rtp g)
pushPausedFrame PausedFrame p sym ext rtp f
o_frame
FrameIdentifier
assume_frame <- SimContext p sym ext
-> (forall {bak}.
IsSymBackend sym bak =>
bak
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
FrameIdentifier)
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
FrameIdentifier
forall personality sym ext a.
SimContext personality sym ext
-> (forall bak. IsSymBackend sym bak => bak -> a) -> a
withBackend SimContext p sym ext
simCtx ((forall {bak}.
IsSymBackend sym bak =>
bak
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
FrameIdentifier)
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
FrameIdentifier)
-> (forall {bak}.
IsSymBackend sym bak =>
bak
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
FrameIdentifier)
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
FrameIdentifier
forall a b. (a -> b) -> a -> b
$ \bak
bak ->
IO FrameIdentifier
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
FrameIdentifier
forall a.
IO a
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO FrameIdentifier
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
FrameIdentifier)
-> IO FrameIdentifier
-> ReaderT
(SimState p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args))
IO
FrameIdentifier
forall a b. (a -> b) -> a -> b
$ bak -> Assumption sym -> IO FrameIdentifier
forall sym bak.
IsSymBackend sym bak =>
bak -> Assumption sym -> IO FrameIdentifier
assumeInNewFrame bak
bak (ProgramLoc -> Maybe ProgramLoc -> Pred sym -> Assumption sym
forall (e :: BaseType -> Type).
ProgramLoc
-> Maybe ProgramLoc -> e BaseBoolType -> CrucibleAssumption e
BranchCondition ProgramLoc
loc (PausedFrame p sym ext rtp f -> Maybe ProgramLoc
forall p sym ext rtp f.
PausedFrame p sym ext rtp f -> Maybe ProgramLoc
pausedLoc PausedFrame p sym ext rtp f
a_frame') Pred sym
p)
let todo :: VFFOtherPath p sym ext rtp f args
todo = PausedFrame p sym ext rtp f -> VFFOtherPath p sym ext rtp f args
forall p sym ext ret f (args :: Maybe (Ctx CrucibleType)).
PausedFrame p sym ext ret f -> VFFOtherPath p sym ext ret f args
VFFActivePath PausedFrame p sym ext rtp f
o_frame'
ctx' :: ValueFromFrame p sym ext rtp f
ctx' = ValueFromFrame p sym ext rtp f
-> FrameIdentifier
-> ProgramLoc
-> Pred sym
-> VFFOtherPath p sym ext rtp f args
-> CrucibleBranchTarget f args
-> ValueFromFrame p sym ext rtp f
forall p sym ext ret f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext ret f
-> FrameIdentifier
-> ProgramLoc
-> Pred sym
-> VFFOtherPath p sym ext ret f args
-> CrucibleBranchTarget f args
-> ValueFromFrame p sym ext ret f
VFFBranch ValueFromFrame p sym ext rtp f
ctx FrameIdentifier
assume_frame ProgramLoc
loc Pred sym
p VFFOtherPath p sym ext rtp f args
todo CrucibleBranchTarget f args
tgt
PausedFrame p sym ext rtp f
-> ValueFromFrame p sym ext rtp f
-> ExecCont p sym ext rtp f ('Just @(Ctx CrucibleType) dc_args)
forall sym p ext rtp f g (ba :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
PausedFrame p sym ext rtp f
-> ValueFromFrame p sym ext rtp f -> ExecCont p sym ext rtp g ba
resumeFrame PausedFrame p sym ext rtp f
a_frame' ValueFromFrame p sym ext rtp f
ctx'
performFunctionCall ::
IsSymInterface sym =>
ReturnHandler ret p sym ext rtp outer_frame outer_args ->
ResolvedCall p sym ext ret ->
ExecCont p sym ext rtp outer_frame outer_args
performFunctionCall :: forall sym (ret :: CrucibleType) p ext rtp outer_frame
(outer_args :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
ReturnHandler ret p sym ext rtp outer_frame outer_args
-> ResolvedCall p sym ext ret
-> ExecCont p sym ext rtp outer_frame outer_args
performFunctionCall ReturnHandler ret p sym ext rtp outer_frame outer_args
retHandler ResolvedCall p sym ext ret
frm =
do sym
sym <- Getting sym (SimState p sym ext rtp outer_frame outer_args) sym
-> ReaderT (SimState p sym ext rtp outer_frame outer_args) IO sym
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting sym (SimState p sym ext rtp outer_frame outer_args) sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
case ResolvedCall p sym ext ret
frm of
OverrideCall Override p sym ext args ret
o OverrideFrame sym ret args
f ->
(SimState p sym ext rtp outer_frame outer_args
-> SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
-> ReaderT
(SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
-> ExecCont p sym ext rtp outer_frame outer_args
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext rtp outer_frame outer_args
-> Identity
(ActiveTree
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)))
-> SimState p sym ext rtp outer_frame outer_args
-> Identity
(SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext rtp outer_frame outer_args
-> Identity
(ActiveTree
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)))
-> SimState p sym ext rtp outer_frame outer_args
-> Identity
(SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)))
-> (ActiveTree p sym ext rtp outer_frame outer_args
-> ActiveTree
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
-> SimState p sym ext rtp outer_frame outer_args
-> SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ReturnHandler
(FrameRetType (OverrideLang ret))
p
sym
ext
rtp
outer_frame
outer_args
-> SimFrame
sym ext (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
-> ActiveTree p sym ext rtp outer_frame outer_args
-> ActiveTree
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
forall a p sym ext r f (old_args :: Maybe (Ctx CrucibleType))
(args :: Maybe (Ctx CrucibleType)).
ReturnHandler (FrameRetType a) p sym ext r f old_args
-> SimFrame sym ext a args
-> ActiveTree p sym ext r f old_args
-> ActiveTree p sym ext r a args
pushCallFrame ReturnHandler ret p sym ext rtp outer_frame outer_args
ReturnHandler
(FrameRetType (OverrideLang ret))
p
sym
ext
rtp
outer_frame
outer_args
retHandler (OverrideFrame sym ret args
-> SimFrame
sym ext (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
forall sym (ret :: CrucibleType) (args1 :: Ctx CrucibleType) ext.
OverrideFrame sym ret args1
-> SimFrame
sym ext (OverrideLang ret) ('Just @(Ctx CrucibleType) args1)
OF OverrideFrame sym ret args
f))
(Override p sym ext args ret
-> ReaderT
(SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType)
rtp.
Override p sym ext args ret
-> ExecCont
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
runOverride Override p sym ext args ret
o)
CrucibleCall BlockID blocks args
entryID CallFrame sym ext blocks ret args
f -> do
let loc :: ProgramLoc
loc = FunctionName -> Position -> ProgramLoc
mkProgramLoc (ResolvedCall p sym ext ret -> FunctionName
forall p sym ext (ret :: CrucibleType).
ResolvedCall p sym ext ret -> FunctionName
resolvedCallName ResolvedCall p sym ext ret
frm) (Text -> Position
OtherPos Text
"<function entry>")
IO ()
-> ReaderT (SimState p sym ext rtp outer_frame outer_args) IO ()
forall a.
IO a
-> ReaderT (SimState p sym ext rtp outer_frame outer_args) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> ReaderT (SimState p sym ext rtp outer_frame outer_args) IO ())
-> IO ()
-> ReaderT (SimState p sym ext rtp outer_frame outer_args) IO ()
forall a b. (a -> b) -> a -> b
$ sym -> ProgramLoc -> IO ()
forall sym. IsExprBuilder sym => sym -> ProgramLoc -> IO ()
setCurrentProgramLoc sym
sym ProgramLoc
loc
(SimState p sym ext rtp outer_frame outer_args
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
-> ExecCont p sym ext rtp outer_frame outer_args
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext rtp outer_frame outer_args
-> Identity
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args)))
-> SimState p sym ext rtp outer_frame outer_args
-> Identity
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext rtp outer_frame outer_args
-> Identity
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args)))
-> SimState p sym ext rtp outer_frame outer_args
-> Identity
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args)))
-> (ActiveTree p sym ext rtp outer_frame outer_args
-> ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args))
-> SimState p sym ext rtp outer_frame outer_args
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ReturnHandler
(FrameRetType (CrucibleLang blocks ret))
p
sym
ext
rtp
outer_frame
outer_args
-> SimFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) args)
-> ActiveTree p sym ext rtp outer_frame outer_args
-> ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args)
forall a p sym ext r f (old_args :: Maybe (Ctx CrucibleType))
(args :: Maybe (Ctx CrucibleType)).
ReturnHandler (FrameRetType a) p sym ext r f old_args
-> SimFrame sym ext a args
-> ActiveTree p sym ext r f old_args
-> ActiveTree p sym ext r a args
pushCallFrame ReturnHandler ret p sym ext rtp outer_frame outer_args
ReturnHandler
(FrameRetType (CrucibleLang blocks ret))
p
sym
ext
rtp
outer_frame
outer_args
retHandler (CallFrame sym ext blocks ret args
-> SimFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) args)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (args1 :: Ctx CrucibleType).
CallFrame sym ext blocks ret args1
-> SimFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) args1)
MF CallFrame sym ext blocks ret args
f))
(RunningStateInfo blocks args
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
forall (blocks :: Ctx (Ctx CrucibleType)) (a :: Ctx CrucibleType) p
sym ext rtp (r :: CrucibleType).
RunningStateInfo blocks a
-> ExecCont
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
continue (BlockID blocks args -> RunningStateInfo blocks args
forall (blocks :: Ctx (Ctx CrucibleType))
(args :: Ctx CrucibleType).
BlockID blocks args -> RunningStateInfo blocks args
RunBlockStart BlockID blocks args
entryID))
performTailCall ::
IsSymInterface sym =>
ValueFromValue p sym ext rtp ret ->
ResolvedCall p sym ext ret ->
ExecCont p sym ext rtp f a
performTailCall :: forall sym p ext rtp (ret :: CrucibleType) f
(a :: Maybe (Ctx CrucibleType)).
IsSymInterface sym =>
ValueFromValue p sym ext rtp ret
-> ResolvedCall p sym ext ret -> ExecCont p sym ext rtp f a
performTailCall ValueFromValue p sym ext rtp ret
vfv ResolvedCall p sym ext ret
frm =
do sym
sym <- Getting sym (SimState p sym ext rtp f a) sym
-> ReaderT (SimState p sym ext rtp f a) IO sym
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting sym (SimState p sym ext rtp f a) sym
forall p sym ext r f1 (a :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
(Contravariant f2, Functor f2) =>
(sym -> f2 sym)
-> SimState p sym ext r f1 a -> f2 (SimState p sym ext r f1 a)
stateSymInterface
let loc :: ProgramLoc
loc = FunctionName -> Position -> ProgramLoc
mkProgramLoc (ResolvedCall p sym ext ret -> FunctionName
forall p sym ext (ret :: CrucibleType).
ResolvedCall p sym ext ret -> FunctionName
resolvedCallName ResolvedCall p sym ext ret
frm) (Text -> Position
OtherPos Text
"<function entry>")
IO () -> ReaderT (SimState p sym ext rtp f a) IO ()
forall a. IO a -> ReaderT (SimState p sym ext rtp f a) IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (SimState p sym ext rtp f a) IO ())
-> IO () -> ReaderT (SimState p sym ext rtp f a) IO ()
forall a b. (a -> b) -> a -> b
$ sym -> ProgramLoc -> IO ()
forall sym. IsExprBuilder sym => sym -> ProgramLoc -> IO ()
setCurrentProgramLoc sym
sym ProgramLoc
loc
case ResolvedCall p sym ext ret
frm of
OverrideCall Override p sym ext args ret
o OverrideFrame sym ret args
f ->
(SimState p sym ext rtp f a
-> SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
-> ReaderT
(SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
-> ExecCont p sym ext rtp f a
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext rtp f a
-> Identity
(ActiveTree
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)))
-> SimState p sym ext rtp f a
-> Identity
(SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext rtp f a
-> Identity
(ActiveTree
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)))
-> SimState p sym ext rtp f a
-> Identity
(SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)))
-> (ActiveTree p sym ext rtp f a
-> ActiveTree
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
-> SimState p sym ext rtp f a
-> SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ValueFromValue p sym ext rtp (FrameRetType (OverrideLang ret))
-> SimFrame
sym ext (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
-> ActiveTree p sym ext rtp f a
-> ActiveTree
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
forall p sym ext rtp f' (args' :: Maybe (Ctx CrucibleType)) f
(args :: Maybe (Ctx CrucibleType)).
ValueFromValue p sym ext rtp (FrameRetType f')
-> SimFrame sym ext f' args'
-> ActiveTree p sym ext rtp f args
-> ActiveTree p sym ext rtp f' args'
swapCallFrame ValueFromValue p sym ext rtp ret
ValueFromValue p sym ext rtp (FrameRetType (OverrideLang ret))
vfv (OverrideFrame sym ret args
-> SimFrame
sym ext (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
forall sym (ret :: CrucibleType) (args1 :: Ctx CrucibleType) ext.
OverrideFrame sym ret args1
-> SimFrame
sym ext (OverrideLang ret) ('Just @(Ctx CrucibleType) args1)
OF OverrideFrame sym ret args
f))
(Override p sym ext args ret
-> ReaderT
(SimState
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
forall p sym ext (args :: Ctx CrucibleType) (ret :: CrucibleType)
rtp.
Override p sym ext args ret
-> ExecCont
p sym ext rtp (OverrideLang ret) ('Just @(Ctx CrucibleType) args)
runOverride Override p sym ext args ret
o)
CrucibleCall BlockID blocks args
entryID CallFrame sym ext blocks ret args
f ->
(SimState p sym ext rtp f a
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args))
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
-> ExecCont p sym ext rtp f a
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
((ActiveTree p sym ext rtp f a
-> Identity
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args)))
-> SimState p sym ext rtp f a
-> Identity
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args))
forall p sym ext rtp f1 (a :: Maybe (Ctx CrucibleType)) g
(b :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(ActiveTree p sym ext rtp f1 a
-> f2 (ActiveTree p sym ext rtp g b))
-> SimState p sym ext rtp f1 a -> f2 (SimState p sym ext rtp g b)
stateTree ((ActiveTree p sym ext rtp f a
-> Identity
(ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args)))
-> SimState p sym ext rtp f a
-> Identity
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args)))
-> (ActiveTree p sym ext rtp f a
-> ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args))
-> SimState p sym ext rtp f a
-> SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ValueFromValue
p sym ext rtp (FrameRetType (CrucibleLang blocks ret))
-> SimFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) args)
-> ActiveTree p sym ext rtp f a
-> ActiveTree
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args)
forall p sym ext rtp f' (args' :: Maybe (Ctx CrucibleType)) f
(args :: Maybe (Ctx CrucibleType)).
ValueFromValue p sym ext rtp (FrameRetType f')
-> SimFrame sym ext f' args'
-> ActiveTree p sym ext rtp f args
-> ActiveTree p sym ext rtp f' args'
swapCallFrame ValueFromValue p sym ext rtp ret
ValueFromValue
p sym ext rtp (FrameRetType (CrucibleLang blocks ret))
vfv (CallFrame sym ext blocks ret args
-> SimFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) args)
forall sym ext (blocks :: Ctx (Ctx CrucibleType))
(ret :: CrucibleType) (args1 :: Ctx CrucibleType).
CallFrame sym ext blocks ret args1
-> SimFrame
sym ext (CrucibleLang blocks ret) ('Just @(Ctx CrucibleType) args1)
MF CallFrame sym ext blocks ret args
f))
(RunningStateInfo blocks args
-> ReaderT
(SimState
p
sym
ext
rtp
(CrucibleLang blocks ret)
('Just @(Ctx CrucibleType) args))
IO
(ExecState p sym ext rtp)
forall (blocks :: Ctx (Ctx CrucibleType)) (a :: Ctx CrucibleType) p
sym ext rtp (r :: CrucibleType).
RunningStateInfo blocks a
-> ExecCont
p sym ext rtp (CrucibleLang blocks r) ('Just @(Ctx CrucibleType) a)
continue (BlockID blocks args -> RunningStateInfo blocks args
forall (blocks :: Ctx (Ctx CrucibleType))
(args :: Ctx CrucibleType).
BlockID blocks args -> RunningStateInfo blocks args
RunBlockStart BlockID blocks args
entryID))
isSingleCont :: ValueFromFrame p sym ext root a -> Bool
isSingleCont :: forall p sym ext root a. ValueFromFrame p sym ext root a -> Bool
isSingleCont ValueFromFrame p sym ext root a
c0 =
case ValueFromFrame p sym ext root a
c0 of
VFFBranch{} -> Bool
False
VFFPartial ValueFromFrame p sym ext root a
c ProgramLoc
_ Pred sym
_ AbortedResult sym ext
_ PendingPartialMerges
_ -> ValueFromFrame p sym ext root a -> Bool
forall p sym ext root a. ValueFromFrame p sym ext root a -> Bool
isSingleCont ValueFromFrame p sym ext root a
c
VFFEnd ValueFromValue p sym ext root (FrameRetType a)
vfv -> ValueFromValue p sym ext root (FrameRetType a) -> Bool
forall p sym ext r (a :: CrucibleType).
ValueFromValue p sym ext r a -> Bool
isSingleVFV ValueFromValue p sym ext root (FrameRetType a)
vfv
isSingleVFV :: ValueFromValue p sym ext r a -> Bool
isSingleVFV :: forall p sym ext r (a :: CrucibleType).
ValueFromValue p sym ext r a -> Bool
isSingleVFV ValueFromValue p sym ext r a
c0 = do
case ValueFromValue p sym ext r a
c0 of
VFVCall ValueFromFrame p sym ext r caller
c SimFrame sym ext caller args
_ ReturnHandler a p sym ext r caller args
_ -> ValueFromFrame p sym ext r caller -> Bool
forall p sym ext root a. ValueFromFrame p sym ext root a -> Bool
isSingleCont ValueFromFrame p sym ext r caller
c
VFVPartial ValueFromValue p sym ext r a
c ProgramLoc
_ Pred sym
_ AbortedResult sym ext
_ -> ValueFromValue p sym ext r a -> Bool
forall p sym ext r (a :: CrucibleType).
ValueFromValue p sym ext r a -> Bool
isSingleVFV ValueFromValue p sym ext r a
c
ValueFromValue p sym ext r a
VFVEnd -> Bool
True
unwindContext ::
ValueFromFrame p sym ext root f ->
Maybe (ValueFromValue p sym ext root (FrameRetType f))
unwindContext :: forall p sym ext root f.
ValueFromFrame p sym ext root f
-> Maybe (ValueFromValue p sym ext root (FrameRetType f))
unwindContext ValueFromFrame p sym ext root f
c0 =
case ValueFromFrame p sym ext root f
c0 of
VFFBranch{} -> Maybe (ValueFromValue p sym ext root (FrameRetType f))
forall a. Maybe a
Nothing
VFFPartial ValueFromFrame p sym ext root f
_ ProgramLoc
_ Pred sym
_ AbortedResult sym ext
_ PendingPartialMerges
NeedsToBeAborted -> Maybe (ValueFromValue p sym ext root (FrameRetType f))
forall a. Maybe a
Nothing
VFFPartial ValueFromFrame p sym ext root f
d ProgramLoc
loc Pred sym
pred AbortedResult sym ext
ar PendingPartialMerges
NoNeedToAbort ->
(\ValueFromValue p sym ext root (FrameRetType f)
d' -> ValueFromValue p sym ext root (FrameRetType f)
-> ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> ValueFromValue p sym ext root (FrameRetType f)
forall p sym ext ret (top_return :: CrucibleType).
ValueFromValue p sym ext ret top_return
-> ProgramLoc
-> Pred sym
-> AbortedResult sym ext
-> ValueFromValue p sym ext ret top_return
VFVPartial ValueFromValue p sym ext root (FrameRetType f)
d' ProgramLoc
loc Pred sym
pred AbortedResult sym ext
ar) (ValueFromValue p sym ext root (FrameRetType f)
-> ValueFromValue p sym ext root (FrameRetType f))
-> Maybe (ValueFromValue p sym ext root (FrameRetType f))
-> Maybe (ValueFromValue p sym ext root (FrameRetType f))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueFromFrame p sym ext root f
-> Maybe (ValueFromValue p sym ext root (FrameRetType f))
forall p sym ext root f.
ValueFromFrame p sym ext root f
-> Maybe (ValueFromValue p sym ext root (FrameRetType f))
unwindContext ValueFromFrame p sym ext root f
d
VFFEnd ValueFromValue p sym ext root (FrameRetType f)
vfv -> ValueFromValue p sym ext root (FrameRetType f)
-> Maybe (ValueFromValue p sym ext root (FrameRetType f))
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ValueFromValue p sym ext root (FrameRetType f)
vfv
returnContext ::
ValueFromFrame ctx sym ext root f ->
ValueFromValue ctx sym ext root (FrameRetType f)
returnContext :: forall ctx sym ext root f.
ValueFromFrame ctx sym ext root f
-> ValueFromValue ctx sym ext root (FrameRetType f)
returnContext ValueFromFrame ctx sym ext root f
c0 =
ValueFromValue ctx sym ext root (FrameRetType f)
-> Maybe (ValueFromValue ctx sym ext root (FrameRetType f))
-> ValueFromValue ctx sym ext root (FrameRetType f)
forall a. a -> Maybe a -> a
fromMaybe
(String
-> [String] -> ValueFromValue ctx sym ext root (FrameRetType f)
forall a. HasCallStack => String -> [String] -> a
panic String
"ExecutionTree.returnContext"
[ String
"Unexpected attempt to exit function before all intra-procedural merges are complete."
, String
"The call stack was:"
, Doc (Any @Type) -> String
forall a. Show a => a -> String
show (ValueFromFrame ctx sym ext root f -> Doc (Any @Type)
forall a ann. Pretty a => a -> Doc ann
forall ann. ValueFromFrame ctx sym ext root f -> Doc ann
PP.pretty ValueFromFrame ctx sym ext root f
c0)
])
(ValueFromFrame ctx sym ext root f
-> Maybe (ValueFromValue ctx sym ext root (FrameRetType f))
forall p sym ext root f.
ValueFromFrame p sym ext root f
-> Maybe (ValueFromValue p sym ext root (FrameRetType f))
unwindContext ValueFromFrame ctx sym ext root f
c0)
replaceTailFrame :: forall p sym ext a b c args args'.
FrameRetType a ~ FrameRetType c =>
ActiveTree p sym ext b a args ->
SimFrame sym ext c args' ->
Maybe (ActiveTree p sym ext b c args')
replaceTailFrame :: forall p sym ext a b c (args :: Maybe (Ctx CrucibleType))
(args' :: Maybe (Ctx CrucibleType)).
((FrameRetType a :: CrucibleType)
~ (FrameRetType c :: CrucibleType)) =>
ActiveTree p sym ext b a args
-> SimFrame sym ext c args'
-> Maybe (ActiveTree p sym ext b c args')
replaceTailFrame t :: ActiveTree p sym ext b a args
t@(ActiveTree ValueFromFrame p sym ext b a
c PartialResultFrame sym ext a args
_) SimFrame sym ext c args'
f = do
ValueFromValue p sym ext b (FrameRetType c)
vfv <- ValueFromFrame p sym ext b a
-> Maybe (ValueFromValue p sym ext b (FrameRetType a))
forall p sym ext root f.
ValueFromFrame p sym ext root f
-> Maybe (ValueFromValue p sym ext root (FrameRetType f))
unwindContext ValueFromFrame p sym ext b a
c
ActiveTree p sym ext b c args'
-> Maybe (ActiveTree p sym ext b c args')
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ActiveTree p sym ext b c args'
-> Maybe (ActiveTree p sym ext b c args'))
-> ActiveTree p sym ext b c args'
-> Maybe (ActiveTree p sym ext b c args')
forall a b. (a -> b) -> a -> b
$ ValueFromValue p sym ext b (FrameRetType c)
-> SimFrame sym ext c args'
-> ActiveTree p sym ext b a args
-> ActiveTree p sym ext b c args'
forall p sym ext rtp f' (args' :: Maybe (Ctx CrucibleType)) f
(args :: Maybe (Ctx CrucibleType)).
ValueFromValue p sym ext rtp (FrameRetType f')
-> SimFrame sym ext f' args'
-> ActiveTree p sym ext rtp f args
-> ActiveTree p sym ext rtp f' args'
swapCallFrame ValueFromValue p sym ext b (FrameRetType c)
vfv SimFrame sym ext c args'
f ActiveTree p sym ext b a args
t
swapCallFrame ::
ValueFromValue p sym ext rtp (FrameRetType f') ->
SimFrame sym ext f' args' ->
ActiveTree p sym ext rtp f args ->
ActiveTree p sym ext rtp f' args'
swapCallFrame :: forall p sym ext rtp f' (args' :: Maybe (Ctx CrucibleType)) f
(args :: Maybe (Ctx CrucibleType)).
ValueFromValue p sym ext rtp (FrameRetType f')
-> SimFrame sym ext f' args'
-> ActiveTree p sym ext rtp f args
-> ActiveTree p sym ext rtp f' args'
swapCallFrame ValueFromValue p sym ext rtp (FrameRetType f')
vfv SimFrame sym ext f' args'
frm (ActiveTree ValueFromFrame p sym ext rtp f
_ PartialResultFrame sym ext f args
er) =
ValueFromFrame p sym ext rtp f'
-> PartialResultFrame sym ext f' args'
-> ActiveTree p sym ext rtp f' args'
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree (ValueFromValue p sym ext rtp (FrameRetType f')
-> ValueFromFrame p sym ext rtp f'
forall p sym ext ret f.
ValueFromValue p sym ext ret (FrameRetType f)
-> ValueFromFrame p sym ext ret f
VFFEnd ValueFromValue p sym ext rtp (FrameRetType f')
vfv) (PartialResultFrame sym ext f args
er PartialResultFrame sym ext f args
-> (PartialResultFrame sym ext f args
-> PartialResultFrame sym ext f' args')
-> PartialResultFrame sym ext f' args'
forall a b. a -> (a -> b) -> b
& (GlobalPair sym (SimFrame sym ext f args)
-> Identity (GlobalPair sym (SimFrame sym ext f' args')))
-> PartialResultFrame sym ext f args
-> Identity (PartialResultFrame sym ext f' args')
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue ((GlobalPair sym (SimFrame sym ext f args)
-> Identity (GlobalPair sym (SimFrame sym ext f' args')))
-> PartialResultFrame sym ext f args
-> Identity (PartialResultFrame sym ext f' args'))
-> ((SimFrame sym ext f args
-> Identity (SimFrame sym ext f' args'))
-> GlobalPair sym (SimFrame sym ext f args)
-> Identity (GlobalPair sym (SimFrame sym ext f' args')))
-> (SimFrame sym ext f args
-> Identity (SimFrame sym ext f' args'))
-> PartialResultFrame sym ext f args
-> Identity (PartialResultFrame sym ext f' args')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimFrame sym ext f args -> Identity (SimFrame sym ext f' args'))
-> GlobalPair sym (SimFrame sym ext f args)
-> Identity (GlobalPair sym (SimFrame sym ext f' args'))
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue ((SimFrame sym ext f args -> Identity (SimFrame sym ext f' args'))
-> PartialResultFrame sym ext f args
-> Identity (PartialResultFrame sym ext f' args'))
-> SimFrame sym ext f' args'
-> PartialResultFrame sym ext f args
-> PartialResultFrame sym ext f' args'
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SimFrame sym ext f' args'
frm)
pushCallFrame ::
ReturnHandler (FrameRetType a) p sym ext r f old_args
->
SimFrame sym ext a args
->
ActiveTree p sym ext r f old_args ->
ActiveTree p sym ext r a args
pushCallFrame :: forall a p sym ext r f (old_args :: Maybe (Ctx CrucibleType))
(args :: Maybe (Ctx CrucibleType)).
ReturnHandler (FrameRetType a) p sym ext r f old_args
-> SimFrame sym ext a args
-> ActiveTree p sym ext r f old_args
-> ActiveTree p sym ext r a args
pushCallFrame ReturnHandler (FrameRetType a) p sym ext r f old_args
rh SimFrame sym ext a args
f' (ActiveTree ValueFromFrame p sym ext r f
ctx PartialResultFrame sym ext f old_args
er) =
ValueFromFrame p sym ext r a
-> PartialResultFrame sym ext a args
-> ActiveTree p sym ext r a args
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree (ValueFromValue p sym ext r (FrameRetType a)
-> ValueFromFrame p sym ext r a
forall p sym ext ret f.
ValueFromValue p sym ext ret (FrameRetType f)
-> ValueFromFrame p sym ext ret f
VFFEnd (ValueFromFrame p sym ext r f
-> SimFrame sym ext f old_args
-> ReturnHandler (FrameRetType a) p sym ext r f old_args
-> ValueFromValue p sym ext r (FrameRetType a)
forall p sym ext ret (top_return :: CrucibleType)
(args :: Maybe (Ctx CrucibleType)) caller.
ValueFromFrame p sym ext ret caller
-> SimFrame sym ext caller args
-> ReturnHandler top_return p sym ext ret caller args
-> ValueFromValue p sym ext ret top_return
VFVCall ValueFromFrame p sym ext r f
ctx SimFrame sym ext f old_args
old_frame ReturnHandler (FrameRetType a) p sym ext r f old_args
rh)) PartialResultFrame sym ext a args
er'
where
old_frame :: SimFrame sym ext f old_args
old_frame = PartialResultFrame sym ext f old_args
er PartialResultFrame sym ext f old_args
-> Getting
(GlobalPair sym (SimFrame sym ext f old_args))
(PartialResultFrame sym ext f old_args)
(GlobalPair sym (SimFrame sym ext f old_args))
-> GlobalPair sym (SimFrame sym ext f old_args)
forall s a. s -> Getting a s a -> a
^. Getting
(GlobalPair sym (SimFrame sym ext f old_args))
(PartialResultFrame sym ext f old_args)
(GlobalPair sym (SimFrame sym ext f old_args))
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue GlobalPair sym (SimFrame sym ext f old_args)
-> Getting
(SimFrame sym ext f old_args)
(GlobalPair sym (SimFrame sym ext f old_args))
(SimFrame sym ext f old_args)
-> SimFrame sym ext f old_args
forall s a. s -> Getting a s a -> a
^. Getting
(SimFrame sym ext f old_args)
(GlobalPair sym (SimFrame sym ext f old_args))
(SimFrame sym ext f old_args)
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue
er' :: PartialResultFrame sym ext a args
er' = PartialResultFrame sym ext f old_args
er PartialResultFrame sym ext f old_args
-> (PartialResultFrame sym ext f old_args
-> PartialResultFrame sym ext a args)
-> PartialResultFrame sym ext a args
forall a b. a -> (a -> b) -> b
& (GlobalPair sym (SimFrame sym ext f old_args)
-> Identity (GlobalPair sym (SimFrame sym ext a args)))
-> PartialResultFrame sym ext f old_args
-> Identity (PartialResultFrame sym ext a args)
forall sym ext u v (f :: Type -> Type).
Functor f =>
(GlobalPair sym u -> f (GlobalPair sym v))
-> PartialResult sym ext u -> f (PartialResult sym ext v)
partialValue ((GlobalPair sym (SimFrame sym ext f old_args)
-> Identity (GlobalPair sym (SimFrame sym ext a args)))
-> PartialResultFrame sym ext f old_args
-> Identity (PartialResultFrame sym ext a args))
-> ((SimFrame sym ext f old_args
-> Identity (SimFrame sym ext a args))
-> GlobalPair sym (SimFrame sym ext f old_args)
-> Identity (GlobalPair sym (SimFrame sym ext a args)))
-> (SimFrame sym ext f old_args
-> Identity (SimFrame sym ext a args))
-> PartialResultFrame sym ext f old_args
-> Identity (PartialResultFrame sym ext a args)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimFrame sym ext f old_args -> Identity (SimFrame sym ext a args))
-> GlobalPair sym (SimFrame sym ext f old_args)
-> Identity (GlobalPair sym (SimFrame sym ext a args))
forall sym u v (f :: Type -> Type).
Functor f =>
(u -> f v) -> GlobalPair sym u -> f (GlobalPair sym v)
gpValue ((SimFrame sym ext f old_args
-> Identity (SimFrame sym ext a args))
-> PartialResultFrame sym ext f old_args
-> Identity (PartialResultFrame sym ext a args))
-> SimFrame sym ext a args
-> PartialResultFrame sym ext f old_args
-> PartialResultFrame sym ext a args
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SimFrame sym ext a args
f'
extractCurrentPath ::
ActiveTree p sym ext ret f args ->
ActiveTree p sym ext ret f args
ActiveTree p sym ext ret f args
t =
ValueFromFrame p sym ext ret f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext ret f args
forall p sym ext root f (args :: Maybe (Ctx CrucibleType)).
ValueFromFrame p sym ext root f
-> PartialResultFrame sym ext f args
-> ActiveTree p sym ext root f args
ActiveTree (ValueFromFrame p sym ext ret f -> ValueFromFrame p sym ext ret f
forall p sym ext ret f.
ValueFromFrame p sym ext ret f -> ValueFromFrame p sym ext ret f
vffSingleContext (ActiveTree p sym ext ret f args
tActiveTree p sym ext ret f args
-> Getting
(ValueFromFrame p sym ext ret f)
(ActiveTree p sym ext ret f args)
(ValueFromFrame p sym ext ret f)
-> ValueFromFrame p sym ext ret f
forall s a. s -> Getting a s a -> a
^.Getting
(ValueFromFrame p sym ext ret f)
(ActiveTree p sym ext ret f args)
(ValueFromFrame p sym ext ret f)
forall p sym ext root f1 (args :: Maybe (Ctx CrucibleType))
(f2 :: Type -> Type).
Functor f2 =>
(ValueFromFrame p sym ext root f1
-> f2 (ValueFromFrame p sym ext root f1))
-> ActiveTree p sym ext root f1 args
-> f2 (ActiveTree p sym ext root f1 args)
actContext))
(GlobalPair sym (SimFrame sym ext f args)
-> PartialResultFrame sym ext f args
forall sym ext v. GlobalPair sym v -> PartialResult sym ext v
TotalRes (ActiveTree p sym ext ret f args
tActiveTree p sym ext ret f args
-> Getting
(GlobalPair sym (SimFrame sym ext f args))
(ActiveTree p sym ext ret f args)
(GlobalPair sym (SimFrame sym ext f args))
-> GlobalPair sym (SimFrame sym ext f args)
forall s a. s -> Getting a s a -> a
^.Getting
(GlobalPair sym (SimFrame sym ext f args))
(ActiveTree p sym ext ret f args)
(GlobalPair sym (SimFrame sym ext f args))
forall p sym ext root f1 (args :: Maybe (Ctx CrucibleType))
(args' :: Maybe (Ctx CrucibleType)) (f2 :: Type -> Type).
Functor f2 =>
(TopFrame sym ext f1 args -> f2 (TopFrame sym ext f1 args'))
-> ActiveTree p sym ext root f1 args
-> f2 (ActiveTree p sym ext root f1 args')
actFrame))
vffSingleContext ::
ValueFromFrame p sym ext ret f ->
ValueFromFrame p sym ext ret f
vffSingleContext :: forall p sym ext ret f.
ValueFromFrame p sym ext ret f -> ValueFromFrame p sym ext ret f
vffSingleContext ValueFromFrame p sym ext ret f
ctx0 =
case ValueFromFrame p sym ext ret f
ctx0 of
VFFBranch ValueFromFrame p sym ext ret f
ctx FrameIdentifier
_ ProgramLoc
_ Pred sym
_ VFFOtherPath p sym ext ret f args
_ CrucibleBranchTarget f args
_ -> ValueFromFrame p sym ext ret f -> ValueFromFrame p sym ext ret f
forall p sym ext ret f.
ValueFromFrame p sym ext ret f -> ValueFromFrame p sym ext ret f
vffSingleContext ValueFromFrame p sym ext ret f
ctx
VFFPartial ValueFromFrame p sym ext ret f
ctx ProgramLoc
_ Pred sym
_ AbortedResult sym ext
_ PendingPartialMerges
_ -> ValueFromFrame p sym ext ret f -> ValueFromFrame p sym ext ret f
forall p sym ext ret f.
ValueFromFrame p sym ext ret f -> ValueFromFrame p sym ext ret f
vffSingleContext ValueFromFrame p sym ext ret f
ctx
VFFEnd ValueFromValue p sym ext ret (FrameRetType f)
ctx -> ValueFromValue p sym ext ret (FrameRetType f)
-> ValueFromFrame p sym ext ret f
forall p sym ext ret f.
ValueFromValue p sym ext ret (FrameRetType f)
-> ValueFromFrame p sym ext ret f
VFFEnd (ValueFromValue p sym ext ret (FrameRetType f)
-> ValueFromValue p sym ext ret (FrameRetType f)
forall p sym ext root (top_ret :: CrucibleType).
ValueFromValue p sym ext root top_ret
-> ValueFromValue p sym ext root top_ret
vfvSingleContext ValueFromValue p sym ext ret (FrameRetType f)
ctx)
vfvSingleContext ::
ValueFromValue p sym ext root top_ret ->
ValueFromValue p sym ext root top_ret
vfvSingleContext :: forall p sym ext root (top_ret :: CrucibleType).
ValueFromValue p sym ext root top_ret
-> ValueFromValue p sym ext root top_ret
vfvSingleContext ValueFromValue p sym ext root top_ret
ctx0 =
case ValueFromValue p sym ext root top_ret
ctx0 of
VFVCall ValueFromFrame p sym ext root caller
ctx SimFrame sym ext caller args
f ReturnHandler top_ret p sym ext root caller args
h -> ValueFromFrame p sym ext root caller
-> SimFrame sym ext caller args
-> ReturnHandler top_ret p sym ext root caller args
-> ValueFromValue p sym ext root top_ret
forall p sym ext ret (top_return :: CrucibleType)
(args :: Maybe (Ctx CrucibleType)) caller.
ValueFromFrame p sym ext ret caller
-> SimFrame sym ext caller args
-> ReturnHandler top_return p sym ext ret caller args
-> ValueFromValue p sym ext ret top_return
VFVCall (ValueFromFrame p sym ext root caller
-> ValueFromFrame p sym ext root caller
forall p sym ext ret f.
ValueFromFrame p sym ext ret f -> ValueFromFrame p sym ext ret f
vffSingleContext ValueFromFrame p sym ext root caller
ctx) SimFrame sym ext caller args
f ReturnHandler top_ret p sym ext root caller args
h
VFVPartial ValueFromValue p sym ext root top_ret
ctx ProgramLoc
_ Pred sym
_ AbortedResult sym ext
_ -> ValueFromValue p sym ext root top_ret
-> ValueFromValue p sym ext root top_ret
forall p sym ext root (top_ret :: CrucibleType).
ValueFromValue p sym ext root top_ret
-> ValueFromValue p sym ext root top_ret
vfvSingleContext ValueFromValue p sym ext root top_ret
ctx
ValueFromValue p sym ext root top_ret
VFVEnd -> ValueFromValue p sym ext root top_ret
forall p sym ext ret (top_return :: CrucibleType).
((ret :: Type) ~ (RegEntry sym top_return :: Type)) =>
ValueFromValue p sym ext ret top_return
VFVEnd