stepwise-1.0.2

Control.Monad.Stepwise.Core

Synopsis

Documentation

data Stepwise e i o w a Source

A step-wise computation with errors e, progress reports i, parametrized by watcher w, and evaluating to a value of type a.

Progress reports i are indexed by the watcher type w. To compose step-wise computations, they must agree on the same type i. However, specific caller/callee combinations can agree on a type w to report progress reports that contain e.g. values computing during the evaluation process.

A stepwise computation may fail with an error of type e. Failure is conceptually just another form of progress reports: however, after a failure, there will not be any subsequent progress reports. This distinction allows us to capture the behavior of the fail function in the Monad class. For non-critical failures, use conventional progress reports. If the information about the failure is not an issue, use either AnyFailure or String as the type for e.

A stepwise computation specifies its operational context via the type index o. There are two operational modes: either the computation requires to be executed sequentially, then it has Sequential as type index, or it may be executed lazily, then it has Lazy as type index. Some operations on stepwise computations may require evaluation to be sequential. There is no way (neither need) to enforce lazy evaluation.

A Stepwise-value represents a partially evaluated step-wise computation. It is essentially a sequence of Info progress reports, closed by either failure, success, or the remaining computation.

The Pending constructor specifies the computation that is 'left-most'. Strict evaluation starts with this computation first. It also specifies the stack of binds that immediately follow the left-most computation. Since the computation to evaluate first is always on top of this structure, we do not have to inspect the stack for each reduction step.

The Ahead constructor represents a suspended computation that needs a continuation, such that it can give the reports for the final result. Note that the function of Ahead takes a continuation that cannot make any assumption about how it is executed (hence the universal o'). If it needs to make an assumption, it should do so via e.g. lazily. Furthermore, the function itself makes the assumption that it is executed in a lazy context. This is a design choice: we could also have demanded that it cannot make any assumptions on how it is called.

Info represents a progress report.

The Ind constructor represents an indirection. Sharing an indirection has the effect that the effort of producing the progress reports is only performed once. In practice are Stepwise values produced by functions, hence sharing is not provided by default. To have a sharing guarantee, however, apply share to a Stepwise value.

The additional indirection allows us to have explicit sharing, such that we can update thunks, which opens up ways for parallelism.

The Mode constructor serves three purposes. With it we can represent entering a certain evaluation mode, leaving a certain evaluation mode, and remembering the stack of evaluation modes we are currently in.

Instances

Error e => MonadError e (Stepwise e i o w)

MonadError instance. A throwError without a catchError is semantically equal to bottom. catchError runs the computation stepwise, until it succeeds (then drops the handler), or fails (then runs the handler instead). However, if the evaluation requires a continuation, we drop the handler, since we do not know what the future is when the handler is present.

Error e => Monad (Stepwise e i o w)

Monad instance for Stepwise. See Control.Monad.BreadthFirst.Proofs for proofs of the monad laws.

Error e => Functor (Stepwise e i o w) 
Error e => MonadFix (Stepwise e i Lazy w)

Instance for MonadFix. Note: the steps resulting from mfix f should not depend on the actual outcome of mfix f: this would create a hard cycle.

Error e => Applicative (Stepwise e i o w) 
(Monoid (i w), Monoid e, Error e) => Alternative (Stepwise e i o w)

Alternative instance. Takes the shortest sequence that yields a value, or the longest that fails.

Error e => MonadIO (Stepwise e i Sequential w)

Instance for MonadIO. The relative order of liftIO's, and non-duplication of effects, is only guaranteed in a sequential context. Use with caution.

data StepHandle e i o w a Source

lazyEval :: Stepwise e i Lazy w a -> aSource

Lazy evaluation of a step-wise computation.

seqEval :: Stepwise e i Sequential w a -> aSource

Sequential evaluation of a step-wise computation.

stepwiseEval :: Stepwise e i o w a -> aSource

Evaluates step-wise (also ties the look-ahead knot)

info :: i w -> Stepwise e i o w a -> Stepwise e i o w aSource

Wrapper for an effect.

emit :: i w -> Stepwise e i o w ()Source

next :: Stepwise e i o w a -> IO (Progress e i o w a)Source

One step strict evaluation. Reduction proceeds until one progress report entry is produced, or the computation is suspended waiting for the continuation.

localStep :: Stepwise e i o w a -> Progress e i o w aSource

smallStep :: Stepwise e i o w a -> Progress e i o w aSource

data Progress e i o w a whereSource

A progress report. Either the progress report denotes a single step, or a finished/failed computation, or a suspended computation in the form of a lookahead that waits for its future continuation before it can proceed.

Constructors

Step :: !(i w) -> Stepwise e i o w a -> Progress e i o w a 
Fin :: !a -> Progress e i o w a 
Lookahead :: !(forall b v. (forall o'. a -> Stepwise e i o' v b) -> Stepwise e i Lazy v b) -> Progress e i o w a 
Failed :: !(Maybe e) -> Progress e i o w a 

lookahead :: (forall b v. (forall o'. a -> Stepwise e i o' v b) -> Stepwise e i Lazy v b) -> Stepwise e i o w aSource

Introduces a computation for merging child-progress reports while taking also into account the effects that the merge has in the evaluation of the parents. The remaining evaluation for the parents is passed as continuation.

transcode :: Transcoder e i v w -> Stepwise e i o v a -> Stepwise e i o w aSource

Applies a transcoder to a computation.

newtype Transcoder e i v w Source

A transcoder is a function that transcodes a progress report of the type i v to reports of the type i w. It gets a CodeIn as input and produces a CodeOut as output. The intention is that transcoders are pure functions: side effect is allowed, but it is up to the programmer to ensure that the progress report are not affected. If the input is TcLazy, the transcoder is notified that lazy evaluation starts running the computation. The outcome of the transcoder is ignored. When this takes place is unspecified.

Constructors

Trans (CodeIn e i v -> IO (CodeOut e i w)) 

data CodeIn e i w whereSource

Input to a transcoder. TcReport represents a single report to be transcoded. TcDone indicates that the computation to where this transcoder is applied, has succeeded. TcFail is its counter-part. TcLazy indicates that a lazy evaluation has taken over the computation.

Constructors

TcReport :: !(i w) -> CodeIn e i w 
TcLazy :: CodeIn e i w 
TcDone :: CodeIn e i w 
TcFail :: !(Maybe e) -> CodeIn e i w 

data CodeOut e i w whereSource

Output of a transcoder. Either it succeeds with zero or more transcoded progress reports, or it aborts the computation.

Constructors

TcReports :: [i w] -> CodeOut e i w 
TcFailed :: !(Maybe e) -> CodeOut e i w 

translate' :: (i v -> IO (Either (Maybe e) [i w])) -> Stepwise e i o v a -> Stepwise e i o w aSource

Translates to zero or more reports, or failure.

translate :: (i v -> i w) -> Stepwise e i o v a -> Stepwise e i o w aSource

Translates progress reports from one domain directly into another.

unsafeTranslate :: Stepwise e i o v a -> Stepwise e i o w aSource

Assumes that 'i v' is structurally equal to 'i w'.

abort :: e -> Stepwise e i o w aSource

Abort a computation. Note that in lazy evaluation mode, abort is semantically equivalent to bottom, whereas in stepwise evaluation, it provides backtracking. This means that if there is no backtracking-alternative left, aborts are replaced by a bottom value.

final :: a -> Stepwise e i o w aSource

Turn a result into a (trivial) stepwise compuation.

resume :: Stepwise e i o w b -> (b -> Stepwise e i o w a) -> Stepwise e i o w aSource

Creates a pending computation for m with f on the stack of parents.

failure :: Maybe e -> Stepwise e i o w aSource

Creates an always failing stepwise computation.

unspecifiedFailure :: Stepwise e i o w aSource

Creates an always failing stepwise computation (without an error message).

lazily :: Stepwise e i Lazy w a -> Stepwise e i o w aSource

Allows the stepwise computation to run in lazy mode.

sequentially :: Stepwise e i Sequential w a -> Stepwise e i o w aSource

Forces the stepwise computation to run in sequential mode.

share :: Stepwise e i o v a -> Stepwise e i Sequential w (Stepwise e i o v a)Source

Shares a stepwise computation. Work for such a shared computation is only performed once.

task :: Progress e i o w a -> Stepwise e i o w aSource

Converts a progress report back into a thunk that upon next-reduction immediately yields the progress report again.

nextTask :: Progress e i o w a -> Stepwise e i o w aSource

Similar to task, except that it takes the next task of a step instead.

handle :: Stepwise e i o v a -> Stepwise e i Sequential w (StepHandle e i o v a)Source

Creates a handle to a stepwise computation.

report :: StepHandle e i o v a -> Stepwise e i Sequential w (Report e i o v a)Source

Access the latest progress report on the handle.

perform :: StepHandle e i o v a -> Stepwise e i Sequential w ()Source

Progress the handle one step. Note that the handle maintains a reference to the outcome of the previous computation. Hence, if this previous computation was a Info, we need to continue with the computation as its rhs.

proceed :: StepHandle e i Lazy w a -> Stepwise e i Sequential w aSource

Closes the handle and embeds the remaining computation.

close :: StepHandle e i Lazy v a -> Stepwise e i Sequential w (Stepwise e i Lazy v a)Source

Closes the handle and returns the remaining computation. The remaining computation emits the last progress report first (if any), because this report may not be acted upon yet. If you don't want this behavior, apply a transcoder that filters out the first report.

data Report e i o w a whereSource

The Report version of a Progress report. The main difference is that this variation is handle-based, which provides a monadic way of accessing the progress reports.

Constructors

Finished :: !a -> Report e i o w a 
Progress :: !(i w) -> Report e i o w a 
Failure :: !(Maybe e) -> Report e i o w a 
Future :: !(forall b v. (forall o'. a -> Stepwise e i o' v b) -> Stepwise e i Lazy v b) -> Report e i o w a 
Unavail :: Report e i o w a 

data Sequential Source

Type level version of ForceSequential

Instances

Error e => MonadIO (Stepwise e i Sequential w)

Instance for MonadIO. The relative order of liftIO's, and non-duplication of effects, is only guaranteed in a sequential context. Use with caution.

data Lazy Source

Type level version of AllowLazy

Instances

Error e => MonadFix (Stepwise e i Lazy w)

Instance for MonadFix. Note: the steps resulting from mfix f should not depend on the actual outcome of mfix f: this would create a hard cycle.

data AnyWatcher Source

Type index representing an arbitrary watcher. Note: in such situations, you can choose an arbitrary type. This type, however, explicitly states that there is no interest in the watcher type, which provides a bit additional documentation.

Instances

data AnyFailure Source

Type index representing arbitrary failure. No information is provided about the failure - only that it happened. We provide instances to treat AnyFailure as error messages, which makes them convenient to use.

Constructors

AnyFailure 

Instances

Monoid AnyFailure

Trivial instance for AnyFailure.

Error AnyFailure

Turn error messages in AnyFailure, effectively loosing all details (if any).

forceSequential :: Stepwise e i Sequential w a -> Stepwise e i Sequential w aSource

Helper function that demands that the type of the stepwise computation is sequential.

memoSteps :: Typeable a => MemoEnvRef e i o w -> Int -> Stepwise e i o w a -> Stepwise e i o w aSource

Memoizes a stepwise computation.

newMemoEnv :: IO (MemoEnvRef e i o w)Source

Creates an empty memo-env.

type MemoEnvRef e i o w = IORef (MemoEnv e i o w)Source

Use a different MemoEnv for different watcher types.