{-# LANGUAGE CPP #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK not-home #-}
{-# OPTIONS_GHC -fno-warn-monomorphism-restriction #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2015-2017 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-----------------------------------------------------------------------------

module Data.Struct.Internal.LinkCut where

import Control.Exception
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Struct.Internal
import Data.Struct.TH

-- $setup
-- >>> import Data.Struct.Internal.LinkCut

#ifdef HLINT
{-# ANN module "HLint: ignore Reduce duplication" #-}
{-# ANN module "HLint: ignore Redundant do" #-}
#endif

-- | Amortized Link-Cut trees via splay trees based on Tarjan's little book.
--
-- These support O(log n) operations for a lot of stuff.
--
-- The parameter `a` is an arbitrary user-supplied monoid that will be summarized
-- along the path to the root of the tree.
--
-- In this example the choice of 'Monoid' is 'String', so we can get a textual description of the path to the root.
--
-- >>> x <- new "x"
-- >>> y <- new "y"
-- >>> link x y -- now x is a child of y
-- >>> x == y
-- False
-- >>> connected x y
-- True
-- >>> z <- new "z"
-- >>> link z x -- now z is a child of y
-- >>> (y ==) <$> root z
-- True
-- >>> cost z
-- "yxz"
-- >>> w <- new "w"
-- >>> u <- new "u"
-- >>> v <- new "v"
-- >>> link u w
-- >>> link v z
-- >>> link w z
-- >>> cost u
-- "yxzwu"
-- >>> (y ==) <$> root v
-- True
-- >>> connected x v
-- True
-- >>> cut z
--
-- @
--      y
--     x          z    y
--    z    ==>   w v  x
--   w v        u
--  u
-- @
--
-- >>> connected x v
-- False
-- >>> cost u
-- "zwu"
-- >>> (z ==) <$> root v
-- True
makeStruct [d|
  data LinkCut a s = LinkCut
    { path, parent, left, right :: !(LinkCut a s)
    , value, summary :: a
    }
   |]

-- | O(1). Allocate a new link-cut tree with a given monoidal summary.
new :: PrimMonad m => a -> m (LinkCut a (PrimState m))
new :: forall (m :: * -> *) a.
PrimMonad m =>
a -> m (LinkCut a (PrimState m))
new a
a = forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (forall a (m :: * -> *).
PrimMonad m =>
LinkCut a (PrimState m)
-> LinkCut a (PrimState m)
-> LinkCut a (PrimState m)
-> LinkCut a (PrimState m)
-> a
-> a
-> m (LinkCut a (PrimState m))
newLinkCut forall (t :: * -> *) s. Struct t => t s
Nil forall (t :: * -> *) s. Struct t => t s
Nil forall (t :: * -> *) s. Struct t => t s
Nil forall (t :: * -> *) s. Struct t => t s
Nil a
a a
a)
{-# INLINE new #-}

-- | O(log n). @'cut' v@ removes the linkage between @v@ upwards to whatever tree it was in, making @v@ a root node.
--
-- Repeated calls on the same value without intermediate accesses are O(1).
cut :: (PrimMonad m, Monoid a) => LinkCut a (PrimState m) -> m ()
cut :: forall (m :: * -> *) a.
(PrimMonad m, Monoid a) =>
LinkCut a (PrimState m) -> m ()
cut LinkCut a (PrimState m)
this = forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st forall a b. (a -> b) -> a -> b
$ do
  forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
this
  LinkCut a (PrimState m)
l <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a (PrimState m)
this
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a (PrimState m)
l) forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a (PrimState m)
this forall (t :: * -> *) s. Struct t => t s
Nil
    forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a (PrimState m)
l forall (t :: * -> *) s. Struct t => t s
Nil
    a
v <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a (PrimState m)
this
    forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a (PrimState m)
this a
v
{-# INLINE cut #-}

-- | O(log n). @'link' v w@ inserts @v@ which must be the root of a tree in as a child of @w@. @v@ and @w@ must not be 'connected'.
link :: (PrimMonad m, Monoid a) => LinkCut a (PrimState m) -> LinkCut a (PrimState m) -> m ()
link :: forall (m :: * -> *) a.
(PrimMonad m, Monoid a) =>
LinkCut a (PrimState m) -> LinkCut a (PrimState m) -> m ()
link LinkCut a (PrimState m)
v LinkCut a (PrimState m)
w = forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st forall a b. (a -> b) -> a -> b
$ do
  --   w          w<~v
  --  a  , v  => a
  --
  --
  forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
v
  forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
w
  forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a (PrimState m)
v LinkCut a (PrimState m)
w
{-# INLINE link #-}

-- | O(log n). @'connected' v w@ determines if @v@ and @w@ inhabit the same tree.
connected :: (PrimMonad m, Monoid a) => LinkCut a (PrimState m) -> LinkCut a (PrimState m) -> m Bool
connected :: forall (m :: * -> *) a.
(PrimMonad m, Monoid a) =>
LinkCut a (PrimState m) -> LinkCut a (PrimState m) -> m Bool
connected LinkCut a (PrimState m)
v LinkCut a (PrimState m)
w = forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> a -> Bool
(==) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PrimMonad m, Monoid a) =>
LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
root LinkCut a (PrimState m)
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(PrimMonad m, Monoid a) =>
LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
root LinkCut a (PrimState m)
w
{-# INLINE connected #-}

-- | O(log n). @'cost' v@ computes the root-to-leaf path cost of @v@ under whatever 'Monoid' was built into the tree.
--
-- Repeated calls on the same value without intermediate accesses are O(1).
cost :: (PrimMonad m, Monoid a) => LinkCut a (PrimState m) -> m a
cost :: forall (m :: * -> *) a.
(PrimMonad m, Monoid a) =>
LinkCut a (PrimState m) -> m a
cost LinkCut a (PrimState m)
v = forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st forall a b. (a -> b) -> a -> b
$ do
  forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
v
  forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
summary LinkCut a (PrimState m)
v
{-# INLINE cost #-}

-- | O(log n). Find the root of a tree.
--
-- Repeated calls on the same value without intermediate accesses are O(1).
root :: (PrimMonad m, Monoid a) => LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
root :: forall (m :: * -> *) a.
(PrimMonad m, Monoid a) =>
LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
root LinkCut a (PrimState m)
this = forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st forall a b. (a -> b) -> a -> b
$ do
    forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
this
    LinkCut a (PrimState m)
r <- forall {m :: * -> *} {a}.
PrimMonad m =>
LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
leftmost LinkCut a (PrimState m)
this
    forall a s. Monoid a => LinkCut a s -> ST s ()
splay LinkCut a (PrimState m)
r -- r is already in the root aux tree
    forall (m :: * -> *) a. Monad m => a -> m a
return LinkCut a (PrimState m)
r
  where
    leftmost :: LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
leftmost LinkCut a (PrimState m)
v = do
      LinkCut a (PrimState m)
l <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a (PrimState m)
v
      if forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a (PrimState m)
l then forall (m :: * -> *) a. Monad m => a -> m a
return LinkCut a (PrimState m)
v
      else LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
leftmost LinkCut a (PrimState m)
l
{-# INLINE root #-}

-- | O(log n). Move upward one level.
--
-- This will return 'Nil' if the parent is not available.
--
-- Note: Repeated calls on the same value without intermediate accesses are O(1).
up :: (PrimMonad m, Monoid a) => LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
up :: forall (m :: * -> *) a.
(PrimMonad m, Monoid a) =>
LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
up LinkCut a (PrimState m)
this = forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st forall a b. (a -> b) -> a -> b
$ do
    forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
this
    LinkCut a (PrimState m)
a <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a (PrimState m)
this
    if forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a (PrimState m)
a then forall (m :: * -> *) a. Monad m => a -> m a
return forall (t :: * -> *) s. Struct t => t s
Nil
    else do
      LinkCut a (PrimState m)
p <- forall {m :: * -> *} {a}.
PrimMonad m =>
LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
rightmost LinkCut a (PrimState m)
a
      forall a s. Monoid a => LinkCut a s -> ST s ()
splay LinkCut a (PrimState m)
p -- p is already in the root aux tree
      forall (m :: * -> *) a. Monad m => a -> m a
return LinkCut a (PrimState m)
p
  where
    rightmost :: LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
rightmost LinkCut a (PrimState m)
v = do
      LinkCut a (PrimState m)
p <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a (PrimState m)
v
      if forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a (PrimState m)
p then forall (m :: * -> *) a. Monad m => a -> m a
return LinkCut a (PrimState m)
v
      else LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
rightmost LinkCut a (PrimState m)
p
{-# INLINE up #-}

-- | O(1)
summarize :: Monoid a => LinkCut a s -> ST s a
summarize :: forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
this
  | forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
this = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  | Bool
otherwise  = forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
summary LinkCut a s
this
{-# INLINE summarize #-}

-- | O(log n)
access :: Monoid a => LinkCut a s -> ST s ()
access :: forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a s
this = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
this) forall a b. (a -> b) -> a -> b
$ forall a e. Exception e => e -> a
throw NullPointerException
NullPointerException
  forall a s. Monoid a => LinkCut a s -> ST s ()
splay LinkCut a s
this
  -- the right hand child is no longer preferred
  LinkCut a s
r <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
this
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
r) forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
this forall (t :: * -> *) s. Struct t => t s
Nil
    forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
r forall (t :: * -> *) s. Struct t => t s
Nil
    forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
r LinkCut a s
this
    -- resummarize
    LinkCut a s
l <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
this
    a
sl <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
l
    a
v <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
this
    forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
this (a
sl forall a. Monoid a => a -> a -> a
`mappend` a
v)
  forall a s. Monoid a => LinkCut a s -> ST s ()
go LinkCut a s
this
  forall a s. Monoid a => LinkCut a s -> ST s ()
splay LinkCut a s
this
 where
  go :: LinkCut a s -> ST s ()
go LinkCut a s
v = do
    LinkCut a s
w <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
v
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
w) forall a b. (a -> b) -> a -> b
$ do
      forall a s. Monoid a => LinkCut a s -> ST s ()
splay LinkCut a s
w
      --      w    v          w
      --     a b  c d   ==>  a  v, b.path = w
      --                       c d
      LinkCut a s
b <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
w
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) forall a b. (a -> b) -> a -> b
$ do -- b is no longer on the preferred path
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
b LinkCut a s
w
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
b forall (t :: * -> *) s. Struct t => t s
Nil
      LinkCut a s
a <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
w
      a
sa <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
a
      a
vw <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
w
      a
sv <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
summary LinkCut a s
v
      forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
v LinkCut a s
w
      forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
w LinkCut a s
v
      forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
w (a
sa forall a. Monoid a => a -> a -> a
`mappend` a
vw forall a. Monoid a => a -> a -> a
`mappend` a
sv)
      LinkCut a s -> ST s ()
go LinkCut a s
w

-- | O(log n). Splay within an auxiliary tree
splay :: Monoid a => LinkCut a s -> ST s ()
splay :: forall a s. Monoid a => LinkCut a s -> ST s ()
splay LinkCut a s
x = do
  LinkCut a s
p <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
x
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
p) forall a b. (a -> b) -> a -> b
$ do
    LinkCut a s
g <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
p
    LinkCut a s
pl <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
p
    if forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
g then do -- zig step
      forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
p LinkCut a s
x
      forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
x forall (t :: * -> *) s. Struct t => t s
Nil
      LinkCut a s
pp <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
p
      forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
x LinkCut a s
pp
      forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
p forall (t :: * -> *) s. Struct t => t s
Nil
      a
sp <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
summary LinkCut a s
p
      forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
x a
sp
      if LinkCut a s
pl forall a. Eq a => a -> a -> Bool
== LinkCut a s
x then do
        --      p           x
        --    x   d  ==>  b   p
        --   b c             c d
        LinkCut a s
c <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
x
        LinkCut a s
d <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
p
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
c) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
c LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
x LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
p LinkCut a s
c
        a
sc <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
c
        a
sd <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
d
        a
vp <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
p (a
sc forall a. Monoid a => a -> a -> a
`mappend` a
vp forall a. Monoid a => a -> a -> a
`mappend` a
sd)
      else do
        --      p            x
        --    a   x   ==>  p   c
        --       b c      a b
        LinkCut a s
b <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
x
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
b LinkCut a s
p
        let a :: LinkCut a s
a = LinkCut a s
pl
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
x LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
p LinkCut a s
b
        a
sa <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
a
        a
sb <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
b
        a
vp <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
p (a
sa forall a. Monoid a => a -> a -> a
`mappend` a
vp forall a. Monoid a => a -> a -> a
`mappend` a
sb)
    else do -- zig-zig or zig-zag
      LinkCut a s
gg <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
g
      LinkCut a s
gl <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
g
      a
sg <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
summary LinkCut a s
g
      forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
x a
sg
      forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
x LinkCut a s
gg
      LinkCut a s
gp <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
g
      forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
x LinkCut a s
gp
      forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
g forall (t :: * -> *) s. Struct t => t s
Nil
      if LinkCut a s
gl forall a. Eq a => a -> a -> Bool
== LinkCut a s
p then do
        if LinkCut a s
pl forall a. Eq a => a -> a -> Bool
== LinkCut a s
x then do -- zig-zig
          --      g       x
          --    p  d     a  p
          --  x  c   ==>   b  g
          -- a b             c d
          LinkCut a s
b <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
x
          LinkCut a s
c <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
p
          LinkCut a s
d <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
g
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
p LinkCut a s
x
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
g LinkCut a s
p
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
b LinkCut a s
p
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
c) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
c LinkCut a s
g
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
x LinkCut a s
p
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
p LinkCut a s
g
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
p LinkCut a s
b
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
g LinkCut a s
c
          a
sb <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
b
          a
vp <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
p
          a
sc <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
c
          a
vg <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
g
          a
sd <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
d
          let sg' :: a
sg' = a
sc forall a. Monoid a => a -> a -> a
`mappend` a
vg forall a. Monoid a => a -> a -> a
`mappend` a
sd
          forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
g a
sg'
          forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
p (a
sb forall a. Monoid a => a -> a -> a
`mappend` a
vp forall a. Monoid a => a -> a -> a
`mappend` a
sg')
        else do -- zig-zag
          --       g           x
          --   p    d  ==>   p   g
          --  a  x          a b c d
          --    b c
          let a :: LinkCut a s
a = LinkCut a s
pl
          LinkCut a s
b <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
x
          LinkCut a s
c <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
x
          LinkCut a s
d <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
g
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
p LinkCut a s
x
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
g LinkCut a s
x
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
b LinkCut a s
p
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
c) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
c LinkCut a s
g
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
x LinkCut a s
p
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
x LinkCut a s
g
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
p LinkCut a s
b
          forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
g LinkCut a s
c
          a
sa <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
a
          a
vp <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
p
          a
sb <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
b
          forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
p (a
sa forall a. Monoid a => a -> a -> a
`mappend` a
vp forall a. Monoid a => a -> a -> a
`mappend` a
sb)
          a
sc <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
c
          a
vg <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
g
          a
sd <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
d
          forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
g (a
sc forall a. Monoid a => a -> a -> a
`mappend` a
vg forall a. Monoid a => a -> a -> a
`mappend` a
sd)
      else if LinkCut a s
pl forall a. Eq a => a -> a -> Bool
== LinkCut a s
x then do -- zig-zag
        --   g               x
        --  a    p         g   p
        --     x  d  ==>  a b c d
        --    b c
        let a :: LinkCut a s
a = LinkCut a s
gl
        LinkCut a s
b <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
x
        LinkCut a s
c <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
x
        LinkCut a s
d <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
g LinkCut a s
x
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
p LinkCut a s
x
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
b LinkCut a s
g
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
c) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
c LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
x LinkCut a s
g
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
x LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
g LinkCut a s
b
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
p LinkCut a s
c
        a
sa <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
a
        a
vg <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
g
        a
sb <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
b
        forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
g (a
sa forall a. Monoid a => a -> a -> a
`mappend` a
vg forall a. Monoid a => a -> a -> a
`mappend` a
sb)
        a
sc <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
c
        a
vp <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
p
        a
sd <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
d
        forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
p (a
sc forall a. Monoid a => a -> a -> a
`mappend` a
vp forall a. Monoid a => a -> a -> a
`mappend` a
sd)
      else do -- zig-zig
        --  g               x
        -- a  p           p  d
        --   b  x  ==>  g  c
        --     c d     a b
        let a :: LinkCut a s
a = LinkCut a s
gl
        let b :: LinkCut a s
b = LinkCut a s
pl
        LinkCut a s
c <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
x
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
b LinkCut a s
g
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
c) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
c LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
p LinkCut a s
x
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
g LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
x LinkCut a s
p
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
p LinkCut a s
g
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
g LinkCut a s
b
        forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
p LinkCut a s
c
        a
sa <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
a
        a
vg <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
g
        a
sb <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
b
        a
vp <- forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField forall a. Field (LinkCut a) a
value LinkCut a s
p
        a
sc <- forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
c
        let sg' :: a
sg' = a
sa forall a. Monoid a => a -> a -> a
`mappend` a
vg forall a. Monoid a => a -> a -> a
`mappend` a
sb
        forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
g a
sg'
        forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField forall a. Field (LinkCut a) a
summary LinkCut a s
p (a
sg' forall a. Monoid a => a -> a -> a
`mappend` a
vp forall a. Monoid a => a -> a -> a
`mappend` a
sc)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
gg) forall a b. (a -> b) -> a -> b
$ do
        LinkCut a s
ggl <- forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
gg
        -- NB: this replacement leaves the summary intact
        if LinkCut a s
ggl forall a. Eq a => a -> a -> Bool
== LinkCut a s
g then forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
gg LinkCut a s
x
        else forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
gg LinkCut a s
x
        forall a s. Monoid a => LinkCut a s -> ST s ()
splay LinkCut a s
x