{-# LANGUAGE TypeOperators
           , KindSignatures
           , DataKinds
           , TypeFamilies
           , GADTs
           , FlexibleInstances
           , NoImplicitPrelude
           , ScopedTypeVariables
           , FlexibleContexts
           , Rank2Types
           #-}

{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
----------------------------------------------------------------
--                                                    2016.04.22
-- |
-- Module      :  Language.Hakaru.Syntax.Prelude
-- Copyright   :  Copyright (c) 2016 the Hakaru team
-- License     :  BSD3
-- Maintainer  :  wren@community.haskell.org
-- Stability   :  experimental
-- Portability :  GHC-only
--
-- A replacement for Haskell's Prelude, using the familiar symbols
-- in order to construct 'AST's and 'ABT's. This is only necessary
-- if we want to use Hakaru as an embedded language in Haskell, but
-- it also provides some examples of how to use the infrastructure.
--
-- TODO: is there a way to get rid of the need to specify @'[]@ everywhere in here? Some sort of distinction between the Var vs the Open parts of View?
----------------------------------------------------------------
module Language.Hakaru.Syntax.Prelude
    (
    -- * Basic syntax
    -- ** Types and coercions
      ann_, triv, memo
    , coerceTo_, fromProb, nat2int, nat2prob, fromInt, nat2real
    , unsafeFrom_, unsafeProb, unsafeProbFraction, unsafeProbFraction_, unsafeProbSemiring, unsafeProbSemiring_
    -- ** Numeric literals
    , literal_, nat_, int_, prob_, real_
    , fromRational, half, third
    -- ** Booleans
    , true, false, bool_, if_
    , not, (&&), and, (||), or, nand, nor
    -- ** Equality and ordering
    , (==), (/=), (<), (<=), (>), (>=), min, minimum, max, maximum
    -- ** Semirings
    , zero, zero_, one, one_, (+), sum, (*), prod, (^), square
    , unsafeMinusNat, unsafeMinusProb, unsafeMinus, unsafeMinus_
    , unsafeDiv, unsafeDiv_
    -- ** Rings
    , (-), negate, negative, abs, abs_, signum
    -- ** Fractional
    , (/), recip, (^^)
    -- ** Radical
    , sqrt, thRootOf
    -- ** Integration
    , integrate, summate, product
    -- ** Continuous
    , RealProb(..), Integrable(..)
    , betaFunc
    , log, logBase
    , negativeInfinity
    -- *** Trig
    , sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh
    -- Choose
    , choose
    -- *** coercions-that-compute
    , floor
    
    -- * Measures
    -- ** Abstract nonsense
    , dirac, (<$>), (<*>), (<*), (*>), (>>=), (>>), bindx, liftM2
    -- ** Linear operators
    , superpose, (<|>)
    , weight, withWeight, weightedDirac
    , reject, guard, withGuard
    -- ** Measure operators
    -- | When two versions of the same operator are given, the one without the prime builds an AST using the built-in operator, whereas the one with the prime is a default definition in terms of more primitive measure operators.
    , lebesgue, lebesgue'
    , counting
    , densityCategorical, categorical, categorical'
    , densityUniform, uniform, uniform'
    , densityNormal, normal, normal'
    , densityPoisson, poisson, poisson'
    , densityGamma, gamma, gamma'
    , densityBeta, beta, beta', beta''
    , plateWithVar, plate, plate'
    , chain, chain'
    , invgamma
    , exponential
    , chi2
    , cauchy
    , laplace
    , studentT
    , weibull
    , bern
    , mix
    , binomial
    , negativeBinomial
    , geometric
    , multinomial
    , dirichlet

    -- * Data types (other than booleans)
    , datum_
    -- * Case and Branch
    , case_, branch
    -- ** HUnit
    , unit
    -- ** HPair
    , pair, pair_, unpair, fst, snd, swap
    -- ** HEither
    , left, right, uneither
    -- ** HMaybe
    , nothing, just, maybe, unmaybe
    -- ** HList
    , nil, cons, list

    -- * Lambda calculus
    , lam, lamWithVar, let_, letM
    , app, app2, app3

    -- * Arrays
    , empty, arrayWithVar, array, arrayLit, (!), size, reduce
    , sumV, summateV, appendV, mapV, mapWithIndex, normalizeV, constV, unitV, zipWithV

    -- * Implementation details
    , primOp0_, primOp1_, primOp2_, primOp3_
    , arrayOp0_, arrayOp1_, arrayOp2_, arrayOp3_
    , measure0_, measure1_, measure2_
    , unsafeNaryOp_, naryOp_withIdentity, naryOp2_

    -- * Reducers
    , bucket, r_fanout, r_index, r_split, r_nop, r_add

    ) where

-- TODO: implement and use Prelude's fromInteger and fromRational, so we can use numeric literals!
import Prelude (Maybe(..), Functor(..), Bool(..), Integer, Rational, ($), flip, const, error)
import qualified Prelude
import           Data.Sequence       (Seq)
import qualified Data.Sequence       as Seq
import qualified Data.Text           as Text
import           Data.List.NonEmpty  (NonEmpty(..))
import qualified Data.List.NonEmpty  as L
import           Data.Semigroup      (Semigroup(..))
import           Control.Category    (Category(..))
import           Control.Monad.Fix

import Data.Number.Natural
import Language.Hakaru.Types.DataKind
import Language.Hakaru.Types.Sing (Sing(..), SingI(sing), sUnPair, sUnEither, sUnMaybe, sUnMeasure, sUnArray)
import Language.Hakaru.Syntax.TypeOf
import Language.Hakaru.Types.HClasses
import Language.Hakaru.Types.Coercion
import Language.Hakaru.Syntax.Reducer
import Language.Hakaru.Syntax.AST
import Language.Hakaru.Syntax.Datum
import Language.Hakaru.Syntax.ABT hiding (View(..))

----------------------------------------------------------------
----- Helper combinators for defining our EDSL
{-
Below we implement a lot of simple optimizations; however, these
optimizations only apply if the client uses the type class methods
to produce the AST. We should implement a stand-alone function which
performs these sorts of optimizations, as a program transformation.
-}
-- TODO: constant propogation

-- TODO: NBE to get rid of administrative redexes.
app :: (ABT Term abt) => abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
app :: abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
app abt '[] (a ':-> b)
e1 abt '[] a
e2 = Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC (a ':-> b), LC a] b
forall (b :: Hakaru) (b :: Hakaru). SCon '[LC (b ':-> b), LC b] b
App_ SCon '[LC (a ':-> b), LC a] b
-> SArgs abt '[LC (a ':-> b), LC a] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] (a ':-> b)
e1 abt '[] (a ':-> b)
-> SArgs abt '[LC a] -> SArgs abt '[LC (a ':-> b), LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] a
e2 abt '[] a -> SArgs abt '[] -> SArgs abt '[LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

app2 :: (ABT Term abt) => abt '[] (a ':-> b ':-> c) -> abt '[] a -> abt '[] b -> abt '[] c
app2 :: abt '[] (a ':-> (b ':-> c)) -> abt '[] a -> abt '[] b -> abt '[] c
app2 = (abt '[] (b ':-> c) -> abt '[] b -> abt '[] c
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
app (abt '[] (b ':-> c) -> abt '[] b -> abt '[] c)
-> (abt '[] a -> abt '[] (b ':-> c))
-> abt '[] a
-> abt '[] b
-> abt '[] c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.) ((abt '[] a -> abt '[] (b ':-> c))
 -> abt '[] a -> abt '[] b -> abt '[] c)
-> (abt '[] (a ':-> (b ':-> c)) -> abt '[] a -> abt '[] (b ':-> c))
-> abt '[] (a ':-> (b ':-> c))
-> abt '[] a
-> abt '[] b
-> abt '[] c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] (a ':-> (b ':-> c)) -> abt '[] a -> abt '[] (b ':-> c)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
app

app3 :: (ABT Term abt) => abt '[] (a ':-> b ':-> c ':-> d) -> abt '[] a -> abt '[] b -> abt '[] c -> abt '[] d
app3 :: abt '[] (a ':-> (b ':-> (c ':-> d)))
-> abt '[] a -> abt '[] b -> abt '[] c -> abt '[] d
app3 = (abt '[] (b ':-> (c ':-> d)) -> abt '[] b -> abt '[] c -> abt '[] d
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
abt '[] (a ':-> (b ':-> c)) -> abt '[] a -> abt '[] b -> abt '[] c
app2 (abt '[] (b ':-> (c ':-> d))
 -> abt '[] b -> abt '[] c -> abt '[] d)
-> (abt '[] a -> abt '[] (b ':-> (c ':-> d)))
-> abt '[] a
-> abt '[] b
-> abt '[] c
-> abt '[] d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.) ((abt '[] a -> abt '[] (b ':-> (c ':-> d)))
 -> abt '[] a -> abt '[] b -> abt '[] c -> abt '[] d)
-> (abt '[] (a ':-> (b ':-> (c ':-> d)))
    -> abt '[] a -> abt '[] (b ':-> (c ':-> d)))
-> abt '[] (a ':-> (b ':-> (c ':-> d)))
-> abt '[] a
-> abt '[] b
-> abt '[] c
-> abt '[] d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] (a ':-> (b ':-> (c ':-> d)))
-> abt '[] a -> abt '[] (b ':-> (c ':-> d))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
app

triv :: TrivialABT Term '[] a -> TrivialABT Term '[] a
triv :: TrivialABT Term '[] a -> TrivialABT Term '[] a
triv = TrivialABT Term '[] a -> TrivialABT Term '[] a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

memo :: MemoizedABT Term '[] a -> MemoizedABT Term '[] a
memo :: MemoizedABT Term '[] a -> MemoizedABT Term '[] a
memo = MemoizedABT Term '[] a -> MemoizedABT Term '[] a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

primOp0_ :: (ABT Term abt) => PrimOp '[] a -> abt '[] a
primOp0_ :: PrimOp '[] a -> abt '[] a
primOp0_ PrimOp '[] a
o = Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[] a -> SCon '[] a
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[] a
o SCon '[] a -> SArgs abt '[] -> Term abt a
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

primOp1_
    :: (ABT Term abt)
    => PrimOp '[ a ] b
    -> abt '[] a -> abt '[] b
primOp1_ :: PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[a] b
o abt '[] a
e1 = Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[a] b -> SCon '[ '( '[], a)] b
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[a] b
o SCon '[ '( '[], a)] b -> SArgs abt '[ '( '[], a)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e1 abt '[] a -> SArgs abt '[] -> SArgs abt '[ '( '[], a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

primOp2_
    :: (ABT Term abt)
    => PrimOp '[ a, b ] c
    -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ :: PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ PrimOp '[a, b] c
o abt '[] a
e1 abt '[] b
e2 = Term abt c -> abt '[] c
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[a, b] c -> SCon '[ '( '[], a), '( '[], b)] c
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[a, b] c
o SCon '[ '( '[], a), '( '[], b)] c
-> SArgs abt '[ '( '[], a), '( '[], b)] -> Term abt c
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e1 abt '[] a
-> SArgs abt '[ '( '[], b)] -> SArgs abt '[ '( '[], a), '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2 abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

primOp3_
    :: (ABT Term abt)
    => PrimOp '[ a, b, c ] d
    -> abt '[] a -> abt '[] b -> abt '[] c -> abt '[] d
primOp3_ :: PrimOp '[a, b, c] d
-> abt '[] a -> abt '[] b -> abt '[] c -> abt '[] d
primOp3_ PrimOp '[a, b, c] d
o abt '[] a
e1 abt '[] b
e2 abt '[] c
e3 = Term abt d -> abt '[] d
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[a, b, c] d
-> SCon '[ '( '[], a), '( '[], b), '( '[], c)] d
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[a, b, c] d
o SCon '[ '( '[], a), '( '[], b), '( '[], c)] d
-> SArgs abt '[ '( '[], a), '( '[], b), '( '[], c)] -> Term abt d
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e1 abt '[] a
-> SArgs abt '[ '( '[], b), '( '[], c)]
-> SArgs abt '[ '( '[], a), '( '[], b), '( '[], c)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2 abt '[] b
-> SArgs abt '[ '( '[], c)] -> SArgs abt '[ '( '[], b), '( '[], c)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] c
e3 abt '[] c -> SArgs abt '[] -> SArgs abt '[ '( '[], c)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

arrayOp0_ :: (ABT Term abt) => ArrayOp '[] a -> abt '[] a
arrayOp0_ :: ArrayOp '[] a -> abt '[] a
arrayOp0_ ArrayOp '[] a
o = Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (ArrayOp '[] a -> SCon '[] a
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
ArrayOp typs a -> SCon args a
ArrayOp_ ArrayOp '[] a
o SCon '[] a -> SArgs abt '[] -> Term abt a
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

arrayOp1_
    :: (ABT Term abt)
    => ArrayOp '[ a ] b
    -> abt '[] a -> abt '[] b
arrayOp1_ :: ArrayOp '[a] b -> abt '[] a -> abt '[] b
arrayOp1_ ArrayOp '[a] b
o abt '[] a
e1 = Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (ArrayOp '[a] b -> SCon '[ '( '[], a)] b
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
ArrayOp typs a -> SCon args a
ArrayOp_ ArrayOp '[a] b
o SCon '[ '( '[], a)] b -> SArgs abt '[ '( '[], a)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e1 abt '[] a -> SArgs abt '[] -> SArgs abt '[ '( '[], a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

arrayOp2_
    :: (ABT Term abt)
    => ArrayOp '[ a, b ] c
    -> abt '[] a -> abt '[] b -> abt '[] c
arrayOp2_ :: ArrayOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
arrayOp2_ ArrayOp '[a, b] c
o abt '[] a
e1 abt '[] b
e2 = Term abt c -> abt '[] c
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (ArrayOp '[a, b] c -> SCon '[ '( '[], a), '( '[], b)] c
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
ArrayOp typs a -> SCon args a
ArrayOp_ ArrayOp '[a, b] c
o SCon '[ '( '[], a), '( '[], b)] c
-> SArgs abt '[ '( '[], a), '( '[], b)] -> Term abt c
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e1 abt '[] a
-> SArgs abt '[ '( '[], b)] -> SArgs abt '[ '( '[], a), '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2 abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

arrayOp3_
    :: (ABT Term abt)
    => ArrayOp '[ a, b, c ] d
    -> abt '[] a -> abt '[] b -> abt '[] c -> abt '[] d
arrayOp3_ :: ArrayOp '[a, b, c] d
-> abt '[] a -> abt '[] b -> abt '[] c -> abt '[] d
arrayOp3_ ArrayOp '[a, b, c] d
o abt '[] a
e1 abt '[] b
e2 abt '[] c
e3 = Term abt d -> abt '[] d
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (ArrayOp '[a, b, c] d
-> SCon '[ '( '[], a), '( '[], b), '( '[], c)] d
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
ArrayOp typs a -> SCon args a
ArrayOp_ ArrayOp '[a, b, c] d
o SCon '[ '( '[], a), '( '[], b), '( '[], c)] d
-> SArgs abt '[ '( '[], a), '( '[], b), '( '[], c)] -> Term abt d
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e1 abt '[] a
-> SArgs abt '[ '( '[], b), '( '[], c)]
-> SArgs abt '[ '( '[], a), '( '[], b), '( '[], c)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2 abt '[] b
-> SArgs abt '[ '( '[], c)] -> SArgs abt '[ '( '[], b), '( '[], c)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] c
e3 abt '[] c -> SArgs abt '[] -> SArgs abt '[ '( '[], c)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

measure0_ :: (ABT Term abt) => MeasureOp '[] a -> abt '[] ('HMeasure a)
measure0_ :: MeasureOp '[] a -> abt '[] ('HMeasure a)
measure0_ MeasureOp '[] a
o = Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (MeasureOp '[] a -> SCon '[] ('HMeasure a)
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
MeasureOp typs a -> SCon args ('HMeasure a)
MeasureOp_ MeasureOp '[] a
o SCon '[] ('HMeasure a) -> SArgs abt '[] -> Term abt ('HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

measure1_
    :: (ABT Term abt)
    => MeasureOp '[ a ] b
    -> abt '[] a -> abt '[] ('HMeasure b)
measure1_ :: MeasureOp '[a] b -> abt '[] a -> abt '[] ('HMeasure b)
measure1_ MeasureOp '[a] b
o abt '[] a
e1 = Term abt ('HMeasure b) -> abt '[] ('HMeasure b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (MeasureOp '[a] b -> SCon '[ '( '[], a)] ('HMeasure b)
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
MeasureOp typs a -> SCon args ('HMeasure a)
MeasureOp_ MeasureOp '[a] b
o SCon '[ '( '[], a)] ('HMeasure b)
-> SArgs abt '[ '( '[], a)] -> Term abt ('HMeasure b)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e1 abt '[] a -> SArgs abt '[] -> SArgs abt '[ '( '[], a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

measure2_
    :: (ABT Term abt)
    => MeasureOp '[ a, b ] c
    -> abt '[] a -> abt '[] b -> abt '[] ('HMeasure c)
measure2_ :: MeasureOp '[a, b] c
-> abt '[] a -> abt '[] b -> abt '[] ('HMeasure c)
measure2_ MeasureOp '[a, b] c
o abt '[] a
e1 abt '[] b
e2 = Term abt ('HMeasure c) -> abt '[] ('HMeasure c)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (MeasureOp '[a, b] c
-> SCon '[ '( '[], a), '( '[], b)] ('HMeasure c)
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
MeasureOp typs a -> SCon args ('HMeasure a)
MeasureOp_ MeasureOp '[a, b] c
o SCon '[ '( '[], a), '( '[], b)] ('HMeasure c)
-> SArgs abt '[ '( '[], a), '( '[], b)] -> Term abt ('HMeasure c)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e1 abt '[] a
-> SArgs abt '[ '( '[], b)] -> SArgs abt '[ '( '[], a), '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2 abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)


-- N.B., we don't take advantage of commutativity, for more predictable
-- AST outputs. However, that means we can end up being slow...
--
-- N.B., we also don't try to eliminate the identity elements or
-- do cancellations because (a) it's undecidable in general, and
-- (b) that's prolly better handled as a post-processing simplification
-- step
--
-- TODO: generalize these two from [] to Foldable?

-- | Apply an n-ary operator to a list. This smart constructor will
-- flatten nested calls to the same operator. And if there is exactly
-- one element in the flattened sequence, then it will remove the
-- 'NaryOp_' node from the AST.
--
-- N.B., if the flattened sequence is empty, this smart constructor
-- will return an AST which applies the operator to the empty
-- sequence; which may or may not be unsafe. If the operator has
-- an identity element, then it's fine (operating on the empty
-- sequence evaluates to the identity element). However, if the
-- operator doesn't have an identity, then the generated code will
-- error whenever we attempt to run it.
unsafeNaryOp_ :: (ABT Term abt) => NaryOp a -> [abt '[] a] -> abt '[] a
unsafeNaryOp_ :: NaryOp a -> [abt '[] a] -> abt '[] a
unsafeNaryOp_ NaryOp a
o = NaryOp a -> abt '[] a -> [abt '[] a] -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> [abt '[] a] -> abt '[] a
naryOp_withIdentity NaryOp a
o (Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt a -> abt '[] a) -> Term abt a -> abt '[] a
forall a b. (a -> b) -> a -> b
$ NaryOp a -> Seq (abt '[] a) -> Term abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp a
o Seq (abt '[] a)
forall a. Seq a
Seq.empty)


-- | A variant of 'unsafeNaryOp_' which will replace operating over
-- the empty sequence with a specified identity element. The produced
-- AST has the same semantics, we're just preemptively
-- evaluating\/simplifying the 'NaryOp_' node of the AST.
--
-- N.B., this function does not simplify away the identity element
-- if it exists in the flattened sequence! We should add that in
-- the future.
naryOp_withIdentity
    :: (ABT Term abt) => NaryOp a -> abt '[] a -> [abt '[] a] -> abt '[] a
naryOp_withIdentity :: NaryOp a -> abt '[] a -> [abt '[] a] -> abt '[] a
naryOp_withIdentity NaryOp a
o abt '[] a
i = Seq (abt '[] a) -> [abt '[] a] -> abt '[] a
go Seq (abt '[] a)
forall a. Seq a
Seq.empty
    where
    go :: Seq (abt '[] a) -> [abt '[] a] -> abt '[] a
go Seq (abt '[] a)
es [] =
        case Seq (abt '[] a) -> ViewL (abt '[] a)
forall a. Seq a -> ViewL a
Seq.viewl Seq (abt '[] a)
es of
        ViewL (abt '[] a)
Seq.EmptyL   -> abt '[] a
i
        abt '[] a
e Seq.:< Seq (abt '[] a)
es' ->
            case Seq (abt '[] a) -> ViewL (abt '[] a)
forall a. Seq a -> ViewL a
Seq.viewl Seq (abt '[] a)
es' of
            ViewL (abt '[] a)
Seq.EmptyL -> abt '[] a
e
            ViewL (abt '[] a)
_          -> Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt a -> abt '[] a) -> Term abt a -> abt '[] a
forall a b. (a -> b) -> a -> b
$ NaryOp a -> Seq (abt '[] a) -> Term abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp a
o Seq (abt '[] a)
es
    go Seq (abt '[] a)
es (abt '[] a
e:[abt '[] a]
es') =
        case NaryOp a -> abt '[] a -> Maybe (Seq (abt '[] a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> Maybe (Seq (abt '[] a))
matchNaryOp NaryOp a
o abt '[] a
e of
        Maybe (Seq (abt '[] a))
Nothing   -> Seq (abt '[] a) -> [abt '[] a] -> abt '[] a
go (Seq (abt '[] a)
es Seq (abt '[] a) -> abt '[] a -> Seq (abt '[] a)
forall a. Seq a -> a -> Seq a
Seq.|> abt '[] a
e)    [abt '[] a]
es'
        Just Seq (abt '[] a)
es'' -> Seq (abt '[] a) -> [abt '[] a] -> abt '[] a
go (Seq (abt '[] a)
es Seq (abt '[] a) -> Seq (abt '[] a) -> Seq (abt '[] a)
forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq (abt '[] a)
es'') [abt '[] a]
es'


-- TODO: is this actually worth breaking out, performance-wise? Or should we simply use:
-- > naryOp2_ o x y = unsafeNaryOp_ o [x,y]
naryOp2_
    :: (ABT Term abt) => NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
naryOp2_ :: NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
naryOp2_ NaryOp a
o abt '[] a
x abt '[] a
y =
    case (NaryOp a -> abt '[] a -> Maybe (Seq (abt '[] a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> Maybe (Seq (abt '[] a))
matchNaryOp NaryOp a
o abt '[] a
x, NaryOp a -> abt '[] a -> Maybe (Seq (abt '[] a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> Maybe (Seq (abt '[] a))
matchNaryOp NaryOp a
o abt '[] a
y) of
    (Just Seq (abt '[] a)
xs, Just Seq (abt '[] a)
ys) -> Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt a -> abt '[] a)
-> (Seq (abt '[] a) -> Term abt a) -> Seq (abt '[] a) -> abt '[] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NaryOp a -> Seq (abt '[] a) -> Term abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp a
o (Seq (abt '[] a) -> abt '[] a) -> Seq (abt '[] a) -> abt '[] a
forall a b. (a -> b) -> a -> b
$ Seq (abt '[] a)
xs Seq (abt '[] a) -> Seq (abt '[] a) -> Seq (abt '[] a)
forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq (abt '[] a)
ys
    (Just Seq (abt '[] a)
xs, Maybe (Seq (abt '[] a))
Nothing) -> Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt a -> abt '[] a)
-> (Seq (abt '[] a) -> Term abt a) -> Seq (abt '[] a) -> abt '[] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NaryOp a -> Seq (abt '[] a) -> Term abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp a
o (Seq (abt '[] a) -> abt '[] a) -> Seq (abt '[] a) -> abt '[] a
forall a b. (a -> b) -> a -> b
$ Seq (abt '[] a)
xs Seq (abt '[] a) -> abt '[] a -> Seq (abt '[] a)
forall a. Seq a -> a -> Seq a
Seq.|> abt '[] a
y
    (Maybe (Seq (abt '[] a))
Nothing, Just Seq (abt '[] a)
ys) -> Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt a -> abt '[] a)
-> (Seq (abt '[] a) -> Term abt a) -> Seq (abt '[] a) -> abt '[] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NaryOp a -> Seq (abt '[] a) -> Term abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp a
o (Seq (abt '[] a) -> abt '[] a) -> Seq (abt '[] a) -> abt '[] a
forall a b. (a -> b) -> a -> b
$ abt '[] a
x  abt '[] a -> Seq (abt '[] a) -> Seq (abt '[] a)
forall a. a -> Seq a -> Seq a
Seq.<| Seq (abt '[] a)
ys
    (Maybe (Seq (abt '[] a))
Nothing, Maybe (Seq (abt '[] a))
Nothing) -> Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt a -> abt '[] a)
-> (Seq (abt '[] a) -> Term abt a) -> Seq (abt '[] a) -> abt '[] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NaryOp a -> Seq (abt '[] a) -> Term abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp a
o (Seq (abt '[] a) -> abt '[] a) -> Seq (abt '[] a) -> abt '[] a
forall a b. (a -> b) -> a -> b
$ abt '[] a
x  abt '[] a -> Seq (abt '[] a) -> Seq (abt '[] a)
forall a. a -> Seq a -> Seq a
Seq.<| abt '[] a -> Seq (abt '[] a)
forall a. a -> Seq a
Seq.singleton abt '[] a
y


matchNaryOp
    :: (ABT Term abt) => NaryOp a -> abt '[] a -> Maybe (Seq (abt '[] a))
matchNaryOp :: NaryOp a -> abt '[] a -> Maybe (Seq (abt '[] a))
matchNaryOp NaryOp a
o abt '[] a
e =
    abt '[] a
-> (Variable a -> Maybe (Seq (abt '[] a)))
-> (Term abt a -> Maybe (Seq (abt '[] a)))
-> Maybe (Seq (abt '[] a))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) r.
ABT syn abt =>
abt '[] a -> (Variable a -> r) -> (syn abt a -> r) -> r
caseVarSyn abt '[] a
e
        (Maybe (Seq (abt '[] a)) -> Variable a -> Maybe (Seq (abt '[] a))
forall a b. a -> b -> a
const Maybe (Seq (abt '[] a))
forall a. Maybe a
Nothing)
        ((Term abt a -> Maybe (Seq (abt '[] a)))
 -> Maybe (Seq (abt '[] a)))
-> (Term abt a -> Maybe (Seq (abt '[] a)))
-> Maybe (Seq (abt '[] a))
forall a b. (a -> b) -> a -> b
$ \Term abt a
t ->
            case Term abt a
t of
            NaryOp_ NaryOp a
o' Seq (abt '[] a)
xs | NaryOp a
o' NaryOp a -> NaryOp a -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== NaryOp a
o -> Seq (abt '[] a) -> Maybe (Seq (abt '[] a))
forall a. a -> Maybe a
Just Seq (abt '[] a)
xs
            Term abt a
_ -> Maybe (Seq (abt '[] a))
forall a. Maybe a
Nothing


----------------------------------------------------------------
----------------------------------------------------------------
----- Now for the actual EDSL

{-
infixr 9 `pair`

infixr 1 =<<
infixr 1 <=<, >=>
infixr 9 .
infixr 0 $
-}

infixl 1 >>=, >>
infixr 2 ||
infixr 3 &&
infix  4 ==, /=, <, <=, >, >=
infixl 4 <$>, <*>, <*, *> -- <$
infixl 6 +, -
infixl 7 *, /
infixr 8 ^, ^^, **
-- infixl9 is the default when things are unspecified
infixl 9 !, `app`, `thRootOf`

-- TODO: some infix notation reminiscent of \"::\"
-- TODO: actually do something with the type argument?
ann_ :: (ABT Term abt) => Sing a -> abt '[] a -> abt '[] a
ann_ :: Sing a -> abt '[] a -> abt '[] a
ann_ Sing a
_ abt '[] a
e = abt '[] a
e

coerceTo_ :: (ABT Term abt) => Coercion a b -> abt '[] a -> abt '[] b
coerceTo_ :: Coercion a b -> abt '[] a -> abt '[] b
coerceTo_ Coercion a b
CNil abt '[] a
e = abt '[] a
abt '[] b
e
coerceTo_ Coercion a b
c    abt '[] a
e = Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Coercion a b -> SCon '[LC a] b
forall (a :: Hakaru) (b :: Hakaru). Coercion a b -> SCon '[LC a] b
CoerceTo_ Coercion a b
c SCon '[LC a] b -> SArgs abt '[LC a] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e abt '[] a -> SArgs abt '[] -> SArgs abt '[LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

unsafeFrom_ :: (ABT Term abt) => Coercion a b -> abt '[] b -> abt '[] a
unsafeFrom_ :: Coercion a b -> abt '[] b -> abt '[] a
unsafeFrom_ Coercion a b
CNil abt '[] b
e = abt '[] a
abt '[] b
e
unsafeFrom_ Coercion a b
c    abt '[] b
e = Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Coercion a b -> SCon '[LC b] a
forall (a :: Hakaru) (b :: Hakaru). Coercion a b -> SCon '[LC b] a
UnsafeFrom_ Coercion a b
c SCon '[LC b] a -> SArgs abt '[LC b] -> Term abt a
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e abt '[] b -> SArgs abt '[] -> SArgs abt '[LC b]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

literal_ :: (ABT Term abt) => Literal a  -> abt '[] a
literal_ :: Literal a -> abt '[] a
literal_ = Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt a -> abt '[] a)
-> (Literal a -> Term abt a) -> Literal a -> abt '[] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Literal a -> Term abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
Literal a -> Term abt a
Literal_
bool_    :: (ABT Term abt) => Bool     -> abt '[] HBool
bool_ :: Bool -> abt '[] HBool
bool_    = Datum (abt '[]) HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
ABT Term abt =>
Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ (Datum (abt '[]) HBool -> abt '[] HBool)
-> (Bool -> Datum (abt '[]) HBool) -> Bool -> abt '[] HBool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\Bool
b -> if Bool
b then Datum (abt '[]) HBool
forall (ast :: Hakaru -> *). Datum ast HBool
dTrue else Datum (abt '[]) HBool
forall (ast :: Hakaru -> *). Datum ast HBool
dFalse)
nat_     :: (ABT Term abt) => Natural  -> abt '[] 'HNat
nat_ :: Natural -> abt '[] 'HNat
nat_     = Literal 'HNat -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HNat -> abt '[] 'HNat)
-> (Natural -> Literal 'HNat) -> Natural -> abt '[] 'HNat
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Natural -> Literal 'HNat
LNat
int_     :: (ABT Term abt) => Integer  -> abt '[] 'HInt
int_ :: Integer -> abt '[] 'HInt
int_     = Literal 'HInt -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HInt -> abt '[] 'HInt)
-> (Integer -> Literal 'HInt) -> Integer -> abt '[] 'HInt
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Literal 'HInt
LInt
prob_    :: (ABT Term abt) => NonNegativeRational -> abt '[] 'HProb
prob_ :: NonNegativeRational -> abt '[] 'HProb
prob_    = Literal 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HProb -> abt '[] 'HProb)
-> (NonNegativeRational -> Literal 'HProb)
-> NonNegativeRational
-> abt '[] 'HProb
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonNegativeRational -> Literal 'HProb
LProb
real_    :: (ABT Term abt) => Rational -> abt '[] 'HReal
real_ :: Rational -> abt '[] 'HReal
real_    = Literal 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HReal -> abt '[] 'HReal)
-> (Rational -> Literal 'HReal) -> Rational -> abt '[] 'HReal
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> Literal 'HReal
LReal

fromRational
    :: forall abt a
    . (ABT Term abt, HFractional_ a)
    => Rational
    -> abt '[] a
fromRational :: Rational -> abt '[] a
fromRational =
    case (HFractional a
forall (a :: Hakaru). HFractional_ a => HFractional a
hFractional :: HFractional a) of
    HFractional a
HFractional_Prob -> NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ (NonNegativeRational -> abt '[] 'HProb)
-> (Rational -> NonNegativeRational) -> Rational -> abt '[] 'HProb
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> NonNegativeRational
unsafeNonNegativeRational
    HFractional a
HFractional_Real -> Rational -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_

half :: forall abt a
     .  (ABT Term abt, HFractional_ a) => abt '[] a
half :: abt '[] a
half = Rational -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
Rational -> abt '[] a
fromRational (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
2)

third :: (ABT Term abt, HFractional_ a) => abt '[] a
third :: abt '[] a
third = Rational -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
Rational -> abt '[] a
fromRational (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
3)


-- Boolean operators
true, false :: (ABT Term abt) => abt '[] HBool
true :: abt '[] HBool
true  = Bool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Bool -> abt '[] HBool
bool_ Bool
True
false :: abt '[] HBool
false = Bool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Bool -> abt '[] HBool
bool_ Bool
False

-- TODO: simplifications: distribution, constant-propogation
-- TODO: do we really want to distribute /by default/? Clearly we'll want to do that in some optimization\/partial-evaluation pass, but do note that it makes terms larger in general...
not :: (ABT Term abt) => abt '[] HBool -> abt '[] HBool
not :: abt '[] HBool -> abt '[] HBool
not abt '[] HBool
e =
    abt '[] HBool
-> (abt '[] HBool -> abt '[] HBool)
-> Maybe (abt '[] HBool)
-> abt '[] HBool
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe (PrimOp '[HBool] HBool -> abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[HBool] HBool
Not abt '[] HBool
e) abt '[] HBool -> abt '[] HBool
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
        (Maybe (abt '[] HBool) -> abt '[] HBool)
-> Maybe (abt '[] HBool) -> abt '[] HBool
forall a b. (a -> b) -> a -> b
$ abt '[] HBool
-> (Variable HBool -> Maybe (abt '[] HBool))
-> (Term abt HBool -> Maybe (abt '[] HBool))
-> Maybe (abt '[] HBool)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) r.
ABT syn abt =>
abt '[] a -> (Variable a -> r) -> (syn abt a -> r) -> r
caseVarSyn abt '[] HBool
e
            (Maybe (abt '[] HBool) -> Variable HBool -> Maybe (abt '[] HBool)
forall a b. a -> b -> a
const Maybe (abt '[] HBool)
forall a. Maybe a
Nothing)
            ((Term abt HBool -> Maybe (abt '[] HBool))
 -> Maybe (abt '[] HBool))
-> (Term abt HBool -> Maybe (abt '[] HBool))
-> Maybe (abt '[] HBool)
forall a b. (a -> b) -> a -> b
$ \Term abt HBool
t ->
                case Term abt HBool
t of
                PrimOp_ PrimOp typs HBool
Not :$ SArgs abt args
es' ->
                    case SArgs abt args
es' of
                    abt vars a
e' :* SArgs abt args
End -> abt vars a -> Maybe (abt vars a)
forall a. a -> Maybe a
Just abt vars a
e'
                NaryOp_ NaryOp HBool
And Seq (abt '[] HBool)
xs ->
                    abt '[] HBool -> Maybe (abt '[] HBool)
forall a. a -> Maybe a
Just (abt '[] HBool -> Maybe (abt '[] HBool))
-> (Seq (abt '[] HBool) -> abt '[] HBool)
-> Seq (abt '[] HBool)
-> Maybe (abt '[] HBool)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Term abt HBool -> abt '[] HBool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt HBool -> abt '[] HBool)
-> (Seq (abt '[] HBool) -> Term abt HBool)
-> Seq (abt '[] HBool)
-> abt '[] HBool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NaryOp HBool -> Seq (abt '[] HBool) -> Term abt HBool
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp HBool
Or  (Seq (abt '[] HBool) -> Maybe (abt '[] HBool))
-> Seq (abt '[] HBool) -> Maybe (abt '[] HBool)
forall a b. (a -> b) -> a -> b
$ (abt '[] HBool -> abt '[] HBool)
-> Seq (abt '[] HBool) -> Seq (abt '[] HBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool -> abt '[] HBool
not Seq (abt '[] HBool)
xs
                NaryOp_ NaryOp HBool
Or Seq (abt '[] HBool)
xs ->
                    abt '[] HBool -> Maybe (abt '[] HBool)
forall a. a -> Maybe a
Just (abt '[] HBool -> Maybe (abt '[] HBool))
-> (Seq (abt '[] HBool) -> abt '[] HBool)
-> Seq (abt '[] HBool)
-> Maybe (abt '[] HBool)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Term abt HBool -> abt '[] HBool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt HBool -> abt '[] HBool)
-> (Seq (abt '[] HBool) -> Term abt HBool)
-> Seq (abt '[] HBool)
-> abt '[] HBool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NaryOp HBool -> Seq (abt '[] HBool) -> Term abt HBool
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp HBool
And (Seq (abt '[] HBool) -> Maybe (abt '[] HBool))
-> Seq (abt '[] HBool) -> Maybe (abt '[] HBool)
forall a b. (a -> b) -> a -> b
$ (abt '[] HBool -> abt '[] HBool)
-> Seq (abt '[] HBool) -> Seq (abt '[] HBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool -> abt '[] HBool
not Seq (abt '[] HBool)
xs
                NaryOp_ NaryOp HBool
Xor Seq (abt '[] HBool)
xs ->
                    abt '[] HBool -> Maybe (abt '[] HBool)
forall a. a -> Maybe a
Just (abt '[] HBool -> Maybe (abt '[] HBool))
-> (Seq (abt '[] HBool) -> abt '[] HBool)
-> Seq (abt '[] HBool)
-> Maybe (abt '[] HBool)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Term abt HBool -> abt '[] HBool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt HBool -> abt '[] HBool)
-> (Seq (abt '[] HBool) -> Term abt HBool)
-> Seq (abt '[] HBool)
-> abt '[] HBool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NaryOp HBool -> Seq (abt '[] HBool) -> Term abt HBool
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp HBool
Iff (Seq (abt '[] HBool) -> Maybe (abt '[] HBool))
-> Seq (abt '[] HBool) -> Maybe (abt '[] HBool)
forall a b. (a -> b) -> a -> b
$ (abt '[] HBool -> abt '[] HBool)
-> Seq (abt '[] HBool) -> Seq (abt '[] HBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool -> abt '[] HBool
not Seq (abt '[] HBool)
xs
                NaryOp_ NaryOp HBool
Iff Seq (abt '[] HBool)
xs ->
                    abt '[] HBool -> Maybe (abt '[] HBool)
forall a. a -> Maybe a
Just (abt '[] HBool -> Maybe (abt '[] HBool))
-> (Seq (abt '[] HBool) -> abt '[] HBool)
-> Seq (abt '[] HBool)
-> Maybe (abt '[] HBool)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Term abt HBool -> abt '[] HBool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt HBool -> abt '[] HBool)
-> (Seq (abt '[] HBool) -> Term abt HBool)
-> Seq (abt '[] HBool)
-> abt '[] HBool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NaryOp HBool -> Seq (abt '[] HBool) -> Term abt HBool
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp HBool
Xor (Seq (abt '[] HBool) -> Maybe (abt '[] HBool))
-> Seq (abt '[] HBool) -> Maybe (abt '[] HBool)
forall a b. (a -> b) -> a -> b
$ (abt '[] HBool -> abt '[] HBool)
-> Seq (abt '[] HBool) -> Seq (abt '[] HBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool -> abt '[] HBool
not Seq (abt '[] HBool)
xs
                Literal_ Literal HBool
_ -> [Char] -> Maybe (abt '[] HBool)
forall a. HasCallStack => [Char] -> a
error [Char]
"not: the impossible happened"
                Term abt HBool
_ -> Maybe (abt '[] HBool)
forall a. Maybe a
Nothing

and, or :: (ABT Term abt) => [abt '[] HBool] -> abt '[] HBool
and :: [abt '[] HBool] -> abt '[] HBool
and = NaryOp HBool -> abt '[] HBool -> [abt '[] HBool] -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> [abt '[] a] -> abt '[] a
naryOp_withIdentity NaryOp HBool
And abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool
true
or :: [abt '[] HBool] -> abt '[] HBool
or  = NaryOp HBool -> abt '[] HBool -> [abt '[] HBool] -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> [abt '[] a] -> abt '[] a
naryOp_withIdentity NaryOp HBool
Or  abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool
false

(&&), (||),
    -- (</=>), (<==>), (==>), (<==), (\\), (//) -- TODO: better names?
    nand, nor
    :: (ABT Term abt) => abt '[] HBool -> abt '[] HBool -> abt '[] HBool
&& :: abt '[] HBool -> abt '[] HBool -> abt '[] HBool
(&&) = NaryOp HBool -> abt '[] HBool -> abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
naryOp2_ NaryOp HBool
And
|| :: abt '[] HBool -> abt '[] HBool -> abt '[] HBool
(||) = NaryOp HBool -> abt '[] HBool -> abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
naryOp2_ NaryOp HBool
Or
-- (</=>) = naryOp2_ Xor
-- (<==>) = naryOp2_ Iff
-- (==>)  = primOp2_ Impl
-- (<==)  = flip (==>)
-- (\\)   = primOp2_ Diff
-- (//)   = flip (\\)
nand :: abt '[] HBool -> abt '[] HBool -> abt '[] HBool
nand   = PrimOp '[HBool, HBool] HBool
-> abt '[] HBool -> abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ PrimOp '[HBool, HBool] HBool
Nand
nor :: abt '[] HBool -> abt '[] HBool -> abt '[] HBool
nor    = PrimOp '[HBool, HBool] HBool
-> abt '[] HBool -> abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ PrimOp '[HBool, HBool] HBool
Nor


-- HEq & HOrder operators
(==), (/=)
    :: (ABT Term abt, HEq_ a) => abt '[] a -> abt '[] a -> abt '[] HBool
== :: abt '[] a -> abt '[] a -> abt '[] HBool
(==) = PrimOp '[a, a] HBool -> abt '[] a -> abt '[] a -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ (PrimOp '[a, a] HBool -> abt '[] a -> abt '[] a -> abt '[] HBool)
-> PrimOp '[a, a] HBool -> abt '[] a -> abt '[] a -> abt '[] HBool
forall a b. (a -> b) -> a -> b
$ HEq a -> PrimOp '[a, a] HBool
forall (a :: Hakaru). HEq a -> PrimOp '[a, a] HBool
Equal HEq a
forall (a :: Hakaru). HEq_ a => HEq a
hEq
/= :: abt '[] a -> abt '[] a -> abt '[] HBool
(/=) = (abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool -> abt '[] HBool
not (abt '[] HBool -> abt '[] HBool)
-> (abt '[] a -> abt '[] HBool) -> abt '[] a -> abt '[] HBool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.) ((abt '[] a -> abt '[] HBool) -> abt '[] a -> abt '[] HBool)
-> (abt '[] a -> abt '[] a -> abt '[] HBool)
-> abt '[] a
-> abt '[] a
-> abt '[] HBool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] a -> abt '[] a -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HEq_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
(==)

(<), (<=), (>), (>=)
    :: (ABT Term abt, HOrd_ a) => abt '[] a -> abt '[] a -> abt '[] HBool
< :: abt '[] a -> abt '[] a -> abt '[] HBool
(<)    = PrimOp '[a, a] HBool -> abt '[] a -> abt '[] a -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ (PrimOp '[a, a] HBool -> abt '[] a -> abt '[] a -> abt '[] HBool)
-> PrimOp '[a, a] HBool -> abt '[] a -> abt '[] a -> abt '[] HBool
forall a b. (a -> b) -> a -> b
$ HOrd a -> PrimOp '[a, a] HBool
forall (a :: Hakaru). HOrd a -> PrimOp '[a, a] HBool
Less HOrd a
forall (a :: Hakaru). HOrd_ a => HOrd a
hOrd
abt '[] a
x <= :: abt '[] a -> abt '[] a -> abt '[] HBool
<= abt '[] a
y = abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool -> abt '[] HBool
not (abt '[] a
x abt '[] a -> abt '[] a -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
> abt '[] a
y) -- or: @(x < y) || (x == y)@
> :: abt '[] a -> abt '[] a -> abt '[] HBool
(>)    = (abt '[] a -> abt '[] a -> abt '[] HBool)
-> abt '[] a -> abt '[] a -> abt '[] HBool
forall a b c. (a -> b -> c) -> b -> a -> c
flip abt '[] a -> abt '[] a -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
(<)
>= :: abt '[] a -> abt '[] a -> abt '[] HBool
(>=)   = (abt '[] a -> abt '[] a -> abt '[] HBool)
-> abt '[] a -> abt '[] a -> abt '[] HBool
forall a b c. (a -> b -> c) -> b -> a -> c
flip abt '[] a -> abt '[] a -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
(<=)

min, max :: (ABT Term abt, HOrd_ a) => abt '[] a -> abt '[] a -> abt '[] a
min :: abt '[] a -> abt '[] a -> abt '[] a
min = NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
naryOp2_ (NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a)
-> NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
forall a b. (a -> b) -> a -> b
$ HOrd a -> NaryOp a
forall (a :: Hakaru). HOrd a -> NaryOp a
Min HOrd a
forall (a :: Hakaru). HOrd_ a => HOrd a
hOrd
max :: abt '[] a -> abt '[] a -> abt '[] a
max = NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
naryOp2_ (NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a)
-> NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
forall a b. (a -> b) -> a -> b
$ HOrd a -> NaryOp a
forall (a :: Hakaru). HOrd a -> NaryOp a
Max HOrd a
forall (a :: Hakaru). HOrd_ a => HOrd a
hOrd

-- TODO: if @a@ is bounded, then we can make these safe...
minimum, maximum :: (ABT Term abt, HOrd_ a) => [abt '[] a] -> abt '[] a
minimum :: [abt '[] a] -> abt '[] a
minimum = NaryOp a -> [abt '[] a] -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> [abt '[] a] -> abt '[] a
unsafeNaryOp_ (NaryOp a -> [abt '[] a] -> abt '[] a)
-> NaryOp a -> [abt '[] a] -> abt '[] a
forall a b. (a -> b) -> a -> b
$ HOrd a -> NaryOp a
forall (a :: Hakaru). HOrd a -> NaryOp a
Min HOrd a
forall (a :: Hakaru). HOrd_ a => HOrd a
hOrd
maximum :: [abt '[] a] -> abt '[] a
maximum = NaryOp a -> [abt '[] a] -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> [abt '[] a] -> abt '[] a
unsafeNaryOp_ (NaryOp a -> [abt '[] a] -> abt '[] a)
-> NaryOp a -> [abt '[] a] -> abt '[] a
forall a b. (a -> b) -> a -> b
$ HOrd a -> NaryOp a
forall (a :: Hakaru). HOrd a -> NaryOp a
Max HOrd a
forall (a :: Hakaru). HOrd_ a => HOrd a
hOrd


-- HSemiring operators
(+), (*)
    :: (ABT Term abt, HSemiring_ a) => abt '[] a -> abt '[] a -> abt '[] a
+ :: abt '[] a -> abt '[] a -> abt '[] a
(+) = NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
naryOp2_ (NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a)
-> NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
forall a b. (a -> b) -> a -> b
$ HSemiring a -> NaryOp a
forall (a :: Hakaru). HSemiring a -> NaryOp a
Sum  HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring
* :: abt '[] a -> abt '[] a -> abt '[] a
(*) = NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
naryOp2_ (NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a)
-> NaryOp a -> abt '[] a -> abt '[] a -> abt '[] a
forall a b. (a -> b) -> a -> b
$ HSemiring a -> NaryOp a
forall (a :: Hakaru). HSemiring a -> NaryOp a
Prod HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring

zero, one :: forall abt a. (ABT Term abt, HSemiring_ a) => abt '[] a
zero :: abt '[] a
zero = HSemiring a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
HSemiring a -> abt '[] a
zero_ (HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring :: HSemiring a)
one :: abt '[] a
one  = HSemiring a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
HSemiring a -> abt '[] a
one_  (HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring :: HSemiring a)

zero_, one_ :: (ABT Term abt) => HSemiring a -> abt '[] a
zero_ :: HSemiring a -> abt '[] a
zero_ HSemiring a
HSemiring_Nat  = Literal 'HNat -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HNat -> abt '[] 'HNat) -> Literal 'HNat -> abt '[] 'HNat
forall a b. (a -> b) -> a -> b
$ Natural -> Literal 'HNat
LNat  Natural
0
zero_ HSemiring a
HSemiring_Int  = Literal 'HInt -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HInt -> abt '[] 'HInt) -> Literal 'HInt -> abt '[] 'HInt
forall a b. (a -> b) -> a -> b
$ Integer -> Literal 'HInt
LInt  Integer
0
zero_ HSemiring a
HSemiring_Prob = Literal 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HProb -> abt '[] 'HProb)
-> Literal 'HProb -> abt '[] 'HProb
forall a b. (a -> b) -> a -> b
$ NonNegativeRational -> Literal 'HProb
LProb NonNegativeRational
0
zero_ HSemiring a
HSemiring_Real = Literal 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HReal -> abt '[] 'HReal)
-> Literal 'HReal -> abt '[] 'HReal
forall a b. (a -> b) -> a -> b
$ Rational -> Literal 'HReal
LReal Rational
0
one_ :: HSemiring a -> abt '[] a
one_  HSemiring a
HSemiring_Nat  = Literal 'HNat -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HNat -> abt '[] 'HNat) -> Literal 'HNat -> abt '[] 'HNat
forall a b. (a -> b) -> a -> b
$ Natural -> Literal 'HNat
LNat  Natural
1
one_  HSemiring a
HSemiring_Int  = Literal 'HInt -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HInt -> abt '[] 'HInt) -> Literal 'HInt -> abt '[] 'HInt
forall a b. (a -> b) -> a -> b
$ Integer -> Literal 'HInt
LInt  Integer
1
one_  HSemiring a
HSemiring_Prob = Literal 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HProb -> abt '[] 'HProb)
-> Literal 'HProb -> abt '[] 'HProb
forall a b. (a -> b) -> a -> b
$ NonNegativeRational -> Literal 'HProb
LProb NonNegativeRational
1
one_  HSemiring a
HSemiring_Real = Literal 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Literal a -> abt '[] a
literal_ (Literal 'HReal -> abt '[] 'HReal)
-> Literal 'HReal -> abt '[] 'HReal
forall a b. (a -> b) -> a -> b
$ Rational -> Literal 'HReal
LReal Rational
1

-- TODO: add a smart constructor for @HSemiring_ a => Natural -> abt '[] a@ and\/or @HRing_ a => Integer -> abt '[] a@

sum, prod :: (ABT Term abt, HSemiring_ a) => [abt '[] a] -> abt '[] a
sum :: [abt '[] a] -> abt '[] a
sum  = NaryOp a -> abt '[] a -> [abt '[] a] -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> [abt '[] a] -> abt '[] a
naryOp_withIdentity (HSemiring a -> NaryOp a
forall (a :: Hakaru). HSemiring a -> NaryOp a
Sum  HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring) abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a
zero
prod :: [abt '[] a] -> abt '[] a
prod = NaryOp a -> abt '[] a -> [abt '[] a] -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NaryOp a -> abt '[] a -> [abt '[] a] -> abt '[] a
naryOp_withIdentity (HSemiring a -> NaryOp a
forall (a :: Hakaru). HSemiring a -> NaryOp a
Prod HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring) abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a
one

{-
sum, product :: (ABT Term abt, HSemiring_ a) => [abt '[] a] -> abt '[] a
sum     = unsafeNaryOp_ $ Sum  hSemiring
product = unsafeNaryOp_ $ Prod hSemiring
-}


-- TODO: simplifications
(^) :: (ABT Term abt, HSemiring_ a)
    => abt '[] a -> abt '[] 'HNat -> abt '[] a
^ :: abt '[] a -> abt '[] 'HNat -> abt '[] a
(^) = PrimOp '[a, 'HNat] a -> abt '[] a -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ (PrimOp '[a, 'HNat] a -> abt '[] a -> abt '[] 'HNat -> abt '[] a)
-> PrimOp '[a, 'HNat] a -> abt '[] a -> abt '[] 'HNat -> abt '[] a
forall a b. (a -> b) -> a -> b
$ HSemiring a -> PrimOp '[a, 'HNat] a
forall (a :: Hakaru). HSemiring a -> PrimOp '[a, 'HNat] a
NatPow HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring

-- TODO: this is actually safe, how can we capture that?
-- TODO: is this type restruction actually helpful anywhere for us?
-- If so, we ought to make this function polymorphic so that we can
-- use it for non-HRing HSemirings too...
square :: (ABT Term abt, HRing_ a) => abt '[] a -> abt '[] (NonNegative a)
square :: abt '[] a -> abt '[] (NonNegative a)
square abt '[] a
e = Coercion (NonNegative a) a -> abt '[] a -> abt '[] (NonNegative a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] b -> abt '[] a
unsafeFrom_ Coercion (NonNegative a) a
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed (abt '[] a
e abt '[] a -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] 'HNat -> abt '[] a
^ Natural -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Natural -> abt '[] 'HNat
nat_ Natural
2)


-- HRing operators
(-) :: (ABT Term abt, HRing_ a) => abt '[] a -> abt '[] a -> abt '[] a
abt '[] a
x - :: abt '[] a -> abt '[] a -> abt '[] a
- abt '[] a
y = abt '[] a
x abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
+ abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a
negate abt '[] a
y


-- TODO: do we really want to distribute negation over addition /by
-- default/? Clearly we'll want to do that in some
-- optimization\/partial-evaluation pass, but do note that it makes
-- terms larger in general...
negate :: (ABT Term abt, HRing_ a) => abt '[] a -> abt '[] a
negate :: abt '[] a -> abt '[] a
negate abt '[] a
e =
    abt '[] a
-> (abt '[] a -> abt '[] a) -> Maybe (abt '[] a) -> abt '[] a
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe (PrimOp '[a] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ (HRing a -> PrimOp '[a] a
forall (a :: Hakaru). HRing a -> PrimOp '[a] a
Negate HRing a
forall (a :: Hakaru). HRing_ a => HRing a
hRing) abt '[] a
e) abt '[] a -> abt '[] a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
        (Maybe (abt '[] a) -> abt '[] a) -> Maybe (abt '[] a) -> abt '[] a
forall a b. (a -> b) -> a -> b
$ abt '[] a
-> (Variable a -> Maybe (abt '[] a))
-> (Term abt a -> Maybe (abt '[] a))
-> Maybe (abt '[] a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) r.
ABT syn abt =>
abt '[] a -> (Variable a -> r) -> (syn abt a -> r) -> r
caseVarSyn abt '[] a
e
            (Maybe (abt '[] a) -> Variable a -> Maybe (abt '[] a)
forall a b. a -> b -> a
const Maybe (abt '[] a)
forall a. Maybe a
Nothing)
            ((Term abt a -> Maybe (abt '[] a)) -> Maybe (abt '[] a))
-> (Term abt a -> Maybe (abt '[] a)) -> Maybe (abt '[] a)
forall a b. (a -> b) -> a -> b
$ \Term abt a
t ->
                case Term abt a
t of
                -- TODO: need we case analyze the @HSemiring@?
                NaryOp_ (Sum HSemiring a
theSemi) Seq (abt '[] a)
xs ->
                    abt '[] a -> Maybe (abt '[] a)
forall a. a -> Maybe a
Just (abt '[] a -> Maybe (abt '[] a))
-> (Seq (abt '[] a) -> abt '[] a)
-> Seq (abt '[] a)
-> Maybe (abt '[] a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt a -> abt '[] a)
-> (Seq (abt '[] a) -> Term abt a) -> Seq (abt '[] a) -> abt '[] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NaryOp a -> Seq (abt '[] a) -> Term abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ (HSemiring a -> NaryOp a
forall (a :: Hakaru). HSemiring a -> NaryOp a
Sum HSemiring a
theSemi) (Seq (abt '[] a) -> Maybe (abt '[] a))
-> Seq (abt '[] a) -> Maybe (abt '[] a)
forall a b. (a -> b) -> a -> b
$ (abt '[] a -> abt '[] a) -> Seq (abt '[] a) -> Seq (abt '[] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a
negate Seq (abt '[] a)
xs
                -- TODO: need we case analyze the @HRing@?
                PrimOp_ (Negate HRing a
_theRing) :$ SArgs abt args
es' ->
                    case SArgs abt args
es' of
                    abt vars a
e' :* SArgs abt args
End -> abt vars a -> Maybe (abt vars a)
forall a. a -> Maybe a
Just abt vars a
e'
                Term abt a
_ -> Maybe (abt '[] a)
forall a. Maybe a
Nothing


-- TODO: test case: @negative . square@ simplifies away the intermediate coercions. (cf., normal')
-- BUG: this can lead to ambiguity when used with the polymorphic functions of RealProb.
-- | An occasionally helpful variant of 'negate'.
negative :: (ABT Term abt, HRing_ a) => abt '[] (NonNegative a) -> abt '[] a
negative :: abt '[] (NonNegative a) -> abt '[] a
negative = abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a
negate (abt '[] a -> abt '[] a)
-> (abt '[] (NonNegative a) -> abt '[] a)
-> abt '[] (NonNegative a)
-> abt '[] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion (NonNegative a) a -> abt '[] (NonNegative a) -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] a -> abt '[] b
coerceTo_ Coercion (NonNegative a) a
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed


abs :: (ABT Term abt, HRing_ a) => abt '[] a -> abt '[] a
abs :: abt '[] a -> abt '[] a
abs = Coercion (NonNegative a) a -> abt '[] (NonNegative a) -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] a -> abt '[] b
coerceTo_ Coercion (NonNegative a) a
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed (abt '[] (NonNegative a) -> abt '[] a)
-> (abt '[] a -> abt '[] (NonNegative a)) -> abt '[] a -> abt '[] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] a -> abt '[] (NonNegative a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] (NonNegative a)
abs_

abs_ :: (ABT Term abt, HRing_ a) => abt '[] a -> abt '[] (NonNegative a)
abs_ :: abt '[] a -> abt '[] (NonNegative a)
abs_ abt '[] a
e = 
    abt '[] (NonNegative a)
-> (abt '[] (NonNegative a) -> abt '[] (NonNegative a))
-> Maybe (abt '[] (NonNegative a))
-> abt '[] (NonNegative a)
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe (PrimOp '[a] (NonNegative a) -> abt '[] a -> abt '[] (NonNegative a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ (HRing a -> PrimOp '[a] (NonNegative a)
forall (a :: Hakaru). HRing a -> PrimOp '[a] (NonNegative a)
Abs HRing a
forall (a :: Hakaru). HRing_ a => HRing a
hRing) abt '[] a
e) abt '[] (NonNegative a) -> abt '[] (NonNegative a)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
        (Maybe (abt '[] (NonNegative a)) -> abt '[] (NonNegative a))
-> Maybe (abt '[] (NonNegative a)) -> abt '[] (NonNegative a)
forall a b. (a -> b) -> a -> b
$ abt '[] a
-> (Variable a -> Maybe (abt '[] (NonNegative a)))
-> (Term abt a -> Maybe (abt '[] (NonNegative a)))
-> Maybe (abt '[] (NonNegative a))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) r.
ABT syn abt =>
abt '[] a -> (Variable a -> r) -> (syn abt a -> r) -> r
caseVarSyn abt '[] a
e
            (Maybe (abt '[] (NonNegative a))
-> Variable a -> Maybe (abt '[] (NonNegative a))
forall a b. a -> b -> a
const Maybe (abt '[] (NonNegative a))
forall a. Maybe a
Nothing)
            ((Term abt a -> Maybe (abt '[] (NonNegative a)))
 -> Maybe (abt '[] (NonNegative a)))
-> (Term abt a -> Maybe (abt '[] (NonNegative a)))
-> Maybe (abt '[] (NonNegative a))
forall a b. (a -> b) -> a -> b
$ \Term abt a
t ->
                case Term abt a
t of
                -- BUG: can't use the 'Signed' pattern synonym here, because that /requires/ the input to be (NonNegative a), instead of giving us the information that it is.
                -- TODO: need we case analyze the @HRing@?
                CoerceTo_ (CCons (Signed HRing b
_theRing) Coercion b a
CNil) :$ SArgs abt args
es' ->
                    case SArgs abt args
es' of
                    abt vars a
e' :* SArgs abt args
End -> abt vars a -> Maybe (abt vars a)
forall a. a -> Maybe a
Just abt vars a
e'
                Term abt a
_ -> Maybe (abt '[] (NonNegative a))
forall a. Maybe a
Nothing


-- TODO: any obvious simplifications? idempotent?
signum :: (ABT Term abt, HRing_ a) => abt '[] a -> abt '[] a
signum :: abt '[] a -> abt '[] a
signum = PrimOp '[a] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ (PrimOp '[a] a -> abt '[] a -> abt '[] a)
-> PrimOp '[a] a -> abt '[] a -> abt '[] a
forall a b. (a -> b) -> a -> b
$ HRing a -> PrimOp '[a] a
forall (a :: Hakaru). HRing a -> PrimOp '[a] a
Signum HRing a
forall (a :: Hakaru). HRing_ a => HRing a
hRing


-- HFractional operators
(/) :: (ABT Term abt, HFractional_ a) => abt '[] a -> abt '[] a -> abt '[] a
abt '[] a
x / :: abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] a
y = abt '[] a
x abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a
recip abt '[] a
y


-- TODO: generalize this pattern so we don't have to repeat it...
--
-- TODO: do we really want to distribute reciprocal over multiplication
-- /by default/? Clearly we'll want to do that in some
-- optimization\/partial-evaluation pass, but do note that it makes
-- terms larger in general...
recip :: (ABT Term abt, HFractional_ a) => abt '[] a -> abt '[] a
recip :: abt '[] a -> abt '[] a
recip abt '[] a
e0 =
    abt '[] a
-> (abt '[] a -> abt '[] a) -> Maybe (abt '[] a) -> abt '[] a
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe (PrimOp '[a] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ (HFractional a -> PrimOp '[a] a
forall (a :: Hakaru). HFractional a -> PrimOp '[a] a
Recip HFractional a
forall (a :: Hakaru). HFractional_ a => HFractional a
hFractional) abt '[] a
e0) abt '[] a -> abt '[] a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
        (Maybe (abt '[] a) -> abt '[] a) -> Maybe (abt '[] a) -> abt '[] a
forall a b. (a -> b) -> a -> b
$ abt '[] a
-> (Variable a -> Maybe (abt '[] a))
-> (Term abt a -> Maybe (abt '[] a))
-> Maybe (abt '[] a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) r.
ABT syn abt =>
abt '[] a -> (Variable a -> r) -> (syn abt a -> r) -> r
caseVarSyn abt '[] a
e0
            (Maybe (abt '[] a) -> Variable a -> Maybe (abt '[] a)
forall a b. a -> b -> a
const Maybe (abt '[] a)
forall a. Maybe a
Nothing)
            ((Term abt a -> Maybe (abt '[] a)) -> Maybe (abt '[] a))
-> (Term abt a -> Maybe (abt '[] a)) -> Maybe (abt '[] a)
forall a b. (a -> b) -> a -> b
$ \Term abt a
t0 ->
                case Term abt a
t0 of
                -- TODO: need we case analyze the @HSemiring@?
                NaryOp_ (Prod HSemiring a
theSemi) Seq (abt '[] a)
xs ->
                    abt '[] a -> Maybe (abt '[] a)
forall a. a -> Maybe a
Just (abt '[] a -> Maybe (abt '[] a))
-> (Seq (abt '[] a) -> abt '[] a)
-> Seq (abt '[] a)
-> Maybe (abt '[] a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt a -> abt '[] a)
-> (Seq (abt '[] a) -> Term abt a) -> Seq (abt '[] a) -> abt '[] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NaryOp a -> Seq (abt '[] a) -> Term abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ (HSemiring a -> NaryOp a
forall (a :: Hakaru). HSemiring a -> NaryOp a
Prod HSemiring a
theSemi) (Seq (abt '[] a) -> Maybe (abt '[] a))
-> Seq (abt '[] a) -> Maybe (abt '[] a)
forall a b. (a -> b) -> a -> b
$ (abt '[] a -> abt '[] a) -> Seq (abt '[] a) -> Seq (abt '[] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a
recip Seq (abt '[] a)
xs
                -- TODO: need we case analyze the @HFractional@?
                PrimOp_ (Recip HFractional a
_theFrac) :$ SArgs abt args
es' ->
                    case SArgs abt args
es' of
                    abt vars a
e :* SArgs abt args
End -> abt vars a -> Maybe (abt vars a)
forall a. a -> Maybe a
Just abt vars a
e
                Term abt a
_ -> Maybe (abt '[] a)
forall a. Maybe a
Nothing


-- TODO: simplifications
-- TODO: a variant of 'if_' which gives us the evidence that the argument is non-negative, so we don't need to coerce or use 'abs_'
(^^) :: (ABT Term abt, HFractional_ a)
    => abt '[] a -> abt '[] 'HInt -> abt '[] a
abt '[] a
x ^^ :: abt '[] a -> abt '[] 'HInt -> abt '[] a
^^ abt '[] 'HInt
y =
    abt '[] HBool -> abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] HBool -> abt '[] a -> abt '[] a -> abt '[] a
if_ (abt '[] 'HInt
y abt '[] 'HInt -> abt '[] 'HInt -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
< Integer -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Integer -> abt '[] 'HInt
int_ Integer
0)
        (abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a
recip abt '[] a
x abt '[] a -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] 'HNat -> abt '[] a
^ abt '[] 'HInt -> abt '[] (NonNegative 'HInt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] (NonNegative a)
abs_ abt '[] 'HInt
y)
        (abt '[] a
x abt '[] a -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] 'HNat -> abt '[] a
^ abt '[] 'HInt -> abt '[] (NonNegative 'HInt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] (NonNegative a)
abs_ abt '[] 'HInt
y)


-- HRadical operators
-- N.B., HProb is the only HRadical type (for now...)
-- TODO: simplifications
thRootOf
    :: (ABT Term abt, HRadical_ a)
    => abt '[] 'HNat -> abt '[] a -> abt '[] a
abt '[] 'HNat
n thRootOf :: abt '[] 'HNat -> abt '[] a -> abt '[] a
`thRootOf` abt '[] a
x = PrimOp '[a, 'HNat] a -> abt '[] a -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ (HRadical a -> PrimOp '[a, 'HNat] a
forall (a :: Hakaru). HRadical a -> PrimOp '[a, 'HNat] a
NatRoot HRadical a
forall (a :: Hakaru). HRadical_ a => HRadical a
hRadical) abt '[] a
x abt '[] 'HNat
n

sqrt :: (ABT Term abt, HRadical_ a) => abt '[] a -> abt '[] a
sqrt :: abt '[] a -> abt '[] a
sqrt = (Natural -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Natural -> abt '[] 'HNat
nat_ Natural
2 abt '[] 'HNat -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRadical_ a) =>
abt '[] 'HNat -> abt '[] a -> abt '[] a
`thRootOf`)

{-
-- TODO: simplifications
(^+) :: (ABT Term abt, HRadical_ a)
    => abt '[] a -> abt '[] 'HPositiveRational -> abt '[] a
x ^+ y = casePositiveRational y $ \n d -> d `thRootOf` (x ^ n)

(^*) :: (ABT Term abt, HRadical_ a)
    => abt '[] a -> abt '[] 'HRational -> abt '[] a
x ^* y = caseRational y $ \n d -> d `thRootOf` (x ^^ n)
-}

betaFunc
    :: (ABT Term abt) => abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
betaFunc :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
betaFunc = PrimOp '[ 'HProb, 'HProb] 'HProb
-> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ PrimOp '[ 'HProb, 'HProb] 'HProb
BetaFunc


integrate
    :: (ABT Term abt)
    => abt '[] 'HReal
    -> abt '[] 'HReal
    -> (abt '[] 'HReal -> abt '[] 'HProb)
    -> abt '[] 'HProb
integrate :: abt '[] 'HReal
-> abt '[] 'HReal
-> (abt '[] 'HReal -> abt '[] 'HProb)
-> abt '[] 'HProb
integrate abt '[] 'HReal
lo abt '[] 'HReal
hi abt '[] 'HReal -> abt '[] 'HProb
f =
    Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC 'HReal, LC 'HReal, '( '[ 'HReal], 'HProb)] 'HProb
Integrate SCon '[LC 'HReal, LC 'HReal, '( '[ 'HReal], 'HProb)] 'HProb
-> SArgs abt '[LC 'HReal, LC 'HReal, '( '[ 'HReal], 'HProb)]
-> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HReal
lo abt '[] 'HReal
-> SArgs abt '[LC 'HReal, '( '[ 'HReal], 'HProb)]
-> SArgs abt '[LC 'HReal, LC 'HReal, '( '[ 'HReal], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] 'HReal
hi abt '[] 'HReal
-> SArgs abt '[ '( '[ 'HReal], 'HProb)]
-> SArgs abt '[LC 'HReal, '( '[ 'HReal], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Text
-> Sing 'HReal
-> (abt '[] 'HReal -> abt '[] 'HProb)
-> abt '[ 'HReal] 'HProb
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty Sing 'HReal
forall k (a :: k). SingI a => Sing a
sing abt '[] 'HReal -> abt '[] 'HProb
f abt '[ 'HReal] 'HProb
-> SArgs abt '[] -> SArgs abt '[ '( '[ 'HReal], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

summate
    :: (ABT Term abt, HDiscrete_ a, HSemiring_ b, SingI a)
    => abt '[] a
    -> abt '[] a
    -> (abt '[] a -> abt '[] b)
    -> abt '[] b
summate :: abt '[] a -> abt '[] a -> (abt '[] a -> abt '[] b) -> abt '[] b
summate abt '[] a
lo abt '[] a
hi abt '[] a -> abt '[] b
f =
    Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (HDiscrete a -> HSemiring b -> SCon '[LC a, LC a, '( '[a], b)] b
forall (a :: Hakaru) (b :: Hakaru).
HDiscrete a -> HSemiring b -> SCon '[LC a, LC a, '( '[a], b)] b
Summate HDiscrete a
forall (a :: Hakaru). HDiscrete_ a => HDiscrete a
hDiscrete HSemiring b
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring
         SCon '[LC a, LC a, '( '[a], b)] b
-> SArgs abt '[LC a, LC a, '( '[a], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
lo abt '[] a
-> SArgs abt '[LC a, '( '[a], b)]
-> SArgs abt '[LC a, LC a, '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] a
hi abt '[] a
-> SArgs abt '[ '( '[a], b)] -> SArgs abt '[LC a, '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Text -> Sing a -> (abt '[] a -> abt '[] b) -> abt '[a] b
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty Sing a
forall k (a :: k). SingI a => Sing a
sing abt '[] a -> abt '[] b
f abt '[a] b -> SArgs abt '[] -> SArgs abt '[ '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

product
    :: (ABT Term abt, HDiscrete_ a, HSemiring_ b, SingI a)
    => abt '[] a
    -> abt '[] a
    -> (abt '[] a -> abt '[] b)
    -> abt '[] b
product :: abt '[] a -> abt '[] a -> (abt '[] a -> abt '[] b) -> abt '[] b
product abt '[] a
lo abt '[] a
hi abt '[] a -> abt '[] b
f =
    Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (HDiscrete a -> HSemiring b -> SCon '[LC a, LC a, '( '[a], b)] b
forall (a :: Hakaru) (b :: Hakaru).
HDiscrete a -> HSemiring b -> SCon '[LC a, LC a, '( '[a], b)] b
Product HDiscrete a
forall (a :: Hakaru). HDiscrete_ a => HDiscrete a
hDiscrete HSemiring b
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring
         SCon '[LC a, LC a, '( '[a], b)] b
-> SArgs abt '[LC a, LC a, '( '[a], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
lo abt '[] a
-> SArgs abt '[LC a, '( '[a], b)]
-> SArgs abt '[LC a, LC a, '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] a
hi abt '[] a
-> SArgs abt '[ '( '[a], b)] -> SArgs abt '[LC a, '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Text -> Sing a -> (abt '[] a -> abt '[] b) -> abt '[a] b
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty Sing a
forall k (a :: k). SingI a => Sing a
sing abt '[] a -> abt '[] b
f abt '[a] b -> SArgs abt '[] -> SArgs abt '[ '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)


class Integrable (a :: Hakaru) where
    infinity :: (ABT Term abt) => abt '[] a

instance Integrable 'HNat where
    infinity :: abt '[] 'HNat
infinity = PrimOp '[] 'HNat -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
PrimOp '[] a -> abt '[] a
primOp0_ (HIntegrable 'HNat -> PrimOp '[] 'HNat
forall (a :: Hakaru). HIntegrable a -> PrimOp '[] a
Infinity HIntegrable 'HNat
HIntegrable_Nat)

instance Integrable 'HInt where
    infinity :: abt '[] 'HInt
infinity = abt '[] 'HNat -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HNat -> abt '[] 'HInt
nat2int (abt '[] 'HNat -> abt '[] 'HInt) -> abt '[] 'HNat -> abt '[] 'HInt
forall a b. (a -> b) -> a -> b
$ PrimOp '[] 'HNat -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
PrimOp '[] a -> abt '[] a
primOp0_ (HIntegrable 'HNat -> PrimOp '[] 'HNat
forall (a :: Hakaru). HIntegrable a -> PrimOp '[] a
Infinity HIntegrable 'HNat
HIntegrable_Nat)

instance Integrable 'HProb where
    infinity :: abt '[] 'HProb
infinity = PrimOp '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
PrimOp '[] a -> abt '[] a
primOp0_ (HIntegrable 'HProb -> PrimOp '[] 'HProb
forall (a :: Hakaru). HIntegrable a -> PrimOp '[] a
Infinity HIntegrable 'HProb
HIntegrable_Prob)

instance Integrable 'HReal where
    infinity :: abt '[] 'HReal
infinity = abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb (abt '[] 'HProb -> abt '[] 'HReal)
-> abt '[] 'HProb -> abt '[] 'HReal
forall a b. (a -> b) -> a -> b
$ PrimOp '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
PrimOp '[] a -> abt '[] a
primOp0_ (HIntegrable 'HProb -> PrimOp '[] 'HProb
forall (a :: Hakaru). HIntegrable a -> PrimOp '[] a
Infinity HIntegrable 'HProb
HIntegrable_Prob)

-- HACK: we define this class in order to gain more polymorphism;
-- but, will it cause type inferencing issues? Excepting 'log'
-- (which should be moved out of the class) these are all safe.
class RealProb (a :: Hakaru) where
    (**) :: (ABT Term abt) => abt '[] 'HProb -> abt '[] a -> abt '[] 'HProb
    exp  :: (ABT Term abt) => abt '[] a -> abt '[] 'HProb
    erf  :: (ABT Term abt) => abt '[] a -> abt '[] a
    pi   :: (ABT Term abt) => abt '[] a
    gammaFunc :: (ABT Term abt) => abt '[] a -> abt '[] 'HProb

instance RealProb 'HReal where
    ** :: abt '[] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
(**)      = PrimOp '[ 'HProb, 'HReal] 'HProb
-> abt '[] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ PrimOp '[ 'HProb, 'HReal] 'HProb
RealPow
    exp :: abt '[] 'HReal -> abt '[] 'HProb
exp       = PrimOp '[ 'HReal] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HProb
Exp
    erf :: abt '[] 'HReal -> abt '[] 'HReal
erf       = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ (PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal)
-> PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall a b. (a -> b) -> a -> b
$ HContinuous 'HReal -> PrimOp '[ 'HReal] 'HReal
forall (a :: Hakaru). HContinuous a -> PrimOp '[a] a
Erf HContinuous 'HReal
forall (a :: Hakaru). HContinuous_ a => HContinuous a
hContinuous
    pi :: abt '[] 'HReal
pi        = abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb (abt '[] 'HProb -> abt '[] 'HReal)
-> abt '[] 'HProb -> abt '[] 'HReal
forall a b. (a -> b) -> a -> b
$ PrimOp '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
PrimOp '[] a -> abt '[] a
primOp0_ PrimOp '[] 'HProb
Pi
    gammaFunc :: abt '[] 'HReal -> abt '[] 'HProb
gammaFunc = PrimOp '[ 'HReal] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HProb
GammaFunc

instance RealProb 'HProb where
    abt '[] 'HProb
x ** :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
** abt '[] 'HProb
y    = PrimOp '[ 'HProb, 'HReal] 'HProb
-> abt '[] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ PrimOp '[ 'HProb, 'HReal] 'HProb
RealPow abt '[] 'HProb
x (abt '[] 'HReal -> abt '[] 'HProb)
-> abt '[] 'HReal -> abt '[] 'HProb
forall a b. (a -> b) -> a -> b
$ abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb abt '[] 'HProb
y
    exp :: abt '[] 'HProb -> abt '[] 'HProb
exp       = PrimOp '[ 'HReal] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HProb
Exp (abt '[] 'HReal -> abt '[] 'HProb)
-> (abt '[] 'HProb -> abt '[] 'HReal)
-> abt '[] 'HProb
-> abt '[] 'HProb
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb
    erf :: abt '[] 'HProb -> abt '[] 'HProb
erf       = PrimOp '[ 'HProb] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ (PrimOp '[ 'HProb] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb)
-> PrimOp '[ 'HProb] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall a b. (a -> b) -> a -> b
$ HContinuous 'HProb -> PrimOp '[ 'HProb] 'HProb
forall (a :: Hakaru). HContinuous a -> PrimOp '[a] a
Erf HContinuous 'HProb
forall (a :: Hakaru). HContinuous_ a => HContinuous a
hContinuous
    pi :: abt '[] 'HProb
pi        = PrimOp '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
PrimOp '[] a -> abt '[] a
primOp0_ PrimOp '[] 'HProb
Pi
    gammaFunc :: abt '[] 'HProb -> abt '[] 'HProb
gammaFunc = PrimOp '[ 'HReal] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HProb
GammaFunc (abt '[] 'HReal -> abt '[] 'HProb)
-> (abt '[] 'HProb -> abt '[] 'HReal)
-> abt '[] 'HProb
-> abt '[] 'HProb
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb

log  :: (ABT Term abt) => abt '[] 'HProb -> abt '[] 'HReal
log :: abt '[] 'HProb -> abt '[] 'HReal
log = PrimOp '[ 'HProb] 'HReal -> abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HProb] 'HReal
Log

logBase
    :: (ABT Term abt)
    => abt '[] 'HProb
    -> abt '[] 'HProb
    -> abt '[] 'HReal
logBase :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HReal
logBase abt '[] 'HProb
b abt '[] 'HProb
x = abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
log abt '[] 'HProb
x abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
log abt '[] 'HProb
b -- undefined when b == 1

sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh
    :: (ABT Term abt) => abt '[] 'HReal -> abt '[] 'HReal
sin :: abt '[] 'HReal -> abt '[] 'HReal
sin    = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Sin
cos :: abt '[] 'HReal -> abt '[] 'HReal
cos    = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Cos
tan :: abt '[] 'HReal -> abt '[] 'HReal
tan    = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Tan
asin :: abt '[] 'HReal -> abt '[] 'HReal
asin   = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Asin
acos :: abt '[] 'HReal -> abt '[] 'HReal
acos   = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Acos
atan :: abt '[] 'HReal -> abt '[] 'HReal
atan   = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Atan
sinh :: abt '[] 'HReal -> abt '[] 'HReal
sinh   = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Sinh
cosh :: abt '[] 'HReal -> abt '[] 'HReal
cosh   = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Cosh
tanh :: abt '[] 'HReal -> abt '[] 'HReal
tanh   = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Tanh
asinh :: abt '[] 'HReal -> abt '[] 'HReal
asinh  = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Asinh
acosh :: abt '[] 'HReal -> abt '[] 'HReal
acosh  = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Acosh
atanh :: abt '[] 'HReal -> abt '[] 'HReal
atanh  = PrimOp '[ 'HReal] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HReal] 'HReal
Atanh

choose
    :: (ABT Term abt) => abt '[] 'HNat -> abt '[] 'HNat -> abt '[] 'HNat
choose :: abt '[] 'HNat -> abt '[] 'HNat -> abt '[] 'HNat
choose = PrimOp '[ 'HNat, 'HNat] 'HNat
-> abt '[] 'HNat -> abt '[] 'HNat -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
PrimOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
primOp2_ PrimOp '[ 'HNat, 'HNat] 'HNat
Choose

floor :: (ABT Term abt) => abt '[] 'HProb -> abt '[] 'HNat
floor :: abt '[] 'HProb -> abt '[] 'HNat
floor  = PrimOp '[ 'HProb] 'HNat -> abt '[] 'HProb -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
PrimOp '[a] b -> abt '[] a -> abt '[] b
primOp1_ PrimOp '[ 'HProb] 'HNat
Floor

----------------------------------------------------------------
datum_
    :: (ABT Term abt)
    => Datum (abt '[]) (HData' t)
    -> abt '[] (HData' t)
datum_ :: Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ = Term abt (HData' t) -> abt '[] (HData' t)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt (HData' t) -> abt '[] (HData' t))
-> (Datum (abt '[]) (HData' t) -> Term abt (HData' t))
-> Datum (abt '[]) (HData' t)
-> abt '[] (HData' t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Datum (abt '[]) (HData' t) -> Term abt (HData' t)
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
Datum (abt '[]) (HData' t) -> Term abt (HData' t)
Datum_

case_
     :: (ABT Term abt)
     => abt '[] a
     -> [Branch a abt b]
     -> abt '[] b
case_ :: abt '[] a -> [Branch a abt b] -> abt '[] b
case_ abt '[] a
e [Branch a abt b]
bs = Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (abt '[] a -> [Branch a abt b] -> Term abt b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
abt '[] a -> [Branch a abt b] -> Term abt b
Case_ abt '[] a
e [Branch a abt b]
bs)

branch
    :: (ABT Term abt)
    => Pattern xs a
    -> abt xs b
    -> Branch a abt b
branch :: Pattern xs a -> abt xs b -> Branch a abt b
branch = Pattern xs a -> abt xs b -> Branch a abt b
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch

unit :: (ABT Term abt) => abt '[] HUnit
unit :: abt '[] HUnit
unit = Datum (abt '[]) (HData' ('TyCon "Unit"))
-> abt '[] (HData' ('TyCon "Unit"))
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
ABT Term abt =>
Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ Datum (abt '[]) (HData' ('TyCon "Unit"))
forall (ast :: Hakaru -> *). Datum ast HUnit
dUnit

pair
    :: (ABT Term abt, SingI a, SingI b)
    => abt '[] a -> abt '[] b -> abt '[] (HPair a b)
pair :: abt '[] a -> abt '[] b -> abt '[] (HPair a b)
pair = (Datum (abt '[]) (HPair a b) -> abt '[] (HPair a b)
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
ABT Term abt =>
Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ (Datum (abt '[]) (HPair a b) -> abt '[] (HPair a b))
-> (abt '[] b -> Datum (abt '[]) (HPair a b))
-> abt '[] b
-> abt '[] (HPair a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.) ((abt '[] b -> Datum (abt '[]) (HPair a b))
 -> abt '[] b -> abt '[] (HPair a b))
-> (abt '[] a -> abt '[] b -> Datum (abt '[]) (HPair a b))
-> abt '[] a
-> abt '[] b
-> abt '[] (HPair a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] a -> abt '[] b -> Datum (abt '[]) (HPair a b)
forall (a :: Hakaru) (b :: Hakaru) (ast :: Hakaru -> *).
(SingI a, SingI b) =>
ast a -> ast b -> Datum ast (HPair a b)
dPair


pair_
    :: (ABT Term abt)
    => Sing a
    -> Sing b
    -> abt '[] a
    -> abt '[] b
    -> abt '[] (HPair a b)
pair_ :: Sing a -> Sing b -> abt '[] a -> abt '[] b -> abt '[] (HPair a b)
pair_ Sing a
a Sing b
b = (Datum (abt '[]) (HPair a b) -> abt '[] (HPair a b)
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
ABT Term abt =>
Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ (Datum (abt '[]) (HPair a b) -> abt '[] (HPair a b))
-> (abt '[] b -> Datum (abt '[]) (HPair a b))
-> abt '[] b
-> abt '[] (HPair a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.) ((abt '[] b -> Datum (abt '[]) (HPair a b))
 -> abt '[] b -> abt '[] (HPair a b))
-> (abt '[] a -> abt '[] b -> Datum (abt '[]) (HPair a b))
-> abt '[] a
-> abt '[] b
-> abt '[] (HPair a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing a
-> Sing b -> abt '[] a -> abt '[] b -> Datum (abt '[]) (HPair a b)
forall (a :: Hakaru) (b :: Hakaru) (ast :: Hakaru -> *).
Sing a -> Sing b -> ast a -> ast b -> Datum ast (HPair a b)
dPair_ Sing a
a Sing b
b


unpair
    :: forall abt a b c
    .  (ABT Term abt)
    => abt '[] (HPair a b)
    -> (abt '[] a -> abt '[] b -> abt '[] c)
    -> abt '[] c
unpair :: abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] c) -> abt '[] c
unpair abt '[] (HPair a b)
e abt '[] a -> abt '[] b -> abt '[] c
hoas =
    let (Sing a
aTyp,Sing b
bTyp) = Sing (HPair a b) -> (Sing a, Sing b)
forall (a :: Hakaru) (b :: Hakaru).
Sing (HPair a b) -> (Sing a, Sing b)
sUnPair (Sing (HPair a b) -> (Sing a, Sing b))
-> Sing (HPair a b) -> (Sing a, Sing b)
forall a b. (a -> b) -> a -> b
$ abt '[] (HPair a b) -> Sing (HPair a b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] (HPair a b)
e
        body :: abt '[] c
body        = abt '[] a -> abt '[] b -> abt '[] c
hoas (Variable a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
Variable a -> abt '[] a
var Variable a
a) (Variable b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
Variable a -> abt '[] a
var Variable b
b)
        inc :: a -> a
inc a
x       = a
1 a -> a -> a
forall a. Num a => a -> a -> a
Prelude.+ a
x
        a :: Variable a
a           = Text -> Nat -> Sing a -> Variable a
forall k (a :: k). Text -> Nat -> Sing a -> Variable a
Variable Text
Text.empty (abt '[] c -> Nat
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) (a :: k).
ABT syn abt =>
abt xs a -> Nat
nextBind abt '[] c
body)         Sing a
aTyp
        b :: Variable b
b           = Text -> Nat -> Sing b -> Variable b
forall k (a :: k). Text -> Nat -> Sing a -> Variable a
Variable Text
Text.empty (Nat -> Nat
forall a. Num a => a -> a
inc (Nat -> Nat) -> (abt '[] c -> Nat) -> abt '[] c -> Nat
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] c -> Nat
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) (a :: k).
ABT syn abt =>
abt xs a -> Nat
nextBind (abt '[] c -> Nat) -> abt '[] c -> Nat
forall a b. (a -> b) -> a -> b
$ abt '[] c
body) Sing b
bTyp
    in abt '[] (HPair a b) -> [Branch (HPair a b) abt c] -> abt '[] c
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] a -> [Branch a abt b] -> abt '[] b
case_ abt '[] (HPair a b)
e
        [Pattern '[a, b] (HPair a b)
-> abt '[a, b] c -> Branch (HPair a b) abt c
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch (Pattern '[a] a
-> Pattern '[b] b -> Pattern ('[a] ++ '[b]) (HPair a b)
forall (vars1 :: [Hakaru]) (a :: Hakaru) (vars2 :: [Hakaru])
       (b :: Hakaru).
Pattern vars1 a
-> Pattern vars2 b -> Pattern (vars1 ++ vars2) (HPair a b)
pPair Pattern '[a] a
forall (a :: Hakaru). Pattern '[a] a
PVar Pattern '[b] b
forall (a :: Hakaru). Pattern '[a] a
PVar)
           (Variable a -> abt '[b] c -> abt '[a, b] c
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable a
a (Variable b -> abt '[] c -> abt '[b] c
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable b
b abt '[] c
body))
        ]

fst :: (ABT Term abt)
    => abt '[] (HPair a b)
    -> abt '[] a
fst :: abt '[] (HPair a b) -> abt '[] a
fst abt '[] (HPair a b)
p = abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] a) -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] c) -> abt '[] c
unpair abt '[] (HPair a b)
p (\abt '[] a
x abt '[] b
_ -> abt '[] a
x)

snd :: (ABT Term abt)
    => abt '[] (HPair a b)
    -> abt '[] b
snd :: abt '[] (HPair a b) -> abt '[] b
snd abt '[] (HPair a b)
p = abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] b) -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] c) -> abt '[] c
unpair abt '[] (HPair a b)
p (\abt '[] a
_ abt '[] b
y -> abt '[] b
y)

swap :: (ABT Term abt, SingI a, SingI b)
    => abt '[] (HPair a b)
    -> abt '[] (HPair b a)
swap :: abt '[] (HPair a b) -> abt '[] (HPair b a)
swap abt '[] (HPair a b)
ab = abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] (HPair b a))
-> abt '[] (HPair b a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] c) -> abt '[] c
unpair abt '[] (HPair a b)
ab ((abt '[] b -> abt '[] a -> abt '[] (HPair b a))
-> abt '[] a -> abt '[] b -> abt '[] (HPair b a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip abt '[] b -> abt '[] a -> abt '[] (HPair b a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a, SingI b) =>
abt '[] a -> abt '[] b -> abt '[] (HPair a b)
pair)

left
    :: (ABT Term abt, SingI a, SingI b)
    => abt '[] a -> abt '[] (HEither a b)
left :: abt '[] a -> abt '[] (HEither a b)
left = Datum (abt '[]) (HEither a b) -> abt '[] (HEither a b)
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
ABT Term abt =>
Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ (Datum (abt '[]) (HEither a b) -> abt '[] (HEither a b))
-> (abt '[] a -> Datum (abt '[]) (HEither a b))
-> abt '[] a
-> abt '[] (HEither a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] a -> Datum (abt '[]) (HEither a b)
forall (a :: Hakaru) (b :: Hakaru) (ast :: Hakaru -> *).
(SingI a, SingI b) =>
ast a -> Datum ast (HEither a b)
dLeft

right
    :: (ABT Term abt, SingI a, SingI b)
    => abt '[] b -> abt '[] (HEither a b)
right :: abt '[] b -> abt '[] (HEither a b)
right = Datum (abt '[]) (HEither a b) -> abt '[] (HEither a b)
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
ABT Term abt =>
Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ (Datum (abt '[]) (HEither a b) -> abt '[] (HEither a b))
-> (abt '[] b -> Datum (abt '[]) (HEither a b))
-> abt '[] b
-> abt '[] (HEither a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] b -> Datum (abt '[]) (HEither a b)
forall (a :: Hakaru) (b :: Hakaru) (ast :: Hakaru -> *).
(SingI a, SingI b) =>
ast b -> Datum ast (HEither a b)
dRight

uneither
    :: (ABT Term abt)
    => abt '[] (HEither a b)
    -> (abt '[] a -> abt '[] c)
    -> (abt '[] b -> abt '[] c)
    -> abt '[] c
uneither :: abt '[] (HEither a b)
-> (abt '[] a -> abt '[] c)
-> (abt '[] b -> abt '[] c)
-> abt '[] c
uneither abt '[] (HEither a b)
e abt '[] a -> abt '[] c
l abt '[] b -> abt '[] c
r =
    let (Sing a
a,Sing b
b) = Sing (HEither a b) -> (Sing a, Sing b)
forall (a :: Hakaru) (b :: Hakaru).
Sing (HEither a b) -> (Sing a, Sing b)
sUnEither (Sing (HEither a b) -> (Sing a, Sing b))
-> Sing (HEither a b) -> (Sing a, Sing b)
forall a b. (a -> b) -> a -> b
$ abt '[] (HEither a b) -> Sing (HEither a b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] (HEither a b)
e
    in abt '[] (HEither a b) -> [Branch (HEither a b) abt c] -> abt '[] c
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] a -> [Branch a abt b] -> abt '[] b
case_ abt '[] (HEither a b)
e
        [ Pattern '[a] (HEither a b)
-> abt '[a] c -> Branch (HEither a b) abt c
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch (Pattern '[a] a -> Pattern '[a] (HEither a b)
forall (vars :: [Hakaru]) (a :: Hakaru) (b :: Hakaru).
Pattern vars a -> Pattern vars (HEither a b)
pLeft  Pattern '[a] a
forall (a :: Hakaru). Pattern '[a] a
PVar) (Text -> Sing a -> (abt '[] a -> abt '[] c) -> abt '[a] c
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty Sing a
a abt '[] a -> abt '[] c
l)
        , Pattern '[b] (HEither a b)
-> abt '[b] c -> Branch (HEither a b) abt c
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch (Pattern '[b] b -> Pattern '[b] (HEither a b)
forall (vars :: [Hakaru]) (b :: Hakaru) (a :: Hakaru).
Pattern vars b -> Pattern vars (HEither a b)
pRight Pattern '[b] b
forall (a :: Hakaru). Pattern '[a] a
PVar) (Text -> Sing b -> (abt '[] b -> abt '[] c) -> abt '[b] c
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty Sing b
b abt '[] b -> abt '[] c
r)
        ]

if_ :: (ABT Term abt)
    => abt '[] HBool
    -> abt '[] a
    -> abt '[] a
    -> abt '[] a
if_ :: abt '[] HBool -> abt '[] a -> abt '[] a -> abt '[] a
if_ abt '[] HBool
b abt '[] a
t abt '[] a
f =
    abt '[] HBool -> [Branch HBool abt a] -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] a -> [Branch a abt b] -> abt '[] b
case_ abt '[] HBool
b
     [ Pattern '[] HBool -> abt '[] a -> Branch HBool abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch Pattern '[] HBool
pTrue  abt '[] a
t
     , Pattern '[] HBool -> abt '[] a -> Branch HBool abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch Pattern '[] HBool
pFalse abt '[] a
f
     ]

nil :: (ABT Term abt, SingI a) => abt '[] (HList a)
nil :: abt '[] (HList a)
nil = Datum (abt '[]) (HData' ('TyCon "List" ':@ a))
-> abt '[] (HData' ('TyCon "List" ':@ a))
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
ABT Term abt =>
Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ Datum (abt '[]) (HData' ('TyCon "List" ':@ a))
forall (a :: Hakaru) (ast :: Hakaru -> *).
SingI a =>
Datum ast (HList a)
dNil

cons
    :: (ABT Term abt, SingI a)
    => abt '[] a -> abt '[] (HList a) -> abt '[] (HList a)
cons :: abt '[] a -> abt '[] (HList a) -> abt '[] (HList a)
cons = (Datum (abt '[]) (HList a) -> abt '[] (HList a)
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
ABT Term abt =>
Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ (Datum (abt '[]) (HList a) -> abt '[] (HList a))
-> (abt '[] (HList a) -> Datum (abt '[]) (HList a))
-> abt '[] (HList a)
-> abt '[] (HList a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.) ((abt '[] (HList a) -> Datum (abt '[]) (HList a))
 -> abt '[] (HList a) -> abt '[] (HList a))
-> (abt '[] a -> abt '[] (HList a) -> Datum (abt '[]) (HList a))
-> abt '[] a
-> abt '[] (HList a)
-> abt '[] (HList a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] a -> abt '[] (HList a) -> Datum (abt '[]) (HList a)
forall (a :: Hakaru) (ast :: Hakaru -> *).
SingI a =>
ast a -> ast (HList a) -> Datum ast (HList a)
dCons

list :: (ABT Term abt, SingI a) => [abt '[] a] -> abt '[] (HList a)
list :: [abt '[] a] -> abt '[] (HList a)
list = (abt '[] a -> abt '[] (HList a) -> abt '[] (HList a))
-> abt '[] (HList a) -> [abt '[] a] -> abt '[] (HList a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr abt '[] a -> abt '[] (HList a) -> abt '[] (HList a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] a -> abt '[] (HList a) -> abt '[] (HList a)
cons abt '[] (HList a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] (HList a)
nil

nothing :: (ABT Term abt, SingI a) => abt '[] (HMaybe a)
nothing :: abt '[] (HMaybe a)
nothing = Datum (abt '[]) (HData' ('TyCon "Maybe" ':@ a))
-> abt '[] (HData' ('TyCon "Maybe" ':@ a))
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
ABT Term abt =>
Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ Datum (abt '[]) (HData' ('TyCon "Maybe" ':@ a))
forall (a :: Hakaru) (ast :: Hakaru -> *).
SingI a =>
Datum ast (HMaybe a)
dNothing

just :: (ABT Term abt, SingI a) => abt '[] a -> abt '[] (HMaybe a)
just :: abt '[] a -> abt '[] (HMaybe a)
just = Datum (abt '[]) (HMaybe a) -> abt '[] (HMaybe a)
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
ABT Term abt =>
Datum (abt '[]) (HData' t) -> abt '[] (HData' t)
datum_ (Datum (abt '[]) (HMaybe a) -> abt '[] (HMaybe a))
-> (abt '[] a -> Datum (abt '[]) (HMaybe a))
-> abt '[] a
-> abt '[] (HMaybe a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] a -> Datum (abt '[]) (HMaybe a)
forall (a :: Hakaru) (ast :: Hakaru -> *).
SingI a =>
ast a -> Datum ast (HMaybe a)
dJust

maybe :: (ABT Term abt, SingI a) => Maybe (abt '[] a) -> abt '[] (HMaybe a)
maybe :: Maybe (abt '[] a) -> abt '[] (HMaybe a)
maybe = abt '[] (HMaybe a)
-> (abt '[] a -> abt '[] (HMaybe a))
-> Maybe (abt '[] a)
-> abt '[] (HMaybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe abt '[] (HMaybe a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] (HMaybe a)
nothing abt '[] a -> abt '[] (HMaybe a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] a -> abt '[] (HMaybe a)
just

unmaybe
    :: (ABT Term abt)
    => abt '[] (HMaybe a)
    -> abt '[] b
    -> (abt '[] a -> abt '[] b)
    -> abt '[] b
unmaybe :: abt '[] (HMaybe a)
-> abt '[] b -> (abt '[] a -> abt '[] b) -> abt '[] b
unmaybe abt '[] (HMaybe a)
e abt '[] b
n abt '[] a -> abt '[] b
j = 
    abt '[] (HMaybe a) -> [Branch (HMaybe a) abt b] -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] a -> [Branch a abt b] -> abt '[] b
case_ abt '[] (HMaybe a)
e
     [ Pattern '[] (HMaybe a) -> abt '[] b -> Branch (HMaybe a) abt b
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch Pattern '[] (HMaybe a)
forall (a :: Hakaru). Pattern '[] (HMaybe a)
pNothing     abt '[] b
n
     , Pattern '[a] (HMaybe a) -> abt '[a] b -> Branch (HMaybe a) abt b
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch (Pattern '[a] a -> Pattern '[a] (HMaybe a)
forall (vars :: [Hakaru]) (a :: Hakaru).
Pattern vars a -> Pattern vars (HMaybe a)
pJust Pattern '[a] a
forall (a :: Hakaru). Pattern '[a] a
PVar) (Text -> Sing a -> (abt '[] a -> abt '[] b) -> abt '[a] b
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty (Sing (HMaybe a) -> Sing a
forall (a :: Hakaru). Sing (HMaybe a) -> Sing a
sUnMaybe (Sing (HMaybe a) -> Sing a) -> Sing (HMaybe a) -> Sing a
forall a b. (a -> b) -> a -> b
$ abt '[] (HMaybe a) -> Sing (HMaybe a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] (HMaybe a)
e) abt '[] a -> abt '[] b
j)
     ]

unsafeProb :: (ABT Term abt) => abt '[] 'HReal -> abt '[] 'HProb
unsafeProb :: abt '[] 'HReal -> abt '[] 'HProb
unsafeProb = Coercion 'HProb 'HReal -> abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] b -> abt '[] a
unsafeFrom_ Coercion 'HProb 'HReal
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed

fromProb   :: (ABT Term abt) => abt '[] 'HProb -> abt '[] 'HReal
fromProb :: abt '[] 'HProb -> abt '[] 'HReal
fromProb   = Coercion 'HProb 'HReal -> abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] a -> abt '[] b
coerceTo_ Coercion 'HProb 'HReal
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed

nat2int    :: (ABT Term abt) => abt '[] 'HNat -> abt '[] 'HInt
nat2int :: abt '[] 'HNat -> abt '[] 'HInt
nat2int    = Coercion 'HNat 'HInt -> abt '[] 'HNat -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] a -> abt '[] b
coerceTo_ Coercion 'HNat 'HInt
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed

fromInt    :: (ABT Term abt) => abt '[] 'HInt  -> abt '[] 'HReal
fromInt :: abt '[] 'HInt -> abt '[] 'HReal
fromInt    = Coercion 'HInt 'HReal -> abt '[] 'HInt -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] a -> abt '[] b
coerceTo_ Coercion 'HInt 'HReal
forall (a :: Hakaru). HContinuous_ a => Coercion (HIntegral a) a
continuous

nat2prob   :: (ABT Term abt) => abt '[] 'HNat  -> abt '[] 'HProb
nat2prob :: abt '[] 'HNat -> abt '[] 'HProb
nat2prob   = Coercion 'HNat 'HProb -> abt '[] 'HNat -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] a -> abt '[] b
coerceTo_ Coercion 'HNat 'HProb
forall (a :: Hakaru). HContinuous_ a => Coercion (HIntegral a) a
continuous

nat2real   :: (ABT Term abt) => abt '[] 'HNat  -> abt '[] 'HReal
nat2real :: abt '[] 'HNat -> abt '[] 'HReal
nat2real   = Coercion 'HNat 'HReal -> abt '[] 'HNat -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] a -> abt '[] b
coerceTo_ (Coercion 'HInt 'HReal
forall (a :: Hakaru). HContinuous_ a => Coercion (HIntegral a) a
continuous Coercion 'HInt 'HReal
-> Coercion 'HNat 'HInt -> Coercion 'HNat 'HReal
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion 'HNat 'HInt
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed)

{- -- Uncomment only if we actually end up needing this anywhere
class FromNat (a :: Hakaru) where
    fromNat :: (ABT Term abt) => abt '[] 'HNat  -> abt '[] a

instance FromNat 'HNat  where fromNat = id
instance FromNat 'HInt  where fromNat = nat2int
instance FromNat 'HProb where fromNat = nat2prob
instance FromNat 'HReal where fromNat = fromProb . nat2prob
-}

unsafeProbFraction
    :: forall abt a
    .  (ABT Term abt, HFractional_ a)
    => abt '[] a
    -> abt '[] 'HProb
unsafeProbFraction :: abt '[] a -> abt '[] 'HProb
unsafeProbFraction abt '[] a
e =
    HFractional a -> abt '[] a -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
HFractional a -> abt '[] a -> abt '[] 'HProb
unsafeProbFraction_ (HFractional a
forall (a :: Hakaru). HFractional_ a => HFractional a
hFractional :: HFractional a) abt '[] a
e

unsafeProbFraction_
    :: (ABT Term abt)
    => HFractional a
    -> abt '[] a
    -> abt '[] 'HProb
unsafeProbFraction_ :: HFractional a -> abt '[] a -> abt '[] 'HProb
unsafeProbFraction_ HFractional a
HFractional_Prob = abt '[] a -> abt '[] 'HProb
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
unsafeProbFraction_ HFractional a
HFractional_Real = abt '[] a -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb
unsafeProb

unsafeProbSemiring
    :: forall abt a
    .  (ABT Term abt, HSemiring_ a)
    => abt '[] a
    -> abt '[] 'HProb
unsafeProbSemiring :: abt '[] a -> abt '[] 'HProb
unsafeProbSemiring abt '[] a
e =
    HSemiring a -> abt '[] a -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
HSemiring a -> abt '[] a -> abt '[] 'HProb
unsafeProbSemiring_ (HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring :: HSemiring a) abt '[] a
e

unsafeProbSemiring_
    :: (ABT Term abt)
    => HSemiring a
    -> abt '[] a
    -> abt '[] 'HProb
unsafeProbSemiring_ :: HSemiring a -> abt '[] a -> abt '[] 'HProb
unsafeProbSemiring_ HSemiring a
HSemiring_Nat  = abt '[] a -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HNat -> abt '[] 'HProb
nat2prob
unsafeProbSemiring_ HSemiring a
HSemiring_Int  = Coercion 'HNat 'HProb -> abt '[] 'HNat -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] a -> abt '[] b
coerceTo_ Coercion 'HNat 'HProb
forall (a :: Hakaru). HContinuous_ a => Coercion (HIntegral a) a
continuous (abt '[] 'HNat -> abt '[] 'HProb)
-> (abt '[] 'HInt -> abt '[] 'HNat)
-> abt '[] 'HInt
-> abt '[] 'HProb
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion 'HNat 'HInt -> abt '[] 'HInt -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] b -> abt '[] a
unsafeFrom_ Coercion 'HNat 'HInt
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed
unsafeProbSemiring_ HSemiring a
HSemiring_Prob = abt '[] a -> abt '[] 'HProb
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
unsafeProbSemiring_ HSemiring a
HSemiring_Real = abt '[] a -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb
unsafeProb


negativeInfinity :: ( ABT Term abt
                    , HRing_ a
                    , Integrable a)
                 => abt '[] a
negativeInfinity :: abt '[] a
negativeInfinity = abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a
negate abt '[] a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(Integrable a, ABT Term abt) =>
abt '[] a
infinity

-- instance (ABT Term abt) => Lambda abt where
-- 'app' already defined

-- TODO: use 'typeOf' to remove the 'SingI' requirement somehow
-- | A variant of 'lamWithVar' for automatically computing the type
-- via 'sing'.
lam :: (ABT Term abt, SingI a)
    => (abt '[] a -> abt '[] b)
    -> abt '[] (a ':-> b)
lam :: (abt '[] a -> abt '[] b) -> abt '[] (a ':-> b)
lam = Text -> Sing a -> (abt '[] a -> abt '[] b) -> abt '[] (a ':-> b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Text -> Sing a -> (abt '[] a -> abt '[] b) -> abt '[] (a ':-> b)
lamWithVar Text
Text.empty Sing a
forall k (a :: k). SingI a => Sing a
sing

-- | Create a lambda abstraction. The first two arguments give the
-- hint and type of the lambda-bound variable in the result. If you
-- want to automatically fill those in, then see 'lam'.
lamWithVar
    :: (ABT Term abt)
    => Text.Text
    -> Sing a
    -> (abt '[] a -> abt '[] b)
    -> abt '[] (a ':-> b)
lamWithVar :: Text -> Sing a -> (abt '[] a -> abt '[] b) -> abt '[] (a ':-> b)
lamWithVar Text
hint Sing a
typ abt '[] a -> abt '[] b
f = Term abt (a ':-> b) -> abt '[] (a ':-> b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[ '( '[a], b)] (a ':-> b)
forall (a :: Hakaru) (b :: Hakaru). SCon '[ '( '[a], b)] (a ':-> b)
Lam_ SCon '[ '( '[a], b)] (a ':-> b)
-> SArgs abt '[ '( '[a], b)] -> Term abt (a ':-> b)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ Text -> Sing a -> (abt '[] a -> abt '[] b) -> abt '[a] b
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
hint Sing a
typ abt '[] a -> abt '[] b
f abt '[a] b -> SArgs abt '[] -> SArgs abt '[ '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

{-
-- some test cases to make sure we tied-the-knot successfully:
> let
    lam :: (ABT Term abt)
        => String
        -> Sing a
        -> (abt '[] a -> abt '[] b)
        -> abt '[] (a ':-> b)
    lam name typ f = syn (Lam_ :$ binder name typ f :* End)
> lam "x" SInt (\x -> x) :: TrivialABT Term ('HInt ':-> 'HInt)
> lam "x" SInt (\x -> lam "y" SInt $ \y -> x < y) :: TrivialABT Term ('HInt ':-> 'HInt ':-> 'HBool)
-}

-- TODO: make this smarter so that if the @e@ is already a variable then we just plug it into @f@ instead of introducing the trivial let-binding.
let_
    :: (ABT Term abt)
    => abt '[] a
    -> (abt '[] a -> abt '[] b)
    -> abt '[] b
let_ :: abt '[] a -> (abt '[] a -> abt '[] b) -> abt '[] b
let_ abt '[] a
e abt '[] a -> abt '[] b
f = Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC a, '( '[a], b)] b
forall (a :: Hakaru) (b :: Hakaru). SCon '[LC a, '( '[a], b)] b
Let_ SCon '[LC a, '( '[a], b)] b
-> SArgs abt '[LC a, '( '[a], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e abt '[] a
-> SArgs abt '[ '( '[a], b)] -> SArgs abt '[LC a, '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Text -> Sing a -> (abt '[] a -> abt '[] b) -> abt '[a] b
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty (abt '[] a -> Sing a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] a
e) abt '[] a -> abt '[] b
f abt '[a] b -> SArgs abt '[] -> SArgs abt '[ '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

letM :: (Functor m, MonadFix m, ABT Term abt)
     => abt '[] a
     -> (abt '[] a -> m (abt '[] b))
     -> m (abt '[] b)
letM :: abt '[] a -> (abt '[] a -> m (abt '[] b)) -> m (abt '[] b)
letM abt '[] a
e abt '[] a -> m (abt '[] b)
f = (abt '[a] b -> abt '[] b) -> m (abt '[a] b) -> m (abt '[] b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ abt '[a] b
body -> Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt b -> abt '[] b) -> Term abt b -> abt '[] b
forall a b. (a -> b) -> a -> b
$ SCon '[LC a, '( '[a], b)] b
forall (a :: Hakaru) (b :: Hakaru). SCon '[LC a, '( '[a], b)] b
Let_ SCon '[LC a, '( '[a], b)] b
-> SArgs abt '[LC a, '( '[a], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e abt '[] a
-> SArgs abt '[ '( '[a], b)] -> SArgs abt '[LC a, '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[a] b
body abt '[a] b -> SArgs abt '[] -> SArgs abt '[ '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End) (Text -> Sing a -> (abt '[] a -> m (abt '[] b)) -> m (abt '[a] b)
forall a1 (m :: * -> *) (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
(MonadFix m, ABT syn abt) =>
Text
-> Sing a2 -> (abt '[] a2 -> m (abt xs b)) -> m (abt (a2 : xs) b)
binderM Text
Text.empty Sing a
t abt '[] a -> m (abt '[] b)
f)
  where t :: Sing a
t = abt '[] a -> Sing a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] a
e

----------------------------------------------------------------
array
    :: (ABT Term abt)
    => abt '[] 'HNat
    -> (abt '[] 'HNat -> abt '[] a)
    -> abt '[] ('HArray a)
array :: abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
array abt '[] 'HNat
n =
    Term abt ('HArray a) -> abt '[] ('HArray a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt ('HArray a) -> abt '[] ('HArray a))
-> ((abt '[] 'HNat -> abt '[] a) -> Term abt ('HArray a))
-> (abt '[] 'HNat -> abt '[] a)
-> abt '[] ('HArray a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] 'HNat -> abt '[ 'HNat] a -> Term abt ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] 'HNat -> abt '[ 'HNat] a -> Term abt ('HArray a)
Array_ abt '[] 'HNat
n (abt '[ 'HNat] a -> Term abt ('HArray a))
-> ((abt '[] 'HNat -> abt '[] a) -> abt '[ 'HNat] a)
-> (abt '[] 'HNat -> abt '[] a)
-> Term abt ('HArray a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text
-> Sing 'HNat -> (abt '[] 'HNat -> abt '[] a) -> abt '[ 'HNat] a
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty Sing 'HNat
forall k (a :: k). SingI a => Sing a
sing        

arrayWithVar
    :: (ABT Term abt)
    => abt '[] 'HNat
    -> Variable 'HNat
    -> abt '[] a
    -> abt '[] ('HArray a)
arrayWithVar :: abt '[] 'HNat -> Variable 'HNat -> abt '[] a -> abt '[] ('HArray a)
arrayWithVar abt '[] 'HNat
n Variable 'HNat
x abt '[] a
body =
    Term abt ('HArray a) -> abt '[] ('HArray a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt ('HArray a) -> abt '[] ('HArray a))
-> Term abt ('HArray a) -> abt '[] ('HArray a)
forall a b. (a -> b) -> a -> b
$ abt '[] 'HNat -> abt '[ 'HNat] a -> Term abt ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] 'HNat -> abt '[ 'HNat] a -> Term abt ('HArray a)
Array_ abt '[] 'HNat
n (Variable 'HNat -> abt '[] a -> abt '[ 'HNat] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable 'HNat
x abt '[] a
body)

arrayLit
    :: (ABT Term abt)
    => [abt '[] a]
    -> abt '[] ('HArray a)
arrayLit :: [abt '[] a] -> abt '[] ('HArray a)
arrayLit = Term abt ('HArray a) -> abt '[] ('HArray a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt ('HArray a) -> abt '[] ('HArray a))
-> ([abt '[] a] -> Term abt ('HArray a))
-> [abt '[] a]
-> abt '[] ('HArray a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [abt '[] a] -> Term abt ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
[abt '[] a] -> Term abt ('HArray a)
ArrayLiteral_

empty :: (ABT Term abt, SingI a) => abt '[] ('HArray a)
empty :: abt '[] ('HArray a)
empty = Term abt ('HArray a) -> abt '[] ('HArray a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Sing ('HArray a) -> Term abt ('HArray a)
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
Sing ('HArray a) -> Term abt ('HArray a)
Empty_ Sing ('HArray a)
forall k (a :: k). SingI a => Sing a
sing)

(!) :: (ABT Term abt)
    => abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
(!) abt '[] ('HArray a)
e = ArrayOp '[ 'HArray a, 'HNat] a
-> abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
ArrayOp '[a, b] c -> abt '[] a -> abt '[] b -> abt '[] c
arrayOp2_ (Sing a -> ArrayOp '[ 'HArray a, 'HNat] a
forall (a :: Hakaru). Sing a -> ArrayOp '[ 'HArray a, 'HNat] a
Index (Sing a -> ArrayOp '[ 'HArray a, 'HNat] a)
-> (Sing ('HArray a) -> Sing a)
-> Sing ('HArray a)
-> ArrayOp '[ 'HArray a, 'HNat] a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing ('HArray a) -> Sing a
forall (a :: Hakaru). Sing ('HArray a) -> Sing a
sUnArray (Sing ('HArray a) -> ArrayOp '[ 'HArray a, 'HNat] a)
-> Sing ('HArray a) -> ArrayOp '[ 'HArray a, 'HNat] a
forall a b. (a -> b) -> a -> b
$ abt '[] ('HArray a) -> Sing ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] ('HArray a)
e) abt '[] ('HArray a)
e

size :: (ABT Term abt) => abt '[] ('HArray a) -> abt '[] 'HNat
size :: abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray a)
e = ArrayOp '[ 'HArray a] 'HNat -> abt '[] ('HArray a) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
ArrayOp '[a] b -> abt '[] a -> abt '[] b
arrayOp1_ (Sing a -> ArrayOp '[ 'HArray a] 'HNat
forall (a :: Hakaru). Sing a -> ArrayOp '[ 'HArray a] 'HNat
Size (Sing a -> ArrayOp '[ 'HArray a] 'HNat)
-> (Sing ('HArray a) -> Sing a)
-> Sing ('HArray a)
-> ArrayOp '[ 'HArray a] 'HNat
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing ('HArray a) -> Sing a
forall (a :: Hakaru). Sing ('HArray a) -> Sing a
sUnArray (Sing ('HArray a) -> ArrayOp '[ 'HArray a] 'HNat)
-> Sing ('HArray a) -> ArrayOp '[ 'HArray a] 'HNat
forall a b. (a -> b) -> a -> b
$ abt '[] ('HArray a) -> Sing ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] ('HArray a)
e) abt '[] ('HArray a)
e

reduce
    :: (ABT Term abt)
    => (abt '[] a -> abt '[] a -> abt '[] a)
    -> abt '[] a
    -> abt '[] ('HArray a)
    -> abt '[] a
reduce :: (abt '[] a -> abt '[] a -> abt '[] a)
-> abt '[] a -> abt '[] ('HArray a) -> abt '[] a
reduce abt '[] a -> abt '[] a -> abt '[] a
f abt '[] a
e =
    let a :: Sing a
a  = abt '[] a -> Sing a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] a
e
        f' :: abt '[] (a ':-> (a ':-> a))
f' = Text
-> Sing a
-> (abt '[] a -> abt '[] (a ':-> a))
-> abt '[] (a ':-> (a ':-> a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Text -> Sing a -> (abt '[] a -> abt '[] b) -> abt '[] (a ':-> b)
lamWithVar Text
Text.empty Sing a
a ((abt '[] a -> abt '[] (a ':-> a)) -> abt '[] (a ':-> (a ':-> a)))
-> (abt '[] a -> abt '[] (a ':-> a)) -> abt '[] (a ':-> (a ':-> a))
forall a b. (a -> b) -> a -> b
$ \abt '[] a
x ->
                Text -> Sing a -> (abt '[] a -> abt '[] a) -> abt '[] (a ':-> a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Text -> Sing a -> (abt '[] a -> abt '[] b) -> abt '[] (a ':-> b)
lamWithVar Text
Text.empty Sing a
a ((abt '[] a -> abt '[] a) -> abt '[] (a ':-> a))
-> (abt '[] a -> abt '[] a) -> abt '[] (a ':-> a)
forall a b. (a -> b) -> a -> b
$ \abt '[] a
y -> abt '[] a -> abt '[] a -> abt '[] a
f abt '[] a
x abt '[] a
y
    in ArrayOp '[ a ':-> (a ':-> a), a, 'HArray a] a
-> abt '[] (a ':-> (a ':-> a))
-> abt '[] a
-> abt '[] ('HArray a)
-> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru) (d :: Hakaru).
ABT Term abt =>
ArrayOp '[a, b, c] d
-> abt '[] a -> abt '[] b -> abt '[] c -> abt '[] d
arrayOp3_ (Sing a -> ArrayOp '[ a ':-> (a ':-> a), a, 'HArray a] a
forall (a :: Hakaru).
Sing a -> ArrayOp '[ a ':-> (a ':-> a), a, 'HArray a] a
Reduce Sing a
a) abt '[] (a ':-> (a ':-> a))
f' abt '[] a
e

-- TODO: better names for all these. The \"V\" suffix doesn't make sense anymore since we're calling these arrays, not vectors...
-- TODO: bust these all out into their own place, since the API for arrays is gonna be huge

sumV :: (ABT Term abt, HSemiring_ a)
    => abt '[] ('HArray a) -> abt '[] a
sumV :: abt '[] ('HArray a) -> abt '[] a
sumV = (abt '[] a -> abt '[] a -> abt '[] a)
-> abt '[] a -> abt '[] ('HArray a) -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
(abt '[] a -> abt '[] a -> abt '[] a)
-> abt '[] a -> abt '[] ('HArray a) -> abt '[] a
reduce abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
(+) abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a
zero -- equivalent to summateV if @a ~ 'HProb@

summateV :: (ABT Term abt) => abt '[] ('HArray 'HProb) -> abt '[] 'HProb
summateV :: abt '[] ('HArray 'HProb) -> abt '[] 'HProb
summateV abt '[] ('HArray 'HProb)
x =
    abt '[] 'HNat
-> abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] 'HProb)
-> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, HDiscrete_ a, HSemiring_ b, SingI a) =>
abt '[] a -> abt '[] a -> (abt '[] a -> abt '[] b) -> abt '[] b
summate (Natural -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Natural -> abt '[] 'HNat
nat_ Natural
0) (abt '[] ('HArray 'HProb) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray 'HProb)
x)
        (\abt '[] 'HNat
i -> abt '[] ('HArray 'HProb)
x abt '[] ('HArray 'HProb) -> abt '[] 'HNat -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
! abt '[] 'HNat
i)

-- TODO: a variant of 'if_' for giving us evidence that the subtraction is sound.

unsafeMinusNat
    :: (ABT Term abt) => abt '[] 'HNat -> abt '[] 'HNat -> abt '[] 'HNat
unsafeMinusNat :: abt '[] 'HNat -> abt '[] 'HNat -> abt '[] 'HNat
unsafeMinusNat abt '[] 'HNat
x abt '[] 'HNat
y = Coercion 'HNat 'HInt -> abt '[] 'HInt -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] b -> abt '[] a
unsafeFrom_ Coercion 'HNat 'HInt
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed (abt '[] 'HNat -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HNat -> abt '[] 'HInt
nat2int abt '[] 'HNat
x abt '[] 'HInt -> abt '[] 'HInt -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
- abt '[] 'HNat -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HNat -> abt '[] 'HInt
nat2int abt '[] 'HNat
y)

unsafeMinusProb
    :: (ABT Term abt) => abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
unsafeMinusProb :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
unsafeMinusProb abt '[] 'HProb
x abt '[] 'HProb
y = abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb
unsafeProb (abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb abt '[] 'HProb
x abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
- abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb abt '[] 'HProb
y)

-- | For any semiring we can attempt subtraction by lifting to a
-- ring, subtracting there, and then lowering back to the semiring.
-- Of course, the lowering step may well fail.
unsafeMinus
    :: (ABT Term abt, HSemiring_ a) => abt '[] a -> abt '[] a -> abt '[] a
unsafeMinus :: abt '[] a -> abt '[] a -> abt '[] a
unsafeMinus = HSemiring a -> abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
HSemiring a -> abt '[] a -> abt '[] a -> abt '[] a
unsafeMinus_ HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring

-- | A variant of 'unsafeMinus' for explicitly passing the semiring
-- instance.
unsafeMinus_
    :: (ABT Term abt) => HSemiring a -> abt '[] a -> abt '[] a -> abt '[] a
unsafeMinus_ :: HSemiring a -> abt '[] a -> abt '[] a -> abt '[] a
unsafeMinus_ HSemiring a
theSemi =
    HSemiring a
-> (forall (b :: Hakaru).
    HRing_ b =>
    Coercion a b -> abt '[] a -> abt '[] a -> abt '[] a)
-> abt '[] a
-> abt '[] a
-> abt '[] a
forall (a :: Hakaru) r.
HSemiring a
-> (forall (b :: Hakaru). HRing_ b => Coercion a b -> r) -> r
signed_HSemiring HSemiring a
theSemi ((forall (b :: Hakaru).
  HRing_ b =>
  Coercion a b -> abt '[] a -> abt '[] a -> abt '[] a)
 -> abt '[] a -> abt '[] a -> abt '[] a)
-> (forall (b :: Hakaru).
    HRing_ b =>
    Coercion a b -> abt '[] a -> abt '[] a -> abt '[] a)
-> abt '[] a
-> abt '[] a
-> abt '[] a
forall a b. (a -> b) -> a -> b
$ \Coercion a b
c ->
        let lift :: abt '[] a -> abt '[] b
lift  = Coercion a b -> abt '[] a -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] a -> abt '[] b
coerceTo_   Coercion a b
c
            lower :: abt '[] b -> abt '[] a
lower = Coercion a b -> abt '[] b -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] b -> abt '[] a
unsafeFrom_ Coercion a b
c
        in \abt '[] a
e1 abt '[] a
e2 -> abt '[] b -> abt '[] a
lower (abt '[] a -> abt '[] b
lift abt '[] a
e1 abt '[] b -> abt '[] b -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
- abt '[] a -> abt '[] b
lift abt '[] a
e2)

-- TODO: move to Coercion.hs?
-- | For any semiring, return a coercion to its ring completion.
-- Because this completion is existentially quantified, we must use
-- a cps trick to eliminate the existential.
signed_HSemiring
    :: HSemiring a -> (forall b. (HRing_ b) => Coercion a b -> r) -> r
signed_HSemiring :: HSemiring a
-> (forall (b :: Hakaru). HRing_ b => Coercion a b -> r) -> r
signed_HSemiring HSemiring a
c forall (b :: Hakaru). HRing_ b => Coercion a b -> r
k =
    case HSemiring a
c of
    HSemiring a
HSemiring_Nat  -> Coercion a 'HInt -> r
forall (b :: Hakaru). HRing_ b => Coercion a b -> r
k (Coercion a 'HInt -> r) -> Coercion a 'HInt -> r
forall a b. (a -> b) -> a -> b
$ PrimCoercion a 'HInt -> Coercion a 'HInt
forall (a :: Hakaru) (b :: Hakaru).
PrimCoercion a b -> Coercion a b
singletonCoercion (HRing 'HInt -> PrimCoercion (NonNegative 'HInt) 'HInt
forall (a :: Hakaru). HRing a -> PrimCoercion (NonNegative a) a
Signed HRing 'HInt
HRing_Int)
    HSemiring a
HSemiring_Int  -> Coercion a a -> r
forall (b :: Hakaru). HRing_ b => Coercion a b -> r
k Coercion a a
forall (a :: Hakaru). Coercion a a
CNil
    HSemiring a
HSemiring_Prob -> Coercion a 'HReal -> r
forall (b :: Hakaru). HRing_ b => Coercion a b -> r
k (Coercion a 'HReal -> r) -> Coercion a 'HReal -> r
forall a b. (a -> b) -> a -> b
$ PrimCoercion a 'HReal -> Coercion a 'HReal
forall (a :: Hakaru) (b :: Hakaru).
PrimCoercion a b -> Coercion a b
singletonCoercion (HRing 'HReal -> PrimCoercion (NonNegative 'HReal) 'HReal
forall (a :: Hakaru). HRing a -> PrimCoercion (NonNegative a) a
Signed HRing 'HReal
HRing_Real)
    HSemiring a
HSemiring_Real -> Coercion a a -> r
forall (b :: Hakaru). HRing_ b => Coercion a b -> r
k Coercion a a
forall (a :: Hakaru). Coercion a a
CNil

-- | For any semiring we can attempt division by lifting to a
-- semifield, dividing there, and then lowering back to the semiring.
-- Of course, the lowering step may well fail.
unsafeDiv
    :: (ABT Term abt, HSemiring_ a) => abt '[] a -> abt '[] a -> abt '[] a
unsafeDiv :: abt '[] a -> abt '[] a -> abt '[] a
unsafeDiv = HSemiring a -> abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
HSemiring a -> abt '[] a -> abt '[] a -> abt '[] a
unsafeDiv_ HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring

-- | A variant of 'unsafeDiv' for explicitly passing the semiring
-- instance.
unsafeDiv_
    :: (ABT Term abt) => HSemiring a -> abt '[] a -> abt '[] a -> abt '[] a
unsafeDiv_ :: HSemiring a -> abt '[] a -> abt '[] a -> abt '[] a
unsafeDiv_ HSemiring a
theSemi =
    HSemiring a
-> (forall (b :: Hakaru).
    HFractional_ b =>
    Coercion a b -> abt '[] a -> abt '[] a -> abt '[] a)
-> abt '[] a
-> abt '[] a
-> abt '[] a
forall (a :: Hakaru) r.
HSemiring a
-> (forall (b :: Hakaru). HFractional_ b => Coercion a b -> r) -> r
continuous_HSemiring HSemiring a
theSemi ((forall (b :: Hakaru).
  HFractional_ b =>
  Coercion a b -> abt '[] a -> abt '[] a -> abt '[] a)
 -> abt '[] a -> abt '[] a -> abt '[] a)
-> (forall (b :: Hakaru).
    HFractional_ b =>
    Coercion a b -> abt '[] a -> abt '[] a -> abt '[] a)
-> abt '[] a
-> abt '[] a
-> abt '[] a
forall a b. (a -> b) -> a -> b
$ \Coercion a b
c ->
        let lift :: abt '[] a -> abt '[] b
lift  = Coercion a b -> abt '[] a -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] a -> abt '[] b
coerceTo_   Coercion a b
c
            lower :: abt '[] b -> abt '[] a
lower = Coercion a b -> abt '[] b -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] b -> abt '[] a
unsafeFrom_ Coercion a b
c
        in \abt '[] a
e1 abt '[] a
e2 -> abt '[] b -> abt '[] a
lower (abt '[] a -> abt '[] b
lift abt '[] a
e1 abt '[] b -> abt '[] b -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] a -> abt '[] b
lift abt '[] a
e2)

-- TODO: move to Coercion.hs?
-- | For any semiring, return a coercion to its semifield completion.
-- Because this completion is existentially quantified, we must use
-- a cps trick to eliminate the existential.
continuous_HSemiring
    :: HSemiring a -> (forall b. (HFractional_ b) => Coercion a b -> r) -> r
continuous_HSemiring :: HSemiring a
-> (forall (b :: Hakaru). HFractional_ b => Coercion a b -> r) -> r
continuous_HSemiring HSemiring a
c forall (b :: Hakaru). HFractional_ b => Coercion a b -> r
k =
    case HSemiring a
c of
    HSemiring a
HSemiring_Nat  -> Coercion a 'HProb -> r
forall (b :: Hakaru). HFractional_ b => Coercion a b -> r
k (Coercion a 'HProb -> r) -> Coercion a 'HProb -> r
forall a b. (a -> b) -> a -> b
$ PrimCoercion a 'HProb -> Coercion a 'HProb
forall (a :: Hakaru) (b :: Hakaru).
PrimCoercion a b -> Coercion a b
singletonCoercion (HContinuous 'HProb -> PrimCoercion (HIntegral 'HProb) 'HProb
forall (a :: Hakaru). HContinuous a -> PrimCoercion (HIntegral a) a
Continuous HContinuous 'HProb
HContinuous_Prob)
    HSemiring a
HSemiring_Int  -> Coercion a 'HReal -> r
forall (b :: Hakaru). HFractional_ b => Coercion a b -> r
k (Coercion a 'HReal -> r) -> Coercion a 'HReal -> r
forall a b. (a -> b) -> a -> b
$ PrimCoercion a 'HReal -> Coercion a 'HReal
forall (a :: Hakaru) (b :: Hakaru).
PrimCoercion a b -> Coercion a b
singletonCoercion (HContinuous 'HReal -> PrimCoercion (HIntegral 'HReal) 'HReal
forall (a :: Hakaru). HContinuous a -> PrimCoercion (HIntegral a) a
Continuous HContinuous 'HReal
HContinuous_Real)
    HSemiring a
HSemiring_Prob -> Coercion a a -> r
forall (b :: Hakaru). HFractional_ b => Coercion a b -> r
k Coercion a a
forall (a :: Hakaru). Coercion a a
CNil
    HSemiring a
HSemiring_Real -> Coercion a a -> r
forall (b :: Hakaru). HFractional_ b => Coercion a b -> r
k Coercion a a
forall (a :: Hakaru). Coercion a a
CNil


appendV
    :: (ABT Term abt)
    => abt '[] ('HArray a) -> abt '[] ('HArray a) -> abt '[] ('HArray a)
appendV :: abt '[] ('HArray a) -> abt '[] ('HArray a) -> abt '[] ('HArray a)
appendV abt '[] ('HArray a)
v1 abt '[] ('HArray a)
v2 =
    abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
array (abt '[] ('HArray a) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray a)
v1 abt '[] 'HNat -> abt '[] 'HNat -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
+ abt '[] ('HArray a) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray a)
v2) ((abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a))
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
forall a b. (a -> b) -> a -> b
$ \abt '[] 'HNat
i ->
        abt '[] HBool -> abt '[] a -> abt '[] a -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] HBool -> abt '[] a -> abt '[] a -> abt '[] a
if_ (abt '[] 'HNat
i abt '[] 'HNat -> abt '[] 'HNat -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
< abt '[] ('HArray a) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray a)
v1)
            (abt '[] ('HArray a)
v1 abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
! abt '[] 'HNat
i)
            (abt '[] ('HArray a)
v2 abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
! (abt '[] 'HNat
i abt '[] 'HNat -> abt '[] 'HNat -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HNat -> abt '[] 'HNat -> abt '[] 'HNat
`unsafeMinusNat` abt '[] ('HArray a) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray a)
v1))

mapWithIndex
    :: (ABT Term abt)
    => (abt '[] 'HNat -> abt '[] a -> abt '[] b)
    -> abt '[] ('HArray a)
    -> abt '[] ('HArray b)
mapWithIndex :: (abt '[] 'HNat -> abt '[] a -> abt '[] b)
-> abt '[] ('HArray a) -> abt '[] ('HArray b)
mapWithIndex abt '[] 'HNat -> abt '[] a -> abt '[] b
f abt '[] ('HArray a)
v = abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] b) -> abt '[] ('HArray b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
array (abt '[] ('HArray a) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray a)
v) ((abt '[] 'HNat -> abt '[] b) -> abt '[] ('HArray b))
-> (abt '[] 'HNat -> abt '[] b) -> abt '[] ('HArray b)
forall a b. (a -> b) -> a -> b
$ \abt '[] 'HNat
i -> abt '[] 'HNat -> abt '[] a -> abt '[] b
f abt '[] 'HNat
i (abt '[] ('HArray a)
v abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
! abt '[] 'HNat
i)

mapV
    :: (ABT Term abt)
    => (abt '[] a -> abt '[] b)
    -> abt '[] ('HArray a)
    -> abt '[] ('HArray b)
mapV :: (abt '[] a -> abt '[] b)
-> abt '[] ('HArray a) -> abt '[] ('HArray b)
mapV abt '[] a -> abt '[] b
f abt '[] ('HArray a)
v = abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] b) -> abt '[] ('HArray b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
array (abt '[] ('HArray a) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray a)
v) ((abt '[] 'HNat -> abt '[] b) -> abt '[] ('HArray b))
-> (abt '[] 'HNat -> abt '[] b) -> abt '[] ('HArray b)
forall a b. (a -> b) -> a -> b
$ \abt '[] 'HNat
i -> abt '[] a -> abt '[] b
f (abt '[] ('HArray a)
v abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
! abt '[] 'HNat
i)

normalizeV
    :: (ABT Term abt)
    => abt '[] ('HArray 'HProb)
    -> abt '[] ('HArray 'HProb)
normalizeV :: abt '[] ('HArray 'HProb) -> abt '[] ('HArray 'HProb)
normalizeV abt '[] ('HArray 'HProb)
x = (abt '[] 'HProb -> abt '[] 'HProb)
-> abt '[] ('HArray 'HProb) -> abt '[] ('HArray 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HArray a) -> abt '[] ('HArray b)
mapV (abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] ('HArray 'HProb) -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] ('HArray a) -> abt '[] a
sumV abt '[] ('HArray 'HProb)
x) abt '[] ('HArray 'HProb)
x

constV
    :: (ABT Term abt) => abt '[] 'HNat -> abt '[] b -> abt '[] ('HArray b)
constV :: abt '[] 'HNat -> abt '[] b -> abt '[] ('HArray b)
constV abt '[] 'HNat
n abt '[] b
c = abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] b) -> abt '[] ('HArray b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
array abt '[] 'HNat
n (abt '[] b -> abt '[] 'HNat -> abt '[] b
forall a b. a -> b -> a
const abt '[] b
c)

unitV
    :: (ABT Term abt)
    => abt '[] 'HNat
    -> abt '[] 'HNat
    -> abt '[] ('HArray 'HProb)
unitV :: abt '[] 'HNat -> abt '[] 'HNat -> abt '[] ('HArray 'HProb)
unitV abt '[] 'HNat
s abt '[] 'HNat
i = abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] 'HProb) -> abt '[] ('HArray 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
array abt '[] 'HNat
s (\abt '[] 'HNat
j -> abt '[] HBool -> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] HBool -> abt '[] a -> abt '[] a -> abt '[] a
if_ (abt '[] 'HNat
i abt '[] 'HNat -> abt '[] 'HNat -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HEq_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
== abt '[] 'HNat
j) (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1) (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
0))

zipWithV
    :: (ABT Term abt)
    => (abt '[] a -> abt '[] b -> abt '[] c)
    -> abt '[] ('HArray a)
    -> abt '[] ('HArray b)
    -> abt '[] ('HArray c)
zipWithV :: (abt '[] a -> abt '[] b -> abt '[] c)
-> abt '[] ('HArray a)
-> abt '[] ('HArray b)
-> abt '[] ('HArray c)
zipWithV abt '[] a -> abt '[] b -> abt '[] c
f abt '[] ('HArray a)
v1 abt '[] ('HArray b)
v2 =
    abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] c) -> abt '[] ('HArray c)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
array (abt '[] ('HArray a) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray a)
v1) (\abt '[] 'HNat
i -> abt '[] a -> abt '[] b -> abt '[] c
f (abt '[] ('HArray a)
v1 abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
! abt '[] 'HNat
i) (abt '[] ('HArray b)
v2 abt '[] ('HArray b) -> abt '[] 'HNat -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
! abt '[] 'HNat
i))

----------------------------------------------------------------

r_fanout
    :: (ABT Term abt)
    => Reducer abt xs a
    -> Reducer abt xs b
    -> Reducer abt xs (HPair a b)
r_fanout :: Reducer abt xs a -> Reducer abt xs b -> Reducer abt xs (HPair a b)
r_fanout = Reducer abt xs a -> Reducer abt xs b -> Reducer abt xs (HPair a b)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru) (b :: Hakaru).
Reducer abt xs a -> Reducer abt xs b -> Reducer abt xs (HPair a b)
Red_Fanout

r_index
    :: (Binders Term abt xs as)
    => (as -> abt '[] 'HNat)
    -> ((abt '[] 'HNat, as) -> abt '[] 'HNat)
    -> Reducer abt ( 'HNat ': xs) a
    -> Reducer abt xs ('HArray a)
r_index :: (as -> abt '[] 'HNat)
-> ((abt '[] 'HNat, as) -> abt '[] 'HNat)
-> Reducer abt ('HNat : xs) a
-> Reducer abt xs ('HArray a)
r_index as -> abt '[] 'HNat
n (abt '[] 'HNat, as) -> abt '[] 'HNat
f = abt xs 'HNat
-> abt ('HNat : xs) 'HNat
-> Reducer abt ('HNat : xs) a
-> Reducer abt xs ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru).
abt xs 'HNat
-> abt ('HNat : xs) 'HNat
-> Reducer abt ('HNat : xs) a
-> Reducer abt xs ('HArray a)
Red_Index ((as -> abt '[] 'HNat) -> abt xs 'HNat
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) as (b :: k).
Binders syn abt xs as =>
(as -> abt '[] b) -> abt xs b
binders as -> abt '[] 'HNat
n) (((abt '[] 'HNat, as) -> abt '[] 'HNat) -> abt ('HNat : xs) 'HNat
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) as (b :: k).
Binders syn abt xs as =>
(as -> abt '[] b) -> abt xs b
binders (abt '[] 'HNat, as) -> abt '[] 'HNat
f)

r_split
    :: (Binders Term abt xs as)
    => ((abt '[] 'HNat, as) -> abt '[] HBool)
    -> Reducer abt xs a
    -> Reducer abt xs b
    -> Reducer abt xs (HPair a b)
r_split :: ((abt '[] 'HNat, as) -> abt '[] HBool)
-> Reducer abt xs a
-> Reducer abt xs b
-> Reducer abt xs (HPair a b)
r_split (abt '[] 'HNat, as) -> abt '[] HBool
b = abt ('HNat : xs) HBool
-> Reducer abt xs a
-> Reducer abt xs b
-> Reducer abt xs (HPair a b)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru) (b :: Hakaru).
abt ('HNat : xs) HBool
-> Reducer abt xs a
-> Reducer abt xs b
-> Reducer abt xs (HPair a b)
Red_Split (((abt '[] 'HNat, as) -> abt '[] HBool) -> abt ('HNat : xs) HBool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) as (b :: k).
Binders syn abt xs as =>
(as -> abt '[] b) -> abt xs b
binders (abt '[] 'HNat, as) -> abt '[] HBool
b)

r_nop :: (ABT Term abt) => Reducer abt xs HUnit
r_nop :: Reducer abt xs HUnit
r_nop = Reducer abt xs HUnit
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru]).
Reducer abt xs HUnit
Red_Nop

r_add
    :: (Binders Term abt xs as, HSemiring_ a)
    => ((abt '[] 'HNat, as) -> abt '[] a)
    -> Reducer abt xs a
r_add :: ((abt '[] 'HNat, as) -> abt '[] a) -> Reducer abt xs a
r_add (abt '[] 'HNat, as) -> abt '[] a
f = HSemiring a -> abt ('HNat : xs) a -> Reducer abt xs a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *)
       (xs :: [Hakaru]).
HSemiring a -> abt ('HNat : xs) a -> Reducer abt xs a
Red_Add HSemiring a
forall (a :: Hakaru). HSemiring_ a => HSemiring a
hSemiring (((abt '[] 'HNat, as) -> abt '[] a) -> abt ('HNat : xs) a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) as (b :: k).
Binders syn abt xs as =>
(as -> abt '[] b) -> abt xs b
binders (abt '[] 'HNat, as) -> abt '[] a
f)

bucket
    :: (ABT Term abt)
    => abt '[] 'HNat
    -> abt '[] 'HNat
    -> Reducer abt '[] a
    -> abt '[] a
bucket :: abt '[] 'HNat -> abt '[] 'HNat -> Reducer abt '[] a -> abt '[] a
bucket abt '[] 'HNat
i abt '[] 'HNat
j Reducer abt '[] a
r = Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt a -> abt '[] a) -> Term abt a -> abt '[] a
forall a b. (a -> b) -> a -> b
$ abt '[] 'HNat -> abt '[] 'HNat -> Reducer abt '[] a -> Term abt a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] 'HNat -> abt '[] 'HNat -> Reducer abt '[] a -> Term abt a
Bucket abt '[] 'HNat
i abt '[] 'HNat
j Reducer abt '[] a
r

----------------------------------------------------------------
(>>=)
    :: (ABT Term abt)
    => abt '[] ('HMeasure a)
    -> (abt '[] a -> abt '[] ('HMeasure b))
    -> abt '[] ('HMeasure b)
abt '[] ('HMeasure a)
m >>= :: abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= abt '[] a -> abt '[] ('HMeasure b)
f =
    Term abt ('HMeasure b) -> abt '[] ('HMeasure b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC ('HMeasure a), '( '[a], 'HMeasure b)] ('HMeasure b)
forall (a :: Hakaru) (a :: Hakaru).
SCon '[LC ('HMeasure a), '( '[a], 'HMeasure a)] ('HMeasure a)
MBind SCon '[LC ('HMeasure a), '( '[a], 'HMeasure b)] ('HMeasure b)
-> SArgs abt '[LC ('HMeasure a), '( '[a], 'HMeasure b)]
-> Term abt ('HMeasure b)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] ('HMeasure a)
m
               abt '[] ('HMeasure a)
-> SArgs abt '[ '( '[a], 'HMeasure b)]
-> SArgs abt '[LC ('HMeasure a), '( '[a], 'HMeasure b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Text
-> Sing a
-> (abt '[] a -> abt '[] ('HMeasure b))
-> abt '[a] ('HMeasure b)
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty (Sing ('HMeasure a) -> Sing a
forall (a :: Hakaru). Sing ('HMeasure a) -> Sing a
sUnMeasure (Sing ('HMeasure a) -> Sing a) -> Sing ('HMeasure a) -> Sing a
forall a b. (a -> b) -> a -> b
$ abt '[] ('HMeasure a) -> Sing ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] ('HMeasure a)
m) abt '[] a -> abt '[] ('HMeasure b)
f
               abt '[a] ('HMeasure b)
-> SArgs abt '[] -> SArgs abt '[ '( '[a], 'HMeasure b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)


dirac :: (ABT Term abt) => abt '[] a -> abt '[] ('HMeasure a)
dirac :: abt '[] a -> abt '[] ('HMeasure a)
dirac abt '[] a
e1 = Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC a] ('HMeasure a)
forall (a :: Hakaru). SCon '[LC a] ('HMeasure a)
Dirac SCon '[LC a] ('HMeasure a)
-> SArgs abt '[LC a] -> Term abt ('HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e1 abt '[] a -> SArgs abt '[] -> SArgs abt '[LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)


-- TODO: can we use let-binding instead of (>>=)-binding (i.e., for when the dirac is immediately (>>=)-bound again...)?
(<$>)
    :: (ABT Term abt, SingI a)
    => (abt '[] a -> abt '[] b)
    -> abt '[] ('HMeasure a)
    -> abt '[] ('HMeasure b)
abt '[] a -> abt '[] b
f <$> :: (abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] ('HMeasure a)
m = abt '[] ('HMeasure a)
m abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= abt '[] b -> abt '[] ('HMeasure b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac (abt '[] b -> abt '[] ('HMeasure b))
-> (abt '[] a -> abt '[] b) -> abt '[] a -> abt '[] ('HMeasure b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] a -> abt '[] b
f

-- | N.B, this function may introduce administrative redexes.
-- Moreover, it's not clear that we should even allow the type
-- @'HMeasure (a ':-> b)@!
(<*>)
    :: (ABT Term abt, SingI a, SingI b)
    => abt '[] ('HMeasure (a ':-> b))
    -> abt '[] ('HMeasure a)
    -> abt '[] ('HMeasure b)
abt '[] ('HMeasure (a ':-> b))
mf <*> :: abt '[] ('HMeasure (a ':-> b))
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<*> abt '[] ('HMeasure a)
mx = abt '[] ('HMeasure (a ':-> b))
mf abt '[] ('HMeasure (a ':-> b))
-> (abt '[] (a ':-> b) -> abt '[] ('HMeasure b))
-> abt '[] ('HMeasure b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] (a ':-> b)
f -> abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
app abt '[] (a ':-> b)
f (abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] ('HMeasure a)
mx

-- TODO: ensure that @dirac a *> n@ simplifies to just @n@, regardless of @a@ but especially when @a = unit@.
(*>), (>>)
    :: (ABT Term abt, SingI a)
    => abt '[] ('HMeasure a)
    -> abt '[] ('HMeasure b)
    -> abt '[] ('HMeasure b)
abt '[] ('HMeasure a)
m *> :: abt '[] ('HMeasure a)
-> abt '[] ('HMeasure b) -> abt '[] ('HMeasure b)
*> abt '[] ('HMeasure b)
n = abt '[] ('HMeasure a)
m abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] a
_ -> abt '[] ('HMeasure b)
n
>> :: abt '[] ('HMeasure a)
-> abt '[] ('HMeasure b) -> abt '[] ('HMeasure b)
(>>) = abt '[] ('HMeasure a)
-> abt '[] ('HMeasure b) -> abt '[] ('HMeasure b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] ('HMeasure a)
-> abt '[] ('HMeasure b) -> abt '[] ('HMeasure b)
(*>)

-- TODO: ensure that @m <* dirac a@ simplifies to just @m@, regardless of @a@ but especially when @a = unit@.
(<*)
    :: (ABT Term abt, SingI a, SingI b)
    => abt '[] ('HMeasure a)
    -> abt '[] ('HMeasure b)
    -> abt '[] ('HMeasure a)
abt '[] ('HMeasure a)
m <* :: abt '[] ('HMeasure a)
-> abt '[] ('HMeasure b) -> abt '[] ('HMeasure a)
<* abt '[] ('HMeasure b)
n = abt '[] ('HMeasure a)
m abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure a)) -> abt '[] ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] a
a -> abt '[] ('HMeasure b)
n abt '[] ('HMeasure b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] ('HMeasure a)
-> abt '[] ('HMeasure b) -> abt '[] ('HMeasure b)
*> abt '[] a -> abt '[] ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac abt '[] a
a

bindx
    :: (ABT Term abt, SingI a, SingI b)
    => abt '[] ('HMeasure a)
    -> (abt '[] a -> abt '[] ('HMeasure b))
    -> abt '[] ('HMeasure (HPair a b))
abt '[] ('HMeasure a)
m bindx :: abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b))
-> abt '[] ('HMeasure (HPair a b))
`bindx` abt '[] a -> abt '[] ('HMeasure b)
f = abt '[] ('HMeasure a)
m abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure (HPair a b)))
-> abt '[] ('HMeasure (HPair a b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] a
a -> abt '[] a -> abt '[] b -> abt '[] (HPair a b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a, SingI b) =>
abt '[] a -> abt '[] b -> abt '[] (HPair a b)
pair abt '[] a
a (abt '[] b -> abt '[] (HPair a b))
-> abt '[] ('HMeasure b) -> abt '[] ('HMeasure (HPair a b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] a -> abt '[] ('HMeasure b)
f abt '[] a
a

-- Defined because using @(<$>)@ and @(<*>)@ would introduce administrative redexes
liftM2
    :: (ABT Term abt, SingI a, SingI b)
    => (abt '[] a -> abt '[] b -> abt '[] c)
    -> abt '[] ('HMeasure a)
    -> abt '[] ('HMeasure b)
    -> abt '[] ('HMeasure c)
liftM2 :: (abt '[] a -> abt '[] b -> abt '[] c)
-> abt '[] ('HMeasure a)
-> abt '[] ('HMeasure b)
-> abt '[] ('HMeasure c)
liftM2 abt '[] a -> abt '[] b -> abt '[] c
f abt '[] ('HMeasure a)
m abt '[] ('HMeasure b)
n = abt '[] ('HMeasure a)
m abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure c)) -> abt '[] ('HMeasure c)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] a
x -> abt '[] a -> abt '[] b -> abt '[] c
f abt '[] a
x (abt '[] b -> abt '[] c)
-> abt '[] ('HMeasure b) -> abt '[] ('HMeasure c)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] ('HMeasure b)
n

lebesgue' :: (ABT Term abt) => abt '[] 'HReal -> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
lebesgue' :: abt '[] 'HReal -> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
lebesgue' = MeasureOp '[ 'HReal, 'HReal] 'HReal
-> abt '[] 'HReal -> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
MeasureOp '[a, b] c
-> abt '[] a -> abt '[] b -> abt '[] ('HMeasure c)
measure2_ MeasureOp '[ 'HReal, 'HReal] 'HReal
Lebesgue 

lebesgue :: (ABT Term abt) => abt '[] ('HMeasure 'HReal)
lebesgue :: abt '[] ('HMeasure 'HReal)
lebesgue = abt '[] 'HReal -> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
lebesgue' abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a, Integrable a) =>
abt '[] a
negativeInfinity abt '[] 'HReal
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(Integrable a, ABT Term abt) =>
abt '[] a
infinity 

counting :: (ABT Term abt) => abt '[] ('HMeasure 'HInt)
counting :: abt '[] ('HMeasure 'HInt)
counting = MeasureOp '[] 'HInt -> abt '[] ('HMeasure 'HInt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
MeasureOp '[] a -> abt '[] ('HMeasure a)
measure0_ MeasureOp '[] 'HInt
Counting

-- TODO: make this smarter by collapsing nested @Superpose_@ similar to how we collapse nested NaryOps. Though beware, that could cause duplication of the computation for the probabilities\/weights; thus may want to only do it when the weights are constant values, or \"simplify\" things by generating let-bindings in order to share work.
--
-- TODO: can we make this smarter enough to handle empty lists?
superpose
    :: (ABT Term abt)
    => NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
    -> abt '[] ('HMeasure a)
superpose :: NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> abt '[] ('HMeasure a)
superpose = Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt ('HMeasure a) -> abt '[] ('HMeasure a))
-> (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
    -> Term abt ('HMeasure a))
-> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> abt '[] ('HMeasure a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> Term abt ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> Term abt ('HMeasure a)
Superpose_

-- | The empty measure. Is called @fail@ in the Core Hakaru paper.
reject
    :: (ABT Term abt)
    => (Sing ('HMeasure a))
    -> abt '[] ('HMeasure a)
reject :: Sing ('HMeasure a) -> abt '[] ('HMeasure a)
reject = Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt ('HMeasure a) -> abt '[] ('HMeasure a))
-> (Sing ('HMeasure a) -> Term abt ('HMeasure a))
-> Sing ('HMeasure a)
-> abt '[] ('HMeasure a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing ('HMeasure a) -> Term abt ('HMeasure a)
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
Sing ('HMeasure a) -> Term abt ('HMeasure a)
Reject_

-- | The sum of two measures. Is called @mplus@ in the Core Hakaru paper.
(<|>) :: (ABT Term abt)
      => abt '[] ('HMeasure a)
      -> abt '[] ('HMeasure a)
      -> abt '[] ('HMeasure a)
abt '[] ('HMeasure a)
x <|> :: abt '[] ('HMeasure a)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure a)
<|> abt '[] ('HMeasure a)
y =
    NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> abt '[] ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> abt '[] ('HMeasure a)
superpose (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
 -> abt '[] ('HMeasure a))
-> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> abt '[] ('HMeasure a)
forall a b. (a -> b) -> a -> b
$
        case (abt '[] ('HMeasure a)
-> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
matchSuperpose abt '[] ('HMeasure a)
x, abt '[] ('HMeasure a)
-> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
matchSuperpose abt '[] ('HMeasure a)
y) of
        (Just NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
xs, Just NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
ys) -> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
xs NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
forall a. Semigroup a => a -> a -> a
<> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
ys
        (Just NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
xs, Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
Nothing) -> (abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a
one, abt '[] ('HMeasure a)
y) (abt '[] 'HProb, abt '[] ('HMeasure a))
-> [(abt '[] 'HProb, abt '[] ('HMeasure a))]
-> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
forall a. a -> [a] -> NonEmpty a
:| NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> [(abt '[] 'HProb, abt '[] ('HMeasure a))]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
xs -- HACK: reordering!
        (Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
Nothing, Just NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
ys) -> (abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a
one, abt '[] ('HMeasure a)
x) (abt '[] 'HProb, abt '[] ('HMeasure a))
-> [(abt '[] 'HProb, abt '[] ('HMeasure a))]
-> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
forall a. a -> [a] -> NonEmpty a
:| NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> [(abt '[] 'HProb, abt '[] ('HMeasure a))]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
ys
        (Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
Nothing, Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
Nothing) -> (abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a
one, abt '[] ('HMeasure a)
x) (abt '[] 'HProb, abt '[] ('HMeasure a))
-> [(abt '[] 'HProb, abt '[] ('HMeasure a))]
-> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
forall a. a -> [a] -> NonEmpty a
:| [(abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a
one, abt '[] ('HMeasure a)
y)]

matchSuperpose
    :: (ABT Term abt) 
    => abt '[] ('HMeasure a)
    -> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
matchSuperpose :: abt '[] ('HMeasure a)
-> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
matchSuperpose abt '[] ('HMeasure a)
e =
    abt '[] ('HMeasure a)
-> (Variable ('HMeasure a)
    -> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))))
-> (Term abt ('HMeasure a)
    -> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))))
-> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) r.
ABT syn abt =>
abt '[] a -> (Variable a -> r) -> (syn abt a -> r) -> r
caseVarSyn abt '[] ('HMeasure a)
e
        (Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
-> Variable ('HMeasure a)
-> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
forall a b. a -> b -> a
const Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
forall a. Maybe a
Nothing)
        ((Term abt ('HMeasure a)
  -> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))))
 -> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))))
-> (Term abt ('HMeasure a)
    -> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))))
-> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
forall a b. (a -> b) -> a -> b
$ \Term abt ('HMeasure a)
t ->
            case Term abt ('HMeasure a)
t of
            Superpose_ NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
xs -> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
forall a. a -> Maybe a
Just NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
xs
            Term abt ('HMeasure a)
_ -> Maybe (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
forall a. Maybe a
Nothing

-- TODO: we should ensure that the following reductions happen:
-- > (withWeight p m >> n) ---> withWeight p (m >> n)
-- > (m >> withWeight p n) ---> withWeight p (m >> n)
-- > withWeight 1 m ---> m
-- > withWeight p (withWeight q m) ---> withWeight (p*q) m
-- > (weight p >> m) ---> withWeight p m
--
-- | Adjust the weight of the current measure.
--
-- /N.B.,/ the name for this function is terribly inconsistent
-- across the literature, even just the Hakaru literature, let alone
-- the Hakaru code base. It is variously called \"factor\" or
-- \"weight\"; though \"factor\" is also used to mean the function
-- 'factor' or the function 'observe', and \"weight\" is also used
-- to mean the 'weight' function.
weight
    :: (ABT Term abt)
    => abt '[] 'HProb
    -> abt '[] ('HMeasure HUnit)
weight :: abt '[] 'HProb -> abt '[] ('HMeasure HUnit)
weight abt '[] 'HProb
p = abt '[] 'HProb
-> abt '[] ('HMeasure HUnit) -> abt '[] ('HMeasure HUnit)
forall (abt :: [Hakaru] -> Hakaru -> *) (w :: Hakaru).
ABT Term abt =>
abt '[] 'HProb -> abt '[] ('HMeasure w) -> abt '[] ('HMeasure w)
withWeight abt '[] 'HProb
p (abt '[] HUnit -> abt '[] ('HMeasure HUnit)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac abt '[] HUnit
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HUnit
unit)


-- | A variant of 'weight' which removes an administrative @(dirac
-- unit >>)@ redex.
--
-- TODO: ideally we'll be able to get rid of this function entirely,
-- and be able to trust optimization to clean up any redexes
-- introduced by 'weight'.
withWeight
    :: (ABT Term abt)
    => abt '[] 'HProb
    -> abt '[] ('HMeasure w)
    -> abt '[] ('HMeasure w)
withWeight :: abt '[] 'HProb -> abt '[] ('HMeasure w) -> abt '[] ('HMeasure w)
withWeight abt '[] 'HProb
p abt '[] ('HMeasure w)
m = Term abt ('HMeasure w) -> abt '[] ('HMeasure w)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt ('HMeasure w) -> abt '[] ('HMeasure w))
-> Term abt ('HMeasure w) -> abt '[] ('HMeasure w)
forall a b. (a -> b) -> a -> b
$ NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure w))
-> Term abt ('HMeasure w)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> Term abt ('HMeasure a)
Superpose_ ((abt '[] 'HProb
p, abt '[] ('HMeasure w)
m) (abt '[] 'HProb, abt '[] ('HMeasure w))
-> [(abt '[] 'HProb, abt '[] ('HMeasure w))]
-> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure w))
forall a. a -> [a] -> NonEmpty a
:| [])


-- | A particularly common use case of 'weight':
--
-- > weightedDirac e p
-- >     == weight p (dirac e)
-- >     == weight p *> dirac e
-- >     == dirac e <* weight p
weightedDirac
    :: (ABT Term abt, SingI a)
    => abt '[] a
    -> abt '[] 'HProb
    -> abt '[] ('HMeasure a)
weightedDirac :: abt '[] a -> abt '[] 'HProb -> abt '[] ('HMeasure a)
weightedDirac abt '[] a
e abt '[] 'HProb
p = abt '[] 'HProb -> abt '[] ('HMeasure a) -> abt '[] ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (w :: Hakaru).
ABT Term abt =>
abt '[] 'HProb -> abt '[] ('HMeasure w) -> abt '[] ('HMeasure w)
withWeight abt '[] 'HProb
p (abt '[] a -> abt '[] ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac abt '[] a
e)


-- TODO: this taking of two arguments is as per the Core Hakaru specification; but for the EDSL, can we rephrase this as just taking the first argument, using @dirac unit@ for the else-branch, and then, making @(>>)@ work in the right way to plug the continuation measure in place of the @dirac unit@.
-- TODO: would it help inference\/simplification at all to move this into the AST as a primitive? I mean, it is a primitive of Core Hakaru afterall... Also, that would help clarify whether the (first)argument should actually be an @HBool@ or whether it should be some sort of proposition.

-- | Assert that a condition is true.
--
-- /N.B.,/ the name for this function is terribly inconsistent
-- across the literature, even just the Hakaru literature, let alone
-- the Hakaru code base. It is variously called \"factor\" or
-- \"observe\"; though \"factor\" is also used to mean the function
-- 'pose', and \"observe\" is also used to mean the backwards part
-- of Lazy.hs.
guard
    :: (ABT Term abt)
    => abt '[] HBool
    -> abt '[] ('HMeasure HUnit)
guard :: abt '[] HBool -> abt '[] ('HMeasure HUnit)
guard abt '[] HBool
b = abt '[] HBool
-> abt '[] ('HMeasure HUnit) -> abt '[] ('HMeasure HUnit)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] HBool -> abt '[] ('HMeasure a) -> abt '[] ('HMeasure a)
withGuard abt '[] HBool
b (abt '[] HUnit -> abt '[] ('HMeasure HUnit)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac abt '[] HUnit
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HUnit
unit)


-- | A variant of 'guard' which removes an administrative @(dirac
-- unit >>)@ redex.
--
-- TODO: ideally we'll be able to get rid of this function entirely,
-- and be able to trust optimization to clean up any redexes
-- introduced by 'guard'.
withGuard
    :: (ABT Term abt)
    => abt '[] HBool
    -> abt '[] ('HMeasure a)
    -> abt '[] ('HMeasure a)
withGuard :: abt '[] HBool -> abt '[] ('HMeasure a) -> abt '[] ('HMeasure a)
withGuard abt '[] HBool
b abt '[] ('HMeasure a)
m = abt '[] HBool
-> abt '[] ('HMeasure a)
-> abt '[] ('HMeasure a)
-> abt '[] ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] HBool -> abt '[] a -> abt '[] a -> abt '[] a
if_ abt '[] HBool
b abt '[] ('HMeasure a)
m (Sing ('HMeasure a) -> abt '[] ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing ('HMeasure a) -> abt '[] ('HMeasure a)
reject (abt '[] ('HMeasure a) -> Sing ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] ('HMeasure a)
m))


densityCategorical
    :: (ABT Term abt)
    => abt '[] ('HArray 'HProb)
    -> abt '[] 'HNat
    -> abt '[] 'HProb
densityCategorical :: abt '[] ('HArray 'HProb) -> abt '[] 'HNat -> abt '[] 'HProb
densityCategorical abt '[] ('HArray 'HProb)
v abt '[] 'HNat
i = abt '[] ('HArray 'HProb)
v abt '[] ('HArray 'HProb) -> abt '[] 'HNat -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
! abt '[] 'HNat
i abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] ('HArray 'HProb) -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HArray 'HProb) -> abt '[] 'HProb
summateV abt '[] ('HArray 'HProb)
v

categorical, categorical'
    :: (ABT Term abt)
    => abt '[] ('HArray 'HProb)
    -> abt '[] ('HMeasure 'HNat)
categorical :: abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
categorical = MeasureOp '[ 'HArray 'HProb] 'HNat
-> abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
MeasureOp '[a] b -> abt '[] a -> abt '[] ('HMeasure b)
measure1_ MeasureOp '[ 'HArray 'HProb] 'HNat
Categorical

-- TODO: a variant of 'if_' which gives us the evidence that the argument is non-negative, so we don't need to coerce or use 'abs_'
categorical' :: abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
categorical' abt '[] ('HArray 'HProb)
v =
    abt '[] ('HMeasure 'HInt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HMeasure 'HInt)
counting abt '[] ('HMeasure 'HInt)
-> (abt '[] 'HInt -> abt '[] ('HMeasure 'HNat))
-> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HInt
i ->
    abt '[] HBool
-> abt '[] ('HMeasure 'HNat) -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] HBool -> abt '[] ('HMeasure a) -> abt '[] ('HMeasure a)
withGuard (Integer -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Integer -> abt '[] 'HInt
int_ Integer
0 abt '[] 'HInt -> abt '[] 'HInt -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
<= abt '[] 'HInt
i abt '[] HBool -> abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool -> abt '[] HBool -> abt '[] HBool
&& abt '[] 'HInt
i abt '[] 'HInt -> abt '[] 'HInt -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
< abt '[] 'HNat -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HNat -> abt '[] 'HInt
nat2int (abt '[] ('HArray 'HProb) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray 'HProb)
v)) (abt '[] ('HMeasure 'HNat) -> abt '[] ('HMeasure 'HNat))
-> abt '[] ('HMeasure 'HNat) -> abt '[] ('HMeasure 'HNat)
forall a b. (a -> b) -> a -> b
$
    abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] ('HMeasure 'HNat))
-> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] a -> (abt '[] a -> abt '[] b) -> abt '[] b
let_ (Coercion 'HNat 'HInt -> abt '[] 'HInt -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] b -> abt '[] a
unsafeFrom_ Coercion 'HNat 'HInt
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed abt '[] 'HInt
i) ((abt '[] 'HNat -> abt '[] ('HMeasure 'HNat))
 -> abt '[] ('HMeasure 'HNat))
-> (abt '[] 'HNat -> abt '[] ('HMeasure 'HNat))
-> abt '[] ('HMeasure 'HNat)
forall a b. (a -> b) -> a -> b
$ \abt '[] 'HNat
i_ ->
    abt '[] 'HNat -> abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] a -> abt '[] 'HProb -> abt '[] ('HMeasure a)
weightedDirac abt '[] 'HNat
i_ (abt '[] ('HArray 'HProb) -> abt '[] 'HNat -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HArray 'HProb) -> abt '[] 'HNat -> abt '[] 'HProb
densityCategorical abt '[] ('HArray 'HProb)
v abt '[] 'HNat
i_)


densityUniform
    :: (ABT Term abt)
    => abt '[] 'HReal
    -> abt '[] 'HReal
    -> abt '[] 'HReal
    -> abt '[] 'HProb
densityUniform :: abt '[] 'HReal
-> abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HProb
densityUniform abt '[] 'HReal
lo abt '[] 'HReal
hi abt '[] 'HReal
_ = abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a
recip (abt '[] 'HProb -> abt '[] 'HProb)
-> (abt '[] 'HReal -> abt '[] 'HProb)
-> abt '[] 'HReal
-> abt '[] 'HProb
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb
unsafeProb (abt '[] 'HReal -> abt '[] 'HProb)
-> abt '[] 'HReal -> abt '[] 'HProb
forall a b. (a -> b) -> a -> b
$ abt '[] 'HReal
hi abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
- abt '[] 'HReal
lo


-- TODO: make Uniform polymorphic, so that if the two inputs are
-- HProb then we know the measure must be over HProb too
uniform, uniform'
    :: (ABT Term abt)
    => abt '[] 'HReal
    -> abt '[] 'HReal
    -> abt '[] ('HMeasure 'HReal)
uniform :: abt '[] 'HReal -> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
uniform = MeasureOp '[ 'HReal, 'HReal] 'HReal
-> abt '[] 'HReal -> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
MeasureOp '[a, b] c
-> abt '[] a -> abt '[] b -> abt '[] ('HMeasure c)
measure2_ MeasureOp '[ 'HReal, 'HReal] 'HReal
Uniform

uniform' :: abt '[] 'HReal -> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
uniform' abt '[] 'HReal
lo abt '[] 'HReal
hi = 
    abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HMeasure 'HReal)
lebesgue abt '[] ('HMeasure 'HReal)
-> (abt '[] 'HReal -> abt '[] ('HMeasure 'HReal))
-> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HReal
x ->
    abt '[] HBool
-> abt '[] ('HMeasure 'HReal) -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] HBool -> abt '[] ('HMeasure a) -> abt '[] ('HMeasure a)
withGuard (abt '[] 'HReal
lo abt '[] 'HReal -> abt '[] 'HReal -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
< abt '[] 'HReal
x abt '[] HBool -> abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool -> abt '[] HBool -> abt '[] HBool
&& abt '[] 'HReal
x abt '[] 'HReal -> abt '[] 'HReal -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
< abt '[] 'HReal
hi) (abt '[] ('HMeasure 'HReal) -> abt '[] ('HMeasure 'HReal))
-> abt '[] ('HMeasure 'HReal) -> abt '[] ('HMeasure 'HReal)
forall a b. (a -> b) -> a -> b
$
        -- TODO: how can we capture that this 'unsafeProb' is safe? (and that this 'recip' isn't Infinity, for that matter)
    abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] a -> abt '[] 'HProb -> abt '[] ('HMeasure a)
weightedDirac abt '[] 'HReal
x (abt '[] 'HReal
-> abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal
-> abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HProb
densityUniform abt '[] 'HReal
lo abt '[] 'HReal
hi abt '[] 'HReal
x)

densityNormal
    :: (ABT Term abt)
    => abt '[] 'HReal
    -> abt '[] 'HProb
    -> abt '[] 'HReal
    -> abt '[] 'HProb
densityNormal :: abt '[] 'HReal
-> abt '[] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
densityNormal abt '[] 'HReal
mu abt '[] 'HProb
sd abt '[] 'HReal
x = 
    abt '[] 'HReal -> abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] a -> abt '[] 'HProb
exp (abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a
negate ((abt '[] 'HReal
x abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
- abt '[] 'HReal
mu) abt '[] 'HReal -> abt '[] 'HNat -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] 'HNat -> abt '[] a
^ Natural -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Natural -> abt '[] 'HNat
nat_ Natural
2)  -- TODO: use negative\/square instead of negate\/(^2)
         abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
2 abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HProb
sd abt '[] 'HProb -> abt '[] 'HNat -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] 'HNat -> abt '[] a
^ Natural -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Natural -> abt '[] 'HNat
nat_ Natural
2)) -- TODO: use square?
     abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] 'HProb
sd abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRadical_ a) =>
abt '[] a -> abt '[] a
sqrt (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
2 abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] a
pi)


normal, normal'
    :: (ABT Term abt)
    => abt '[] 'HReal
    -> abt '[] 'HProb
    -> abt '[] ('HMeasure 'HReal)
normal :: abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
normal = MeasureOp '[ 'HReal, 'HProb] 'HReal
-> abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
MeasureOp '[a, b] c
-> abt '[] a -> abt '[] b -> abt '[] ('HMeasure c)
measure2_ MeasureOp '[ 'HReal, 'HProb] 'HReal
Normal

normal' :: abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
normal' abt '[] 'HReal
mu abt '[] 'HProb
sd  = 
    abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HMeasure 'HReal)
lebesgue abt '[] ('HMeasure 'HReal)
-> (abt '[] 'HReal -> abt '[] ('HMeasure 'HReal))
-> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HReal
x ->
    abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] a -> abt '[] 'HProb -> abt '[] ('HMeasure a)
weightedDirac abt '[] 'HReal
x (abt '[] 'HReal
-> abt '[] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal
-> abt '[] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
densityNormal abt '[] 'HReal
mu abt '[] 'HProb
sd abt '[] 'HReal
x)


densityPoisson
    :: (ABT Term abt)
    => abt '[] 'HProb
    -> abt '[] 'HNat
    -> abt '[] 'HProb
densityPoisson :: abt '[] 'HProb -> abt '[] 'HNat -> abt '[] 'HProb
densityPoisson abt '[] 'HProb
l abt '[] 'HNat
x =
     abt '[] 'HProb
l abt '[] 'HProb -> abt '[] 'HNat -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] 'HNat -> abt '[] a
^ abt '[] 'HNat
x
       abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] 'HReal -> abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] a -> abt '[] 'HProb
gammaFunc (abt '[] 'HNat -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HNat -> abt '[] 'HReal
nat2real (abt '[] 'HNat
x abt '[] 'HNat -> abt '[] 'HNat -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
+ Natural -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Natural -> abt '[] 'HNat
nat_ Natural
1)) -- TODO: use factorial instead of gammaFunc...
       abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] 'HProb -> abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] a -> abt '[] 'HProb
exp abt '[] 'HProb
l


poisson, poisson'
    :: (ABT Term abt) => abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
poisson :: abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
poisson = MeasureOp '[ 'HProb] 'HNat
-> abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
MeasureOp '[a] b -> abt '[] a -> abt '[] ('HMeasure b)
measure1_ MeasureOp '[ 'HProb] 'HNat
Poisson

poisson' :: abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
poisson' abt '[] 'HProb
l = 
    abt '[] ('HMeasure 'HInt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HMeasure 'HInt)
counting abt '[] ('HMeasure 'HInt)
-> (abt '[] 'HInt -> abt '[] ('HMeasure 'HNat))
-> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HInt
x ->
    -- TODO: use 'SafeFrom_' instead of @if_ (x >= int_ 0)@ so we can prove that @unsafeFrom_ signed x@ is actually always safe.
    abt '[] HBool
-> abt '[] ('HMeasure 'HNat) -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] HBool -> abt '[] ('HMeasure a) -> abt '[] ('HMeasure a)
withGuard (Integer -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Integer -> abt '[] 'HInt
int_ Integer
0 abt '[] 'HInt -> abt '[] 'HInt -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
<= abt '[] 'HInt
x abt '[] HBool -> abt '[] HBool -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool -> abt '[] HBool -> abt '[] HBool
&& NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
0 abt '[] 'HProb -> abt '[] 'HProb -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
< abt '[] 'HProb
l) (abt '[] ('HMeasure 'HNat) -> abt '[] ('HMeasure 'HNat))
-> abt '[] ('HMeasure 'HNat) -> abt '[] ('HMeasure 'HNat)
forall a b. (a -> b) -> a -> b
$ -- N.B., @0 < l@ means simply that @l /= 0@; why phrase it the other way?
    abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] ('HMeasure 'HNat))
-> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] a -> (abt '[] a -> abt '[] b) -> abt '[] b
let_ (Coercion 'HNat 'HInt -> abt '[] 'HInt -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Coercion a b -> abt '[] b -> abt '[] a
unsafeFrom_ Coercion 'HNat 'HInt
forall (a :: Hakaru). HRing_ a => Coercion (NonNegative a) a
signed abt '[] 'HInt
x) ((abt '[] 'HNat -> abt '[] ('HMeasure 'HNat))
 -> abt '[] ('HMeasure 'HNat))
-> (abt '[] 'HNat -> abt '[] ('HMeasure 'HNat))
-> abt '[] ('HMeasure 'HNat)
forall a b. (a -> b) -> a -> b
$ \abt '[] 'HNat
x_ ->
        abt '[] 'HNat -> abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] a -> abt '[] 'HProb -> abt '[] ('HMeasure a)
weightedDirac abt '[] 'HNat
x_ (abt '[] 'HProb -> abt '[] 'HNat -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HNat -> abt '[] 'HProb
densityPoisson abt '[] 'HProb
l abt '[] 'HNat
x_)

densityGamma
    :: (ABT Term abt)
    => abt '[] 'HProb
    -> abt '[] 'HProb
    -> abt '[] 'HProb
    -> abt '[] 'HProb
densityGamma :: abt '[] 'HProb
-> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
densityGamma abt '[] 'HProb
shape abt '[] 'HProb
scale abt '[] 'HProb
x =
    abt '[] 'HProb
x abt '[] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] 'HProb -> abt '[] a -> abt '[] 'HProb
** (abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb abt '[] 'HProb
shape abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
- Rational -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_ Rational
1)
    abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HReal -> abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] a -> abt '[] 'HProb
exp (abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a
negate (abt '[] 'HReal -> abt '[] 'HReal)
-> (abt '[] 'HProb -> abt '[] 'HReal)
-> abt '[] 'HProb
-> abt '[] 'HReal
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb (abt '[] 'HProb -> abt '[] 'HReal)
-> abt '[] 'HProb -> abt '[] 'HReal
forall a b. (a -> b) -> a -> b
$ abt '[] 'HProb
x abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] 'HProb
scale)
    abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ (abt '[] 'HProb
scale abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] 'HProb -> abt '[] a -> abt '[] 'HProb
** abt '[] 'HProb
shape abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HProb -> abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] a -> abt '[] 'HProb
gammaFunc abt '[] 'HProb
shape)


gamma, gamma'
    :: (ABT Term abt)
    => abt '[] 'HProb
    -> abt '[] 'HProb
    -> abt '[] ('HMeasure 'HProb)
gamma :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
gamma = MeasureOp '[ 'HProb, 'HProb] 'HProb
-> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
MeasureOp '[a, b] c
-> abt '[] a -> abt '[] b -> abt '[] ('HMeasure c)
measure2_ MeasureOp '[ 'HProb, 'HProb] 'HProb
Gamma

gamma' :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
gamma' abt '[] 'HProb
shape abt '[] 'HProb
scale =
    abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HMeasure 'HReal)
lebesgue abt '[] ('HMeasure 'HReal)
-> (abt '[] 'HReal -> abt '[] ('HMeasure 'HProb))
-> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HReal
x ->
    -- TODO: use 'SafeFrom_' instead of @if_ (real_ 0 < x)@ so we can prove that @unsafeProb x@ is actually always safe. Of course, then we'll need to mess around with checking (/=0) which'll get ugly... Use another SafeFrom_ with an associated NonZero type?
    abt '[] HBool
-> abt '[] ('HMeasure 'HProb) -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] HBool -> abt '[] ('HMeasure a) -> abt '[] ('HMeasure a)
withGuard (Rational -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_ Rational
0 abt '[] 'HReal -> abt '[] 'HReal -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HOrd_ a) =>
abt '[] a -> abt '[] a -> abt '[] HBool
< abt '[] 'HReal
x) (abt '[] ('HMeasure 'HProb) -> abt '[] ('HMeasure 'HProb))
-> abt '[] ('HMeasure 'HProb) -> abt '[] ('HMeasure 'HProb)
forall a b. (a -> b) -> a -> b
$
    abt '[] 'HProb
-> (abt '[] 'HProb -> abt '[] ('HMeasure 'HProb))
-> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] a -> (abt '[] a -> abt '[] b) -> abt '[] b
let_ (abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb
unsafeProb abt '[] 'HReal
x) ((abt '[] 'HProb -> abt '[] ('HMeasure 'HProb))
 -> abt '[] ('HMeasure 'HProb))
-> (abt '[] 'HProb -> abt '[] ('HMeasure 'HProb))
-> abt '[] ('HMeasure 'HProb)
forall a b. (a -> b) -> a -> b
$ \ abt '[] 'HProb
x_ ->
    abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] a -> abt '[] 'HProb -> abt '[] ('HMeasure a)
weightedDirac abt '[] 'HProb
x_ (abt '[] 'HProb
-> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb
-> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
densityGamma abt '[] 'HProb
shape abt '[] 'HProb
scale abt '[] 'HProb
x_)

densityBeta
    :: (ABT Term abt)
    => abt '[] 'HProb
    -> abt '[] 'HProb
    -> abt '[] 'HProb
    -> abt '[] 'HProb
densityBeta :: abt '[] 'HProb
-> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
densityBeta abt '[] 'HProb
a abt '[] 'HProb
b abt '[] 'HProb
x =
    abt '[] 'HProb
x abt '[] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] 'HProb -> abt '[] a -> abt '[] 'HProb
** (abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb abt '[] 'HProb
a abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
- Rational -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_ Rational
1)
    abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb
unsafeProb (Rational -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_ Rational
1 abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
- abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb abt '[] 'HProb
x) abt '[] 'HProb -> abt '[] 'HReal -> abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] 'HProb -> abt '[] a -> abt '[] 'HProb
** (abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb abt '[] 'HProb
b abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRing_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
- Rational -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_ Rational
1)
    abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
betaFunc abt '[] 'HProb
a abt '[] 'HProb
b

beta, beta', beta''
    :: (ABT Term abt)
    => abt '[] 'HProb
    -> abt '[] 'HProb
    -> abt '[] ('HMeasure 'HProb)
beta :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
beta = MeasureOp '[ 'HProb, 'HProb] 'HProb
-> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
MeasureOp '[a, b] c
-> abt '[] a -> abt '[] b -> abt '[] ('HMeasure c)
measure2_ MeasureOp '[ 'HProb, 'HProb] 'HProb
Beta

beta' :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
beta' abt '[] 'HProb
a abt '[] 'HProb
b =
    -- TODO: make Uniform polymorphic, so that if the two inputs are HProb then we know the measure must be over HProb too, and hence @unsafeProb x@ must always be safe. Alas, capturing the safety of @unsafeProb (1-x)@ would take a lot more work...
    abt '[] 'HReal -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb
unsafeProb (abt '[] 'HReal -> abt '[] 'HProb)
-> abt '[] ('HMeasure 'HReal) -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] 'HReal -> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
uniform (Rational -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_ Rational
0) (Rational -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_ Rational
1) abt '[] ('HMeasure 'HProb)
-> (abt '[] 'HProb -> abt '[] ('HMeasure 'HProb))
-> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HProb
x ->
    abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] a -> abt '[] 'HProb -> abt '[] ('HMeasure a)
weightedDirac abt '[] 'HProb
x (abt '[] 'HProb
-> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb
-> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
densityBeta abt '[] 'HProb
a abt '[] 'HProb
b abt '[] 'HProb
x)

beta'' :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
beta'' abt '[] 'HProb
a abt '[] 'HProb
b =
    abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
gamma abt '[] 'HProb
a (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1) abt '[] ('HMeasure 'HProb)
-> (abt '[] 'HProb -> abt '[] ('HMeasure 'HProb))
-> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HProb
x ->
    abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
gamma abt '[] 'HProb
b (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1) abt '[] ('HMeasure 'HProb)
-> (abt '[] 'HProb -> abt '[] ('HMeasure 'HProb))
-> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HProb
y ->
    abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac (abt '[] 'HProb
x abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ (abt '[] 'HProb
xabt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
+abt '[] 'HProb
y))

plateWithVar
    :: (ABT Term abt)
    => abt '[] 'HNat
    -> Variable 'HNat
    -> abt '[] ('HMeasure a)
    -> abt '[] ('HMeasure ('HArray a))
plateWithVar :: abt '[] 'HNat
-> Variable 'HNat
-> abt '[] ('HMeasure a)
-> abt '[] ('HMeasure ('HArray a))
plateWithVar abt '[] 'HNat
e1 Variable 'HNat
x abt '[] ('HMeasure a)
e2 = Term abt ('HMeasure ('HArray a)) -> abt '[] ('HMeasure ('HArray a))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
forall (a :: Hakaru).
SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
Plate SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
-> SArgs abt '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)]
-> Term abt ('HMeasure ('HArray a))
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HNat
e1 abt '[] 'HNat
-> SArgs abt '[ '( '[ 'HNat], 'HMeasure a)]
-> SArgs abt '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Variable 'HNat
-> abt '[] ('HMeasure a) -> abt '[ 'HNat] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable 'HNat
x abt '[] ('HMeasure a)
e2 abt '[ 'HNat] ('HMeasure a)
-> SArgs abt '[] -> SArgs abt '[ '( '[ 'HNat], 'HMeasure a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        
plate :: (ABT Term abt)
      => abt '[] 'HNat
      -> (abt '[] 'HNat -> abt '[] ('HMeasure a))
      -> abt '[] ('HMeasure ('HArray a))
plate :: abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] ('HMeasure a))
-> abt '[] ('HMeasure ('HArray a))
plate abt '[] 'HNat
e abt '[] 'HNat -> abt '[] ('HMeasure a)
f = Term abt ('HMeasure ('HArray a)) -> abt '[] ('HMeasure ('HArray a))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
forall (a :: Hakaru).
SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
Plate SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
-> SArgs abt '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)]
-> Term abt ('HMeasure ('HArray a))
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HNat
e abt '[] 'HNat
-> SArgs abt '[ '( '[ 'HNat], 'HMeasure a)]
-> SArgs abt '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Text
-> Sing 'HNat
-> (abt '[] 'HNat -> abt '[] ('HMeasure a))
-> abt '[ 'HNat] ('HMeasure a)
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty Sing 'HNat
forall k (a :: k). SingI a => Sing a
sing abt '[] 'HNat -> abt '[] ('HMeasure a)
f abt '[ 'HNat] ('HMeasure a)
-> SArgs abt '[] -> SArgs abt '[ '( '[ 'HNat], 'HMeasure a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

plate'
    :: (ABT Term abt, SingI a)
    => abt '[] ('HArray ('HMeasure          a))
    -> abt '[] (         'HMeasure ('HArray a))

plate' :: abt '[] ('HArray ('HMeasure a)) -> abt '[] ('HMeasure ('HArray a))
plate' abt '[] ('HArray ('HMeasure a))
v = (abt '[] ('HMeasure ('HArray a))
 -> abt '[] ('HMeasure ('HArray a))
 -> abt '[] ('HMeasure ('HArray a)))
-> abt '[] ('HMeasure ('HArray a))
-> abt '[] ('HArray ('HMeasure ('HArray a)))
-> abt '[] ('HMeasure ('HArray a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
(abt '[] a -> abt '[] a -> abt '[] a)
-> abt '[] a -> abt '[] ('HArray a) -> abt '[] a
reduce abt '[] ('HMeasure ('HArray a))
-> abt '[] ('HMeasure ('HArray a))
-> abt '[] ('HMeasure ('HArray a))
r abt '[] ('HMeasure ('HArray a))
z ((abt '[] ('HMeasure a) -> abt '[] ('HMeasure ('HArray a)))
-> abt '[] ('HArray ('HMeasure a))
-> abt '[] ('HArray ('HMeasure ('HArray a)))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HArray a) -> abt '[] ('HArray b)
mapV abt '[] ('HMeasure a) -> abt '[] ('HMeasure ('HArray a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] ('HMeasure a) -> abt '[] ('HMeasure ('HArray a))
m abt '[] ('HArray ('HMeasure a))
v)
    where
    r :: abt '[] ('HMeasure ('HArray a))
-> abt '[] ('HMeasure ('HArray a))
-> abt '[] ('HMeasure ('HArray a))
r   = (abt '[] ('HArray a) -> abt '[] ('HArray a) -> abt '[] ('HArray a))
-> abt '[] ('HMeasure ('HArray a))
-> abt '[] ('HMeasure ('HArray a))
-> abt '[] ('HMeasure ('HArray a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
(ABT Term abt, SingI a, SingI b) =>
(abt '[] a -> abt '[] b -> abt '[] c)
-> abt '[] ('HMeasure a)
-> abt '[] ('HMeasure b)
-> abt '[] ('HMeasure c)
liftM2 abt '[] ('HArray a) -> abt '[] ('HArray a) -> abt '[] ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] ('HArray a) -> abt '[] ('HArray a)
appendV
    z :: abt '[] ('HMeasure ('HArray a))
z   = abt '[] ('HArray a) -> abt '[] ('HMeasure ('HArray a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac abt '[] ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] ('HArray a)
empty
    m :: abt '[] ('HMeasure a) -> abt '[] ('HMeasure ('HArray a))
m abt '[] ('HMeasure a)
a = (abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
array (Natural -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Natural -> abt '[] 'HNat
nat_ Natural
1) ((abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a))
-> (abt '[] a -> abt '[] 'HNat -> abt '[] a)
-> abt '[] a
-> abt '[] ('HArray a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] a -> abt '[] 'HNat -> abt '[] a
forall a b. a -> b -> a
const) (abt '[] a -> abt '[] ('HArray a))
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure ('HArray a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] ('HMeasure a)
a


-- BUG: remove the 'SingI' requirement!
chain :: (ABT Term abt, SingI s)
      => abt '[] 'HNat
      -> abt '[] s
      -> (abt '[] s -> abt '[] ('HMeasure (HPair a s)))
      -> abt '[] ('HMeasure (HPair ('HArray a) s))
chain :: abt '[] 'HNat
-> abt '[] s
-> (abt '[] s -> abt '[] ('HMeasure (HPair a s)))
-> abt '[] ('HMeasure (HPair ('HArray a) s))
chain abt '[] 'HNat
n abt '[] s
s abt '[] s -> abt '[] ('HMeasure (HPair a s))
f = Term abt ('HMeasure (HPair ('HArray a) s))
-> abt '[] ('HMeasure (HPair ('HArray a) s))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon
  '[LC 'HNat, LC s, '( '[s], 'HMeasure (HPair a s))]
  ('HMeasure (HPair ('HArray a) s))
forall (s :: Hakaru) (a :: Hakaru).
SCon
  '[LC 'HNat, LC s, '( '[s], 'HMeasure (HPair a s))]
  ('HMeasure (HPair ('HArray a) s))
Chain SCon
  '[LC 'HNat, LC s, '( '[s], 'HMeasure (HPair a s))]
  ('HMeasure (HPair ('HArray a) s))
-> SArgs abt '[LC 'HNat, LC s, '( '[s], 'HMeasure (HPair a s))]
-> Term abt ('HMeasure (HPair ('HArray a) s))
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HNat
n abt '[] 'HNat
-> SArgs abt '[LC s, '( '[s], 'HMeasure (HPair a s))]
-> SArgs abt '[LC 'HNat, LC s, '( '[s], 'HMeasure (HPair a s))]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] s
s abt '[] s
-> SArgs abt '[ '( '[s], 'HMeasure (HPair a s))]
-> SArgs abt '[LC s, '( '[s], 'HMeasure (HPair a s))]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Text
-> Sing s
-> (abt '[] s -> abt '[] ('HMeasure (HPair a s)))
-> abt '[s] ('HMeasure (HPair a s))
forall a1 (syn :: ([a1] -> a1 -> *) -> a1 -> *)
       (abt :: [a1] -> a1 -> *) (a2 :: a1) (xs :: [a1]) (b :: a1).
ABT syn abt =>
Text -> Sing a2 -> (abt '[] a2 -> abt xs b) -> abt (a2 : xs) b
binder Text
Text.empty Sing s
forall k (a :: k). SingI a => Sing a
sing abt '[] s -> abt '[] ('HMeasure (HPair a s))
f abt '[s] ('HMeasure (HPair a s))
-> SArgs abt '[] -> SArgs abt '[ '( '[s], 'HMeasure (HPair a s))]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

chain'
    :: (ABT Term abt, SingI s, SingI a)
    => abt '[] ('HArray (s ':-> 'HMeasure (HPair a s)))
    -> abt '[] s
    -> abt '[] ('HMeasure (HPair ('HArray a) s))

chain' :: abt '[] ('HArray (s ':-> 'HMeasure (HPair a s)))
-> abt '[] s -> abt '[] ('HMeasure (HPair ('HArray a) s))
chain' abt '[] ('HArray (s ':-> 'HMeasure (HPair a s)))
v abt '[] s
s0 = (abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
 -> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
 -> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s)))
-> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
-> abt '[] ('HArray (s ':-> 'HMeasure (HPair ('HArray a) s)))
-> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
(abt '[] a -> abt '[] a -> abt '[] a)
-> abt '[] a -> abt '[] ('HArray a) -> abt '[] a
reduce abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
-> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
-> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (a :: Hakaru)
       (b :: Hakaru) (a :: Hakaru).
(ABT Term abt, SingI a, SingI a, SingI b) =>
abt '[] (a ':-> 'HMeasure (HPair ('HArray a) a))
-> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
-> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
r abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
z ((abt '[] (s ':-> 'HMeasure (HPair a s))
 -> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s)))
-> abt '[] ('HArray (s ':-> 'HMeasure (HPair a s)))
-> abt '[] ('HArray (s ':-> 'HMeasure (HPair ('HArray a) s)))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HArray a) -> abt '[] ('HArray b)
mapV abt '[] (s ':-> 'HMeasure (HPair a s))
-> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a, SingI a, SingI b) =>
abt '[] (a ':-> 'HMeasure (HPair a b))
-> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
m abt '[] ('HArray (s ':-> 'HMeasure (HPair a s)))
v) abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
-> abt '[] s -> abt '[] ('HMeasure (HPair ('HArray a) s))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
`app` abt '[] s
s0
    where
    r :: abt '[] (a ':-> 'HMeasure (HPair ('HArray a) a))
-> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
-> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
r abt '[] (a ':-> 'HMeasure (HPair ('HArray a) a))
x abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
y = (abt '[] a -> abt '[] ('HMeasure (HPair ('HArray a) b)))
-> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b) -> abt '[] (a ':-> b)
lam ((abt '[] a -> abt '[] ('HMeasure (HPair ('HArray a) b)))
 -> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b)))
-> (abt '[] a -> abt '[] ('HMeasure (HPair ('HArray a) b)))
-> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
forall a b. (a -> b) -> a -> b
$ \abt '[] a
s ->
            abt '[] (a ':-> 'HMeasure (HPair ('HArray a) a))
-> abt '[] a -> abt '[] ('HMeasure (HPair ('HArray a) a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
app abt '[] (a ':-> 'HMeasure (HPair ('HArray a) a))
x abt '[] a
s abt '[] ('HMeasure (HPair ('HArray a) a))
-> (abt '[] (HPair ('HArray a) a)
    -> abt '[] ('HMeasure (HPair ('HArray a) b)))
-> abt '[] ('HMeasure (HPair ('HArray a) b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] (HPair ('HArray a) a)
v1s1 ->
            abt '[] (HPair ('HArray a) a)
v1s1 abt '[] (HPair ('HArray a) a)
-> (abt '[] ('HArray a)
    -> abt '[] a -> abt '[] ('HMeasure (HPair ('HArray a) b)))
-> abt '[] ('HMeasure (HPair ('HArray a) b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] c) -> abt '[] c
`unpair` \abt '[] ('HArray a)
v1 abt '[] a
s1 ->
            abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
-> abt '[] a -> abt '[] ('HMeasure (HPair ('HArray a) b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
app abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
y abt '[] a
s1 abt '[] ('HMeasure (HPair ('HArray a) b))
-> (abt '[] (HPair ('HArray a) b)
    -> abt '[] ('HMeasure (HPair ('HArray a) b)))
-> abt '[] ('HMeasure (HPair ('HArray a) b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] (HPair ('HArray a) b)
v2s2 ->
            abt '[] (HPair ('HArray a) b)
v2s2 abt '[] (HPair ('HArray a) b)
-> (abt '[] ('HArray a)
    -> abt '[] b -> abt '[] ('HMeasure (HPair ('HArray a) b)))
-> abt '[] ('HMeasure (HPair ('HArray a) b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] c) -> abt '[] c
`unpair` \abt '[] ('HArray a)
v2 abt '[] b
s2 ->
            abt '[] (HPair ('HArray a) b)
-> abt '[] ('HMeasure (HPair ('HArray a) b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac (abt '[] (HPair ('HArray a) b)
 -> abt '[] ('HMeasure (HPair ('HArray a) b)))
-> abt '[] (HPair ('HArray a) b)
-> abt '[] ('HMeasure (HPair ('HArray a) b))
forall a b. (a -> b) -> a -> b
$ abt '[] ('HArray a) -> abt '[] b -> abt '[] (HPair ('HArray a) b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a, SingI b) =>
abt '[] a -> abt '[] b -> abt '[] (HPair a b)
pair (abt '[] ('HArray a) -> abt '[] ('HArray a) -> abt '[] ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] ('HArray a) -> abt '[] ('HArray a)
appendV abt '[] ('HArray a)
v1 abt '[] ('HArray a)
v2) abt '[] b
s2
    z :: abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
z     = (abt '[] s -> abt '[] ('HMeasure (HPair ('HArray a) s)))
-> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b) -> abt '[] (a ':-> b)
lam ((abt '[] s -> abt '[] ('HMeasure (HPair ('HArray a) s)))
 -> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s)))
-> (abt '[] s -> abt '[] ('HMeasure (HPair ('HArray a) s)))
-> abt '[] (s ':-> 'HMeasure (HPair ('HArray a) s))
forall a b. (a -> b) -> a -> b
$ \abt '[] s
s -> abt '[] (HPair ('HArray a) s)
-> abt '[] ('HMeasure (HPair ('HArray a) s))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac (abt '[] ('HArray a) -> abt '[] s -> abt '[] (HPair ('HArray a) s)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a, SingI b) =>
abt '[] a -> abt '[] b -> abt '[] (HPair a b)
pair abt '[] ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, SingI a) =>
abt '[] ('HArray a)
empty abt '[] s
s)
    m :: abt '[] (a ':-> 'HMeasure (HPair a b))
-> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
m abt '[] (a ':-> 'HMeasure (HPair a b))
a   = (abt '[] a -> abt '[] ('HMeasure (HPair ('HArray a) b)))
-> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b) -> abt '[] (a ':-> b)
lam ((abt '[] a -> abt '[] ('HMeasure (HPair ('HArray a) b)))
 -> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b)))
-> (abt '[] a -> abt '[] ('HMeasure (HPair ('HArray a) b)))
-> abt '[] (a ':-> 'HMeasure (HPair ('HArray a) b))
forall a b. (a -> b) -> a -> b
$ \abt '[] a
s -> (abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] (HPair ('HArray a) b))
-> abt '[] (HPair ('HArray a) b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
abt '[] (HPair a b)
-> (abt '[] a -> abt '[] b -> abt '[] c) -> abt '[] c
`unpair` abt '[] ('HArray a) -> abt '[] b -> abt '[] (HPair ('HArray a) b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a, SingI b) =>
abt '[] a -> abt '[] b -> abt '[] (HPair a b)
pair (abt '[] ('HArray a) -> abt '[] b -> abt '[] (HPair ('HArray a) b))
-> (abt '[] a -> abt '[] ('HArray a))
-> abt '[] a
-> abt '[] b
-> abt '[] (HPair ('HArray a) b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a)
array (Natural -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Natural -> abt '[] 'HNat
nat_ Natural
1) ((abt '[] 'HNat -> abt '[] a) -> abt '[] ('HArray a))
-> (abt '[] a -> abt '[] 'HNat -> abt '[] a)
-> abt '[] a
-> abt '[] ('HArray a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] a -> abt '[] 'HNat -> abt '[] a
forall a b. a -> b -> a
const) (abt '[] (HPair a b) -> abt '[] (HPair ('HArray a) b))
-> abt '[] ('HMeasure (HPair a b))
-> abt '[] ('HMeasure (HPair ('HArray a) b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] (a ':-> 'HMeasure (HPair a b))
-> abt '[] a -> abt '[] ('HMeasure (HPair a b))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] (a ':-> b) -> abt '[] a -> abt '[] b
app abt '[] (a ':-> 'HMeasure (HPair a b))
a abt '[] a
s


invgamma
    :: (ABT Term abt)
    => abt '[] 'HProb
    -> abt '[] 'HProb
    -> abt '[] ('HMeasure 'HProb)
invgamma :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
invgamma abt '[] 'HProb
k abt '[] 'HProb
t = abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a
recip (abt '[] 'HProb -> abt '[] 'HProb)
-> abt '[] ('HMeasure 'HProb) -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
gamma abt '[] 'HProb
k (abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a
recip abt '[] 'HProb
t)

exponential
    :: (ABT Term abt) => abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
exponential :: abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
exponential = abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
gamma (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1)

chi2 :: (ABT Term abt) => abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
chi2 :: abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
chi2 abt '[] 'HProb
v = abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
gamma (abt '[] 'HProb
v abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
2) (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
2)

cauchy
    :: (ABT Term abt)
    => abt '[] 'HReal
    -> abt '[] 'HProb
    -> abt '[] ('HMeasure 'HReal)
cauchy :: abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
cauchy abt '[] 'HReal
loc abt '[] 'HProb
scale =
    abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
normal (Rational -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_ Rational
0) (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1) abt '[] ('HMeasure 'HReal)
-> (abt '[] 'HReal -> abt '[] ('HMeasure 'HReal))
-> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HReal
x ->
    abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
normal (Rational -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_ Rational
0) (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1) abt '[] ('HMeasure 'HReal)
-> (abt '[] 'HReal -> abt '[] ('HMeasure 'HReal))
-> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HReal
y ->
    abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac (abt '[] 'HReal -> abt '[] ('HMeasure 'HReal))
-> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
forall a b. (a -> b) -> a -> b
$ abt '[] 'HReal
loc abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
+ abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb abt '[] 'HProb
scale abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HReal
x abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] 'HReal
y

laplace
    :: (ABT Term abt)
    => abt '[] 'HReal
    -> abt '[] 'HProb
    -> abt '[] ('HMeasure 'HReal)
laplace :: abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
laplace abt '[] 'HReal
loc abt '[] 'HProb
scale =
    abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
exponential (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1) abt '[] ('HMeasure 'HProb)
-> (abt '[] 'HProb -> abt '[] ('HMeasure 'HReal))
-> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HProb
v ->
    abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
normal (Rational -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Rational -> abt '[] 'HReal
real_ Rational
0) (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1) abt '[] ('HMeasure 'HReal)
-> (abt '[] 'HReal -> abt '[] ('HMeasure 'HReal))
-> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HReal
z ->
    abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac (abt '[] 'HReal -> abt '[] ('HMeasure 'HReal))
-> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
forall a b. (a -> b) -> a -> b
$ abt '[] 'HReal
loc abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
+ abt '[] 'HReal
z abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb (abt '[] 'HProb
scale abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRadical_ a) =>
abt '[] a -> abt '[] a
sqrt (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
2 abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HProb
v))

studentT
    :: (ABT Term abt)
    => abt '[] 'HReal
    -> abt '[] 'HProb
    -> abt '[] 'HProb
    -> abt '[] ('HMeasure 'HReal)
studentT :: abt '[] 'HReal
-> abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
studentT abt '[] 'HReal
loc abt '[] 'HProb
scale abt '[] 'HProb
v =
    abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HReal -> abt '[] 'HProb -> abt '[] ('HMeasure 'HReal)
normal abt '[] 'HReal
loc abt '[] 'HProb
scale abt '[] ('HMeasure 'HReal)
-> (abt '[] 'HReal -> abt '[] ('HMeasure 'HReal))
-> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HReal
z ->
    abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
chi2 abt '[] 'HProb
v abt '[] ('HMeasure 'HProb)
-> (abt '[] 'HProb -> abt '[] ('HMeasure 'HReal))
-> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HProb
df ->
    abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac (abt '[] 'HReal -> abt '[] ('HMeasure 'HReal))
-> abt '[] 'HReal -> abt '[] ('HMeasure 'HReal)
forall a b. (a -> b) -> a -> b
$ abt '[] 'HReal
z abt '[] 'HReal -> abt '[] 'HReal -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HProb -> abt '[] 'HReal
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HReal
fromProb (abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HRadical_ a) =>
abt '[] a -> abt '[] a
sqrt (abt '[] 'HProb
v abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
/ abt '[] 'HProb
df))

weibull
    :: (ABT Term abt)
    => abt '[] 'HProb
    -> abt '[] 'HProb
    -> abt '[] ('HMeasure 'HProb)
weibull :: abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
weibull abt '[] 'HProb
b abt '[] 'HProb
k =
    abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
exponential (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1) abt '[] ('HMeasure 'HProb)
-> (abt '[] 'HProb -> abt '[] ('HMeasure 'HProb))
-> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HProb
x ->
    abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac (abt '[] 'HProb -> abt '[] ('HMeasure 'HProb))
-> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall a b. (a -> b) -> a -> b
$ abt '[] 'HProb
b abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
* abt '[] 'HProb
x abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
(RealProb a, ABT Term abt) =>
abt '[] 'HProb -> abt '[] a -> abt '[] 'HProb
** abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a
recip abt '[] 'HProb
k

bern :: (ABT Term abt) => abt '[] 'HProb -> abt '[] ('HMeasure HBool)
bern :: abt '[] 'HProb -> abt '[] ('HMeasure HBool)
bern abt '[] 'HProb
p = abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
categorical ([abt '[] 'HProb] -> abt '[] ('HArray 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
[abt '[] a] -> abt '[] ('HArray a)
arrayLit [abt '[] 'HProb
p, NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1 abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
`unsafeMinusProb` abt '[] 'HProb
p]) abt '[] ('HMeasure 'HNat)
-> (abt '[] 'HNat -> abt '[] ('HMeasure HBool))
-> abt '[] ('HMeasure HBool)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= \abt '[] 'HNat
i ->
         abt '[] HBool -> abt '[] ('HMeasure HBool)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac ([abt '[] HBool] -> abt '[] ('HArray HBool)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
[abt '[] a] -> abt '[] ('HArray a)
arrayLit [abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool
true, abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] HBool
false] abt '[] ('HArray HBool) -> abt '[] 'HNat -> abt '[] HBool
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
! abt '[] 'HNat
i)

mix :: (ABT Term abt)
    => abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
mix :: abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
mix abt '[] ('HArray 'HProb)
v = abt '[] 'HProb
-> abt '[] ('HMeasure 'HNat) -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (w :: Hakaru).
ABT Term abt =>
abt '[] 'HProb -> abt '[] ('HMeasure w) -> abt '[] ('HMeasure w)
withWeight (abt '[] ('HArray 'HProb) -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] ('HArray a) -> abt '[] a
sumV abt '[] ('HArray 'HProb)
v) (abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
categorical abt '[] ('HArray 'HProb)
v)

binomial
    :: (ABT Term abt)
    => abt '[] 'HNat
    -> abt '[] 'HProb
    -> abt '[] ('HMeasure 'HInt)
binomial :: abt '[] 'HNat -> abt '[] 'HProb -> abt '[] ('HMeasure 'HInt)
binomial abt '[] 'HNat
n abt '[] 'HProb
p =
    abt '[] ('HArray 'HInt) -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] ('HArray a) -> abt '[] a
sumV (abt '[] ('HArray 'HInt) -> abt '[] 'HInt)
-> abt '[] ('HMeasure ('HArray 'HInt)) -> abt '[] ('HMeasure 'HInt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] ('HMeasure 'HInt))
-> abt '[] ('HMeasure ('HArray 'HInt))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] ('HMeasure a))
-> abt '[] ('HMeasure ('HArray a))
plate abt '[] 'HNat
n (abt '[] ('HMeasure 'HInt)
-> abt '[] 'HNat -> abt '[] ('HMeasure 'HInt)
forall a b. a -> b -> a
const (abt '[] ('HMeasure 'HInt)
 -> abt '[] 'HNat -> abt '[] ('HMeasure 'HInt))
-> abt '[] ('HMeasure 'HInt)
-> abt '[] 'HNat
-> abt '[] ('HMeasure 'HInt)
forall a b. (a -> b) -> a -> b
$ ((\abt '[] HBool
b -> abt '[] HBool -> abt '[] 'HInt -> abt '[] 'HInt -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] HBool -> abt '[] a -> abt '[] a -> abt '[] a
if_ abt '[] HBool
b (Integer -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Integer -> abt '[] 'HInt
int_ Integer
1) (Integer -> abt '[] 'HInt
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Integer -> abt '[] 'HInt
int_ Integer
0)) (abt '[] HBool -> abt '[] 'HInt)
-> abt '[] ('HMeasure HBool) -> abt '[] ('HMeasure 'HInt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] 'HProb -> abt '[] ('HMeasure HBool)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] ('HMeasure HBool)
bern abt '[] 'HProb
p))

-- BUG: would it be better to 'observe' that @p >= 1@ before doing everything? At least that way things would be /defined/ for all inputs...
negativeBinomial
    :: (ABT Term abt)
    => abt '[] 'HNat
    -> abt '[] 'HProb -- N.B., must actually be between 0 and 1
    -> abt '[] ('HMeasure 'HNat)
negativeBinomial :: abt '[] 'HNat -> abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
negativeBinomial abt '[] 'HNat
r abt '[] 'HProb
p =
    abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
gamma (abt '[] 'HNat -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HNat -> abt '[] 'HProb
nat2prob abt '[] 'HNat
r) (abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a
recip (abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HFractional_ a) =>
abt '[] a -> abt '[] a
recip abt '[] 'HProb
p abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
`unsafeMinusProb` NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1)) abt '[] ('HMeasure 'HProb)
-> (abt '[] 'HProb -> abt '[] ('HMeasure 'HNat))
-> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
abt '[] ('HMeasure a)
-> (abt '[] a -> abt '[] ('HMeasure b)) -> abt '[] ('HMeasure b)
>>= abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
poisson

geometric :: (ABT Term abt) => abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
geometric :: abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
geometric = abt '[] 'HNat -> abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HNat -> abt '[] 'HProb -> abt '[] ('HMeasure 'HNat)
negativeBinomial (Natural -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Natural -> abt '[] 'HNat
nat_ Natural
1)


multinomial
    :: (ABT Term abt)
    => abt '[] 'HNat
    -> abt '[] ('HArray 'HProb)
    -> abt '[] ('HMeasure ('HArray 'HProb))
multinomial :: abt '[] 'HNat
-> abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure ('HArray 'HProb))
multinomial abt '[] 'HNat
n abt '[] ('HArray 'HProb)
v =
    (abt '[] ('HMeasure ('HArray 'HProb))
 -> abt '[] ('HMeasure ('HArray 'HProb))
 -> abt '[] ('HMeasure ('HArray 'HProb)))
-> abt '[] ('HMeasure ('HArray 'HProb))
-> abt '[] ('HArray ('HMeasure ('HArray 'HProb)))
-> abt '[] ('HMeasure ('HArray 'HProb))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
(abt '[] a -> abt '[] a -> abt '[] a)
-> abt '[] a -> abt '[] ('HArray a) -> abt '[] a
reduce ((abt '[] ('HArray 'HProb)
 -> abt '[] ('HArray 'HProb) -> abt '[] ('HArray 'HProb))
-> abt '[] ('HMeasure ('HArray 'HProb))
-> abt '[] ('HMeasure ('HArray 'HProb))
-> abt '[] ('HMeasure ('HArray 'HProb))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
(ABT Term abt, SingI a, SingI b) =>
(abt '[] a -> abt '[] b -> abt '[] c)
-> abt '[] ('HMeasure a)
-> abt '[] ('HMeasure b)
-> abt '[] ('HMeasure c)
liftM2 ((abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb)
-> abt '[] ('HArray 'HProb)
-> abt '[] ('HArray 'HProb)
-> abt '[] ('HArray 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (c :: Hakaru).
ABT Term abt =>
(abt '[] a -> abt '[] b -> abt '[] c)
-> abt '[] ('HArray a)
-> abt '[] ('HArray b)
-> abt '[] ('HArray c)
zipWithV abt '[] 'HProb -> abt '[] 'HProb -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
(ABT Term abt, HSemiring_ a) =>
abt '[] a -> abt '[] a -> abt '[] a
(+)))
        (abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure ('HArray 'HProb))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> abt '[] ('HMeasure a)
dirac (abt '[] 'HNat -> abt '[] 'HProb -> abt '[] ('HArray 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
ABT Term abt =>
abt '[] 'HNat -> abt '[] b -> abt '[] ('HArray b)
constV (abt '[] ('HArray 'HProb) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray 'HProb)
v) (NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
0)))
        (abt '[] 'HNat
-> abt '[] ('HMeasure ('HArray 'HProb))
-> abt '[] ('HArray ('HMeasure ('HArray 'HProb)))
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
ABT Term abt =>
abt '[] 'HNat -> abt '[] b -> abt '[] ('HArray b)
constV abt '[] 'HNat
n (abt '[] 'HNat -> abt '[] 'HNat -> abt '[] ('HArray 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HNat -> abt '[] 'HNat -> abt '[] ('HArray 'HProb)
unitV (abt '[] ('HArray 'HProb) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray 'HProb)
v) (abt '[] 'HNat -> abt '[] ('HArray 'HProb))
-> abt '[] ('HMeasure 'HNat)
-> abt '[] ('HMeasure ('HArray 'HProb))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure 'HNat)
categorical abt '[] ('HArray 'HProb)
v))

dirichlet
    :: (ABT Term abt)
    => abt '[] ('HArray 'HProb)
    -> abt '[] ('HMeasure ('HArray 'HProb))
dirichlet :: abt '[] ('HArray 'HProb) -> abt '[] ('HMeasure ('HArray 'HProb))
dirichlet abt '[] ('HArray 'HProb)
a = abt '[] ('HArray 'HProb) -> abt '[] ('HArray 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] ('HArray 'HProb) -> abt '[] ('HArray 'HProb)
normalizeV (abt '[] ('HArray 'HProb) -> abt '[] ('HArray 'HProb))
-> abt '[] ('HMeasure ('HArray 'HProb))
-> abt '[] ('HMeasure ('HArray 'HProb))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
(ABT Term abt, SingI a) =>
(abt '[] a -> abt '[] b)
-> abt '[] ('HMeasure a) -> abt '[] ('HMeasure b)
<$> abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] ('HMeasure 'HProb))
-> abt '[] ('HMeasure ('HArray 'HProb))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] 'HNat
-> (abt '[] 'HNat -> abt '[] ('HMeasure a))
-> abt '[] ('HMeasure ('HArray a))
plate (abt '[] ('HArray 'HProb) -> abt '[] 'HNat
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat
size abt '[] ('HArray 'HProb)
a) (\ abt '[] 'HNat
i -> abt '[] ('HArray 'HProb)
a abt '[] ('HArray 'HProb) -> abt '[] 'HNat -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] ('HArray a) -> abt '[] 'HNat -> abt '[] a
! abt '[] 'HNat
i  abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
abt '[] 'HProb -> abt '[] 'HProb -> abt '[] ('HMeasure 'HProb)
`gamma` NonNegativeRational -> abt '[] 'HProb
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
NonNegativeRational -> abt '[] 'HProb
prob_ NonNegativeRational
1)

----------------------------------------------------------------
----------------------------------------------------------- fin.