crucible-0.7: Crucible is a library for language-agnostic symbolic simulation
Copyright(c) Galois Inc 2014
LicenseBSD3
MaintainerJoe Hendrix <jhendrix@galois.com>
Stabilityprovisional
Safe HaskellSafe-Inferred
LanguageHaskell2010

Lang.Crucible.Simulator.CallFrame

Description

Call frames are used to record information about suspended stack frames when functions are called.

Synopsis

CrucibleBranchTarget

data CrucibleBranchTarget f (args :: Maybe (Ctx CrucibleType)) where Source #

A CrucibleBranchTarget identifies a program location that is a potential join point. Each label is a merge point, and there is an additional implicit join point at function returns.

Constructors

BlockTarget :: !(BlockID blocks args) -> CrucibleBranchTarget (CrucibleLang blocks r) ('Just args) 
ReturnTarget :: CrucibleBranchTarget f 'Nothing 

Instances

Instances details
TestEquality (CrucibleBranchTarget f :: Maybe (Ctx CrucibleType) -> Type) Source # 
Instance details

Defined in Lang.Crucible.Simulator.CallFrame

Methods

testEquality :: forall (a :: k) (b :: k). CrucibleBranchTarget f a -> CrucibleBranchTarget f b -> Maybe (a :~: b) #

Call frame

data CallFrame sym ext blocks ret args Source #

A call frame for a crucible block.

Constructors

forall initialArgs. CallFrame 

Fields

mkCallFrame Source #

Arguments

:: CFG ext blocks init ret

Control flow graph

-> CFGPostdom blocks

Post dominator information.

-> RegMap sym init

Initial arguments

-> CallFrame sym ext blocks ret init 

Create a new call frame.

mkBlockFrame Source #

Arguments

:: CFG ext blocks init ret

Control flow graph

-> BlockID blocks args

Entry point

-> CFGPostdom blocks

Post dominator information

-> RegMap sym args

Initial arguments

-> CallFrame sym ext blocks ret args 

Create a new call frame.

framePostdomMap :: Simple Lens (CallFrame sym ext blocks ret ctx) (CFGPostdom blocks) Source #

frameBlockMap :: CallFrame sym ext blocks ret ctx -> BlockMap ext blocks ret Source #

frameHandle :: CallFrame sym ext blocks ret ctx -> SomeHandle Source #

frameReturnType :: CallFrame sym ext blocks ret ctx -> TypeRepr ret Source #

frameBlockID :: Simple Lens (CallFrame sym ext blocks ret ctx) (Some (BlockID blocks)) Source #

frameRegs :: Simple Lens (CallFrame sym ext blocks ret args) (RegMap sym args) Source #

frameStmts :: Simple Lens (CallFrame sym ext blocks ret ctx) (StmtSeq ext blocks ret ctx) Source #

List of statements to execute next.

framePostdom :: Simple Lens (CallFrame sym ext blocks ret ctx) (Some (CrucibleBranchTarget (CrucibleLang blocks ret))) Source #

List of statements to execute next.

frameProgramLoc :: CallFrame sym ext blocks ret ctx -> ProgramLoc Source #

Return program location associated with frame.

setFrameBlock :: BlockID blocks args -> RegMap sym args -> CallFrame sym ext blocks ret ctx -> CallFrame sym ext blocks ret args Source #

setFrameBreakpointPostdomInfo :: [BreakpointName] -> CallFrame sym ext blocks ret ctx -> CallFrame sym ext blocks ret ctx Source #

extendFrame :: TypeRepr tp -> RegValue sym tp -> StmtSeq ext blocks ret (ctx ::> tp) -> CallFrame sym ext blocks ret ctx -> CallFrame sym ext blocks ret (ctx ::> tp) Source #

Extend frame with new register.

updateFrame :: RegMap sym ctx' -> BlockID blocks ctx -> StmtSeq ext blocks ret ctx' -> CallFrame sym ext blocks ret ctx -> CallFrame sym ext blocks ret ctx' Source #

mergeCallFrame :: IsSymInterface sym => sym -> IntrinsicTypes sym -> MuxFn (Pred sym) (CallFrame sym ext blocks ret args) Source #

SomeHandle

data SomeHandle where Source #

A function handle is a reference to a function in a given run of the simulator. It has a set of expected arguments and return type.

Constructors

SomeHandle :: !(FnHandle args ret) -> SomeHandle 

Simulator frames

data SimFrame sym ext l (args :: Maybe (Ctx CrucibleType)) where Source #

Constructors

OF :: !(OverrideFrame sym ret args) -> SimFrame sym ext (OverrideLang ret) ('Just args)

Custom code to execute, typically for "overrides"

MF :: !(CallFrame sym ext blocks ret args) -> SimFrame sym ext (CrucibleLang blocks ret) ('Just args)

We are executing some Crucible instructions

RF :: !FunctionName -> !(RegEntry sym (FrameRetType f)) -> SimFrame sym ext f 'Nothing

We should return this value.

data CrucibleLang (blocks :: Ctx (Ctx CrucibleType)) (ret :: CrucibleType) Source #

Nominal type for identifying override frames.

data OverrideLang (ret :: CrucibleType) Source #

Nominal type for identifying override frames.

Instances

Instances details
MonadState (SimState p sym ext rtp (OverrideLang ret) ('Just args)) (OverrideSim p sym ext rtp args ret) Source # 
Instance details

Defined in Lang.Crucible.Simulator.OverrideSim

Methods

get :: OverrideSim p sym ext rtp args ret (SimState p sym ext rtp (OverrideLang ret) ('Just args)) #

put :: SimState p sym ext rtp (OverrideLang ret) ('Just args) -> OverrideSim p sym ext rtp args ret () #

state :: (SimState p sym ext rtp (OverrideLang ret) ('Just args) -> (a, SimState p sym ext rtp (OverrideLang ret) ('Just args))) -> OverrideSim p sym ext rtp args ret a #

type family FrameRetType (f :: Type) :: CrucibleType where ... Source #

Equations

FrameRetType (CrucibleLang b r) = r 
FrameRetType (OverrideLang r) = r 

data OverrideFrame sym (ret :: CrucibleType) args Source #

Frame in call to override.

Constructors

OverrideFrame 

Fields

overrideRegMap :: Lens (OverrideFrame sym ret args) (OverrideFrame sym ret args') (RegMap sym args) (RegMap sym args') Source #

overrideSimFrame :: Lens (SimFrame sym ext (OverrideLang r) ('Just args)) (SimFrame sym ext (OverrideLang r') ('Just args')) (OverrideFrame sym r args) (OverrideFrame sym r' args') Source #

crucibleSimFrame :: Lens (SimFrame sym ext (CrucibleLang blocks r) ('Just args)) (SimFrame sym ext (CrucibleLang blocks' r') ('Just args')) (CallFrame sym ext blocks r args) (CallFrame sym ext blocks' r' args') Source #

fromCallFrame :: SimFrame sym ext (CrucibleLang b r) ('Just a) -> CallFrame sym ext b r a Source #