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

Language.Hakaru.Syntax.ABT

Description

The interface for abstract binding trees. Given the generating functor Term: the non-recursive View type extends Term by adding variables and binding; and each ABT type (1) provides some additional annotations at each recursion site, and then (2) ties the knot to produce the recursive trees. For an introduction to this technique/approach, see:

Synopsis

Our basic notion of variables.

resolveVar :: (JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), ABT syn abt) => abt '[] (a :: k) -> Assocs (abt '[]) -> Either (Variable a) (syn abt a) Source #

If the expression is a variable, then look it up. Recursing until we can finally return some syntax.

The abstract binding tree interface

data View :: (k -> Type) -> [k] -> k -> Type where Source #

The raw view of abstract binding trees, to separate out variables and binders from (1) the rest of syntax (cf., Term), and (2) whatever annotations (cf., the ABT instances).

The first parameter gives the generating signature for the signature. The second index gives the number and types of locally-bound variables. And the final parameter gives the type of the whole expression.

HACK: We only want to expose the patterns generated by this type, not the constructors themselves. That way, callers must use the smart constructors of the ABT class. But if we don't expose this type, then clients can't define their own ABT instances (without reinventing their own copy of this type)...

Constructors

Syn :: !(rec a) -> View rec '[] a 
Var :: !(Variable a) -> View rec '[] a 
Bind :: !(Variable a) -> !(View rec xs b) -> View rec (a ': xs) b 

Instances

Instances details
Traversable12 (View :: (k3 -> Type) -> [k3] -> k3 -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

traverse12 :: forall f a b (j :: k2) (l :: k30). Applicative f => (forall (i :: k1). a i -> f (b i)) -> View a j l -> f (View b j l) Source #

Foldable12 (View :: (k3 -> Type) -> [k3] -> k3 -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

fold12 :: forall m (j :: k2) (l :: k30). Monoid m => View (Lift1 m) j l -> m Source #

foldMap12 :: forall m a (j :: k2) (l :: k30). Monoid m => (forall (i :: k1). a i -> m) -> View a j l -> m Source #

Functor12 (View :: (k3 -> Type) -> [k3] -> k3 -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

fmap12 :: forall a b (j :: k2) (l :: k30). (forall (i :: k1). a i -> b i) -> View a j l -> View b j l Source #

(Show1 (Sing :: k -> Type), Show1 rec) => Show1 (View rec xs :: k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec1 :: forall (i :: k0). Int -> View rec xs i -> ShowS Source #

show1 :: forall (i :: k0). View rec xs i -> String Source #

(Show1 (Sing :: k -> Type), Show1 rec) => Show2 (View rec :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec2 :: forall (i :: k1) (j :: k2). Int -> View rec i j -> ShowS Source #

show2 :: forall (i :: k1) (j :: k2). View rec i j -> String Source #

(Show1 (Sing :: k -> Type), Show1 rec) => Show (View rec xs a) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec :: Int -> View rec xs a -> ShowS #

show :: View rec xs a -> String #

showList :: [View rec xs a] -> ShowS #

unviewABT :: ABT syn abt => View (syn abt) xs a -> abt xs a Source #

class ABT (syn :: ([k] -> k -> Type) -> k -> Type) (abt :: [k] -> k -> Type) | abt -> syn where Source #

The class interface for abstract binding trees. The first argument, syn, gives the syntactic signature of the ABT; whereas, the second argument, abt, is thing being declared as an ABT for syn. The first three methods (syn, var, bind) alow us to inject any View into the abt. The other methods provide various views for extracting information from the abt.

At present we're using fundeps in order to restrict the relationship between abt and syn. However, in the future we may move syn into being an associated type, if that helps to clean things up (since fundeps and type families don't play well together). The idea behind the fundep is that certain abt implementations may only be able to work for particular syn signatures. This isn't the case for TrivialABT nor MemoizedABT, but isn't too far-fetched.

Minimal complete definition

syn, var, bind, caseBind, viewABT, freeVars, nextBind

Methods

syn :: syn abt a -> abt '[] a Source #

var :: Variable a -> abt '[] a Source #

bind :: Variable a -> abt xs b -> abt (a ': xs) b Source #

caseBind :: abt (x ': xs) a -> (Variable x -> abt xs a -> r) -> r Source #

Since the first argument to abt is not '[], we know it must be Bind. So we do case analysis on that constructor, pushing the annotation down one binder (but not over the whole recursive View layer).

viewABT :: abt xs a -> View (syn abt) xs a Source #

freeVars :: abt xs a -> VarSet (KindOf a) Source #

nextFree :: abt xs a -> Nat Source #

Return the successor of the largest varID of free variables. Thus, if there are no free variables we return zero. The default implementation is to take the successor of the maximum of freeVars. This is part of the class in case you want to memoize it.

This function is used in order to generate guaranteed-fresh variables without the need for a name supply. In particular, it's used to ensure that the generated variable don't capture any free variables in the term.

nextBind :: abt xs a -> Nat Source #

Return the successor of the largest varID of variable binding sites (i.e., of variables bound by the Bind constructor). Thus, if there are no binders, then we will return zero. N.B., this should return zero for uses of the bound variables themselves. This is part of the class in case you want to memoize it.

This function is used in order to generate guaranteed-fresh variables without the need for a name supply. In particular, it's used to ensure that the generated variable won't be captured or shadowed by bindings already in the term.

nextFreeOrBind :: abt xs a -> Nat Source #

Return the maximum of nextFree and nextBind. For when you want to be really paranoid about choosing new variable IDs. In principle this shouldn't be necessary since we should always freshen things when going under binders; but for some reason only using nextFree keeps leading to bugs in transformations like disintegration and expectation.

N.B., it is impossible to implement this function such that it is lazy in the bound variables like nextBind is. Thus, it cannot be used for knot-tying tricks like nextBind can.

Instances

Instances details
(JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Foldable21 syn) => ABT (syn :: ([k] -> k -> Type) -> k -> Type) (MemoizedABT syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

syn :: forall (a :: k0). syn (MemoizedABT syn) a -> MemoizedABT syn '[] a Source #

var :: forall (a :: k0). Variable a -> MemoizedABT syn '[] a Source #

bind :: forall (a :: k0) (xs :: [k0]) (b :: k0). Variable a -> MemoizedABT syn xs b -> MemoizedABT syn (a ': xs) b Source #

caseBind :: forall (x :: k0) (xs :: [k0]) (a :: k0) r. MemoizedABT syn (x ': xs) a -> (Variable x -> MemoizedABT syn xs a -> r) -> r Source #

viewABT :: forall (xs :: [k0]) (a :: k0). MemoizedABT syn xs a -> View (syn (MemoizedABT syn)) xs a Source #

freeVars :: forall (xs :: [k0]) (a :: k0). MemoizedABT syn xs a -> VarSet (KindOf a) Source #

nextFree :: forall (xs :: [k0]) (a :: k0). MemoizedABT syn xs a -> Nat Source #

nextBind :: forall (xs :: [k0]) (a :: k0). MemoizedABT syn xs a -> Nat Source #

nextFreeOrBind :: forall (xs :: [k0]) (a :: k0). MemoizedABT syn xs a -> Nat Source #

(JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Foldable21 syn) => ABT (syn :: ([k] -> k -> Type) -> k -> Type) (TrivialABT syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

syn :: forall (a :: k0). syn (TrivialABT syn) a -> TrivialABT syn '[] a Source #

var :: forall (a :: k0). Variable a -> TrivialABT syn '[] a Source #

bind :: forall (a :: k0) (xs :: [k0]) (b :: k0). Variable a -> TrivialABT syn xs b -> TrivialABT syn (a ': xs) b Source #

caseBind :: forall (x :: k0) (xs :: [k0]) (a :: k0) r. TrivialABT syn (x ': xs) a -> (Variable x -> TrivialABT syn xs a -> r) -> r Source #

viewABT :: forall (xs :: [k0]) (a :: k0). TrivialABT syn xs a -> View (syn (TrivialABT syn)) xs a Source #

freeVars :: forall (xs :: [k0]) (a :: k0). TrivialABT syn xs a -> VarSet (KindOf a) Source #

nextFree :: forall (xs :: [k0]) (a :: k0). TrivialABT syn xs a -> Nat Source #

nextBind :: forall (xs :: [k0]) (a :: k0). TrivialABT syn xs a -> Nat Source #

nextFreeOrBind :: forall (xs :: [k0]) (a :: k0). TrivialABT syn xs a -> Nat Source #

(JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Foldable21 syn) => ABT (syn :: ([k] -> k -> Type) -> k -> Type) (MetaABT meta syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

syn :: forall (a :: k0). syn (MetaABT meta syn) a -> MetaABT meta syn '[] a Source #

var :: forall (a :: k0). Variable a -> MetaABT meta syn '[] a Source #

bind :: forall (a :: k0) (xs :: [k0]) (b :: k0). Variable a -> MetaABT meta syn xs b -> MetaABT meta syn (a ': xs) b Source #

caseBind :: forall (x :: k0) (xs :: [k0]) (a :: k0) r. MetaABT meta syn (x ': xs) a -> (Variable x -> MetaABT meta syn xs a -> r) -> r Source #

viewABT :: forall (xs :: [k0]) (a :: k0). MetaABT meta syn xs a -> View (syn (MetaABT meta syn)) xs a Source #

freeVars :: forall (xs :: [k0]) (a :: k0). MetaABT meta syn xs a -> VarSet (KindOf a) Source #

nextFree :: forall (xs :: [k0]) (a :: k0). MetaABT meta syn xs a -> Nat Source #

nextBind :: forall (xs :: [k0]) (a :: k0). MetaABT meta syn xs a -> Nat Source #

nextFreeOrBind :: forall (xs :: [k0]) (a :: k0). MetaABT meta syn xs a -> Nat Source #

caseVarSyn :: ABT syn abt => abt '[] a -> (Variable a -> r) -> (syn abt a -> r) -> r Source #

Since the first argument to abt is '[], we know it must be either Syn of Var. So we do case analysis with those two constructors.

binds :: ABT syn abt => List1 Variable xs -> abt ys b -> abt (xs ++ ys) b Source #

Call bind repeatedly.

binds_ :: ABT syn abt => List1 Variable xs -> abt '[] b -> abt xs b Source #

A specialization of binds for when ys ~ '[]. We define this to avoid the need for using eqAppendIdentity on the result of binds itself.

caseBinds :: ABT syn abt => abt xs a -> (List1 Variable xs, abt '[] a) Source #

Call caseBind repeatedly. (Actually we use viewABT.)

underBinders :: ABT syn abt => (abt '[] a -> abt '[] b) -> abt xs a -> abt xs b Source #

Transform expression under binds

maxNextFree :: (ABT syn abt, Foldable f) => f (Some2 abt) -> Nat Source #

Call nextFree on all the terms and return the maximum.

maxNextBind :: (ABT syn abt, Foldable f) => f (Some2 abt) -> Nat Source #

Call nextBind on all the terms and return the maximum.

maxNextFreeOrBind :: (ABT syn abt, Foldable f) => f (Some2 abt) -> Nat Source #

Call nextFreeOrBind on all the terms and return the maximum.

Capture avoiding substitution for any ABT

rename :: forall k syn abt (a :: k) xs (b :: k). (JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Functor21 syn, ABT syn abt) => Variable a -> Variable a -> abt xs b -> abt xs b Source #

Rename a free variable. Does nothing if the variable is bound.

renames :: forall k (syn :: ([k] -> k -> Type) -> k -> Type) (abt :: [k] -> k -> Type) (xs :: [k]) (a :: k). (ABT syn abt, JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Functor21 syn) => Assocs (Variable :: k -> Type) -> abt xs a -> abt xs a Source #

subst :: forall k syn abt (a :: k) xs (b :: k). (JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Traversable21 syn, ABT syn abt) => Variable a -> abt '[] a -> abt xs b -> abt xs b Source #

Perform capture-avoiding substitution. This function will either preserve type-safety or else throw an VarEqTypeError (depending on which interpretation of varEq is chosen). N.B., to ensure timely throwing of exceptions, the Term and ABT should have strict fmap21 definitions.

substM :: forall k syn abt (a :: k) xs (b :: k) m. (JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Traversable21 syn, ABT syn abt, Applicative m, Functor m, Monad m) => Variable a -> abt '[] a -> (forall b'. Variable b' -> m (abt '[] b')) -> abt xs b -> m (abt xs b) Source #

substs :: forall k (syn :: ([k] -> k -> Type) -> k -> Type) (abt :: [k] -> k -> Type) (xs :: [k]) (a :: k). (ABT syn abt, JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Traversable21 syn) => Assocs (abt '[]) -> abt xs a -> abt xs a Source #

The parallel version of subst for performing multiple substitutions at once.

Constructing first-order trees with a HOAS-like API

binder Source #

Arguments

:: ABT syn abt 
=> Text

The variable's name hint

-> Sing a

The variable's type

-> (abt '[] a -> abt xs b)

Build the binder's body from a variable

-> abt (a ': xs) b 

A combinator for defining a HOAS-like API for our syntax. Because our Term is first-order, we cannot actually have any exotic terms in our language. In principle, this function could be used to do exotic things when constructing those non-exotic terms; however, trying to do anything other than change the variable's name hint will cause things to explode (since it'll interfere with our tying-the-knot).

N.B., if you manually construct free variables and use them in the body (i.e., via var), they may become captured by the new binding introduced here! This is inevitable since nextBind never looks at variable use sites; it only ever looks at binding sites. On the other hand, if you manually construct a bound variable (i.e., manually calling bind yourself), then the new binding introduced here will respect the old binding and avoid that variable ID.

binderM :: (MonadFix m, ABT syn abt) => Text -> Sing a -> (abt '[] a -> m (abt xs b)) -> m (abt (a ': xs) b) Source #

class ABT syn abt => Binders syn abt xs as | abt -> syn, abt xs -> as, abt as -> xs where Source #

Methods

binders :: (as -> abt '[] b) -> abt xs b Source #

Instances

Instances details
ABT syn abt => Binders (syn :: ([k] -> k -> Type) -> k -> Type) (abt :: [k] -> k -> Type) ('[] :: [k]) () Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

binders :: forall (b :: k0). (() -> abt '[] b) -> abt '[] b Source #

(Binders syn abt xs as, SingI x) => Binders (syn :: ([a] -> a -> Type) -> a -> Type) (abt :: [a] -> a -> Type) (x ': xs :: [a]) (abt ('[] :: [a]) x, as) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

binders :: forall (b :: k). ((abt '[] x, as) -> abt '[] b) -> abt (x ': xs) b Source #

Highly experimental

withMetadata :: meta -> MetaABT meta syn xs a -> MetaABT meta syn xs a Source #

Abstract nonsense

cataABT :: forall k (abt :: [k] -> k -> Type) (syn :: ([k] -> k -> Type) -> k -> Type) (r :: [k] -> k -> Type). (ABT syn abt, Functor21 syn) => (forall a. Variable a -> r '[] a) -> (forall x xs a. Variable x -> r xs a -> r (x ': xs) a) -> (forall a. syn r a -> r '[] a) -> forall xs a. abt xs a -> r xs a Source #

The catamorphism (aka: iterator) for ABTs. While this is equivalent to paraABT in terms of the definable functions, it is weaker in terms of definable algorithms. If you need access to (subterms of) the original ABT, it is more efficient to use paraABT than to rebuild them. However, if you never need access to the original ABT, then this function has somewhat less overhead.

cataABTM :: forall k (abt :: [k] -> k -> Type) (syn :: ([k] -> k -> Type) -> k -> Type) (r :: [k] -> k -> Type) (f :: Type -> Type). (ABT syn abt, Traversable21 syn, Applicative f) => (forall a. Variable a -> f (r '[] a)) -> (forall x xs a. Variable x -> f (r xs a) -> f (r (x ': xs) a)) -> (forall a. f (syn r a) -> f (r '[] a)) -> forall xs a. abt xs a -> f (r xs a) Source #

A monadic variant of cataABT, which may not fit the precise definition of a catamorphism? The bind and syn operations receive monadic actions as their inputs, which allows the bind and syn operations to update the monadic context in which the subterms are evaluated if need be.

paraABT :: forall k (abt :: [k] -> k -> Type) (syn :: ([k] -> k -> Type) -> k -> Type) (r :: [k] -> k -> Type). (ABT syn abt, Functor21 syn) => (forall a. Variable a -> r '[] a) -> (forall x xs a. Variable x -> abt xs a -> r xs a -> r (x ': xs) a) -> (forall a. syn (Pair2 abt r) a -> r '[] a) -> forall xs a. abt xs a -> r xs a Source #

The paramorphism (aka: recursor) for ABTs. While this is equivalent to cataABT in terms of the definable functions, it is stronger in terms of definable algorithms. If you need access to (subterms of) the original ABT, it is more efficient to use this function than to use cataABT and rebuild them. However, if you never need access to the original ABT, then cataABT has somewhat less overhead.

The provided type is slightly non-uniform since we inline (i.e., curry) the definition of Pair2 in the type of the bind_ argument. But we can't inline Pair2 away in the type of the syn_ argument. N.B., if you treat the second component of the Pair2 (either the real ones or the curried ones) lazily, then this is a top-down function; however, if you treat them strictly then it becomes a bottom-up function.

dupABT :: (ABT syn abt0, ABT syn abt1, Functor21 syn) => abt0 xs a -> abt1 xs a Source #

Makes a copy of an ABT at another type

Some ABT instances

data TrivialABT (syn :: ([k] -> k -> Type) -> k -> Type) (xs :: [k]) (a :: k) Source #

A trivial ABT with no annotations.

The Show instance does not expose the raw underlying data types, but rather prints the smart constructors var, syn, and bind. This makes things prettier, but also means that if you paste the string into a Haskell file you can use it for any ABT instance.

The freeVars, nextFree, and nextBind methods are all very expensive for this ABT, because we have to traverse the term every time we want to call them. The MemoizedABT implementation fixes this.

Instances

Instances details
(JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Foldable21 syn) => ABT (syn :: ([k] -> k -> Type) -> k -> Type) (TrivialABT syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

syn :: forall (a :: k0). syn (TrivialABT syn) a -> TrivialABT syn '[] a Source #

var :: forall (a :: k0). Variable a -> TrivialABT syn '[] a Source #

bind :: forall (a :: k0) (xs :: [k0]) (b :: k0). Variable a -> TrivialABT syn xs b -> TrivialABT syn (a ': xs) b Source #

caseBind :: forall (x :: k0) (xs :: [k0]) (a :: k0) r. TrivialABT syn (x ': xs) a -> (Variable x -> TrivialABT syn xs a -> r) -> r Source #

viewABT :: forall (xs :: [k0]) (a :: k0). TrivialABT syn xs a -> View (syn (TrivialABT syn)) xs a Source #

freeVars :: forall (xs :: [k0]) (a :: k0). TrivialABT syn xs a -> VarSet (KindOf a) Source #

nextFree :: forall (xs :: [k0]) (a :: k0). TrivialABT syn xs a -> Nat Source #

nextBind :: forall (xs :: [k0]) (a :: k0). TrivialABT syn xs a -> Nat Source #

nextFreeOrBind :: forall (xs :: [k0]) (a :: k0). TrivialABT syn xs a -> Nat Source #

(Show1 (Sing :: k -> Type), JmEq1 (Sing :: k -> Type), JmEq1 (syn (TrivialABT syn)), Foldable21 syn) => JmEq1 (TrivialABT syn xs :: k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.AST.Eq

Methods

jmEq1 :: forall (i :: k0) (j :: k0). TrivialABT syn xs i -> TrivialABT syn xs j -> Maybe (TypeEq i j) Source #

(Show1 (Sing :: k -> Type), JmEq1 (Sing :: k -> Type), Foldable21 syn, JmEq1 (syn (TrivialABT syn))) => Eq1 (TrivialABT syn xs :: k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.AST.Eq

Methods

eq1 :: forall (i :: k0). TrivialABT syn xs i -> TrivialABT syn xs i -> Bool Source #

(Show1 (Sing :: k -> Type), Show1 (syn (TrivialABT syn))) => Show1 (TrivialABT syn xs :: k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec1 :: forall (i :: k0). Int -> TrivialABT syn xs i -> ShowS Source #

show1 :: forall (i :: k0). TrivialABT syn xs i -> String Source #

(Show1 (Sing :: k -> Type), JmEq1 (Sing :: k -> Type), JmEq1 (syn (TrivialABT syn)), Foldable21 syn) => JmEq2 (TrivialABT syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.AST.Eq

Methods

jmEq2 :: forall (i1 :: k1) (j1 :: k2) (i2 :: k1) (j2 :: k2). TrivialABT syn i1 j1 -> TrivialABT syn i2 j2 -> Maybe (TypeEq i1 i2, TypeEq j1 j2) Source #

(Show1 (Sing :: k -> Type), JmEq1 (Sing :: k -> Type), Foldable21 syn, JmEq1 (syn (TrivialABT syn))) => Eq2 (TrivialABT syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.AST.Eq

Methods

eq2 :: forall (i :: k1) (j :: k2). TrivialABT syn i j -> TrivialABT syn i j -> Bool Source #

(Show1 (Sing :: k -> Type), Show1 (syn (TrivialABT syn))) => Show2 (TrivialABT syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec2 :: forall (i :: k1) (j :: k2). Int -> TrivialABT syn i j -> ShowS Source #

show2 :: forall (i :: k1) (j :: k2). TrivialABT syn i j -> String Source #

(Show1 (Sing :: k -> Type), JmEq1 (Sing :: k -> Type), Foldable21 syn, JmEq1 (syn (TrivialABT syn))) => Eq (TrivialABT syn xs a) Source # 
Instance details

Defined in Language.Hakaru.Syntax.AST.Eq

Methods

(==) :: TrivialABT syn xs a -> TrivialABT syn xs a -> Bool #

(/=) :: TrivialABT syn xs a -> TrivialABT syn xs a -> Bool #

(Show1 (Sing :: k -> Type), Show1 (syn (TrivialABT syn))) => Show (TrivialABT syn xs a) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec :: Int -> TrivialABT syn xs a -> ShowS #

show :: TrivialABT syn xs a -> String #

showList :: [TrivialABT syn xs a] -> ShowS #

data MemoizedABT (syn :: ([k] -> k -> Type) -> k -> Type) (xs :: [k]) (a :: k) Source #

An ABT which memoizes freeVars, nextBind, and nextFree, thereby making them take only O(1) time.

N.B., the memoized set of free variables is lazy so that we can tie-the-knot in binder without interfering with our memos. The memoized nextFree must be lazy for the same reason.

Instances

Instances details
(JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Foldable21 syn) => ABT (syn :: ([k] -> k -> Type) -> k -> Type) (MemoizedABT syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

syn :: forall (a :: k0). syn (MemoizedABT syn) a -> MemoizedABT syn '[] a Source #

var :: forall (a :: k0). Variable a -> MemoizedABT syn '[] a Source #

bind :: forall (a :: k0) (xs :: [k0]) (b :: k0). Variable a -> MemoizedABT syn xs b -> MemoizedABT syn (a ': xs) b Source #

caseBind :: forall (x :: k0) (xs :: [k0]) (a :: k0) r. MemoizedABT syn (x ': xs) a -> (Variable x -> MemoizedABT syn xs a -> r) -> r Source #

viewABT :: forall (xs :: [k0]) (a :: k0). MemoizedABT syn xs a -> View (syn (MemoizedABT syn)) xs a Source #

freeVars :: forall (xs :: [k0]) (a :: k0). MemoizedABT syn xs a -> VarSet (KindOf a) Source #

nextFree :: forall (xs :: [k0]) (a :: k0). MemoizedABT syn xs a -> Nat Source #

nextBind :: forall (xs :: [k0]) (a :: k0). MemoizedABT syn xs a -> Nat Source #

nextFreeOrBind :: forall (xs :: [k0]) (a :: k0). MemoizedABT syn xs a -> Nat Source #

(Show1 (Sing :: k -> Type), Show1 (syn (MemoizedABT syn))) => Show1 (MemoizedABT syn xs :: k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec1 :: forall (i :: k0). Int -> MemoizedABT syn xs i -> ShowS Source #

show1 :: forall (i :: k0). MemoizedABT syn xs i -> String Source #

(Show1 (Sing :: k -> Type), Show1 (syn (MemoizedABT syn))) => Show2 (MemoizedABT syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec2 :: forall (i :: k1) (j :: k2). Int -> MemoizedABT syn i j -> ShowS Source #

show2 :: forall (i :: k1) (j :: k2). MemoizedABT syn i j -> String Source #

(Show1 (Sing :: k -> Type), Show1 (syn (MemoizedABT syn))) => Show (MemoizedABT syn xs a) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec :: Int -> MemoizedABT syn xs a -> ShowS #

show :: MemoizedABT syn xs a -> String #

showList :: [MemoizedABT syn xs a] -> ShowS #

data MetaABT (meta :: Type) (syn :: ([k] -> k -> Type) -> k -> Type) (xs :: [k]) (a :: k) Source #

An ABT which carries around metadata at each node.

Right now this essentially inlines the the TrivialABT instance but it would be nice if it was abstract in the choice of ABT.

Constructors

MetaABT 

Fields

Instances

Instances details
(JmEq1 (Sing :: k -> Type), Show1 (Sing :: k -> Type), Foldable21 syn) => ABT (syn :: ([k] -> k -> Type) -> k -> Type) (MetaABT meta syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

syn :: forall (a :: k0). syn (MetaABT meta syn) a -> MetaABT meta syn '[] a Source #

var :: forall (a :: k0). Variable a -> MetaABT meta syn '[] a Source #

bind :: forall (a :: k0) (xs :: [k0]) (b :: k0). Variable a -> MetaABT meta syn xs b -> MetaABT meta syn (a ': xs) b Source #

caseBind :: forall (x :: k0) (xs :: [k0]) (a :: k0) r. MetaABT meta syn (x ': xs) a -> (Variable x -> MetaABT meta syn xs a -> r) -> r Source #

viewABT :: forall (xs :: [k0]) (a :: k0). MetaABT meta syn xs a -> View (syn (MetaABT meta syn)) xs a Source #

freeVars :: forall (xs :: [k0]) (a :: k0). MetaABT meta syn xs a -> VarSet (KindOf a) Source #

nextFree :: forall (xs :: [k0]) (a :: k0). MetaABT meta syn xs a -> Nat Source #

nextBind :: forall (xs :: [k0]) (a :: k0). MetaABT meta syn xs a -> Nat Source #

nextFreeOrBind :: forall (xs :: [k0]) (a :: k0). MetaABT meta syn xs a -> Nat Source #

(Show1 (Sing :: k -> Type), Show1 (syn (MetaABT meta syn)), Show meta) => Show1 (MetaABT meta syn xs :: k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec1 :: forall (i :: k0). Int -> MetaABT meta syn xs i -> ShowS Source #

show1 :: forall (i :: k0). MetaABT meta syn xs i -> String Source #

(Show1 (Sing :: k -> Type), Show1 (syn (MetaABT meta syn)), Show meta) => Show2 (MetaABT meta syn :: [k] -> k -> Type) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec2 :: forall (i :: k1) (j :: k2). Int -> MetaABT meta syn i j -> ShowS Source #

show2 :: forall (i :: k1) (j :: k2). MetaABT meta syn i j -> String Source #

(Show1 (Sing :: k -> Type), Show1 (syn (MetaABT meta syn)), Show meta) => Show (MetaABT meta syn xs a) Source # 
Instance details

Defined in Language.Hakaru.Syntax.ABT

Methods

showsPrec :: Int -> MetaABT meta syn xs a -> ShowS #

show :: MetaABT meta syn xs a -> String #

showList :: [MetaABT meta syn xs a] -> ShowS #