Portability	non-portable (GHC Extensions)
Stability	experimental
Maintainer	Patrick Bahr <paba@diku.dk>

Data.Comp

Contents

Examples

Description

This module defines the infrastructure necessary to use Compositional Data Types. Compositional Data Types is an extension of Wouter Swierstra's Functional Pearl: Data types a la carte. Examples of usage are provided below.

Synopsis

Examples

Pure Computations

The example below illustrates how to use compositional data types to implement a small expression language, with a sub language of values, and an evaluation function mapping expressions to values.

The following language extensions are needed in order to run the example: TemplateHaskell, TypeOperators, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, and UndecidableInstances.

 import Data.Comp
 import Data.Comp.Show ()
 import Data.Comp.Derive
 
 -- Signature for values and operators
 data Value e = Const Int | Pair e e
 data Op e = Add e e | Mult e e | Fst e | Snd e
 
 -- Signature for the simple expression language
 type Sig = Op :+: Value
 
 -- Derive boilerplate code using Template Haskell
 $(derive [instanceFunctor, instanceShowF, smartConstructors] [''Value, ''Op])
 
 -- Term evaluation algebra
 class Eval f v where
   evalAlg :: Alg f (Term v)
 
 instance (Eval f v, Eval g v) => Eval (f :+: g) v where
   evalAlg (Inl x) = evalAlg x
   evalAlg (Inr x) = evalAlg x
 
 -- Lift the evaluation algebra to a catamorphism
 eval :: (Functor f, Eval f v) => Term f -> Term v
 eval = cata evalAlg
 
 instance (Value :<: v) => Eval Value v where
   evalAlg = inject
 
 instance (Value :<: v) => Eval Op v where
   evalAlg (Add x y)  = iConst $ (projC x) + (projC y)
   evalAlg (Mult x y) = iConst $ (projC x) * (projC y)
   evalAlg (Fst x)    = fst $ projP x
   evalAlg (Snd x)    = snd $ projP x
 
 projC :: (Value :<: v) => Term v -> Int
 projC v = let Just (Const n) = project v in n
 
 projP :: (Value :<: v) => Term v -> (Term v, Term v)
 projP v = let Just (Pair x y) = project v in (x,y)
 
 -- Example: evalEx = iConst 5
 evalEx :: Term Value
 evalEx = eval ((iConst 1) `iAdd` (iConst 2 `iMult` iConst 2) :: Term Sig)

Monadic Computations

The example below illustrates how to use compositional data types to implement a small expression language, with a sub language of values, and a monadic evaluation function mapping expressions to values.

The following language extensions are needed in order to run the example: TemplateHaskell, TypeOperators, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, and UndecidableInstances.

 import Data.Comp
 import Data.Comp.Derive
 import Control.Monad (liftM)
 
 -- Signature for values and operators
 data Value e = Const Int | Pair e e
 data Op e = Add e e | Mult e e | Fst e | Snd e
 
 -- Signature for the simple expression language
 type Sig = Op :+: Value
 
 -- Derive boilerplate code using Template Haskell
 $(derive [instanceFunctor, instanceTraversable, instanceFoldable,
           instanceEqF, instanceShowF, smartConstructors]
          [''Value, ''Op])
 
 -- Monadic term evaluation algebra
 class EvalM f v where
   evalAlgM :: AlgM Maybe f (Term v)
 
 instance (EvalM f v, EvalM g v) => EvalM (f :+: g) v where
   evalAlgM (Inl x) = evalAlgM x
   evalAlgM (Inr x) = evalAlgM x
 
 -- Lift the monadic evaluation algebra to a monadic catamorphism
 evalM :: (Traversable f, EvalM f v) => Term f -> Maybe (Term v)
 evalM = cataM evalAlgM
 
 instance (Value :<: v) => EvalM Value v where
   evalAlgM = return . inject
 
 instance (Value :<: v) => EvalM Op v where
   evalAlgM (Add x y)  = do n1 <- projC x
                            n2 <- projC y
                            return $ iConst $ n1 + n2
   evalAlgM (Mult x y) = do n1 <- projC x
                            n2 <- projC y
                            return $ iConst $ n1 * n2
   evalAlgM (Fst v)    = liftM fst $ projP v
   evalAlgM (Snd v)    = liftM snd $ projP v
 
 projC :: (Value :<: v) => Term v -> Maybe Int
 projC v = case project v of
             Just (Const n) -> return n
             _ -> Nothing
 
 projP :: (Value :<: v) => Term v -> Maybe (Term v, Term v)
 projP v = case project v of
             Just (Pair x y) -> return (x,y)
             _ -> Nothing
 
 -- Example: evalMEx = Just (iConst 5)
 evalMEx :: Maybe (Term Value)
 evalMEx = evalM ((iConst 1) `iAdd` (iConst 2 `iMult` iConst 2) :: Term Sig)

Composing Term Homomorphisms and Algebras

The example below illustrates how to compose a term homomorphism and an algebra, exemplified via a desugaring term homomorphism and an evaluation algebra.

The following language extensions are needed in order to run the example: TemplateHaskell, TypeOperators, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, and UndecidableInstances.

 import Data.Comp
 import Data.Comp.Show ()
 import Data.Comp.Derive
 
 -- Signature for values, operators, and syntactic sugar
 data Value e = Const Int | Pair e e
 data Op e = Add e e | Mult e e | Fst e | Snd e
 data Sugar e = Neg e | Swap e

 -- Source position information (line number, column number)
 data Pos = Pos Int Int
            deriving Show
 
 -- Signature for the simple expression language
 type Sig = Op :+: Value
 type SigP = Op :&: Pos :+: Value :&: Pos

 -- Signature for the simple expression language, extended with syntactic sugar
 type Sig' = Sugar :+: Op :+: Value
 type SigP' = Sugar :&: Pos :+: Op :&: Pos :+: Value :&: Pos

 -- Derive boilerplate code using Template Haskell
 $(derive [instanceFunctor, instanceTraversable, instanceFoldable,
           instanceEqF, instanceShowF, smartConstructors]
          [''Value, ''Op, ''Sugar])
 
 -- Term homomorphism for desugaring of terms
 class (Functor f, Functor g) => Desugar f g where
   desugHom :: TermHom f g
   desugHom = desugHom' . fmap Hole
   desugHom' :: Alg f (Context g a)
   desugHom' x = appCxt (desugHom x)
 
 instance (Desugar f h, Desugar g h) => Desugar (f :+: g) h where
   desugHom (Inl x) = desugHom x
   desugHom (Inr x) = desugHom x
   desugHom' (Inl x) = desugHom' x
   desugHom' (Inr x) = desugHom' x
 
 instance (Value :<: v, Functor v) => Desugar Value v where
   desugHom = simpCxt . inj
 
 instance (Op :<: v, Functor v) => Desugar Op v where
   desugHom = simpCxt . inj
 
 instance (Op :<: v, Value :<: v, Functor v) => Desugar Sugar v where
   desugHom' (Neg x)  = iConst (-1) `iMult` x
   desugHom' (Swap x) = iSnd x `iPair` iFst x

 -- Term evaluation algebra
 class Eval f v where
   evalAlg :: Alg f (Term v)
 
 instance (Eval f v, Eval g v) => Eval (f :+: g) v where
   evalAlg (Inl x) = evalAlg x
   evalAlg (Inr x) = evalAlg x
 
 instance (Value :<: v) => Eval Value v where
   evalAlg = inject
 
 instance (Value :<: v) => Eval Op v where
   evalAlg (Add x y)  = iConst $ (projC x) + (projC y)
   evalAlg (Mult x y) = iConst $ (projC x) * (projC y)
   evalAlg (Fst x)    = fst $ projP x
   evalAlg (Snd x)    = snd $ projP x
 
 projC :: (Value :<: v) => Term v -> Int
 projC v = let Just (Const n) = project v in n
 
 projP :: (Value :<: v) => Term v -> (Term v, Term v)
 projP v = let Just (Pair x y) = project v in (x,y)

 -- Compose the evaluation algebra and the desugaring homomorphism to an
 -- algebra
 eval :: Term Sig' -> Term Value
 eval = cata (evalAlg `compAlg` (desugHom :: TermHom Sig' Sig))
 
 -- Example: evalEx = iPair (iConst 2) (iConst 1)
 evalEx :: Term Value
 evalEx = eval $ iSwap $ iPair (iConst 1) (iConst 2)

Lifting Term Homomorphisms to Products

The example below illustrates how to lift a term homomorphism to products, exemplified via a desugaring term homomorphism lifted to terms annotated with source position information.

The following language extensions are needed in order to run the example: TemplateHaskell, TypeOperators, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, and UndecidableInstances.

 import Data.Comp
 import Data.Comp.Show ()
 import Data.Comp.Derive
 
 -- Signature for values, operators, and syntactic sugar
 data Value e = Const Int | Pair e e
 data Op e = Add e e | Mult e e | Fst e | Snd e
 data Sugar e = Neg e | Swap e

 -- Source position information (line number, column number)
 data Pos = Pos Int Int
            deriving Show
 
 -- Signature for the simple expression language
 type Sig = Op :+: Value
 type SigP = Op :&: Pos :+: Value :&: Pos

 -- Signature for the simple expression language, extended with syntactic sugar
 type Sig' = Sugar :+: Op :+: Value
 type SigP' = Sugar :&: Pos :+: Op :&: Pos :+: Value :&: Pos

 -- Derive boilerplate code using Template Haskell
 $(derive [instanceFunctor, instanceTraversable, instanceFoldable,
           instanceEqF, instanceShowF, smartConstructors]
          [''Value, ''Op, ''Sugar])
 
 -- Term homomorphism for desugaring of terms
 class (Functor f, Functor g) => Desugar f g where
   desugHom :: TermHom f g
   desugHom = desugHom' . fmap Hole
   desugHom' :: Alg f (Context g a)
   desugHom' x = appCxt (desugHom x)
 
 instance (Desugar f h, Desugar g h) => Desugar (f :+: g) h where
   desugHom (Inl x) = desugHom x
   desugHom (Inr x) = desugHom x
   desugHom' (Inl x) = desugHom' x
   desugHom' (Inr x) = desugHom' x
 
 instance (Value :<: v, Functor v) => Desugar Value v where
   desugHom = simpCxt . inj
 
 instance (Op :<: v, Functor v) => Desugar Op v where
   desugHom = simpCxt . inj
 
 instance (Op :<: v, Value :<: v, Functor v) => Desugar Sugar v where
   desugHom' (Neg x)  = iConst (-1) `iMult` x
   desugHom' (Swap x) = iSnd x `iPair` iFst x
 
 -- Lift the desugaring term homomorphism to a catamorphism
 desug :: Term Sig' -> Term Sig
 desug = appTermHom desugHom

 -- Example: desugEx = iPair (iConst 2) (iConst 1)
 desugEx :: Term Sig
 desugEx = desug $ iSwap $ iPair (iConst 1) (iConst 2)

 -- Lift desugaring to terms annotated with source positions
 desugP :: Term SigP' -> Term SigP
 desugP = appTermHom (productTermHom desugHom)

 iSwapP :: (DistProd f p f', Sugar :<: f) => p -> Term f' -> Term f'
 iSwapP p x = Term (injectP p $ inj $ Swap x)

 iConstP :: (DistProd f p f', Value :<: f) => p -> Int -> Term f'
 iConstP p x = Term (injectP p $ inj $ Const x)

 iPairP :: (DistProd f p f', Value :<: f) => p -> Term f' -> Term f' -> Term f'
 iPairP p x y = Term (injectP p $ inj $ Pair x y)

 iFstP :: (DistProd f p f', Op :<: f) => p -> Term f' -> Term f'
 iFstP p x = Term (injectP p $ inj $ Fst x)

 iSndP :: (DistProd f p f', Op :<: f) => p -> Term f' -> Term f'
 iSndP p x = Term (injectP p $ inj $ Snd x)

 -- Example: desugPEx = iPairP (Pos 1 0)
 --                            (iSndP (Pos 1 0) (iPairP (Pos 1 1)
 --                                                     (iConstP (Pos 1 2) 1)
 --                                                     (iConstP (Pos 1 3) 2)))
 --                            (iFstP (Pos 1 0) (iPairP (Pos 1 1)
 --                                                     (iConstP (Pos 1 2) 1)
 --                                                     (iConstP (Pos 1 3) 2)))
 desugPEx :: Term SigP
 desugPEx = desugP $ iSwapP (Pos 1 0) (iPairP (Pos 1 1) (iConstP (Pos 1 2) 1)
                                                        (iConstP (Pos 1 3) 2))

module Data.Comp.Term

module Data.Comp.Algebra

module Data.Comp.Sum

module Data.Comp.Product

module Data.Comp.Equality

module Data.Comp.Ordering

module Data.Comp.Generic