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