datafix-0.0.0.1: Fixing data-flow problems

Copyright(c) Sebastian Graf 2018
LicenseISC
Maintainersgraf1337@gmail.com
Portabilityportable
Safe HaskellNone
LanguageHaskell2010

Datafix.Worklist.Internal

Description

Internal module, does not follow the PVP. Breaking changes may happen at any minor version.

Synopsis

Documentation

newtype DependencyM graph domain a Source #

The concrete MonadDependency for this worklist-based solver.

This essentially tracks the current approximation of the solution to the DataFlowProblem as mutable state while solveProblem makes sure we will eventually halt with a conservative approximation.

Constructors

DM (ReaderT (Env graph domain) IO a)

Why does this use IO? Actually, we only need ST here, but that means we have to carry around the state thread in type signatures.

This ultimately leaks badly into the exported interface in solveProblem: Since we can't have universally quantified instance contexts (yet!), we can' write (forall s. Datafixable (DependencyM s graph domain)) => (forall s. DataFlowProblem (DependencyM s graph domain)) -> ... and have to instead have the isomorphic (forall s r. (Datafixable (DependencyM s graph domain) => r) -> r) -> (forall s. DataFlowProblem (DependencyM s graph domain)) -> ... and urge all call sites to pass a meaningless id parameter.

Also, this means more explicit type signatures as we have to make clear to the type-checker that s is universally quantified in everything that touches it, e.g. Analyses.StrAnal.LetDn.buildProblem from the test suite.

So, bottom line: We resort to IO and unsafePerformIO and promise not to launch missiles. In particular, we don't export DM and also there must never be an instance of MonadIO for this.

Instances

Monad (DependencyM graph domain) Source # 

Methods

(>>=) :: DependencyM graph domain a -> (a -> DependencyM graph domain b) -> DependencyM graph domain b #

(>>) :: DependencyM graph domain a -> DependencyM graph domain b -> DependencyM graph domain b #

return :: a -> DependencyM graph domain a #

fail :: String -> DependencyM graph domain a #

Functor (DependencyM graph domain) Source # 

Methods

fmap :: (a -> b) -> DependencyM graph domain a -> DependencyM graph domain b #

(<$) :: a -> DependencyM graph domain b -> DependencyM graph domain a #

Applicative (DependencyM graph domain) Source # 

Methods

pure :: a -> DependencyM graph domain a #

(<*>) :: DependencyM graph domain (a -> b) -> DependencyM graph domain a -> DependencyM graph domain b #

liftA2 :: (a -> b -> c) -> DependencyM graph domain a -> DependencyM graph domain b -> DependencyM graph domain c #

(*>) :: DependencyM graph domain a -> DependencyM graph domain b -> DependencyM graph domain b #

(<*) :: DependencyM graph domain a -> DependencyM graph domain b -> DependencyM graph domain a #

(Datafixable (DependencyM graph domain), GraphRef graph) => MonadDependency (DependencyM graph domain) Source #

This allows us to solve MonadDependency m => DataFlowProblem m descriptions with solveProblem. The Domain is extracted from a type parameter.

Associated Types

type Domain (DependencyM graph domain :: * -> *) :: * Source #

Methods

dependOn :: Node -> LiftedFunc (Domain (DependencyM graph domain)) (DependencyM graph domain) Source #

type Domain (DependencyM graph domain) Source # 
type Domain (DependencyM graph domain) = domain

data Env graph domain Source #

The iteration state of 'DependencyM'/'solveProblem'.

Constructors

Env 

Fields

initialEnv :: IntArgsMonoSet (Products (ParamTypes domain)) -> DataFlowProblem (DependencyM graph domain) -> IterationBound domain -> IO (graph domain) -> IO (Env graph domain) Source #

type Datafixable m = (Currying (ParamTypes (Domain m)) (ReturnType (Domain m)), Currying (ParamTypes (Domain m)) (m (ReturnType (Domain m))), Currying (ParamTypes (Domain m)) (ReturnType (Domain m) -> ReturnType (Domain m) -> Bool), Currying (ParamTypes (Domain m)) (ReturnType (Domain m) -> ReturnType (Domain m)), MonoMapKey (Products (ParamTypes (Domain m))), BoundedJoinSemiLattice (ReturnType (Domain m))) Source #

A constraint synonym for the constraints m and its associated Domain have to suffice.

This is actually a lot less scary than you might think. Assuming we got quantified class constraints, Datafixable is a specialized version of this:

type Datafixable m =
  ( forall r. Currying (ParamTypes (Domain m)) r
  , MonoMapKey (Products (ParamTypes (Domain m)))
  , BoundedJoinSemiLattice (ReturnType (Domain m))
  )

Now, let's assume a concrete Domain m ~ String -> Bool -> Int, so that ParamTypes (String -> Bool -> Int) expands to the type-level list '[String, Bool] and Products '[String, Bool] reduces to (String, Bool).

Then this constraint makes sure we are able to

  1. Curry the domain of String -> Bool -> r for all r to e.g. (String, Bool) -> r. See Currying. This constraint should always be discharged automatically by the type-checker as soon as ParamTypes and ReturnTypes reduce for the Domain argument, which happens when the concrete MonadDependency m is known.

    (Actually, we do this for multiple concrete r because of the missing support for quantified class constraints)

  2. We want to use a monotone map of (String, Bool) to Int (the ReturnType (Domain m)). This is ensured by the MonoMapKey (String, Bool) constraint.

    This constraint has to be discharged manually, but should amount to a single line of boiler-plate in most cases, see MonoMapKey.

    Note that the monotonicity requirement means we have to pull non-monotone arguments in Domain m into the Node portion of the DataFlowProblem.

  3. For fixed-point iteration to work at all, the values which we iterate naturally have to be instances of BoundedJoinSemiLattice. That type-class allows us to start iteration from a most-optimistic bottom value and successively iterate towards a conservative approximation using the '(/)' operator.

data Density graph where Source #

Specifies the density of the problem, e.g. whether the domain of Nodes can be confined to a finite range, in which case solveProblem tries to use a Data.Vector based graph representation rather than one based on Data.IntMap.

Constructors

Sparse :: Density Ref 
Dense :: Node -> Density Ref 

type AbortionFunction domain = Arrows (ParamTypes domain) (ReturnType domain -> ReturnType domain) Source #

A function that computes a sufficiently conservative approximation of a point in the abstract domain for when the solution algorithm decides to have iterated the node often enough.

When domain is a 'BoundedMeetSemilattice'/'BoundedLattice', the simplest abortion function would be to constantly return top.

As is the case for LiftedFunc and ChangeDetector, this carries little semantic meaning if viewed in isolation, so here are a few examples for how the synonym expands:

  AbortionFunction Int ~ Int -> Int
  AbortionFunction (String -> Int) ~ String -> Int -> Int
  AbortionFunction (a -> b -> c -> PowerSet) ~ a -> b -> c -> PowerSet -> PowerSet

E.g., the current value of the point is passed in (the tuple (a, b, c, PowerSet)) and the function returns an appropriate conservative approximation in that point.

abortWithTop :: forall domain. Currying (ParamTypes domain) (ReturnType domain -> ReturnType domain) => BoundedMeetSemiLattice (ReturnType domain) => AbortionFunction domain Source #

Aborts iteration of a value by constantly returning the top element of the assumed BoundedMeetSemiLattice of the ReturnType.

data IterationBound domain Source #

Expresses that iteration should or shouldn't stop after a point has been iterated a finite number of times.

Constructors

NeverAbort

Will keep on iterating until a precise, yet conservative approximation has been reached. Make sure that your domain satisfies the ascending chain condition, e.g. that fixed-point iteration always comes to a halt!

AbortAfter Int (AbortionFunction domain)

For when your domain doesn't satisfy the ascending chain condition or when you are sensitive about solution performance.

The Integer determines the maximum number of iterations of a single point of a Node (with which an entire function with many points may be associated) before iteration aborts in that point by calling the supplied AbortionFunction. The responsibility of the AbortionFunction is to find a sufficiently conservative approximation for the current value at that point.

When your ReturnType is an instance of BoundedMeetSemiLattice, abortWithTop might be a worthwhile option. A more sophisticated solution would trim the current value to a certain cut-off depth, depending on the first parameter, instead.

zoomReferencedPoints :: State (IntArgsMonoSet (Products (ParamTypes domain))) a -> ReaderT (Env graph domain) IO a Source #

zoomUnstable :: State (IntArgsMonoSet (Products (ParamTypes domain))) a -> ReaderT (Env graph domain) IO a Source #

enqueueUnstable :: k ~ Products (ParamTypes domain) => MonoMapKey k => Int -> k -> ReaderT (Env graph domain) IO () Source #

deleteUnstable :: k ~ Products (ParamTypes domain) => MonoMapKey k => Int -> k -> ReaderT (Env graph domain) IO () Source #

highestPriorityUnstableNode :: k ~ Products (ParamTypes domain) => MonoMapKey k => ReaderT (Env graph domain) IO (Maybe (Int, k)) Source #

withCall :: Datafixable (DependencyM graph domain) => Int -> Products (ParamTypes domain) -> ReaderT (Env graph domain) IO a -> ReaderT (Env graph domain) IO a Source #

recompute :: forall domain graph dom cod depm. dom ~ ParamTypes domain => cod ~ ReturnType domain => depm ~ DependencyM graph domain => GraphRef graph => Datafixable depm => Int -> Products dom -> ReaderT (Env graph domain) IO cod Source #

The first of the two major functions of this module.

recompute node args iterates the value of the passed node at the point args by invoking its transfer function. It does so in a way that respects the IterationBound.

This function is not exported, and is only called by work and dependOn, for when the iteration strategy decides that the node needs to be (and can be) re-iterated. It performs tracking of which Nodes the transfer function depended on, do that the worklist algorithm can do its magic.

dependOn :: forall domain graph. Datafixable (DependencyM graph domain) => GraphRef graph => Node -> LiftedFunc domain (DependencyM graph domain) Source #

optimisticApproximation :: GraphRef graph => Datafixable (DependencyM graph domain) => Int -> Products (ParamTypes domain) -> ReaderT (Env graph domain) IO (ReturnType domain) Source #

Compute an optimistic approximation for a point of a given node that is as precise as possible, given the other points of that node we already computed.

E.g., it is always valid to return bottom from this, but in many cases we can be more precise since we possibly have computed points for the node that are lower bounds to the current point.

scheme2 :: GraphRef graph => Datafixable (DependencyM graph domain) => Maybe (ReturnType domain) -> Int -> Products (ParamTypes domain) -> ReaderT (Env graph domain) IO (ReturnType domain) Source #

scheme 2 (see https://github.com/sgraf812/journal/blob/09f0521dbdf53e7e5777501fc868bb507f5ceb1a/datafix.md.html#how-an-algorithm-that-can-do-3-looks-like).

Descend into \(\bot\) nodes when there is no cycle to discover the set of reachable nodes as quick as possible. Do *not* descend into unstable, non-(bot) nodes.

whileJust_ :: Monad m => m (Maybe a) -> (a -> m b) -> m () Source #

As long as the supplied Maybe expression returns "Just _", the loop body will be called and passed the value contained in the Just. Results are discarded.

Taken from whileJust_.

work :: GraphRef graph => Datafixable (DependencyM graph domain) => ReaderT (Env graph domain) IO () Source #

Defined as 'work = whileJust_ highestPriorityUnstableNode (uncurry recompute)'.

Tries to dequeue the highestPriorityUnstableNode and recomputes the value of one of its unstable points, until the worklist is empty, indicating that a fixed-point has been reached.

solveProblem Source #

Arguments

:: GraphRef graph 
=> Datafixable (DependencyM graph domain) 
=> DataFlowProblem (DependencyM graph domain)

The description of the DataFlowProblem to solve.

-> Density graph

Describes if the algorithm is free to use a Dense, Vector-based graph representation or has to go with a Sparse one based on IntMap.

-> IterationBound domain

Whether the solution algorithm should respect a maximum bound on the number of iterations per point. Pass NeverAbort if you don't care.

-> Node

The Node that is initially assumed to be unstable. This should be the Node you are interested in, e.g. Node 42 if you are interested in the value of fib 42 for a hypothetical fibProblem, or the Node denoting the root expression of your data-flow analysis you specified via the DataFlowProblem.

-> domain 

Computes a solution to the described DataFlowProblem by iterating transfer functions until a fixed-point is reached.

It does do by employing a worklist algorithm, iterating unstable Nodes only. Nodes become unstable when the point of another Node their transfer function dependOned changed.

The sole initially unstable Node is the last parameter, and if your domain is function-valued (so the returned Arrows expands to a function), then any further parameters specify the exact point in the Nodes transfer function you are interested in.

If your problem only has finitely many different Nodes , consider using the ProblemBuilder API (e.g. datafix + evalDenotation) for a higher-level API that let's you forget about Nodes and instead let's you focus on building more complex data-flow frameworks.

evalDenotation Source #

Arguments

:: Datafixable (DependencyM Ref domain) 
=> ProblemBuilder (DependencyM Ref domain) (LiftedFunc domain (DependencyM Ref domain))

A build plan for computing the denotation, possibly involving fixed-point iteration factored through calls to datafix.

-> IterationBound domain

Whether the solution algorithm should respect a maximum bound on the number of iterations per point. Pass NeverAbort if you don't care.

-> domain 

evalDenotation denot ib returns a value in domain that is described by the denotation denot.

It does so by building up the DataFlowProblem corresponding to denot and solving the resulting problem with solveProblem, the documentation of which describes in detail how to arrive at a stable denotation and what the IterationBound ib is for.