hakaru-0.7.0: A probabilistic programming language
CopyrightCopyright (c) 2016 the Hakaru team
LicenseBSD3
Maintainerwren@community.haskell.org
Stabilityexperimental
PortabilityGHC-only
Safe HaskellNone
LanguageHaskell2010

Language.Hakaru.Evaluation.ExpectMonad

Description

 
Synopsis

Documentation

The expectation-evaluation monad

List-based version

data ListContext (abt :: [Hakaru] -> Hakaru -> *) (p :: Purity) Source #

An ordered collection of statements representing the context surrounding the current focus of our program transformation. That is, since some transformations work from the bottom up, we need to keep track of the statements we passed along the way when reaching for the bottom.

The tail of the list takes scope over the head of the list. Thus, the back/end of the list is towards the top of the program, whereas the front of the list is towards the bottom.

This type was formerly called Heap (presumably due to the Statement type being called Binding) but that seems like a misnomer to me since this really has nothing to do with allocation. However, it is still like a heap inasmuch as it's a dependency graph and we may wish to change the topological sorting or remove "garbage" (subject to correctness criteria).

TODO: Figure out what to do with SWeight, SGuard, SStuff, etc, so that we can use an IntMap (Statement abt) in order to speed up the lookup times in select. (Assuming callers don't use unsafePush unsafely: we can recover the order things were inserted from their varID since we've freshened them all and therefore their IDs are monotonic in the insertion order.)

Constructors

ListContext 

Fields

type ExpectAns abt = ListContext abt 'ExpectP -> abt '[] 'HProb Source #

newtype Expect abt x Source #

Constructors

Expect 

Fields

Instances

Instances details
ABT Term abt => EvaluationMonad abt (Expect abt) 'ExpectP Source # 
Instance details

Defined in Language.Hakaru.Evaluation.ExpectMonad

Methods

freshNat :: Expect abt Nat Source #

freshLocStatement :: Statement abt Variable 'ExpectP -> Expect abt (Statement abt Location 'ExpectP, Assocs Variable) Source #

getIndices :: Expect abt [Index (abt '[])] Source #

unsafePush :: Statement abt Location 'ExpectP -> Expect abt () Source #

unsafePushes :: [Statement abt Location 'ExpectP] -> Expect abt () Source #

select :: forall (a :: Hakaru) r. Location a -> (Statement abt Location 'ExpectP -> Maybe (Expect abt r)) -> Expect abt (Maybe r) Source #

substVar :: forall (a :: Hakaru). Variable a -> abt '[] a -> forall (b' :: Hakaru). Variable b' -> Expect abt (abt '[] b') Source #

extFreeVars :: forall (xs :: [Hakaru]) (a :: Hakaru). abt xs a -> Expect abt (VarSet (KindOf a)) Source #

evaluateCase :: TermEvaluator abt (Expect abt) -> CaseEvaluator abt (Expect abt) Source #

evaluateVar :: MeasureEvaluator abt (Expect abt) -> TermEvaluator abt (Expect abt) -> VariableEvaluator abt (Expect abt) Source #

Monad (Expect abt) Source # 
Instance details

Defined in Language.Hakaru.Evaluation.ExpectMonad

Methods

(>>=) :: Expect abt a -> (a -> Expect abt b) -> Expect abt b #

(>>) :: Expect abt a -> Expect abt b -> Expect abt b #

return :: a -> Expect abt a #

Functor (Expect abt) Source # 
Instance details

Defined in Language.Hakaru.Evaluation.ExpectMonad

Methods

fmap :: (a -> b) -> Expect abt a -> Expect abt b #

(<$) :: a -> Expect abt b -> Expect abt a #

Applicative (Expect abt) Source # 
Instance details

Defined in Language.Hakaru.Evaluation.ExpectMonad

Methods

pure :: a -> Expect abt a #

(<*>) :: Expect abt (a -> b) -> Expect abt a -> Expect abt b #

liftA2 :: (a -> b -> c) -> Expect abt a -> Expect abt b -> Expect abt c #

(*>) :: Expect abt a -> Expect abt b -> Expect abt b #

(<*) :: Expect abt a -> Expect abt b -> Expect abt a #

runExpect :: forall abt f a. (ABT Term abt, Foldable f) => Expect abt (abt '[] a) -> TransformCtx -> abt '[a] 'HProb -> f (Some2 abt) -> abt '[] 'HProb Source #

Run a computation in the Expect monad, residualizing out all the statements in the final evaluation context. The second argument should include all the terms altered by the Eval expression; this is necessary to ensure proper hygiene; for example(s):

runExpect (pureEvaluate e) [Some2 e]

We use Some2 on the inputs because it doesn't matter what their type or locally-bound variables are, so we want to allow f to contain terms with different indices.

residualizeExpectListContext :: forall abt. ABT Term abt => abt '[] 'HProb -> ListContext abt 'ExpectP -> abt '[] 'HProb Source #

TODO: IntMap-based version

...

emit :: ABT Term abt => Text -> Sing a -> (abt '[a] 'HProb -> abt '[] 'HProb) -> Expect abt (Variable a) Source #

emit_ :: ABT Term abt => (abt '[] 'HProb -> abt '[] 'HProb) -> Expect abt () Source #