-----------------------------------------------------------------------
-- |
-- Module           : Lang.Crucible.Simulator.Operations
-- Description      : Basic operations on execution trees
-- Copyright        : (c) Galois, Inc 2014-2018
-- License          : BSD3
-- Maintainer       : Joe Hendrix <jhendrix@galois.com>
-- Stability        : provisional
--
-- Operations corresponding to basic control-flow events on
-- simulator execution trees.
------------------------------------------------------------------------

{-# 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
  ( -- * Control-flow operations
    continue
  , jumpToBlock
  , conditionalBranch
  , variantCases
  , returnValue
  , callFunction
  , tailCallFunction
  , runOverride
  , runAbortHandler
  , runErrorHandler
  , runGenericErrorHandler
  , performIntraFrameMerge
  , performIntraFrameSplit
  , performFunctionCall
  , performTailCall
  , performReturn
  , performControlTransfer
  , resumeFrame
  , resumeValueFromValueAbort
  , overrideSymbolicBranch

    -- * Resolving calls
  , ResolvedCall(..)
  , UnresolvableFunction(..)
  , resolveCall
  , resolvedCallName

    -- * Abort handlers
  , abortExecAndLog
  , abortExec
  , defaultAbortHandler

    -- * Call tree manipulations
  , 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

---------------------------------------------------------------------
-- Intermediate state branching/merging

-- | Merge two globals together.
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 {- ^ Program location of control-flow branching -} ->
  Pred sym {- ^ Branch predicate -} ->
  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 {- ^ Program location of control-flow branching -} ->
  Pred sym {- ^ This needs to hold to avoid the aborted result -} ->
  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 {- ^ Target of branch -} ->
  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


------------------------------------------------------------------------
-- resolveCall

-- | This exception is thrown if a 'FnHandle' cannot be resolved to
--   a callable function.  This usually indicates a programming error,
--   but might also be used to allow on-demand function loading.
--
--   The 'ProgramLoc' argument references the call site for the unresolved
--   function call.
--
--   The @['SomeFrame']@ argument is the active call stack at the time of
--   the exception.
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) ]


-- | Utility function that packs the tail of a collection of arguments
--   into a vector of ANY type values for passing to varargs functions.
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

-- | Given a set of function bindings, a function-
--   value (which is possibly a closure) and a
--   collection of arguments, resolve the identity
--   of the function to call, and set it up to be called.
--
--   Will throw an 'UnresolvableFunction' exception if
--   the underlying function handle is not found in the
--   'FunctionBindings' map.
resolveCall ::
  FunctionBindings p sym ext {- ^ Map from function handles to semantics -} ->
  FnVal sym args ret {- ^ Function handle and any closure variables -} ->
  RegMap sym args {- ^ Arguments to the function -} ->
  ProgramLoc {- ^ Location of the call -} ->
  [SomeFrame (SimFrame sym ext)] {-^ current call stack (for exceptions) -} ->
  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

---------------------------------------------------------------------
-- Control-flow operations

-- | Immediately transtition to an 'OverrideState'.  On the next
--   execution step, the simulator will execute the given override.
runOverride ::
  Override p sym ext args ret {- ^ Override to execute -} ->
  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)

-- | Immediately transition to a 'RunningState'.  On the next
--   execution step, the simulator will interpret the next basic
--   block.
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)

-- | Immediately transition to an 'AbortState'.  On the next
--   execution step, the simulator will unwind the 'SimState'
--   and resolve the abort.
runAbortHandler ::
  AbortExecReason {- ^ Description of the abort condition -} ->
  SimState p sym ext rtp f args {- ^ Simulator state prior to the abort -} ->
  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)

-- | Abort the current thread of execution with an error.
--   This adds a proof obligation that requires the current
--   execution path to be infeasible, and unwids to the
--   nearest branch point to resume.
runErrorHandler ::
  SimErrorReason {- ^ Description of the error -} ->
  SimState p sym ext rtp f args {- ^ Simulator state prior to the abort -} ->
  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)

-- | Abort the current thread of execution with an error.
--   This adds a proof obligation that requires the current
--   execution path to be infeasible, and unwids to the
--   nearest branch point to resume.
runGenericErrorHandler ::
  String {- ^ Generic description of the error condition -} ->
  SimState p sym ext rtp f args {- ^ Simulator state prior to the abort -} ->
  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

-- | Transfer control to the given resolved jump, after first
--   checking for any pending symbolic merges at the destination
--   of the jump.
jumpToBlock ::
  IsSymInterface sym =>
  ResolvedJump sym blocks {- ^ Jump target and arguments -} ->
  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

-- | Perform a conditional branch on the given predicate.
--   If the predicate is symbolic, this will record a symbolic
--   branch state.
conditionalBranch ::
  (IsSymInterface sym, IsSyntaxExtension ext) =>
  Pred sym {- ^ Predicate to branch on -} ->
  ResolvedJump sym blocks {- ^ True branch -} ->
  ResolvedJump sym blocks {- ^ False branch -} ->
  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

-- | Execute the next branch of a sequence of branch cases.
--   These arise from the implementation of the 'VariantElim'
--   construct.  The predicates are expected to be mutually
--   disjoint.  However, the construct still has well defined
--   semantics even in the case where they overlap; in this case,
--   the first branch with a true 'Pred' is taken.  In other words,
--   each branch assumes the negation of all the predicates of branches
--   appearing before it.
--
--   In the final default case (corresponding to an empty list of branches),
--   a 'VariantOptionsExhausted' abort will be executed.
variantCases ::
  IsSymInterface sym =>
  [(Pred sym, ResolvedJump sym blocks)] {- ^ Variant branches to execute -} ->
  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

-- | Return a value from current Crucible execution.
returnValue :: forall p sym ext rtp f args.
  RegEntry sym (FrameRetType f) {- ^ return value -} ->
  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 {- ^ Function handle and any closure variables -} ->
  RegMap sym args {- ^ Arguments to the function -} ->
  ReturnHandler ret p sym ext rtp f a {- ^ How to modify the caller's scope with the return value -} ->
  ProgramLoc {-^ location of call -} ->
  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 {- ^ Function handle and any closure variables -} ->
  RegMap sym args {- ^ Arguments to the function -} ->
  ValueFromValue p sym ext rtp ret ->
  ProgramLoc {-^ location of call -} ->
  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


-- | Immediately transition to the 'BranchMergeState'.
--   On the next simulator step, this will checks for the
--   opportunity to merge within a frame.
--
--   This should be called everytime the current control flow location
--   changes to a potential merge point.
checkForIntraFrameMerge ::
  CrucibleBranchTarget f args
    {- ^ The location of the block we are transferring to -} ->
  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

-- | Perform a single instance of path merging at a join point.
--   This will resume an alternate branch, if it is pending,
--   or merge result values if a completed branch has alread reached
--   this point. If there are no pending merge points at this location,
--   continue executing by transfering control to the given target.
performIntraFrameMerge ::
  IsSymInterface sym =>
  CrucibleBranchTarget f args
    {- ^ The location of the block we are transferring to -} ->
  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'

        -- Did we get to our merge point (i.e., we are finished with this branch)
        | 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

            -- We still have some more work to do, reactivate the other, postponed branch
            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)

                 -- The current branch is done
                 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)

            -- We are done with both branches, pop-off back to the outer context.
            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

                 -- Merge the assumptions from each branch and add to the
                 -- current assumption frame
                 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

                 -- Check for more potential merge targets.
                 (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)

      -- Since the other branch aborted before it got to the merge point,
      -- we merge-in the partiality on our current path and keep going.
      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)

      -- There are no pending merges to deal with.  Instead, complete
      -- the transfer of control by either transitioning into an ordinary
      -- running state, or by returning a value to the calling context.
      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)

---------------------------------------------------------------------
-- Abort handling

-- | The default abort handler calls `abortExecAndLog`.
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

-- | Abort the current execution and roll back to the nearest
--   symbolic branch point.  When verbosity is 3 or more, a message
--   will be logged indicating the reason for the abort.
--
--   The default abort handler calls this function.
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) ]
    -- Print error message.
    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)

  -- Switch to new frame.
  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


-- | Abort the current execution and roll back to the nearest
--   symbolic branch point.
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
$
    -- Get aborted result from active result.
    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


------------------------------------------------------------------------
-- Internal operations

-- | Resolve the fact that the current branch aborted.
resumeValueFromFrameAbort ::
  IsSymInterface sym =>
  ValueFromFrame p sym ext r f ->
  AbortedResult sym ext {- ^ The execution that is being aborted. -} ->
  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

      -- This is the first abort.
      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

           -- Reset the backend path state
           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

             -- We have some more work to do.
             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

             -- The other branch had finished successfully;
             -- Since this one aborted, then the other one is really the only
             -- viable option we have, and so we commit to it.
             VFFCompletePath CrucibleAssumptions (SymExpr sym)
otherAssumes PartialResultFrame sym ext f args
er ->
               do -- We are committed to the other path,
                  -- assume all of its suspended assumptions
                  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

                  -- check for further merges, then continue onward.
                  (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)

      -- Both branches aborted
      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

-- | Run rest of execution given a value from value context and an aborted
-- result.
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

-- | Resume a paused frame.
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 #-}


-- | Transition immediately to a @ReturnState@.  We are done with all
--   intercall merges, and are ready to resmue execution in the caller's
--   context.
handleSimReturn ::
  IsSymInterface sym =>
  FunctionName {- ^ Name of the function we are returning from -} ->
  ValueFromValue p sym ext r ret {- ^ Context to return to. -} ->
  RegEntry sym ret {- ^ Value that is being returned. -} ->
  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


-- | Resolve the return value, and begin executing in the caller's context again.
performReturn ::
  IsSymInterface sym =>
  FunctionName {- ^ Name of the function we are returning from -} ->
  ValueFromValue p sym ext r ret {- ^ Context to return to. -} ->
  RegEntry sym ret {- ^ Value that is being returned. -} ->
  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 {- ^ postdominator target -} ->
  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) {- ^ if branch -} ->
  Maybe Position {- ^ optional if branch location -} ->

  RegMap sym else_args ->
  ExecCont p sym ext rtp (OverrideLang r) ('Just else_args) {- ^ else branch -} ->
  Maybe Position {- ^ optional else branch location -} ->

  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)

-- | Return the context of the current top frame.
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


-- | Return assertion where predicate equals a constant
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

-- | Branch with a merge point inside this frame.
intra_branch ::
  IsSymInterface sym =>
  Pred sym
  {- ^ Branch condition branch -} ->

  PausedFrame p sym ext rtp f
  {- ^ true branch. -} ->

  PausedFrame p sym ext rtp f
  {- ^ false branch. -} ->

  CrucibleBranchTarget f (args :: Maybe (Ctx CrucibleType))
  {- ^ Postdominator merge point, where both branches meet again. -} ->

  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 #-}

-- | Branch with a merge point inside this frame.
performIntraFrameSplit ::
  IsSymInterface sym =>
  Pred sym
  {- ^ Branch condition -} ->

  PausedFrame p sym ext rtp f
  {- ^ active branch. -} ->

  PausedFrame p sym ext rtp f
  {- ^ other branch. -} ->

  CrucibleBranchTarget f (args :: Maybe (Ctx CrucibleType))
  {- ^ Postdominator merge point, where both branches meet again. -} ->

  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)

     -- Create context for paused frame.
     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

     -- Start a_state (where branch pred is 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'

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 ->
         -- Eventually, locations should be nested. However, for now,
         -- while they're not, it's useful for the location of an
         -- override to be the location of its call site, so we don't
         -- change it here.
         (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))

------------------------------------------------------------------------
-- Context tree manipulations

-- | Returns true if tree contains a single non-aborted execution.
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

-- | Attempt to unwind a frame context into a value context.
--   This succeeds only if there are no pending symbolic
--   merges.
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

-- | Get the context for when returning (assumes no
-- intra-procedural merges are possible).
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)

-- | Replace the given frame with a new frame.  Succeeds
--   only if there are no pending symbolic merge points.
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
    {- ^ What to do with the result of the function -} ->

  SimFrame sym ext a args
    {- ^ The code to run -} ->

  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'


-- | Create a tree that contains just a single path with no branches.
--
-- All branch conditions are converted to assertions.
extractCurrentPath ::
  ActiveTree p sym ext ret f args ->
  ActiveTree p sym ext ret f args
extractCurrentPath :: forall p sym ext ret f (args :: Maybe (Ctx CrucibleType)).
ActiveTree p sym ext ret f args -> ActiveTree p sym ext ret f args
extractCurrentPath 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


------------------------------------------------------------------------
-- branchConditions

-- -- | Return all branch conditions along path to this node.
-- branchConditions :: ActiveTree ctx sym ext ret f args -> [Pred sym]
-- branchConditions t =
--   case t^.actResult of
--     TotalRes _ -> vffBranchConditions (t^.actContext)
--     PartialRes p _ _ -> p : vffBranchConditions (t^.actContext)

-- vffBranchConditions :: ValueFromFrame p sym ext ret f
--                     -> [Pred sym]
-- vffBranchConditions ctx0 =
--   case ctx0 of
--     VFFBranch   ctx _ _ p _ _  -> p : vffBranchConditions ctx
--     VFFPartial  ctx p _ _      -> p : vffBranchConditions ctx
--     VFFEnd  ctx -> vfvBranchConditions ctx

-- vfvBranchConditions :: ValueFromValue p sym ext root top_ret
--                     -> [Pred sym]
-- vfvBranchConditions ctx0 =
--   case ctx0 of
--     VFVCall     ctx _ _      -> vffBranchConditions ctx
--     VFVPartial  ctx p _      -> p : vfvBranchConditions ctx
--     VFVEnd                   -> []