Portability | non-portable |
---|---|
Stability | experimental |
Maintainer | hpacheco@di.uminho.pt |
Pointless Haskell: point-free programming with recursion patterns as hylomorphisms
This module defines data types as fixed points of functor. 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 Id x = Id {
- unId :: x
- newtype Const t x = Cons {
- unCons :: t
- data (g :+: h) x
- data (g :*: h) x = Prod (g x) (h x)
- newtype (g :@: h) x = Comp {
- unComp :: g (h x)
- newtype Fix f = Fix {}
- type family PF a :: * -> *
- type family Rep f x :: *
- class Functor f where
- type F a x = Rep (PF a) x
- pmap :: Functor (PF a) => a -> (x -> y) -> F a x -> F a y
- class Mu a where
- data I = FixId
- data K a = FixConst {
- unFixConst :: a
- data a :+!: b = FixSum {}
- data a :*!: b = FixProd {}
- data a :@!: b = FixComp {}
- nil :: One -> [a]
- cons :: (a, [a]) -> [a]
- data Nat
- zero :: One -> Int
- suck :: Int -> Int
- true :: One -> Bool
- false :: One -> Bool
- maybe2bool :: Maybe a -> Bool
Functors
Definition and operations over functors
Identity functor.
Constant functor.
Sum of functors.
Product of functors.
Prod (g x) (h x) |
Composition of functors.
Explicit fixpoint operator.
type family PF a :: * -> *Source
Family of patterns functors of data types.
The type function is not necessarily injective, this is, different data types can have the same base functor.
Semantically, we can say that a =
.
Fix
f
type family Rep f x :: *Source
Family of functor representations.
The Rep
family implements the implicit coercion between the application of a functor and the structurally equivalent sum of products.
Functors applied to types can be represented as sums of products.
Polytypic Prelude.Functor
class for functor representations
Functor [] | The list functor maps the specific |
Functor Id | The identity functor applies the mapping function the argument type |
Functor (Const t) | The constant functor preserves the argument type |
(Functor g, Functor h) => Functor (:@: g h) | The composition functor applies in the nesting of the mapping function to the nested functor applications |
(Functor g, Functor h) => Functor (:*: g h) | The product functor recursively applies the mapping function to both sides |
(Functor g, Functor h) => Functor (:+: g h) | The sum functor recursively applies the mapping function to each alternative |
type F a x = Rep (PF a) xSource
Short alias to express the structurally equivalent sum of products for some data type
:: Functor (PF a) | |
=> a | A value of a data type that is the fixed point of the desired functor |
-> (x -> y) | |
-> F a x | |
-> F a y | The mapping over the equivalent sum of products |
Polytypic map function
The Mu
class provides the value-level translation between data types and their sum of products representations
Packs a sum of products into one equivalent data type
unpacks a data type into the equivalent sum of products
Fixpoint combinators
In order to simplify type-level composition of functors, we can create fixpoint combinators that implicitely assume fixpoint application.
FixConst | |
|
(Typeable a, Observable a) => Observable (K a) | |
Mu (K a) |
Default definitions for commonly used data types
List
Natural Numbers
Int (positive only)
Bool
Maybe
maybe2bool :: Maybe a -> BoolSource