| Copyright | (c) Galois Inc 2015 |
|---|---|
| License | BSD3 |
| Maintainer | Tristan Ravitch <tristan@galois.com> |
| Stability | provisional Abstract interpretation over the Crucible IR Supports widening with an iteration order based on weak topological orderings. Some basic tests on hand-written IR programs are included. |
| Safe Haskell | None |
| Language | Haskell2010 |
Lang.Crucible.Analysis.Fixpoint
Description
Synopsis
- forwardFixpoint :: forall ext dom (blocks :: Ctx (Ctx CrucibleType)) (ret :: CrucibleType) (init :: Ctx CrucibleType). Domain dom -> Interpretation ext dom -> CFG ext blocks init ret -> MapF GlobalVar dom -> Assignment dom init -> (Assignment (PointAbstraction blocks dom) blocks, dom ret)
- forwardFixpoint' :: forall ext dom (blocks :: Ctx (Ctx CrucibleType)) (ret :: CrucibleType) (init :: Ctx CrucibleType). Domain dom -> Interpretation ext dom -> CFG ext blocks init ret -> MapF GlobalVar dom -> Assignment dom init -> (Assignment (PointAbstraction blocks dom) blocks, Assignment (Ignore (Some (PointAbstraction blocks dom)) :: Ctx CrucibleType -> Type) blocks, dom ret)
- data ScopedReg where
- ScopedReg :: forall (blocks :: Ctx (Ctx CrucibleType)) (ctx1 :: Ctx CrucibleType) (ctx2 :: Ctx CrucibleType) (tp :: CrucibleType). BlockID blocks ctx1 -> Reg ctx2 tp -> ScopedReg
- lookupAbstractScopedRegValue :: forall (blocks :: Ctx (Ctx CrucibleType)) (dom :: CrucibleType -> Type). ScopedReg -> Assignment (Ignore (Some (PointAbstraction blocks dom)) :: Ctx CrucibleType -> Type) blocks -> Maybe (Some dom)
- lookupAbstractScopedRegValueByIndex :: forall (blocks :: Ctx (Ctx CrucibleType)) (dom :: CrucibleType -> Type). (Int, Int) -> Assignment (Ignore (Some (PointAbstraction blocks dom)) :: Ctx CrucibleType -> Type) blocks -> Maybe (Some dom)
- newtype Ignore a (b :: k) = Ignore {
- _ignoreOut :: a
- data Domain (dom :: CrucibleType -> Type) = Domain {
- domTop :: forall (tp :: CrucibleType). dom tp
- domBottom :: forall (tp :: CrucibleType). dom tp
- domJoin :: forall (tp :: CrucibleType). dom tp -> dom tp -> dom tp
- domIter :: IterationStrategy dom
- domEq :: forall (tp :: CrucibleType). dom tp -> dom tp -> Bool
- data IterationStrategy (dom :: CrucibleType -> Type) where
- WTO :: forall (dom :: CrucibleType -> Type). IterationStrategy dom
- WTOWidening :: forall (dom :: CrucibleType -> Type). (Int -> Bool) -> (forall (tp :: CrucibleType). dom tp -> dom tp -> dom tp) -> IterationStrategy dom
- Worklist :: forall (dom :: CrucibleType -> Type). IterationStrategy dom
- data Interpretation ext (dom :: CrucibleType -> Type) = Interpretation {
- interpExpr :: forall (blocks :: Ctx (Ctx CrucibleType)) (ctx :: Ctx CrucibleType) (tp :: CrucibleType). ScopedReg -> TypeRepr tp -> Expr ext ctx tp -> PointAbstraction blocks dom ctx -> (Maybe (PointAbstraction blocks dom ctx), dom tp)
- interpExt :: forall (blocks :: Ctx (Ctx CrucibleType)) (ctx :: Ctx CrucibleType) (tp :: CrucibleType). ScopedReg -> StmtExtension ext (Reg ctx) tp -> PointAbstraction blocks dom ctx -> (Maybe (PointAbstraction blocks dom ctx), dom tp)
- interpCall :: forall (blocks :: Ctx (Ctx CrucibleType)) (ctx :: Ctx CrucibleType) (args :: Ctx CrucibleType) (ret :: CrucibleType). CtxRepr args -> TypeRepr ret -> Reg ctx (FunctionHandleType args ret) -> dom (FunctionHandleType args ret) -> Assignment dom args -> PointAbstraction blocks dom ctx -> (Maybe (PointAbstraction blocks dom ctx), dom ret)
- interpReadGlobal :: forall (blocks :: Ctx (Ctx CrucibleType)) (ctx :: Ctx CrucibleType) (tp :: CrucibleType). GlobalVar tp -> PointAbstraction blocks dom ctx -> (Maybe (PointAbstraction blocks dom ctx), dom tp)
- interpWriteGlobal :: forall (blocks :: Ctx (Ctx CrucibleType)) (ctx :: Ctx CrucibleType) (tp :: CrucibleType). GlobalVar tp -> Reg ctx tp -> PointAbstraction blocks dom ctx -> Maybe (PointAbstraction blocks dom ctx)
- interpBr :: forall (blocks :: Ctx (Ctx CrucibleType)) (ctx :: Ctx CrucibleType). Reg ctx BoolType -> dom BoolType -> JumpTarget blocks ctx -> JumpTarget blocks ctx -> PointAbstraction blocks dom ctx -> (Maybe (PointAbstraction blocks dom ctx), Maybe (PointAbstraction blocks dom ctx))
- interpMaybe :: forall (blocks :: Ctx (Ctx CrucibleType)) (ctx :: Ctx CrucibleType) (tp :: CrucibleType). TypeRepr tp -> Reg ctx (MaybeType tp) -> dom (MaybeType tp) -> PointAbstraction blocks dom ctx -> (Maybe (PointAbstraction blocks dom ctx), dom tp, Maybe (PointAbstraction blocks dom ctx))
- data PointAbstraction (blocks :: Ctx (Ctx CrucibleType)) (dom :: CrucibleType -> Type) (ctx :: Ctx CrucibleType) = PointAbstraction {
- _paGlobals :: MapF GlobalVar dom
- _paRegisters :: Assignment dom ctx
- _paRefs :: MapF (RefStmtId blocks) dom
- _paRegisterRefs :: Assignment (RefSet blocks) ctx
- data RefSet (blocks :: Ctx (Ctx CrucibleType)) (tp :: CrucibleType)
- emptyRefSet :: forall (blocks :: Ctx (Ctx CrucibleType)) (tp :: CrucibleType). RefSet blocks tp
- paGlobals :: forall f (dom :: CrucibleType -> Type) (blocks :: Ctx (Ctx CrucibleType)) (ctx :: Ctx CrucibleType). Functor f => (MapF GlobalVar dom -> f (MapF GlobalVar dom)) -> PointAbstraction blocks dom ctx -> f (PointAbstraction blocks dom ctx)
- paRegisters :: forall f (dom :: CrucibleType -> Type) (ctx :: Ctx CrucibleType) (blocks :: Ctx (Ctx CrucibleType)). Functor f => (Assignment dom ctx -> f (Assignment dom ctx)) -> PointAbstraction blocks dom ctx -> f (PointAbstraction blocks dom ctx)
- lookupAbstractRegValue :: forall (blocks :: Ctx (Ctx CrucibleType)) dom (ctx :: Ctx CrucibleType) (tp :: CrucibleType). PointAbstraction blocks dom ctx -> Reg ctx tp -> dom tp
- modifyAbstractRegValue :: forall (blocks :: Ctx (Ctx CrucibleType)) dom (ctx :: Ctx CrucibleType) (tp :: CrucibleType). PointAbstraction blocks dom ctx -> Reg ctx tp -> (dom tp -> dom tp) -> PointAbstraction blocks dom ctx
- cfgWeakTopologicalOrdering :: forall ext (blocks :: Ctx (Ctx CrucibleType)) (init :: Ctx CrucibleType) (ret :: CrucibleType). CFG ext blocks init ret -> [WTOComponent (Some (BlockID blocks))]
- data Pointed (dom :: CrucibleType -> Type) (tp :: CrucibleType) where
- Top :: forall (dom :: CrucibleType -> Type) (tp :: CrucibleType). Pointed dom tp
- Pointed :: forall (dom :: CrucibleType -> Type) (tp :: CrucibleType). dom tp -> Pointed dom tp
- Bottom :: forall (dom :: CrucibleType -> Type) (tp :: CrucibleType). Pointed dom tp
- pointed :: (forall (tp :: CrucibleType). dom tp -> dom tp -> Pointed dom tp) -> (forall (tp :: CrucibleType). dom tp -> dom tp -> Bool) -> IterationStrategy (Pointed dom) -> Domain (Pointed dom)
Entry point
forwardFixpoint :: forall ext dom (blocks :: Ctx (Ctx CrucibleType)) (ret :: CrucibleType) (init :: Ctx CrucibleType). Domain dom -> Interpretation ext dom -> CFG ext blocks init ret -> MapF GlobalVar dom -> Assignment dom init -> (Assignment (PointAbstraction blocks dom) blocks, dom ret) Source #
Arguments
| :: forall ext dom (blocks :: Ctx (Ctx CrucibleType)) (ret :: CrucibleType) (init :: Ctx CrucibleType). Domain dom | The domain of abstract values |
| -> Interpretation ext dom | The transfer functions for each statement type |
| -> CFG ext blocks init ret | The function to analyze |
| -> MapF GlobalVar dom | Assignments of abstract values to global variables at the function start |
| -> Assignment dom init | Assignments of abstract values to the function arguments |
| -> (Assignment (PointAbstraction blocks dom) blocks, Assignment (Ignore (Some (PointAbstraction blocks dom)) :: Ctx CrucibleType -> Type) blocks, dom ret) |
Compute a fixed point via abstract interpretation over a control
flow graph (CFG) given 1) an interpretation + domain, 2) initial
assignments of domain values to global variables, and 3) initial
assignments of domain values to function arguments.
This is an intraprocedural analysis. To handle function calls, the transfer function for call statements must know how to supply summaries or compute an appropriate conservative approximation.
There are two results from the fixed point computation:
1) For each block in the CFG, the abstraction computed at the *entry* to the block
2) For each block in the CFG, the abstraction computed at the
*exit* from the block. The Assignment for these "exit"
abstractions ignores the ctx index on the blocks, since that
context is for *entry* to the blocks.
3) The final abstract value for the value returned by the function
A CFG-scoped SSA temp register.
We don't care about the type params yet, hence the
existential quantification. We may want to look up the instruction
corresponding to a ScopedReg after analysis though, and we'll
surely want to compare ScopedRegs for equality, and use them to
look up values in point abstractions after analysis.
Constructors
| ScopedReg :: forall (blocks :: Ctx (Ctx CrucibleType)) (ctx1 :: Ctx CrucibleType) (ctx2 :: Ctx CrucibleType) (tp :: CrucibleType). BlockID blocks ctx1 -> Reg ctx2 tp -> ScopedReg |
Instances
| Show ScopedReg Source # | |
| Eq ScopedReg Source # | |
| Ord ScopedReg Source # | |
lookupAbstractScopedRegValue :: forall (blocks :: Ctx (Ctx CrucibleType)) (dom :: CrucibleType -> Type). ScopedReg -> Assignment (Ignore (Some (PointAbstraction blocks dom)) :: Ctx CrucibleType -> Type) blocks -> Maybe (Some dom) Source #
Lookup the abstract value of scoped reg in an exit assignment.
lookupAbstractScopedRegValueByIndex :: forall (blocks :: Ctx (Ctx CrucibleType)) (dom :: CrucibleType -> Type). (Int, Int) -> Assignment (Ignore (Some (PointAbstraction blocks dom)) :: Ctx CrucibleType -> Type) blocks -> Maybe (Some dom) Source #
Lookup the abstract value of scoped reg -- specified by 0-based int indices -- in an exit assignment.
newtype Ignore a (b :: k) Source #
Turn a non paramaterized type into a parameterized type.
For when you want to use a parameterized-utils style data
structure with a type that doesn't have a parameter.
The same definition as Const, but with a
different Show instance.
Constructors
| Ignore | |
Fields
| |
Instances
| Show a => ShowF (Ignore a :: k -> Type) Source # | |
| Show a => Show (Ignore a tp) Source # | |
| Eq a => Eq (Ignore a b) Source # | |
| Ord a => Ord (Ignore a b) Source # | |
Defined in Lang.Crucible.Analysis.Fixpoint | |
Abstract Domains
data Domain (dom :: CrucibleType -> Type) Source #
A domain of abstract values, parameterized by a term type
Constructors
| Domain | |
Fields
| |
data IterationStrategy (dom :: CrucibleType -> Type) where Source #
The iteration strategies available for computing fixed points.
Algorithmically, the best strategies seem to be based on Weak Topological Orders (WTOs). The WTO approach also naturally supports widening (with a specified widening strategy and widening operator).
A simple worklist approach is also available.
Constructors
| WTO :: forall (dom :: CrucibleType -> Type). IterationStrategy dom | |
| WTOWidening :: forall (dom :: CrucibleType -> Type). (Int -> Bool) -> (forall (tp :: CrucibleType). dom tp -> dom tp -> dom tp) -> IterationStrategy dom | |
| Worklist :: forall (dom :: CrucibleType -> Type). IterationStrategy dom |
data Interpretation ext (dom :: CrucibleType -> Type) Source #
Transfer functions for each statement type
Interpretation functions for some statement types --
e.g. interpExpr and interpExt -- receive ScopedReg arguments
corresponding to the SSA tmp that the result of the interpreted
statement get assigned to. Some interpretation functions that could
receive this argument do not -- e.g. interpCall -- because
conathan didn't have a use for that.
Constructors
| Interpretation | |
Fields
| |
data PointAbstraction (blocks :: Ctx (Ctx CrucibleType)) (dom :: CrucibleType -> Type) (ctx :: Ctx CrucibleType) Source #
This abstraction contains the abstract values of each register at the program point represented by the abstraction. It also contains a map of abstractions for all of the global variables currently known.
Constructors
| PointAbstraction | |
Fields
| |
Instances
| ShowF dom => ShowF (PointAbstraction blocks dom :: Ctx CrucibleType -> Type) Source # | |
Defined in Lang.Crucible.Analysis.Fixpoint Methods withShow :: forall p q (tp :: Ctx CrucibleType) a. p (PointAbstraction blocks dom) -> q tp -> (Show (PointAbstraction blocks dom tp) => a) -> a # showF :: forall (tp :: Ctx CrucibleType). PointAbstraction blocks dom tp -> String # showsPrecF :: forall (tp :: Ctx CrucibleType). Int -> PointAbstraction blocks dom tp -> String -> String # | |
| ShowF dom => Show (PointAbstraction blocks dom ctx) Source # | |
Defined in Lang.Crucible.Analysis.Fixpoint Methods showsPrec :: Int -> PointAbstraction blocks dom ctx -> ShowS # show :: PointAbstraction blocks dom ctx -> String # showList :: [PointAbstraction blocks dom ctx] -> ShowS # | |
data RefSet (blocks :: Ctx (Ctx CrucibleType)) (tp :: CrucibleType) Source #
This is a wrapper around a set of StmtIds that name allocation sites of
references. We need the wrapper to correctly position the tp type
parameter so that we can put them in an Assignment.
emptyRefSet :: forall (blocks :: Ctx (Ctx CrucibleType)) (tp :: CrucibleType). RefSet blocks tp Source #
paGlobals :: forall f (dom :: CrucibleType -> Type) (blocks :: Ctx (Ctx CrucibleType)) (ctx :: Ctx CrucibleType). Functor f => (MapF GlobalVar dom -> f (MapF GlobalVar dom)) -> PointAbstraction blocks dom ctx -> f (PointAbstraction blocks dom ctx) Source #
paRegisters :: forall f (dom :: CrucibleType -> Type) (ctx :: Ctx CrucibleType) (blocks :: Ctx (Ctx CrucibleType)). Functor f => (Assignment dom ctx -> f (Assignment dom ctx)) -> PointAbstraction blocks dom ctx -> f (PointAbstraction blocks dom ctx) Source #
lookupAbstractRegValue :: forall (blocks :: Ctx (Ctx CrucibleType)) dom (ctx :: Ctx CrucibleType) (tp :: CrucibleType). PointAbstraction blocks dom ctx -> Reg ctx tp -> dom tp Source #
Look up the abstract value of a register at a program point
modifyAbstractRegValue :: forall (blocks :: Ctx (Ctx CrucibleType)) dom (ctx :: Ctx CrucibleType) (tp :: CrucibleType). PointAbstraction blocks dom ctx -> Reg ctx tp -> (dom tp -> dom tp) -> PointAbstraction blocks dom ctx Source #
Modify the abstract value of a register at a program point
cfgWeakTopologicalOrdering :: forall ext (blocks :: Ctx (Ctx CrucibleType)) (init :: Ctx CrucibleType) (ret :: CrucibleType). CFG ext blocks init ret -> [WTOComponent (Some (BlockID blocks))] Source #
Compute a weak topological order for the CFG.
Pointed domains
The Pointed type is a wrapper around another Domain that
provides distinguished Top and Bottom elements. Use of this
type is never required (domains can always define their own top and
bottom), but this1 wrapper can save some boring boilerplate.
data Pointed (dom :: CrucibleType -> Type) (tp :: CrucibleType) where Source #
The Pointed wrapper that adds Top and Bottom elements
Constructors
| Top :: forall (dom :: CrucibleType -> Type) (tp :: CrucibleType). Pointed dom tp | |
| Pointed :: forall (dom :: CrucibleType -> Type) (tp :: CrucibleType). dom tp -> Pointed dom tp | |
| Bottom :: forall (dom :: CrucibleType -> Type) (tp :: CrucibleType). Pointed dom tp |
Instances
| ShowF dom => ShowF (Pointed dom :: CrucibleType -> Type) Source # | |
Defined in Lang.Crucible.Analysis.Fixpoint Methods withShow :: forall p q (tp :: CrucibleType) a. p (Pointed dom) -> q tp -> (Show (Pointed dom tp) => a) -> a # showF :: forall (tp :: CrucibleType). Pointed dom tp -> String # showsPrecF :: forall (tp :: CrucibleType). Int -> Pointed dom tp -> String -> String # | |
| ShowF dom => Show (Pointed dom tp) Source # | |
| Eq (dom tp) => Eq (Pointed dom tp) Source # | |
Arguments
| :: (forall (tp :: CrucibleType). dom tp -> dom tp -> Pointed dom tp) | Join of contained domain elements |
| -> (forall (tp :: CrucibleType). dom tp -> dom tp -> Bool) | Equality for domain elements |
| -> IterationStrategy (Pointed dom) | |
| -> Domain (Pointed dom) |