{-# 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 :: a -> m (LinkCut a (PrimState m))
new a
a = ST (PrimState m) (LinkCut a (PrimState m))
-> m (LinkCut a (PrimState m))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (LinkCut a (PrimState (ST (PrimState m)))
-> LinkCut a (PrimState (ST (PrimState m)))
-> LinkCut a (PrimState (ST (PrimState m)))
-> LinkCut a (PrimState (ST (PrimState m)))
-> a
-> a
-> ST (PrimState m) (LinkCut a (PrimState (ST (PrimState m))))
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 LinkCut a (PrimState (ST (PrimState m)))
forall (t :: * -> *) s. Struct t => t s
Nil LinkCut a (PrimState (ST (PrimState m)))
forall (t :: * -> *) s. Struct t => t s
Nil LinkCut a (PrimState (ST (PrimState m)))
forall (t :: * -> *) s. Struct t => t s
Nil LinkCut a (PrimState (ST (PrimState m)))
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 :: LinkCut a (PrimState m) -> m ()
cut LinkCut a (PrimState m)
this = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  LinkCut a (PrimState m) -> ST (PrimState m) ()
forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
this
  LinkCut a (PrimState m)
l <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (LinkCut a (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a (PrimState m)
LinkCut a (PrimState (ST (PrimState m)))
this
  Bool -> ST (PrimState m) () -> ST (PrimState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a (PrimState m)
l) (ST (PrimState m) () -> ST (PrimState m) ())
-> ST (PrimState m) () -> ST (PrimState m) ()
forall a b. (a -> b) -> a -> b
$ do
    Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST (PrimState m)))
-> LinkCut a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a (PrimState m)
LinkCut a (PrimState (ST (PrimState m)))
this LinkCut a (PrimState (ST (PrimState m)))
forall (t :: * -> *) s. Struct t => t s
Nil
    Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST (PrimState m)))
-> LinkCut a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a (PrimState m)
LinkCut a (PrimState (ST (PrimState m)))
l LinkCut a (PrimState (ST (PrimState m)))
forall (t :: * -> *) s. Struct t => t s
Nil
    a
v <- Field (LinkCut a) a
-> LinkCut a (PrimState (ST (PrimState m))) -> ST (PrimState m) a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a (PrimState m)
LinkCut a (PrimState (ST (PrimState m)))
this
    Field (LinkCut a) a
-> LinkCut a (PrimState (ST (PrimState m)))
-> a
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a (PrimState m)
LinkCut a (PrimState (ST (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 :: LinkCut a (PrimState m) -> LinkCut a (PrimState m) -> m ()
link LinkCut a (PrimState m)
v LinkCut a (PrimState m)
w = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  --   w          w<~v
  --  a  , v  => a
  --
  --
  LinkCut a (PrimState m) -> ST (PrimState m) ()
forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
v
  LinkCut a (PrimState m) -> ST (PrimState m) ()
forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
w
  Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST (PrimState m)))
-> LinkCut a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a (PrimState m)
LinkCut a (PrimState (ST (PrimState m)))
v LinkCut a (PrimState m)
LinkCut a (PrimState (ST (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 :: LinkCut a (PrimState m) -> LinkCut a (PrimState m) -> m Bool
connected LinkCut a (PrimState m)
v LinkCut a (PrimState m)
w = ST (PrimState m) Bool -> m Bool
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) Bool -> m Bool)
-> ST (PrimState m) Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ LinkCut a (PrimState m) -> LinkCut a (PrimState m) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (LinkCut a (PrimState m) -> LinkCut a (PrimState m) -> Bool)
-> ST (PrimState m) (LinkCut a (PrimState m))
-> ST (PrimState m) (LinkCut a (PrimState m) -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LinkCut a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (LinkCut a (PrimState (ST (PrimState m))))
forall (m :: * -> *) a.
(PrimMonad m, Monoid a) =>
LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
root LinkCut a (PrimState m)
LinkCut a (PrimState (ST (PrimState m)))
v ST (PrimState m) (LinkCut a (PrimState m) -> Bool)
-> ST (PrimState m) (LinkCut a (PrimState m))
-> ST (PrimState m) Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LinkCut a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (LinkCut a (PrimState (ST (PrimState m))))
forall (m :: * -> *) a.
(PrimMonad m, Monoid a) =>
LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
root LinkCut a (PrimState m)
LinkCut a (PrimState (ST (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 :: LinkCut a (PrimState m) -> m a
cost LinkCut a (PrimState m)
v = ST (PrimState m) a -> m a
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) a -> m a) -> ST (PrimState m) a -> m a
forall a b. (a -> b) -> a -> b
$ do
  LinkCut a (PrimState m) -> ST (PrimState m) ()
forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
v
  Field (LinkCut a) a
-> LinkCut a (PrimState (ST (PrimState m))) -> ST (PrimState m) a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a (PrimState m)
LinkCut a (PrimState (ST (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 :: LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
root LinkCut a (PrimState m)
this = ST (PrimState m) (LinkCut a (PrimState m))
-> m (LinkCut a (PrimState m))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) (LinkCut a (PrimState m))
 -> m (LinkCut a (PrimState m)))
-> ST (PrimState m) (LinkCut a (PrimState m))
-> m (LinkCut a (PrimState m))
forall a b. (a -> b) -> a -> b
$ do
    LinkCut a (PrimState m) -> ST (PrimState m) ()
forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
this
    LinkCut a (PrimState m)
r <- LinkCut a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (LinkCut a (PrimState (ST (PrimState m))))
forall (m :: * -> *) a.
PrimMonad m =>
LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
leftmost LinkCut a (PrimState m)
LinkCut a (PrimState (ST (PrimState m)))
this
    LinkCut a (PrimState m) -> ST (PrimState m) ()
forall a s. Monoid a => LinkCut a s -> ST s ()
splay LinkCut a (PrimState m)
r -- r is already in the root aux tree
    LinkCut a (PrimState m)
-> ST (PrimState m) (LinkCut a (PrimState m))
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a (PrimState m)
v
      if LinkCut a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a (PrimState m)
l then LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
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 :: LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
up LinkCut a (PrimState m)
this = ST (PrimState m) (LinkCut a (PrimState m))
-> m (LinkCut a (PrimState m))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) (LinkCut a (PrimState m))
 -> m (LinkCut a (PrimState m)))
-> ST (PrimState m) (LinkCut a (PrimState m))
-> m (LinkCut a (PrimState m))
forall a b. (a -> b) -> a -> b
$ do
    LinkCut a (PrimState m) -> ST (PrimState m) ()
forall a s. Monoid a => LinkCut a s -> ST s ()
access LinkCut a (PrimState m)
this
    LinkCut a (PrimState m)
a <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (LinkCut a (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a (PrimState m)
LinkCut a (PrimState (ST (PrimState m)))
this
    if LinkCut a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a (PrimState m)
a then LinkCut a (PrimState m)
-> ST (PrimState m) (LinkCut a (PrimState m))
forall (m :: * -> *) a. Monad m => a -> m a
return LinkCut a (PrimState m)
forall (t :: * -> *) s. Struct t => t s
Nil
    else do
      LinkCut a (PrimState m)
p <- LinkCut a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (LinkCut a (PrimState (ST (PrimState m))))
forall (m :: * -> *) a.
PrimMonad m =>
LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
rightmost LinkCut a (PrimState m)
LinkCut a (PrimState (ST (PrimState m)))
a
      LinkCut a (PrimState m) -> ST (PrimState m) ()
forall a s. Monoid a => LinkCut a s -> ST s ()
splay LinkCut a (PrimState m)
p -- p is already in the root aux tree
      LinkCut a (PrimState m)
-> ST (PrimState m) (LinkCut a (PrimState m))
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a (PrimState m)
v
      if LinkCut a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a (PrimState m)
p then LinkCut a (PrimState m) -> m (LinkCut a (PrimState m))
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 :: LinkCut a s -> ST s a
summarize LinkCut a s
this
  | LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
this = a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
  | Bool
otherwise  = Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
this
{-# INLINE summarize #-}

-- | O(log n)
access :: Monoid a => LinkCut a s -> ST s ()
access :: LinkCut a s -> ST s ()
access LinkCut a s
this = do
  Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
this) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ NullPointerException -> ST s ()
forall a e. Exception e => e -> a
throw NullPointerException
NullPointerException
  LinkCut a s -> ST s ()
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
this
  Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
r) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
    Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
this LinkCut a (PrimState (ST s))
forall (t :: * -> *) s. Struct t => t s
Nil
    Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
r LinkCut a (PrimState (ST s))
forall (t :: * -> *) s. Struct t => t s
Nil
    Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
LinkCut a (PrimState (ST s))
r LinkCut a s
LinkCut a (PrimState (ST s))
this
    -- resummarize
    LinkCut a s
l <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
this
    a
sl <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
l
    a
v <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
this
    Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
this (a
sl a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
v)
  LinkCut a s -> ST s ()
forall a s. Monoid a => LinkCut a s -> ST s ()
go LinkCut a s
this
  LinkCut a s -> ST s ()
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
LinkCut a (PrimState (ST s))
v
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
w) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
      LinkCut a s -> ST s ()
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
w
      Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do -- b is no longer on the preferred path
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
LinkCut a (PrimState (ST s))
b LinkCut a s
LinkCut a (PrimState (ST s))
w
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
b LinkCut a (PrimState (ST s))
forall (t :: * -> *) s. Struct t => t s
Nil
      LinkCut a s
a <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
w
      a
sa <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
a
      a
vw <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
w
      a
sv <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
v
      Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
v LinkCut a s
LinkCut a (PrimState (ST s))
w
      Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
w LinkCut a s
LinkCut a (PrimState (ST s))
v
      Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
w (a
sa a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vw a -> a -> a
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 :: LinkCut a s -> ST s ()
splay LinkCut a s
x = do
  LinkCut a s
p <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
x
  Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
p) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
    LinkCut a s
g <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
p
    LinkCut a s
pl <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
p
    if LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
g then do -- zig step
      Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
x
      Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a (PrimState (ST s))
forall (t :: * -> *) s. Struct t => t s
Nil
      LinkCut a s
pp <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
LinkCut a (PrimState (ST s))
p
      Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
pp
      Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a (PrimState (ST s))
forall (t :: * -> *) s. Struct t => t s
Nil
      a
sp <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
p
      Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
x a
sp
      if LinkCut a s
pl LinkCut a s -> LinkCut a s -> Bool
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
x
        LinkCut a s
d <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
p
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
c) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
c LinkCut a s
LinkCut a (PrimState (ST s))
p
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
p
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
c
        a
sc <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
c
        a
sd <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
d
        a
vp <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
p
        Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
p (a
sc a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vp a -> a -> a
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
x
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
b LinkCut a s
LinkCut a (PrimState (ST s))
p
        let a :: LinkCut a s
a = LinkCut a s
pl
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
p
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
b
        a
sa <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
a
        a
sb <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
b
        a
vp <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
p
        Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
p (a
sa a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vp a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
sb)
    else do -- zig-zig or zig-zag
      LinkCut a s
gg <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
g
      LinkCut a s
gl <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
g
      a
sg <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
g
      Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
x a
sg
      Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
gg
      LinkCut a s
gp <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
LinkCut a (PrimState (ST s))
g
      Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
gp
      Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
path LinkCut a s
LinkCut a (PrimState (ST s))
g LinkCut a (PrimState (ST s))
forall (t :: * -> *) s. Struct t => t s
Nil
      if LinkCut a s
gl LinkCut a s -> LinkCut a s -> Bool
forall a. Eq a => a -> a -> Bool
== LinkCut a s
p then do
        if LinkCut a s
pl LinkCut a s -> LinkCut a s -> Bool
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
x
          LinkCut a s
c <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
p
          LinkCut a s
d <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
g
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
x
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
g LinkCut a s
LinkCut a (PrimState (ST s))
p
          Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
b LinkCut a s
LinkCut a (PrimState (ST s))
p
          Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
c) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
c LinkCut a s
LinkCut a (PrimState (ST s))
g
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
p
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
g
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
b
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
g LinkCut a s
LinkCut a (PrimState (ST s))
c
          a
sb <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
b
          a
vp <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
p
          a
sc <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
c
          a
vg <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
g
          a
sd <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
d
          let sg' :: a
sg' = a
sc a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vg a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
sd
          Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
g a
sg'
          Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
p (a
sb a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vp a -> a -> a
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
x
          LinkCut a s
c <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
x
          LinkCut a s
d <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
g
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
x
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
g LinkCut a s
LinkCut a (PrimState (ST s))
x
          Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
b LinkCut a s
LinkCut a (PrimState (ST s))
p
          Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
c) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
c LinkCut a s
LinkCut a (PrimState (ST s))
g
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
p
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
g
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
b
          Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
g LinkCut a s
LinkCut a (PrimState (ST s))
c
          a
sa <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
a
          a
vp <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
p
          a
sb <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
b
          Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
p (a
sa a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vp a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
sb)
          a
sc <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
c
          a
vg <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
g
          a
sd <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
d
          Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
g (a
sc a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vg a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
sd)
      else if LinkCut a s
pl LinkCut a s -> LinkCut a s -> Bool
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
x
        LinkCut a s
c <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
x
        LinkCut a s
d <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
p
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
g LinkCut a s
LinkCut a (PrimState (ST s))
x
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
x
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
b LinkCut a s
LinkCut a (PrimState (ST s))
g
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
c) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
c LinkCut a s
LinkCut a (PrimState (ST s))
p
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
g
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
p
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
g LinkCut a s
LinkCut a (PrimState (ST s))
b
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
c
        a
sa <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
a
        a
vg <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
g
        a
sb <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
b
        Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
g (a
sa a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vg a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
sb)
        a
sc <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
c
        a
vp <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
p
        a
sd <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
d
        Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
p (a
sc a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vp a -> a -> a
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 <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
x
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
b) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
b LinkCut a s
LinkCut a (PrimState (ST s))
g
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
c) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
c LinkCut a s
LinkCut a (PrimState (ST s))
p
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
x
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
parent LinkCut a s
LinkCut a (PrimState (ST s))
g LinkCut a s
LinkCut a (PrimState (ST s))
p
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
x LinkCut a s
LinkCut a (PrimState (ST s))
p
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
g
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
g LinkCut a s
LinkCut a (PrimState (ST s))
b
        Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
p LinkCut a s
LinkCut a (PrimState (ST s))
c
        a
sa <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
a
        a
vg <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
g
        a
sb <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
b
        a
vp <- Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> ST s a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (LinkCut a) a
forall a. Field (LinkCut a) a
value LinkCut a s
LinkCut a (PrimState (ST s))
p
        a
sc <- LinkCut a s -> ST s a
forall a s. Monoid a => LinkCut a s -> ST s a
summarize LinkCut a s
c
        let sg' :: a
sg' = a
sa a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vg a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
sb
        Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
g a
sg'
        Field (LinkCut a) a -> LinkCut a (PrimState (ST s)) -> a -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (LinkCut a) a
forall a. Field (LinkCut a) a
summary LinkCut a s
LinkCut a (PrimState (ST s))
p (a
sg' a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
vp a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
sc)
      Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LinkCut a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil LinkCut a s
gg) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
        LinkCut a s
ggl <- Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> ST s (LinkCut a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
gg
        -- NB: this replacement leaves the summary intact
        if LinkCut a s
ggl LinkCut a s -> LinkCut a s -> Bool
forall a. Eq a => a -> a -> Bool
== LinkCut a s
g then Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
left LinkCut a s
LinkCut a (PrimState (ST s))
gg LinkCut a s
LinkCut a (PrimState (ST s))
x
        else Slot (LinkCut a) (LinkCut a)
-> LinkCut a (PrimState (ST s))
-> LinkCut a (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (LinkCut a) (LinkCut a)
forall a. Slot (LinkCut a) (LinkCut a)
right LinkCut a s
LinkCut a (PrimState (ST s))
gg LinkCut a s
LinkCut a (PrimState (ST s))
x
        LinkCut a s -> ST s ()
forall a s. Monoid a => LinkCut a s -> ST s ()
splay LinkCut a s
x