Copyright | (c) 2009 University of Minho |
---|---|
License | BSD3 |
Maintainer | hpacheco@di.uminho.pt |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell98 |
Pointless Haskell: point-free programming with recursion patterns as hylomorphisms
This module defines polymorphic data types as fixed points of bifunctor. Pointless Haskell works on a view of data types as fixed points of functors, in the same style as the PolyP (http://www.cse.chalmers.se/~patrikj/poly/polyp/) library. Instead of using an explicit fixpoint operator, a type function is used to relate the data types with their equivalent functor representations.
- newtype BId a x = BId {
- unBId :: x
- newtype BConst t a x = BConst {
- unBConst :: t
- newtype BPar a x = Par {
- unPar :: a
- data (g :+| h) a x
- data (g :*| h) a x = BProd (g a x) (h a x)
- newtype (g :@| h) a x = BComp {
- unBComp :: g a (h a x)
- newtype BFix f = BFix {}
- type family BF f :: * -> * -> *
- type family BRep f a :: * -> *
- class Bifunctor f where
- type B d a x = Rep (BRep (BF d) a) x
- class Bimu d where
- pbmap :: Bifunctor (BF d) => Ann (d a) -> (a -> b) -> (x -> y) -> B d a x -> B d b y
- data BI x = FixBId
- data BK a x = FixBConst {
- unFixBConst :: a
- data (a :+!| b) x = FixBSum {}
- data (a :*!| b) x = FixBProd {
- unFixBProd :: B (a :*!| b) x ((a :*!| b) x)
- data (a :@!| b) x = FixBComp {
- unFixBComp :: B (a :@!| b) x ((a :@!| b) x)
Bifunctors
type family BRep f a :: * -> * Source
type BRep BPar a = Const a | |
type BRep BId a = Id | Representation of bifunctors with the |
type BRep (BConst t) a = Const t | |
type BRep ((:@|) g h) a = (:@:) (BRep g a) (BRep h a) | |
type BRep ((:*|) g h) a = (:*:) (BRep g a) (BRep h a) | |
type BRep ((:+|) g h) a = (:+:) (BRep g a) (BRep h a) |
class Bifunctor f where Source
The polytypic bifunctor zipping combinator.
Just maps over the polymorphic parameter. To map over the recursive parameter we can use fzip
.