1
1
mirror of https://github.com/coot/free-category.git synced 2024-09-11 14:17:30 +03:00

Optimisations of 'Cat'

Adding INLINE pragmas, optimising order of pattern matches.
This commit is contained in:
Marcin Szamotulski 2019-09-01 13:18:37 +02:00
parent 3b9c127ff8
commit 5864b3ad7f

View File

@ -85,6 +85,7 @@ arrCat :: forall (f :: k -> k -> *) a b.
f a b
-> Cat f a b
arrCat fab = Cat fab emptyQ
{-# INLINE arrCat #-}
-- | Smart constructor 'mapCat' for morphisms of @'Cat' f@ category.
--
@ -108,17 +109,15 @@ foldCat nat (Cat tr q) =
NilQ -> nat tr
ConsQ Id q' -> nat tr . foldQ (foldCat nat) q'
ConsQ c q' -> nat tr . foldCat nat c . foldQ (foldCat nat) q'
-- TODO: implement foldl; it might require different representation. Function
-- composition is applied from right to left, so it should be more efficient.
{-# INLINE foldCat #-}
-- | /complexity/ of composition @('.')@: @O\(1\)@ (worst case)
instance Category (Cat f) where
id = Id
Id . f = f
f . Id = f
Cat f q . h = Cat f (q `snoc` h)
Id . f = f
{-# INLINE (.) #-}
type instance AlgebraType0 Cat f = ()
type instance AlgebraType Cat c = Category c
@ -128,10 +127,8 @@ type instance AlgebraType Cat c = Category c
--
instance FreeAlgebra2 Cat where
liftFree2 = arrCat
{-# INLINE liftFree2 #-}
foldNatFree2 = foldCat
{-# INLINE foldNatFree2 #-}
codom2 = proof
forget2 = proof
@ -181,6 +178,7 @@ newtype C f a b
instance Category (C f) where
id = C (const id)
C bc . C ab = C $ \k -> bc k . ab k
{-# INLINE (.) #-}
-- |
-- Isomorphism from @'Cat'@ to @'C'@, which is a specialisation of