{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Hoopl.Block
    ( C
    , O
    , MaybeO(..)
    , IndexedCO
    , Block(..)
    , blockAppend
    , blockCons
    , blockFromList
    , blockJoin
    , blockJoinHead
    , blockJoinTail
    , blockSnoc
    , blockSplit
    , blockSplitHead
    , blockSplitTail
    , blockToList
    , emptyBlock
    , firstNode
    , foldBlockNodesB
    , foldBlockNodesB3
    , foldBlockNodesF
    , isEmptyBlock
    , lastNode
    , mapBlock
    , mapBlock'
    , mapBlock3'
    , replaceFirstNode
    , replaceLastNode
    ) where

import GhcPrelude

-- -----------------------------------------------------------------------------
-- Shapes: Open and Closed

-- | Used at the type level to indicate an "open" structure with
-- a unique, unnamed control-flow edge flowing in or out.
-- "Fallthrough" and concatenation are permitted at an open point.
data O

-- | Used at the type level to indicate a "closed" structure which
-- supports control transfer only through the use of named
-- labels---no "fallthrough" is permitted.  The number of control-flow
-- edges is unconstrained.
data C

-- | Either type indexed by closed/open using type families
type family IndexedCO ex a b :: *
type instance IndexedCO C a _b = a
type instance IndexedCO O _a b = b

-- | Maybe type indexed by open/closed
data MaybeO ex t where
  JustO    :: t -> MaybeO O t
  NothingO ::      MaybeO C t

-- | Maybe type indexed by closed/open
data MaybeC ex t where
  JustC    :: t -> MaybeC C t
  NothingC ::      MaybeC O t


instance Functor (MaybeO ex) where
  fmap :: (a -> b) -> MaybeO ex a -> MaybeO ex b
fmap _ NothingO = MaybeO ex b
forall t. MaybeO C t
NothingO
  fmap f :: a -> b
f (JustO a :: a
a) = b -> MaybeO O b
forall t. t -> MaybeO O t
JustO (a -> b
f a
a)

instance Functor (MaybeC ex) where
  fmap :: (a -> b) -> MaybeC ex a -> MaybeC ex b
fmap _ NothingC = MaybeC ex b
forall t. MaybeC O t
NothingC
  fmap f :: a -> b
f (JustC a :: a
a) = b -> MaybeC C b
forall t. t -> MaybeC C t
JustC (a -> b
f a
a)

-- -----------------------------------------------------------------------------
-- The Block type

-- | A sequence of nodes.  May be any of four shapes (O/O, O/C, C/O, C/C).
-- Open at the entry means single entry, mutatis mutandis for exit.
-- A closed/closed block is a /basic/ block and can't be extended further.
-- Clients should avoid manipulating blocks and should stick to either nodes
-- or graphs.
data Block n e x where
  BlockCO  :: n C O -> Block n O O          -> Block n C O
  BlockCC  :: n C O -> Block n O O -> n O C -> Block n C C
  BlockOC  ::          Block n O O -> n O C -> Block n O C

  BNil    :: Block n O O
  BMiddle :: n O O                      -> Block n O O
  BCat    :: Block n O O -> Block n O O -> Block n O O
  BSnoc   :: Block n O O -> n O O       -> Block n O O
  BCons   :: n O O       -> Block n O O -> Block n O O


-- -----------------------------------------------------------------------------
-- Simple operations on Blocks

-- Predicates

isEmptyBlock :: Block n e x -> Bool
isEmptyBlock :: Block n e x -> Bool
isEmptyBlock BNil       = Bool
True
isEmptyBlock (BCat l :: Block n O O
l r :: Block n O O
r) = Block n O O -> Bool
forall (n :: * -> * -> *) e x. Block n e x -> Bool
isEmptyBlock Block n O O
l Bool -> Bool -> Bool
&& Block n O O -> Bool
forall (n :: * -> * -> *) e x. Block n e x -> Bool
isEmptyBlock Block n O O
r
isEmptyBlock _          = Bool
False


-- Building

emptyBlock :: Block n O O
emptyBlock :: Block n O O
emptyBlock = Block n O O
forall (n :: * -> * -> *). Block n O O
BNil

blockCons :: n O O -> Block n O x -> Block n O x
blockCons :: n O O -> Block n O x -> Block n O x
blockCons n :: n O O
n b :: Block n O x
b = case Block n O x
b of
  BlockOC b :: Block n O O
b l :: n O C
l  -> (Block n O O -> n O C -> Block n O C
forall (n :: * -> * -> *). Block n O O -> n O C -> Block n O C
BlockOC (Block n O O -> n O C -> Block n O C)
-> Block n O O -> n O C -> Block n O C
forall a b. (a -> b) -> a -> b
$! (n O O
n n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *) x. n O O -> Block n O x -> Block n O x
`blockCons` Block n O O
b)) n O C
l
  BNil{}    -> n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O
BMiddle n O O
n
  BMiddle{} -> n O O
n n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
`BCons` Block n O x
Block n O O
b
  BCat{}    -> n O O
n n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
`BCons` Block n O x
Block n O O
b
  BSnoc{}   -> n O O
n n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
`BCons` Block n O x
Block n O O
b
  BCons{}   -> n O O
n n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
`BCons` Block n O x
Block n O O
b

blockSnoc :: Block n e O -> n O O -> Block n e O
blockSnoc :: Block n e O -> n O O -> Block n e O
blockSnoc b :: Block n e O
b n :: n O O
n = case Block n e O
b of
  BlockCO f :: n C O
f b :: Block n O O
b -> n C O -> Block n O O -> Block n C O
forall (n :: * -> * -> *). n C O -> Block n O O -> Block n C O
BlockCO n C O
f (Block n O O -> Block n C O) -> Block n O O -> Block n C O
forall a b. (a -> b) -> a -> b
$! (Block n O O
b Block n O O -> n O O -> Block n O O
forall (n :: * -> * -> *) e. Block n e O -> n O O -> Block n e O
`blockSnoc` n O O
n)
  BNil{}      -> n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O
BMiddle n O O
n
  BMiddle{}   -> Block n e O
Block n O O
b Block n O O -> n O O -> Block n O O
forall (n :: * -> * -> *). Block n O O -> n O O -> Block n O O
`BSnoc` n O O
n
  BCat{}      -> Block n e O
Block n O O
b Block n O O -> n O O -> Block n O O
forall (n :: * -> * -> *). Block n O O -> n O O -> Block n O O
`BSnoc` n O O
n
  BSnoc{}     -> Block n e O
Block n O O
b Block n O O -> n O O -> Block n O O
forall (n :: * -> * -> *). Block n O O -> n O O -> Block n O O
`BSnoc` n O O
n
  BCons{}     -> Block n e O
Block n O O
b Block n O O -> n O O -> Block n O O
forall (n :: * -> * -> *). Block n O O -> n O O -> Block n O O
`BSnoc` n O O
n

blockJoinHead :: n C O -> Block n O x -> Block n C x
blockJoinHead :: n C O -> Block n O x -> Block n C x
blockJoinHead f :: n C O
f (BlockOC b :: Block n O O
b l :: n O C
l) = n C O -> Block n O O -> n O C -> Block n C C
forall (n :: * -> * -> *).
n C O -> Block n O O -> n O C -> Block n C C
BlockCC n C O
f Block n O O
b n O C
l
blockJoinHead f :: n C O
f b :: Block n O x
b = n C O -> Block n O O -> Block n C O
forall (n :: * -> * -> *). n C O -> Block n O O -> Block n C O
BlockCO n C O
f Block n O O
forall (n :: * -> * -> *). Block n O O
BNil Block n C O -> Block n O x -> Block n C x
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O x
b

blockJoinTail :: Block n e O -> n O C -> Block n e C
blockJoinTail :: Block n e O -> n O C -> Block n e C
blockJoinTail (BlockCO f :: n C O
f b :: Block n O O
b) t :: n O C
t = n C O -> Block n O O -> n O C -> Block n C C
forall (n :: * -> * -> *).
n C O -> Block n O O -> n O C -> Block n C C
BlockCC n C O
f Block n O O
b n O C
t
blockJoinTail b :: Block n e O
b t :: n O C
t = Block n e O
b Block n e O -> Block n O C -> Block n e C
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O O -> n O C -> Block n O C
forall (n :: * -> * -> *). Block n O O -> n O C -> Block n O C
BlockOC Block n O O
forall (n :: * -> * -> *). Block n O O
BNil n O C
t

blockJoin :: n C O -> Block n O O -> n O C -> Block n C C
blockJoin :: n C O -> Block n O O -> n O C -> Block n C C
blockJoin f :: n C O
f b :: Block n O O
b t :: n O C
t = n C O -> Block n O O -> n O C -> Block n C C
forall (n :: * -> * -> *).
n C O -> Block n O O -> n O C -> Block n C C
BlockCC n C O
f Block n O O
b n O C
t

blockAppend :: Block n e O -> Block n O x -> Block n e x
blockAppend :: Block n e O -> Block n O x -> Block n e x
blockAppend = Block n e O -> Block n O x -> Block n e x
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
cat


-- Taking apart

firstNode :: Block n C x -> n C O
firstNode :: Block n C x -> n C O
firstNode (BlockCO n :: n C O
n _)   = n C O
n
firstNode (BlockCC n :: n C O
n _ _) = n C O
n

lastNode :: Block n x C -> n O C
lastNode :: Block n x C -> n O C
lastNode (BlockOC   _ n :: n O C
n) = n O C
n
lastNode (BlockCC _ _ n :: n O C
n) = n O C
n

blockSplitHead :: Block n C x -> (n C O, Block n O x)
blockSplitHead :: Block n C x -> (n C O, Block n O x)
blockSplitHead (BlockCO n :: n C O
n b :: Block n O O
b)   = (n C O
n, Block n O x
Block n O O
b)
blockSplitHead (BlockCC n :: n C O
n b :: Block n O O
b t :: n O C
t) = (n C O
n, Block n O O -> n O C -> Block n O C
forall (n :: * -> * -> *). Block n O O -> n O C -> Block n O C
BlockOC Block n O O
b n O C
t)

blockSplitTail :: Block n e C -> (Block n e O, n O C)
blockSplitTail :: Block n e C -> (Block n e O, n O C)
blockSplitTail (BlockOC b :: Block n O O
b n :: n O C
n)   = (Block n e O
Block n O O
b, n O C
n)
blockSplitTail (BlockCC f :: n C O
f b :: Block n O O
b t :: n O C
t) = (n C O -> Block n O O -> Block n C O
forall (n :: * -> * -> *). n C O -> Block n O O -> Block n C O
BlockCO n C O
f Block n O O
b, n O C
t)

-- | Split a closed block into its entry node, open middle block, and
-- exit node.
blockSplit :: Block n C C -> (n C O, Block n O O, n O C)
blockSplit :: Block n C C -> (n C O, Block n O O, n O C)
blockSplit (BlockCC f :: n C O
f b :: Block n O O
b t :: n O C
t) = (n C O
f, Block n O O
b, n O C
t)

blockToList :: Block n O O -> [n O O]
blockToList :: Block n O O -> [n O O]
blockToList b :: Block n O O
b = Block n O O -> [n O O] -> [n O O]
forall (n :: * -> * -> *). Block n O O -> [n O O] -> [n O O]
go Block n O O
b []
   where go :: Block n O O -> [n O O] -> [n O O]
         go :: Block n O O -> [n O O] -> [n O O]
go BNil         r :: [n O O]
r = [n O O]
r
         go (BMiddle n :: n O O
n)  r :: [n O O]
r = n O O
n n O O -> [n O O] -> [n O O]
forall a. a -> [a] -> [a]
: [n O O]
r
         go (BCat b1 :: Block n O O
b1 b2 :: Block n O O
b2) r :: [n O O]
r = Block n O O -> [n O O] -> [n O O]
forall (n :: * -> * -> *). Block n O O -> [n O O] -> [n O O]
go Block n O O
b1 ([n O O] -> [n O O]) -> [n O O] -> [n O O]
forall a b. (a -> b) -> a -> b
$! Block n O O -> [n O O] -> [n O O]
forall (n :: * -> * -> *). Block n O O -> [n O O] -> [n O O]
go Block n O O
b2 [n O O]
r
         go (BSnoc b1 :: Block n O O
b1 n :: n O O
n) r :: [n O O]
r = Block n O O -> [n O O] -> [n O O]
forall (n :: * -> * -> *). Block n O O -> [n O O] -> [n O O]
go Block n O O
b1 (n O O
nn O O -> [n O O] -> [n O O]
forall a. a -> [a] -> [a]
:[n O O]
r)
         go (BCons n :: n O O
n b1 :: Block n O O
b1) r :: [n O O]
r = n O O
n n O O -> [n O O] -> [n O O]
forall a. a -> [a] -> [a]
: Block n O O -> [n O O] -> [n O O]
forall (n :: * -> * -> *). Block n O O -> [n O O] -> [n O O]
go Block n O O
b1 [n O O]
r

blockFromList :: [n O O] -> Block n O O
blockFromList :: [n O O] -> Block n O O
blockFromList = (n O O -> Block n O O -> Block n O O)
-> Block n O O -> [n O O] -> Block n O O
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
BCons Block n O O
forall (n :: * -> * -> *). Block n O O
BNil

-- Modifying

replaceFirstNode :: Block n C x -> n C O -> Block n C x
replaceFirstNode :: Block n C x -> n C O -> Block n C x
replaceFirstNode (BlockCO _ b :: Block n O O
b)   f :: n C O
f = n C O -> Block n O O -> Block n C O
forall (n :: * -> * -> *). n C O -> Block n O O -> Block n C O
BlockCO n C O
f Block n O O
b
replaceFirstNode (BlockCC _ b :: Block n O O
b n :: n O C
n) f :: n C O
f = n C O -> Block n O O -> n O C -> Block n C C
forall (n :: * -> * -> *).
n C O -> Block n O O -> n O C -> Block n C C
BlockCC n C O
f Block n O O
b n O C
n

replaceLastNode :: Block n x C -> n O C -> Block n x C
replaceLastNode :: Block n x C -> n O C -> Block n x C
replaceLastNode (BlockOC   b :: Block n O O
b _) n :: n O C
n = Block n O O -> n O C -> Block n O C
forall (n :: * -> * -> *). Block n O O -> n O C -> Block n O C
BlockOC Block n O O
b n O C
n
replaceLastNode (BlockCC l :: n C O
l b :: Block n O O
b _) n :: n O C
n = n C O -> Block n O O -> n O C -> Block n C C
forall (n :: * -> * -> *).
n C O -> Block n O O -> n O C -> Block n C C
BlockCC n C O
l Block n O O
b n O C
n

-- -----------------------------------------------------------------------------
-- General concatenation

cat :: Block n e O -> Block n O x -> Block n e x
cat :: Block n e O -> Block n O x -> Block n e x
cat x :: Block n e O
x y :: Block n O x
y = case Block n e O
x of
  BNil -> Block n e x
Block n O x
y

  BlockCO l :: n C O
l b1 :: Block n O O
b1 -> case Block n O x
y of
                   BlockOC b2 :: Block n O O
b2 n :: n O C
n -> (n C O -> Block n O O -> n O C -> Block n C C
forall (n :: * -> * -> *).
n C O -> Block n O O -> n O C -> Block n C C
BlockCC n C O
l (Block n O O -> n O C -> Block n C C)
-> Block n O O -> n O C -> Block n C C
forall a b. (a -> b) -> a -> b
$! (Block n O O
b1 Block n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O O
b2)) n O C
n
                   BNil         -> Block n e x
Block n e O
x
                   BMiddle _    -> n C O -> Block n O O -> Block n C O
forall (n :: * -> * -> *). n C O -> Block n O O -> Block n C O
BlockCO n C O
l (Block n O O -> Block n C O) -> Block n O O -> Block n C O
forall a b. (a -> b) -> a -> b
$! (Block n O O
b1 Block n O O -> Block n O x -> Block n O x
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O x
y)
                   BCat{}       -> n C O -> Block n O O -> Block n C O
forall (n :: * -> * -> *). n C O -> Block n O O -> Block n C O
BlockCO n C O
l (Block n O O -> Block n C O) -> Block n O O -> Block n C O
forall a b. (a -> b) -> a -> b
$! (Block n O O
b1 Block n O O -> Block n O x -> Block n O x
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O x
y)
                   BSnoc{}      -> n C O -> Block n O O -> Block n C O
forall (n :: * -> * -> *). n C O -> Block n O O -> Block n C O
BlockCO n C O
l (Block n O O -> Block n C O) -> Block n O O -> Block n C O
forall a b. (a -> b) -> a -> b
$! (Block n O O
b1 Block n O O -> Block n O x -> Block n O x
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O x
y)
                   BCons{}      -> n C O -> Block n O O -> Block n C O
forall (n :: * -> * -> *). n C O -> Block n O O -> Block n C O
BlockCO n C O
l (Block n O O -> Block n C O) -> Block n O O -> Block n C O
forall a b. (a -> b) -> a -> b
$! (Block n O O
b1 Block n O O -> Block n O x -> Block n O x
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O x
y)

  BMiddle n :: n O O
n -> case Block n O x
y of
                   BlockOC b2 :: Block n O O
b2 n2 :: n O C
n2 -> (Block n O O -> n O C -> Block n O C
forall (n :: * -> * -> *). Block n O O -> n O C -> Block n O C
BlockOC (Block n O O -> n O C -> Block n O C)
-> Block n O O -> n O C -> Block n O C
forall a b. (a -> b) -> a -> b
$! (Block n e O
x Block n e O -> Block n O O -> Block n e O
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O O
b2)) n O C
n2
                   BNil          -> Block n e x
Block n e O
x
                   BMiddle{}     -> n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
BCons n O O
n Block n O x
Block n O O
y
                   BCat{}        -> n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
BCons n O O
n Block n O x
Block n O O
y
                   BSnoc{}       -> n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
BCons n O O
n Block n O x
Block n O O
y
                   BCons{}       -> n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
BCons n O O
n Block n O x
Block n O O
y

  BCat{} -> case Block n O x
y of
                   BlockOC b3 :: Block n O O
b3 n2 :: n O C
n2 -> (Block n O O -> n O C -> Block n O C
forall (n :: * -> * -> *). Block n O O -> n O C -> Block n O C
BlockOC (Block n O O -> n O C -> Block n O C)
-> Block n O O -> n O C -> Block n O C
forall a b. (a -> b) -> a -> b
$! (Block n e O
x Block n e O -> Block n O O -> Block n e O
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O O
b3)) n O C
n2
                   BNil          -> Block n e x
Block n e O
x
                   BMiddle n :: n O O
n     -> Block n O O -> n O O -> Block n O O
forall (n :: * -> * -> *). Block n O O -> n O O -> Block n O O
BSnoc Block n e O
Block n O O
x n O O
n
                   BCat{}        -> Block n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat Block n e O
Block n O O
x Block n O x
Block n O O
y
                   BSnoc{}       -> Block n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat Block n e O
Block n O O
x Block n O x
Block n O O
y
                   BCons{}       -> Block n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat Block n e O
Block n O O
x Block n O x
Block n O O
y

  BSnoc{} -> case Block n O x
y of
                   BlockOC b2 :: Block n O O
b2 n2 :: n O C
n2 -> (Block n O O -> n O C -> Block n O C
forall (n :: * -> * -> *). Block n O O -> n O C -> Block n O C
BlockOC (Block n O O -> n O C -> Block n O C)
-> Block n O O -> n O C -> Block n O C
forall a b. (a -> b) -> a -> b
$! (Block n e O
x Block n e O -> Block n O O -> Block n e O
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O O
b2)) n O C
n2
                   BNil          -> Block n e x
Block n e O
x
                   BMiddle n :: n O O
n     -> Block n O O -> n O O -> Block n O O
forall (n :: * -> * -> *). Block n O O -> n O O -> Block n O O
BSnoc Block n e O
Block n O O
x n O O
n
                   BCat{}        -> Block n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat Block n e O
Block n O O
x Block n O x
Block n O O
y
                   BSnoc{}       -> Block n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat Block n e O
Block n O O
x Block n O x
Block n O O
y
                   BCons{}       -> Block n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat Block n e O
Block n O O
x Block n O x
Block n O O
y


  BCons{} -> case Block n O x
y of
                   BlockOC b2 :: Block n O O
b2 n2 :: n O C
n2 -> (Block n O O -> n O C -> Block n O C
forall (n :: * -> * -> *). Block n O O -> n O C -> Block n O C
BlockOC (Block n O O -> n O C -> Block n O C)
-> Block n O O -> n O C -> Block n O C
forall a b. (a -> b) -> a -> b
$! (Block n e O
x Block n e O -> Block n O O -> Block n e O
forall (n :: * -> * -> *) e x.
Block n e O -> Block n O x -> Block n e x
`cat` Block n O O
b2)) n O C
n2
                   BNil          -> Block n e x
Block n e O
x
                   BMiddle n :: n O O
n     -> Block n O O -> n O O -> Block n O O
forall (n :: * -> * -> *). Block n O O -> n O O -> Block n O O
BSnoc Block n e O
Block n O O
x n O O
n
                   BCat{}        -> Block n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat Block n e O
Block n O O
x Block n O x
Block n O O
y
                   BSnoc{}       -> Block n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat Block n e O
Block n O O
x Block n O x
Block n O O
y
                   BCons{}       -> Block n O O -> Block n O O -> Block n O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat Block n e O
Block n O O
x Block n O x
Block n O O
y


-- -----------------------------------------------------------------------------
-- Mapping

-- | map a function over the nodes of a 'Block'
mapBlock :: (forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x
mapBlock :: (forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x
mapBlock f :: forall e x. n e x -> n' e x
f (BlockCO n :: n C O
n b :: Block n O O
b  ) = n' C O -> Block n' O O -> Block n' C O
forall (n :: * -> * -> *). n C O -> Block n O O -> Block n C O
BlockCO (n C O -> n' C O
forall e x. n e x -> n' e x
f n C O
n) ((forall e x. n e x -> n' e x) -> Block n O O -> Block n' O O
forall (n :: * -> * -> *) (n' :: * -> * -> *) e x.
(forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x
mapBlock forall e x. n e x -> n' e x
f Block n O O
b)
mapBlock f :: forall e x. n e x -> n' e x
f (BlockOC   b :: Block n O O
b n :: n O C
n) = Block n' O O -> n' O C -> Block n' O C
forall (n :: * -> * -> *). Block n O O -> n O C -> Block n O C
BlockOC       ((forall e x. n e x -> n' e x) -> Block n O O -> Block n' O O
forall (n :: * -> * -> *) (n' :: * -> * -> *) e x.
(forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x
mapBlock forall e x. n e x -> n' e x
f Block n O O
b) (n O C -> n' O C
forall e x. n e x -> n' e x
f n O C
n)
mapBlock f :: forall e x. n e x -> n' e x
f (BlockCC n :: n C O
n b :: Block n O O
b m :: n O C
m) = n' C O -> Block n' O O -> n' O C -> Block n' C C
forall (n :: * -> * -> *).
n C O -> Block n O O -> n O C -> Block n C C
BlockCC (n C O -> n' C O
forall e x. n e x -> n' e x
f n C O
n) ((forall e x. n e x -> n' e x) -> Block n O O -> Block n' O O
forall (n :: * -> * -> *) (n' :: * -> * -> *) e x.
(forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x
mapBlock forall e x. n e x -> n' e x
f Block n O O
b) (n O C -> n' O C
forall e x. n e x -> n' e x
f n O C
m)
mapBlock _  BNil           = Block n' e x
forall (n :: * -> * -> *). Block n O O
BNil
mapBlock f :: forall e x. n e x -> n' e x
f (BMiddle n :: n O O
n)     = n' O O -> Block n' O O
forall (n :: * -> * -> *). n O O -> Block n O O
BMiddle (n O O -> n' O O
forall e x. n e x -> n' e x
f n O O
n)
mapBlock f :: forall e x. n e x -> n' e x
f (BCat b1 :: Block n O O
b1 b2 :: Block n O O
b2)    = Block n' O O -> Block n' O O -> Block n' O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat    ((forall e x. n e x -> n' e x) -> Block n O O -> Block n' O O
forall (n :: * -> * -> *) (n' :: * -> * -> *) e x.
(forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x
mapBlock forall e x. n e x -> n' e x
f Block n O O
b1) ((forall e x. n e x -> n' e x) -> Block n O O -> Block n' O O
forall (n :: * -> * -> *) (n' :: * -> * -> *) e x.
(forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x
mapBlock forall e x. n e x -> n' e x
f Block n O O
b2)
mapBlock f :: forall e x. n e x -> n' e x
f (BSnoc b :: Block n O O
b n :: n O O
n)     = Block n' O O -> n' O O -> Block n' O O
forall (n :: * -> * -> *). Block n O O -> n O O -> Block n O O
BSnoc   ((forall e x. n e x -> n' e x) -> Block n O O -> Block n' O O
forall (n :: * -> * -> *) (n' :: * -> * -> *) e x.
(forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x
mapBlock forall e x. n e x -> n' e x
f Block n O O
b)  (n O O -> n' O O
forall e x. n e x -> n' e x
f n O O
n)
mapBlock f :: forall e x. n e x -> n' e x
f (BCons n :: n O O
n b :: Block n O O
b)     = n' O O -> Block n' O O -> Block n' O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
BCons   (n O O -> n' O O
forall e x. n e x -> n' e x
f n O O
n)  ((forall e x. n e x -> n' e x) -> Block n O O -> Block n' O O
forall (n :: * -> * -> *) (n' :: * -> * -> *) e x.
(forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x
mapBlock forall e x. n e x -> n' e x
f Block n O O
b)

-- | A strict 'mapBlock'
mapBlock' :: (forall e x. n e x -> n' e x) -> (Block n e x -> Block n' e x)
mapBlock' :: (forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x
mapBlock' f :: forall e x. n e x -> n' e x
f = (n C O -> n' C O, n O O -> n' O O, n O C -> n' O C)
-> Block n e x -> Block n' e x
forall (n :: * -> * -> *) (n' :: * -> * -> *) e x.
(n C O -> n' C O, n O O -> n' O O, n O C -> n' O C)
-> Block n e x -> Block n' e x
mapBlock3' (n C O -> n' C O
forall e x. n e x -> n' e x
f, n O O -> n' O O
forall e x. n e x -> n' e x
f, n O C -> n' O C
forall e x. n e x -> n' e x
f)

-- | map over a block, with different functions to apply to first nodes,
-- middle nodes and last nodes respectively.  The map is strict.
--
mapBlock3' :: forall n n' e x .
             ( n C O -> n' C O
             , n O O -> n' O O,
               n O C -> n' O C)
          -> Block n e x -> Block n' e x
mapBlock3' :: (n C O -> n' C O, n O O -> n' O O, n O C -> n' O C)
-> Block n e x -> Block n' e x
mapBlock3' (f :: n C O -> n' C O
f, m :: n O O -> n' O O
m, l :: n O C -> n' O C
l) b :: Block n e x
b = Block n e x -> Block n' e x
forall e x. Block n e x -> Block n' e x
go Block n e x
b
  where go :: forall e x . Block n e x -> Block n' e x
        go :: Block n e x -> Block n' e x
go (BlockOC b :: Block n O O
b y :: n O C
y)   = (Block n' O O -> n' O C -> Block n' O C
forall (n :: * -> * -> *). Block n O O -> n O C -> Block n O C
BlockOC (Block n' O O -> n' O C -> Block n' O C)
-> Block n' O O -> n' O C -> Block n' O C
forall a b. (a -> b) -> a -> b
$! Block n O O -> Block n' O O
forall e x. Block n e x -> Block n' e x
go Block n O O
b) (n' O C -> Block n' O C) -> n' O C -> Block n' O C
forall a b. (a -> b) -> a -> b
$! n O C -> n' O C
l n O C
y
        go (BlockCO x :: n C O
x b :: Block n O O
b)   = (n' C O -> Block n' O O -> Block n' C O
forall (n :: * -> * -> *). n C O -> Block n O O -> Block n C O
BlockCO (n' C O -> Block n' O O -> Block n' C O)
-> n' C O -> Block n' O O -> Block n' C O
forall a b. (a -> b) -> a -> b
$! n C O -> n' C O
f n C O
x) (Block n' O O -> Block n' C O) -> Block n' O O -> Block n' C O
forall a b. (a -> b) -> a -> b
$! (Block n O O -> Block n' O O
forall e x. Block n e x -> Block n' e x
go Block n O O
b)
        go (BlockCC x :: n C O
x b :: Block n O O
b y :: n O C
y) = ((n' C O -> Block n' O O -> n' O C -> Block n' C C
forall (n :: * -> * -> *).
n C O -> Block n O O -> n O C -> Block n C C
BlockCC (n' C O -> Block n' O O -> n' O C -> Block n' C C)
-> n' C O -> Block n' O O -> n' O C -> Block n' C C
forall a b. (a -> b) -> a -> b
$! n C O -> n' C O
f n C O
x) (Block n' O O -> n' O C -> Block n' C C)
-> Block n' O O -> n' O C -> Block n' C C
forall a b. (a -> b) -> a -> b
$! Block n O O -> Block n' O O
forall e x. Block n e x -> Block n' e x
go Block n O O
b) (n' O C -> Block n' C C) -> n' O C -> Block n' C C
forall a b. (a -> b) -> a -> b
$! (n O C -> n' O C
l n O C
y)
        go BNil            = Block n' e x
forall (n :: * -> * -> *). Block n O O
BNil
        go (BMiddle n :: n O O
n)     = n' O O -> Block n' O O
forall (n :: * -> * -> *). n O O -> Block n O O
BMiddle (n' O O -> Block n' O O) -> n' O O -> Block n' O O
forall a b. (a -> b) -> a -> b
$! n O O -> n' O O
m n O O
n
        go (BCat x :: Block n O O
x y :: Block n O O
y)      = (Block n' O O -> Block n' O O -> Block n' O O
forall (n :: * -> * -> *).
Block n O O -> Block n O O -> Block n O O
BCat (Block n' O O -> Block n' O O -> Block n' O O)
-> Block n' O O -> Block n' O O -> Block n' O O
forall a b. (a -> b) -> a -> b
$! Block n O O -> Block n' O O
forall e x. Block n e x -> Block n' e x
go Block n O O
x) (Block n' O O -> Block n' O O) -> Block n' O O -> Block n' O O
forall a b. (a -> b) -> a -> b
$! (Block n O O -> Block n' O O
forall e x. Block n e x -> Block n' e x
go Block n O O
y)
        go (BSnoc x :: Block n O O
x n :: n O O
n)     = (Block n' O O -> n' O O -> Block n' O O
forall (n :: * -> * -> *). Block n O O -> n O O -> Block n O O
BSnoc (Block n' O O -> n' O O -> Block n' O O)
-> Block n' O O -> n' O O -> Block n' O O
forall a b. (a -> b) -> a -> b
$! Block n O O -> Block n' O O
forall e x. Block n e x -> Block n' e x
go Block n O O
x) (n' O O -> Block n' O O) -> n' O O -> Block n' O O
forall a b. (a -> b) -> a -> b
$! (n O O -> n' O O
m n O O
n)
        go (BCons n :: n O O
n x :: Block n O O
x)     = (n' O O -> Block n' O O -> Block n' O O
forall (n :: * -> * -> *). n O O -> Block n O O -> Block n O O
BCons (n' O O -> Block n' O O -> Block n' O O)
-> n' O O -> Block n' O O -> Block n' O O
forall a b. (a -> b) -> a -> b
$! n O O -> n' O O
m n O O
n) (Block n' O O -> Block n' O O) -> Block n' O O -> Block n' O O
forall a b. (a -> b) -> a -> b
$! (Block n O O -> Block n' O O
forall e x. Block n e x -> Block n' e x
go Block n O O
x)

-- -----------------------------------------------------------------------------
-- Folding


-- | Fold a function over every node in a block, forward or backward.
-- The fold function must be polymorphic in the shape of the nodes.
foldBlockNodesF3 :: forall n a b c .
                   ( n C O       -> a -> b
                   , n O O       -> b -> b
                   , n O C       -> b -> c)
                 -> (forall e x . Block n e x -> IndexedCO e a b -> IndexedCO x c b)
foldBlockNodesF  :: forall n a .
                    (forall e x . n e x       -> a -> a)
                 -> (forall e x . Block n e x -> IndexedCO e a a -> IndexedCO x a a)
foldBlockNodesB3 :: forall n a b c .
                   ( n C O       -> b -> c
                   , n O O       -> b -> b
                   , n O C       -> a -> b)
                 -> (forall e x . Block n e x -> IndexedCO x a b -> IndexedCO e c b)
foldBlockNodesB  :: forall n a .
                    (forall e x . n e x       -> a -> a)
                 -> (forall e x . Block n e x -> IndexedCO x a a -> IndexedCO e a a)

foldBlockNodesF3 :: (n C O -> a -> b, n O O -> b -> b, n O C -> b -> c)
-> forall e x. Block n e x -> IndexedCO e a b -> IndexedCO x c b
foldBlockNodesF3 (ff :: n C O -> a -> b
ff, fm :: n O O -> b -> b
fm, fl :: n O C -> b -> c
fl) = Block n e x -> IndexedCO e a b -> IndexedCO x c b
forall e x. Block n e x -> IndexedCO e a b -> IndexedCO x c b
block
  where block :: forall e x . Block n e x -> IndexedCO e a b -> IndexedCO x c b
        block :: Block n e x -> IndexedCO e a b -> IndexedCO x c b
block (BlockCO f :: n C O
f b :: Block n O O
b  )   = n C O -> a -> b
ff n C O
f (a -> b) -> (b -> b) -> a -> b
forall a b c. (a -> b) -> (b -> c) -> a -> c
`cat` Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO e a b -> IndexedCO x c b
block Block n O O
b
        block (BlockCC f :: n C O
f b :: Block n O O
b l :: n O C
l)   = n C O -> a -> b
ff n C O
f (a -> b) -> (b -> b) -> a -> b
forall a b c. (a -> b) -> (b -> c) -> a -> c
`cat` Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO e a b -> IndexedCO x c b
block Block n O O
b (a -> b) -> (b -> c) -> a -> c
forall a b c. (a -> b) -> (b -> c) -> a -> c
`cat` n O C -> b -> c
fl n O C
l
        block (BlockOC   b :: Block n O O
b l :: n O C
l)   =            Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO e a b -> IndexedCO x c b
block Block n O O
b (b -> b) -> (b -> c) -> b -> c
forall a b c. (a -> b) -> (b -> c) -> a -> c
`cat` n O C -> b -> c
fl n O C
l
        block BNil              = IndexedCO e a b -> IndexedCO x c b
forall a. a -> a
id
        block (BMiddle node :: n O O
node)    = n O O -> b -> b
fm n O O
node
        block (b1 :: Block n O O
b1 `BCat`    b2 :: Block n O O
b2) = Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO e a b -> IndexedCO x c b
block Block n O O
b1 (b -> b) -> (b -> b) -> b -> b
forall a b c. (a -> b) -> (b -> c) -> a -> c
`cat` Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO e a b -> IndexedCO x c b
block Block n O O
b2
        block (b1 :: Block n O O
b1 `BSnoc` n :: n O O
n)    = Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO e a b -> IndexedCO x c b
block Block n O O
b1 (b -> b) -> (b -> b) -> b -> b
forall a b c. (a -> b) -> (b -> c) -> a -> c
`cat` n O O -> b -> b
fm n O O
n
        block (n :: n O O
n `BCons` b2 :: Block n O O
b2)    = n O O -> b -> b
fm n O O
n (b -> b) -> (b -> b) -> b -> b
forall a b c. (a -> b) -> (b -> c) -> a -> c
`cat` Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO e a b -> IndexedCO x c b
block Block n O O
b2
        cat :: forall a b c. (a -> b) -> (b -> c) -> a -> c
        cat :: (a -> b) -> (b -> c) -> a -> c
cat f :: a -> b
f f' :: b -> c
f' = b -> c
f' (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

foldBlockNodesF :: (forall e x. n e x -> a -> a)
-> forall e x. Block n e x -> IndexedCO e a a -> IndexedCO x a a
foldBlockNodesF f :: forall e x. n e x -> a -> a
f = (n C O -> a -> a, n O O -> a -> a, n O C -> a -> a)
-> forall e x. Block n e x -> IndexedCO e a a -> IndexedCO x a a
forall (n :: * -> * -> *) a b c.
(n C O -> a -> b, n O O -> b -> b, n O C -> b -> c)
-> forall e x. Block n e x -> IndexedCO e a b -> IndexedCO x c b
foldBlockNodesF3 (n C O -> a -> a
forall e x. n e x -> a -> a
f, n O O -> a -> a
forall e x. n e x -> a -> a
f, n O C -> a -> a
forall e x. n e x -> a -> a
f)

foldBlockNodesB3 :: (n C O -> b -> c, n O O -> b -> b, n O C -> a -> b)
-> forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
foldBlockNodesB3 (ff :: n C O -> b -> c
ff, fm :: n O O -> b -> b
fm, fl :: n O C -> a -> b
fl) = Block n e x -> IndexedCO x a b -> IndexedCO e c b
forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
block
  where block :: forall e x . Block n e x -> IndexedCO x a b -> IndexedCO e c b
        block :: Block n e x -> IndexedCO x a b -> IndexedCO e c b
block (BlockCO f :: n C O
f b :: Block n O O
b  )   = n C O -> b -> c
ff n C O
f (b -> c) -> (b -> b) -> b -> c
forall a b c. (b -> c) -> (a -> b) -> a -> c
`cat` Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
block Block n O O
b
        block (BlockCC f :: n C O
f b :: Block n O O
b l :: n O C
l)   = n C O -> b -> c
ff n C O
f (b -> c) -> (b -> b) -> b -> c
forall a b c. (b -> c) -> (a -> b) -> a -> c
`cat` Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
block Block n O O
b (b -> c) -> (a -> b) -> a -> c
forall a b c. (b -> c) -> (a -> b) -> a -> c
`cat` n O C -> a -> b
fl n O C
l
        block (BlockOC   b :: Block n O O
b l :: n O C
l)   =            Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
block Block n O O
b (b -> b) -> (a -> b) -> a -> b
forall a b c. (b -> c) -> (a -> b) -> a -> c
`cat` n O C -> a -> b
fl n O C
l
        block BNil              = IndexedCO x a b -> IndexedCO e c b
forall a. a -> a
id
        block (BMiddle node :: n O O
node)    = n O O -> b -> b
fm n O O
node
        block (b1 :: Block n O O
b1 `BCat`    b2 :: Block n O O
b2) = Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
block Block n O O
b1 (b -> b) -> (b -> b) -> b -> b
forall a b c. (b -> c) -> (a -> b) -> a -> c
`cat` Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
block Block n O O
b2
        block (b1 :: Block n O O
b1 `BSnoc` n :: n O O
n)    = Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
block Block n O O
b1 (b -> b) -> (b -> b) -> b -> b
forall a b c. (b -> c) -> (a -> b) -> a -> c
`cat` n O O -> b -> b
fm n O O
n
        block (n :: n O O
n `BCons` b2 :: Block n O O
b2)    = n O O -> b -> b
fm n O O
n (b -> b) -> (b -> b) -> b -> b
forall a b c. (b -> c) -> (a -> b) -> a -> c
`cat` Block n O O -> IndexedCO O a b -> IndexedCO O c b
forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
block Block n O O
b2
        cat :: forall a b c. (b -> c) -> (a -> b) -> a -> c
        cat :: (b -> c) -> (a -> b) -> a -> c
cat f :: b -> c
f f' :: a -> b
f' = b -> c
f (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f'

foldBlockNodesB :: (forall e x. n e x -> a -> a)
-> forall e x. Block n e x -> IndexedCO x a a -> IndexedCO e a a
foldBlockNodesB f :: forall e x. n e x -> a -> a
f = (n C O -> a -> a, n O O -> a -> a, n O C -> a -> a)
-> forall e x. Block n e x -> IndexedCO x a a -> IndexedCO e a a
forall (n :: * -> * -> *) a b c.
(n C O -> b -> c, n O O -> b -> b, n O C -> a -> b)
-> forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
foldBlockNodesB3 (n C O -> a -> a
forall e x. n e x -> a -> a
f, n O O -> a -> a
forall e x. n e x -> a -> a
f, n O C -> a -> a
forall e x. n e x -> a -> a
f)