{-# LANGUAGE Safe, MagicHash, MultiParamTypeClasses, FlexibleInstances #-}

{- |
    Module      :  SDP.Unrolled.Unlist
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  portable
    
    "SDP.Unrolled.Unlist" provides 'Unlist' - lazy boxed unrolled linked list.
-}
module SDP.Unrolled.Unlist
(
  -- * Exports
  module SDP.Indexed,
  module SDP.Sort,
  module SDP.Scan,
  module SDP.Set,
  
  -- * Unlist
  Unlist
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.Indexed
import SDP.Sort
import SDP.Scan
import SDP.Set

import SDP.Templates.AnyChunks
import SDP.Prim.SArray
import SDP.SortM.Tim

default ()

--------------------------------------------------------------------------------

-- | 'Unlist' is unrolled linked list of boxed values.
type Unlist = AnyChunks SArray#

--------------------------------------------------------------------------------

{- Eq1 and Ord1 instances. -}

instance Eq1 Unlist
  where
    liftEq :: (a -> b -> Bool) -> Unlist a -> Unlist b -> Bool
liftEq a -> b -> Bool
_ Unlist a
Z Unlist b
Z = Bool
True
    liftEq a -> b -> Bool
_ Unlist a
Z Unlist b
_ = Bool
False
    liftEq a -> b -> Bool
_ Unlist a
_ Unlist b
Z = Bool
False
    liftEq a -> b -> Bool
f Unlist a
xs Unlist b
ys = if Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n2
        then (a -> b -> Bool) -> SArray# a -> SArray# b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f (Int -> SArray# a -> SArray# a
forall s e. Split s e => Int -> s -> s
take Int
n2 SArray# a
x) SArray# b
y Bool -> Bool -> Bool
&& (a -> b -> Bool) -> Unlist a -> Unlist b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f (Int -> Unlist a -> Unlist a
forall s e. Split s e => Int -> s -> s
drop Int
n2 Unlist a
xs) ([SArray# b] -> Unlist b
forall (rep :: * -> *) e.
Nullable (rep e) =>
[rep e] -> AnyChunks rep e
fromChunks [SArray# b]
ys')
        else (a -> b -> Bool) -> SArray# a -> SArray# b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f SArray# a
x (Int -> SArray# b -> SArray# b
forall s e. Split s e => Int -> s -> s
take Int
n1 SArray# b
y) Bool -> Bool -> Bool
&& (a -> b -> Bool) -> Unlist a -> Unlist b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f ([SArray# a] -> Unlist a
forall (rep :: * -> *) e.
Nullable (rep e) =>
[rep e] -> AnyChunks rep e
fromChunks [SArray# a]
xs') (Int -> Unlist b -> Unlist b
forall s e. Split s e => Int -> s -> s
drop Int
n1 Unlist b
ys)
      where
        (SArray# a
x : [SArray# a]
xs') = Unlist a -> [SArray# a]
forall (rep :: * -> *) e. AnyChunks rep e -> [rep e]
toChunks Unlist a
xs; n1 :: Int
n1 = SArray# a -> Int
forall b i. Bordered b i => b -> Int
sizeOf SArray# a
x
        (SArray# b
y : [SArray# b]
ys') = Unlist b -> [SArray# b]
forall (rep :: * -> *) e. AnyChunks rep e -> [rep e]
toChunks Unlist b
ys; n2 :: Int
n2 = SArray# b -> Int
forall b i. Bordered b i => b -> Int
sizeOf SArray# b
y

instance Ord1 Unlist
  where
    liftCompare :: (a -> b -> Ordering) -> Unlist a -> Unlist b -> Ordering
liftCompare a -> b -> Ordering
_ Unlist a
Z Unlist b
Z = Ordering
EQ
    liftCompare a -> b -> Ordering
_ Unlist a
Z Unlist b
_ = Ordering
LT
    liftCompare a -> b -> Ordering
_ Unlist a
_ Unlist b
Z = Ordering
GT
    liftCompare a -> b -> Ordering
f Unlist a
xs Unlist b
ys = if Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n2
        then (a -> b -> Ordering) -> SArray# a -> SArray# b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f (Int -> SArray# a -> SArray# a
forall s e. Split s e => Int -> s -> s
take Int
n2 SArray# a
x) SArray# b
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (a -> b -> Ordering) -> Unlist a -> Unlist b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f (Int -> Unlist a -> Unlist a
forall s e. Split s e => Int -> s -> s
drop Int
n2 Unlist a
xs) ([SArray# b] -> Unlist b
forall (rep :: * -> *) e.
Nullable (rep e) =>
[rep e] -> AnyChunks rep e
fromChunks [SArray# b]
ys')
        else (a -> b -> Ordering) -> SArray# a -> SArray# b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f SArray# a
x (Int -> SArray# b -> SArray# b
forall s e. Split s e => Int -> s -> s
take Int
n1 SArray# b
y) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (a -> b -> Ordering) -> Unlist a -> Unlist b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f ([SArray# a] -> Unlist a
forall (rep :: * -> *) e.
Nullable (rep e) =>
[rep e] -> AnyChunks rep e
fromChunks [SArray# a]
xs') (Int -> Unlist b -> Unlist b
forall s e. Split s e => Int -> s -> s
drop Int
n1 Unlist b
ys)
      where
        (SArray# a
x : [SArray# a]
xs') = Unlist a -> [SArray# a]
forall (rep :: * -> *) e. AnyChunks rep e -> [rep e]
toChunks Unlist a
xs; n1 :: Int
n1 = SArray# a -> Int
forall b i. Bordered b i => b -> Int
sizeOf SArray# a
x
        (SArray# b
y : [SArray# b]
ys') = Unlist b -> [SArray# b]
forall (rep :: * -> *) e. AnyChunks rep e -> [rep e]
toChunks Unlist b
ys; n2 :: Int
n2 = SArray# b -> Int
forall b i. Bordered b i => b -> Int
sizeOf SArray# b
y

instance Zip Unlist
  where
    all2 :: (a -> b -> Bool) -> Unlist a -> Unlist b -> Bool
all2 a -> b -> Bool
f Unlist a
as Unlist b
bs             = (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (z :: * -> *) a b.
Zip z =>
(a -> b -> Bool) -> z a -> z b -> Bool
all2 a -> b -> Bool
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs)
    any2 :: (a -> b -> Bool) -> Unlist a -> Unlist b -> Bool
any2 a -> b -> Bool
f Unlist a
as Unlist b
bs             = (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (z :: * -> *) a b.
Zip z =>
(a -> b -> Bool) -> z a -> z b -> Bool
any2 a -> b -> Bool
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs)
    all3 :: (a -> b -> c -> Bool) -> Unlist a -> Unlist b -> Unlist c -> Bool
all3 a -> b -> c -> Bool
f Unlist a
as Unlist b
bs Unlist c
cs          = (a -> b -> c -> Bool) -> [a] -> [b] -> [c] -> Bool
forall (z :: * -> *) a b c.
Zip z =>
(a -> b -> c -> Bool) -> z a -> z b -> z c -> Bool
all3 a -> b -> c -> Bool
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs)
    any3 :: (a -> b -> c -> Bool) -> Unlist a -> Unlist b -> Unlist c -> Bool
any3 a -> b -> c -> Bool
f Unlist a
as Unlist b
bs Unlist c
cs          = (a -> b -> c -> Bool) -> [a] -> [b] -> [c] -> Bool
forall (z :: * -> *) a b c.
Zip z =>
(a -> b -> c -> Bool) -> z a -> z b -> z c -> Bool
any3 a -> b -> c -> Bool
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs)
    all4 :: (a -> b -> c -> d -> Bool)
-> Unlist a -> Unlist b -> Unlist c -> Unlist d -> Bool
all4 a -> b -> c -> d -> Bool
f Unlist a
as Unlist b
bs Unlist c
cs Unlist d
ds       = (a -> b -> c -> d -> Bool) -> [a] -> [b] -> [c] -> [d] -> Bool
forall (z :: * -> *) a b c d.
Zip z =>
(a -> b -> c -> d -> Bool) -> z a -> z b -> z c -> z d -> Bool
all4 a -> b -> c -> d -> Bool
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs) (Unlist d -> [d]
forall l e. Linear l e => l -> [e]
listL Unlist d
ds)
    any4 :: (a -> b -> c -> d -> Bool)
-> Unlist a -> Unlist b -> Unlist c -> Unlist d -> Bool
any4 a -> b -> c -> d -> Bool
f Unlist a
as Unlist b
bs Unlist c
cs Unlist d
ds       = (a -> b -> c -> d -> Bool) -> [a] -> [b] -> [c] -> [d] -> Bool
forall (z :: * -> *) a b c d.
Zip z =>
(a -> b -> c -> d -> Bool) -> z a -> z b -> z c -> z d -> Bool
any4 a -> b -> c -> d -> Bool
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs) (Unlist d -> [d]
forall l e. Linear l e => l -> [e]
listL Unlist d
ds)
    all5 :: (a -> b -> c -> d -> e -> Bool)
-> Unlist a -> Unlist b -> Unlist c -> Unlist d -> Unlist e -> Bool
all5 a -> b -> c -> d -> e -> Bool
f Unlist a
as Unlist b
bs Unlist c
cs Unlist d
ds Unlist e
es    = (a -> b -> c -> d -> e -> Bool)
-> [a] -> [b] -> [c] -> [d] -> [e] -> Bool
forall (z :: * -> *) a b c d e.
Zip z =>
(a -> b -> c -> d -> e -> Bool)
-> z a -> z b -> z c -> z d -> z e -> Bool
all5 a -> b -> c -> d -> e -> Bool
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs) (Unlist d -> [d]
forall l e. Linear l e => l -> [e]
listL Unlist d
ds) (Unlist e -> [e]
forall l e. Linear l e => l -> [e]
listL Unlist e
es)
    any5 :: (a -> b -> c -> d -> e -> Bool)
-> Unlist a -> Unlist b -> Unlist c -> Unlist d -> Unlist e -> Bool
any5 a -> b -> c -> d -> e -> Bool
f Unlist a
as Unlist b
bs Unlist c
cs Unlist d
ds Unlist e
es    = (a -> b -> c -> d -> e -> Bool)
-> [a] -> [b] -> [c] -> [d] -> [e] -> Bool
forall (z :: * -> *) a b c d e.
Zip z =>
(a -> b -> c -> d -> e -> Bool)
-> z a -> z b -> z c -> z d -> z e -> Bool
any5 a -> b -> c -> d -> e -> Bool
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs) (Unlist d -> [d]
forall l e. Linear l e => l -> [e]
listL Unlist d
ds) (Unlist e -> [e]
forall l e. Linear l e => l -> [e]
listL Unlist e
es)
    all6 :: (a -> b -> c -> d -> e -> f -> Bool)
-> Unlist a
-> Unlist b
-> Unlist c
-> Unlist d
-> Unlist e
-> Unlist f
-> Bool
all6 a -> b -> c -> d -> e -> f -> Bool
f Unlist a
as Unlist b
bs Unlist c
cs Unlist d
ds Unlist e
es Unlist f
fs = (a -> b -> c -> d -> e -> f -> Bool)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> Bool
forall (z :: * -> *) a b c d e f.
Zip z =>
(a -> b -> c -> d -> e -> f -> Bool)
-> z a -> z b -> z c -> z d -> z e -> z f -> Bool
all6 a -> b -> c -> d -> e -> f -> Bool
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs) (Unlist d -> [d]
forall l e. Linear l e => l -> [e]
listL Unlist d
ds) (Unlist e -> [e]
forall l e. Linear l e => l -> [e]
listL Unlist e
es) (Unlist f -> [f]
forall l e. Linear l e => l -> [e]
listL Unlist f
fs)
    any6 :: (a -> b -> c -> d -> e -> f -> Bool)
-> Unlist a
-> Unlist b
-> Unlist c
-> Unlist d
-> Unlist e
-> Unlist f
-> Bool
any6 a -> b -> c -> d -> e -> f -> Bool
f Unlist a
as Unlist b
bs Unlist c
cs Unlist d
ds Unlist e
es Unlist f
fs = (a -> b -> c -> d -> e -> f -> Bool)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> Bool
forall (z :: * -> *) a b c d e f.
Zip z =>
(a -> b -> c -> d -> e -> f -> Bool)
-> z a -> z b -> z c -> z d -> z e -> z f -> Bool
any6 a -> b -> c -> d -> e -> f -> Bool
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs) (Unlist d -> [d]
forall l e. Linear l e => l -> [e]
listL Unlist d
ds) (Unlist e -> [e]
forall l e. Linear l e => l -> [e]
listL Unlist e
es) (Unlist f -> [f]
forall l e. Linear l e => l -> [e]
listL Unlist f
fs)
    
    zipWith :: (a -> b -> c) -> Unlist a -> Unlist b -> Unlist c
zipWith  a -> b -> c
f Unlist a
as Unlist b
bs             = [c] -> Unlist c
forall l e. Linear l e => [e] -> l
fromList ([c] -> Unlist c) -> [c] -> Unlist c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> [a] -> [b] -> [c]
forall (z :: * -> *) a b c.
Zip z =>
(a -> b -> c) -> z a -> z b -> z c
zipWith  a -> b -> c
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs)
    zipWith3 :: (a -> b -> c -> d) -> Unlist a -> Unlist b -> Unlist c -> Unlist d
zipWith3 a -> b -> c -> d
f Unlist a
as Unlist b
bs Unlist c
cs          = [d] -> Unlist d
forall l e. Linear l e => [e] -> l
fromList ([d] -> Unlist d) -> [d] -> Unlist d
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
forall (z :: * -> *) a b c d.
Zip z =>
(a -> b -> c -> d) -> z a -> z b -> z c -> z d
zipWith3 a -> b -> c -> d
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs)
    zipWith4 :: (a -> b -> c -> d -> e)
-> Unlist a -> Unlist b -> Unlist c -> Unlist d -> Unlist e
zipWith4 a -> b -> c -> d -> e
f Unlist a
as Unlist b
bs Unlist c
cs Unlist d
ds       = [e] -> Unlist e
forall l e. Linear l e => [e] -> l
fromList ([e] -> Unlist e) -> [e] -> Unlist e
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
forall (z :: * -> *) a b c d e.
Zip z =>
(a -> b -> c -> d -> e) -> z a -> z b -> z c -> z d -> z e
zipWith4 a -> b -> c -> d -> e
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs) (Unlist d -> [d]
forall l e. Linear l e => l -> [e]
listL Unlist d
ds)
    zipWith5 :: (a -> b -> c -> d -> e -> f)
-> Unlist a
-> Unlist b
-> Unlist c
-> Unlist d
-> Unlist e
-> Unlist f
zipWith5 a -> b -> c -> d -> e -> f
f Unlist a
as Unlist b
bs Unlist c
cs Unlist d
ds Unlist e
es    = [f] -> Unlist f
forall l e. Linear l e => [e] -> l
fromList ([f] -> Unlist f) -> [f] -> Unlist f
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> d -> e -> f)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
forall (z :: * -> *) a b c d e f.
Zip z =>
(a -> b -> c -> d -> e -> f)
-> z a -> z b -> z c -> z d -> z e -> z f
zipWith5 a -> b -> c -> d -> e -> f
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs) (Unlist d -> [d]
forall l e. Linear l e => l -> [e]
listL Unlist d
ds) (Unlist e -> [e]
forall l e. Linear l e => l -> [e]
listL Unlist e
es)
    zipWith6 :: (a -> b -> c -> d -> e -> f -> g)
-> Unlist a
-> Unlist b
-> Unlist c
-> Unlist d
-> Unlist e
-> Unlist f
-> Unlist g
zipWith6 a -> b -> c -> d -> e -> f -> g
f Unlist a
as Unlist b
bs Unlist c
cs Unlist d
ds Unlist e
es Unlist f
fs = [g] -> Unlist g
forall l e. Linear l e => [e] -> l
fromList ([g] -> Unlist g) -> [g] -> Unlist g
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
forall (z :: * -> *) a b c d e f g.
Zip z =>
(a -> b -> c -> d -> e -> f -> g)
-> z a -> z b -> z c -> z d -> z e -> z f -> z g
zipWith6 a -> b -> c -> d -> e -> f -> g
f (Unlist a -> [a]
forall l e. Linear l e => l -> [e]
listL Unlist a
as) (Unlist b -> [b]
forall l e. Linear l e => l -> [e]
listL Unlist b
bs) (Unlist c -> [c]
forall l e. Linear l e => l -> [e]
listL Unlist c
cs) (Unlist d -> [d]
forall l e. Linear l e => l -> [e]
listL Unlist d
ds) (Unlist e -> [e]
forall l e. Linear l e => l -> [e]
listL Unlist e
es) (Unlist f -> [f]
forall l e. Linear l e => l -> [e]
listL Unlist f
fs)

instance Sort (Unlist e) e
  where
    sortBy :: Compare e -> Unlist e -> Unlist e
sortBy Compare e
cmp Unlist e
es = (forall s. ST s (Unlist e)) -> Unlist e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Unlist e)) -> Unlist e)
-> (forall s. ST s (Unlist e)) -> Unlist e
forall a b. (a -> b) -> a -> b
$ do STArray# s e
es' <- Unlist e -> ST s (STArray# s e)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
thaw Unlist e
es; Compare e -> STArray# s e -> ST s ()
forall (m :: * -> *) v e i.
(LinearM m v e, BorderedM m v i) =>
Compare e -> v -> m ()
timSortBy Compare e
cmp STArray# s e
es'; STArray# s e -> ST s (Unlist e)
forall s e. STArray# s e -> ST s (Unlist e)
done STArray# s e
es'
    
    sortedBy :: (e -> e -> Bool) -> Unlist e -> Bool
sortedBy e -> e -> Bool
f = [SArray# e] -> Bool
forall s. (Sort s e, Linear s e) => [s] -> Bool
go ([SArray# e] -> Bool)
-> (Unlist e -> [SArray# e]) -> Unlist e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unlist e -> [SArray# e]
forall (rep :: * -> *) e. AnyChunks rep e -> [rep e]
toChunks
      where
        go :: [s] -> Bool
go (s
x1 : s
x2 : [s]
xs) = (e -> e -> Bool) -> s -> Bool
forall s e. Sort s e => (e -> e -> Bool) -> s -> Bool
sortedBy e -> e -> Bool
f s
x1 Bool -> Bool -> Bool
&& s -> e
forall l e. Linear l e => l -> e
last s
x1 e -> e -> Bool
`f` s -> e
forall l e. Linear l e => l -> e
head s
x2 Bool -> Bool -> Bool
&& [s] -> Bool
go (s
x2 s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
xs)
        go      [s
x1]      = (e -> e -> Bool) -> s -> Bool
forall s e. Sort s e => (e -> e -> Bool) -> s -> Bool
sortedBy e -> e -> Bool
f s
x1
        go       []       = Bool
True

--------------------------------------------------------------------------------

{-# INLINE done #-}
done :: STArray# s e -> ST s (Unlist e)
done :: STArray# s e -> ST s (Unlist e)
done =  STArray# s e -> ST s (Unlist e)
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
unsafeFreeze