This module imprements a Point-Free library using Formal Methods approach. See Mpi.hs or CP.hs from http://www.di.uminho.pt/ \begin{code} -- | -- Maintainer : silva.samuel@alumni.uminho.pt -- Stability : experimental -- Portability: portable -- This module implements Point-Free library module Music.Analysis.PF where import Data.Maybe (Maybe(..), maybe) import Data.Either (Either(..), either) import Data.Bool (Bool) import Data.Tuple (uncurry, curry, fst, snd) import Data.Function ((.), ($), id, const) import Data.List ((++)) import Prelude () infix 5 >< infix 4 -|- \end{code} \begin{code} -- * Product -- ** Combinators -- | split split :: (a -> b) -> (a -> c) -> a -> (b,c) split f g x = (f x, g x) -- | product (><) :: (a -> b) -> (c -> d) -> (a,c) -> (b,d) f >< g = split (f . p1) (g . p2) -- | the 0-adic split (!) :: a -> () (!) = const () \end{code} \begin{code} -- ** Renamings -- | fst p1 :: (a, b) -> a p1 = fst -- | snd p2 :: (a, b) -> b p2 = snd \end{code} \begin{code} -- * Coproduct -- ** Renamings -- | Left i1 :: a -> Either a b i1 = Left -- | Right i2 :: b -> Either a b i2 = Right -- ** Combinators -- either is predefined -- | sum (-|-) :: (a -> b) -> (c -> d) -> Either a c -> Either b d f -|- g = either (i1 . f) (i2 . g) -- | McCarthy's conditional: cond :: (b -> Bool) -> (b -> c) -> (b -> c) -> b -> c cond p f g = (either f g) . (grd p) \end{code} \begin{code} -- * Exponentiation -- ** Combinators -- curry is predefined -- | ap ap :: (a -> b,a) -> b ap = uncurry ($) -- | expn expn :: (b -> c) -> (a -> b) -> a -> c expn f = curry (f . ap) -- exponentiation functor is (a->) predefined \end{code} \begin{code} -- * Others -- @const :: a -> b -> a st @ -- @const a x = a is predefined@ -- | guard grd :: (a -> Bool) -> a -> Either a a grd p x = if p x then Left x else Right x \end{code} \begin{code} -- * Natural isomorphisms -- | swap swap :: (a,b) -> (b,a) swap = split snd fst -- | assoc right assocr :: ((a,b),c) -> (a,(b,c)) assocr = split ( fst . fst ) (split ( snd . fst ) snd ) -- | assoc left assocl :: (a,(b,c)) -> ((a,b),c) assocl = split ( id >< p1 ) ( p2 . p2 ) -- | dist right distr :: (a,Either b c) -> Either (a,b) (a,c) distr (a, Left b) = i1 (a, b) distr (a, Right c) = i2 (a, c) -- | undist right undistr :: Either (a,b) (a,c) -> (a,Either b c) undistr = either ( id >< i1 ) ( id >< i2 ) -- | flat right flatr :: (a,(b,c)) -> (a,b,c) flatr (a,(b,c)) = (a,b,c) -- | flat left flatl :: ((a,b),c) -> (a,b,c) flatl ((b,c),d) = (b,c,d) -- | unflat right unflatr :: (a,b,c) -> (a,(b,c)) unflatr (a,b,c) = (a,(b,c)) -- | unflat left unflatl :: (a,b,c) -> ((a,b),c) unflatl (b,c,d) = ((b,c),d) -- | pair with nil pwnil :: a -> (a,()) -- pwnil means 'pair with nil' pwnil = split id (!) -- | coswap coswap :: Either a b -> Either b a coswap = either i2 i1 -- | coassoc right coassocr :: Either (Either a b) c -> Either a (Either b c) coassocr = either (id -|- i1) (i2 . i2) \end{code} \begin{code} -- * More funtions -- | maybe 2 Either maybe2either :: Maybe a -> Either () a maybe2either Nothing = Left () maybe2either (Just v) = Right v -- | either 2 maybe either2maybe :: Either () a -> Maybe a either2maybe (Left ()) = Nothing either2maybe (Right a) = Just a -- | Binding to either2maybe e2m :: Either () a -> Maybe a e2m = either2maybe -- | Binding to maybe2either m2e :: Maybe a -> Either () a m2e = maybe2either \end{code} \begin{code} -- * Algebras and Co-Algebras -- | out outL :: [a] -> Maybe (a, [a]) outL [] = Nothing outL (h:t) = Just (h,t) -- | catamorphism cataL :: (Maybe (a, c) -> c) -> [a] -> c cataL g = g . e2m . (id -|- id >< cataL g) . m2e . outL -- | in inL :: Maybe (a, [a]) -> [a] inL Nothing = [] inL (Just v) = uncurry (:) v -- | anamorphism anaL :: (c -> Maybe (a, c)) -> c -> [a] anaL g = inL . e2m . (id -|- id >< anaL g) . m2e . g -- | hylomorphism hyloL :: (Maybe (c, b) -> b) -> (a -> Maybe (c, a)) -> a -> b hyloL g h = g . e2m . (id -|- id >< hyloL g h) . m2e . h \end{code} \begin{code} -- | mapping mapL :: (a -> b) -> [a] -> [b] mapL f = cataL (maybe [] (uncurry (:) . (f >< id))) -- | concat concatL :: [[a]] -> [a] concatL = cataL (maybe [] (uncurry (++))) -- | reverse reverseL :: [a] -> [a] reverseL = cataL (maybe [] (uncurry (++) . swap . ((:[]). id >< id))) \end{code} \begin{code} -- * Algebras and Co-Algebras -- | out outL1 :: [a] -> Maybe (Either a (a, [a])) outL1 [] = Nothing outL1 [x] = Just (i1 x) outL1 (h:t) = Just (i2 (h,t)) -- | catamorphism cataL1 :: (Maybe (Either a (a, c)) -> c) -> [a] -> c cataL1 g = g . e2m . (id -|- (id -|- id >< cataL1 g)) . m2e . outL1 -- | in inL1 :: Maybe (Either a (a, [a])) -> [a] inL1 Nothing = [] inL1 (Just v) = either (:[]) (uncurry (:)) v -- | anamorphism anaL1 :: (c -> Maybe (Either a (a, c))) -> c -> [a] anaL1 g = inL1 . e2m . (id -|- (id -|- id >< anaL1 g)) . m2e . g -- | hylomorphism hyloL1 :: (Maybe (Either d (c, b)) -> b) -> (a -> Maybe (Either d (c, a))) -> a -> b hyloL1 g h = g . e2m . (id -|- (id -|- id >< hyloL1 g h)) . m2e . h \end{code}