mirror of
https://github.com/coot/free-category.git
synced 2024-09-11 14:17:30 +03:00
foldrQ and folrQ for 'Queue'
This commit is contained in:
parent
93d0f96b5d
commit
c5d2d09539
@ -4,6 +4,7 @@
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
@ -37,6 +38,8 @@ module Control.Category.Free.Internal
|
||||
, uncons
|
||||
, snoc
|
||||
, foldQ
|
||||
, foldrQ
|
||||
, foldlQ
|
||||
, hoistQ
|
||||
, zipWithQ
|
||||
) where
|
||||
@ -225,7 +228,18 @@ pattern NilQ <- (uncons -> EmptyL) where
|
||||
{-# complete NilQ, ConsQ #-}
|
||||
#endif
|
||||
|
||||
-- | Efficient fold of a queue into a category.
|
||||
-- | 'foldr' of a 'Queue'
|
||||
--
|
||||
foldrQ :: forall (f :: k -> k -> *) c a b d.
|
||||
(forall x y z. f y z -> c x y -> c x z)
|
||||
-> c a b
|
||||
-> Queue f b d
|
||||
-> c a d
|
||||
foldrQ _nat ab NilQ = ab
|
||||
foldrQ nat ab (ConsQ xd bx) = nat xd (foldrQ nat ab bx)
|
||||
{-# INLINE foldrQ #-}
|
||||
|
||||
-- | Efficient fold of a queue into a category, analogous to 'foldM'.
|
||||
--
|
||||
-- /complexity/ @O\(n\)@
|
||||
--
|
||||
@ -234,11 +248,22 @@ foldQ :: forall (f :: k -> k -> *) c a b.
|
||||
=> (forall x y. f x y -> c x y)
|
||||
-> Queue f a b
|
||||
-> c a b
|
||||
foldQ nat q = case q of
|
||||
NilQ -> id
|
||||
ConsQ tr q' -> nat tr . foldQ nat q'
|
||||
foldQ nat = foldrQ (\f c -> nat f . c) id
|
||||
{-# INLINE foldQ #-}
|
||||
|
||||
-- | 'foldl' of a 'Queue'
|
||||
--
|
||||
-- TODO: make it strict, like 'foldl''.
|
||||
--
|
||||
foldlQ :: forall (f :: k -> k -> *) c a b d.
|
||||
(forall x y z. c y z -> f x y -> c x z)
|
||||
-> c b d
|
||||
-> Queue f a b
|
||||
-> c a d
|
||||
foldlQ _nat bd NilQ = bd
|
||||
foldlQ nat bd (ConsQ xb ax) = foldlQ nat (nat bd xb) ax
|
||||
{-# INLINE foldlQ #-}
|
||||
|
||||
zipWithQ :: forall f g a b a' b'.
|
||||
Category f
|
||||
=> (forall x y x' y'. f x y -> f x' y' -> f (g x x') (g y y'))
|
||||
|
Loading…
Reference in New Issue
Block a user