multirec-0.7.5: Generic programming for families of recursive datatypes

Copyright(c) 2009--2010 Universiteit Utrecht
LicenseBSD3
Maintainergenerics@haskell.org
Stabilityexperimental
Portabilitynon-portable
Safe HaskellSafe-Inferred
LanguageHaskell98

Generics.MultiRec.FoldAlg

Contents

Description

A variant of fold that allows the specification of the algebra in a convenient way.

Synopsis

The type family of convenient algebras.

type family Alg f r ix :: * Source

The type family we use to describe the convenient algebras.

Instances

type Alg U r ix = r ix

For a unit, no arguments are available.

type Alg (K a) r ix = a -> r ix

For a constant, we take the constant value to a result.

type Alg (I xi) r ix = r xi -> r ix

For an identity, we turn the recursive result into a final result. Note that the index can change.

type Alg (C c f) r ix = Alg f r ix

Constructors are ignored.

type Alg ((:.:) f (I xi)) r ix = f (r xi) -> r ix 
type Alg ((:>:) f xi) r ix = Alg f r xi

A tag changes the index of the final result.

type Alg ((:*:) f g) r ix = Comp f r ix -> Alg g r ix

For a product where the left hand side is a constant, we take the value as an additional argument.

type Alg ((:+:) f g) r ix = (Alg f r ix, Alg g r ix)

For a sum, the algebra is a pair of two algebras.

type family Comp f r ix :: * Source

Instances

type Comp (K a) r ix = a 
type Comp (I xi) r ix = r xi 
type Comp ((:.:) f g) r ix = f (Comp g r ix) 

type Algebra phi r = forall ix. phi ix -> Alg (PF phi) r ix Source

The algebras passed to the fold have to work for all index types in the family. The additional witness argument is required only to make GHC's typechecker happy.

The class to turn convenient algebras into standard algebras.

class Fold f where Source

The class fold explains how to convert a convenient algebra Alg back into a function from functor to result, as required by the standard fold function.

Methods

alg :: Alg f r ix -> f r ix -> r ix Source

Instances

Fold U 
Fold (K a) 
Fold (I xi) 
Fold f => Fold (C c f) 
Functor f => Fold ((:.:) f (I xi)) 
Fold f => Fold ((:>:) f xi) 
Fold g => Fold ((:*:) (K a) g) 
Fold g => Fold ((:*:) (I xi) g) 
(Fold f, Fold g) => Fold ((:+:) f g) 

Interface

fold :: forall phi ix r. (Fam phi, HFunctor phi (PF phi), Fold (PF phi)) => Algebra phi r -> phi ix -> ix -> r ix Source

Fold with convenient algebras.

Construction of algebras

(&) :: a -> b -> (a, b) infixr 5 Source

For constructing algebras that are made of nested pairs rather than n-ary tuples, it is helpful to use this pairing combinator.