{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Implementation of pairing heaps stored off-heap
module Foreign.Heap where

import qualified Data.List as List
import Foreign.List (List)
import qualified Foreign.List as List
import Foreign.Marshal.Pure (Box, Pool)
import qualified Foreign.Marshal.Pure as Manual
import Prelude.Linear hiding (foldl)

data Heap k a
  = Empty
  | NonEmpty (Box (NEHeap k a))

data NEHeap k a
  = Heap k a (Box (List (NEHeap k a)))

instance
  (Manual.Representable k, Manual.Representable a) =>
  Manual.MkRepresentable (NEHeap k a) (k, a, Box (List (NEHeap k a)))
  where
  toRepr :: NEHeap k a %1 -> (k, a, Box (List (NEHeap k a)))
toRepr (Heap k
k a
a Box (List (NEHeap k a))
l) = (k
k, a
a, Box (List (NEHeap k a))
l)
  ofRepr :: (k, a, Box (List (NEHeap k a))) %1 -> NEHeap k a
ofRepr (k
k, a
a, Box (List (NEHeap k a))
l) = k -> a -> Box (List (NEHeap k a)) -> NEHeap k a
forall k a. k -> a -> Box (List (NEHeap k a)) -> NEHeap k a
Heap k
k a
a Box (List (NEHeap k a))
l

instance (Manual.Representable k, Manual.Representable a) => Manual.Representable (NEHeap k a) where
  type AsKnown (NEHeap k a) = Manual.AsKnown (k, a, (Box (List (NEHeap k a))))

-- * Non-empty heap primitives

singletonN :: (Manual.Representable k, Manual.Representable a) => k %1 -> a %1 -> Pool %1 -> NEHeap k a
singletonN :: forall k a.
(Representable k, Representable a) =>
k %1 -> a %1 -> Pool %1 -> NEHeap k a
singletonN k
k a
a Pool
pool = k -> a -> Box (List (NEHeap k a)) -> NEHeap k a
forall k a. k -> a -> Box (List (NEHeap k a)) -> NEHeap k a
Heap k
k a
a (List (NEHeap k a) %1 -> Pool %1 -> Box (List (NEHeap k a))
forall a. Representable a => a %1 -> Pool %1 -> Box a
Manual.alloc List (NEHeap k a)
forall a. List a
List.Nil Pool
pool)

-- XXX: (Movable k, Ord k) is a bit stronger than strictly required. We could
-- give a linear version of `Ord` instead.
mergeN :: forall k a. (Manual.Representable k, Manual.Representable a, Movable k, Ord k) => NEHeap k a %1 -> NEHeap k a %1 -> Pool %1 -> NEHeap k a
mergeN :: forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
NEHeap k a %1 -> NEHeap k a %1 -> Pool %1 -> NEHeap k a
mergeN (Heap k
k1 a
a1 Box (List (NEHeap k a))
h1) (Heap k
k2 a
a2 Box (List (NEHeap k a))
h2) Pool
pool =
  Ur k
%1 -> a
%1 -> Box (List (NEHeap k a))
%1 -> Ur k
%1 -> a
%1 -> Box (List (NEHeap k a))
%1 -> Pool
%1 -> NEHeap k a
testAndRebuild (k %1 -> Ur k
forall a. Movable a => a %1 -> Ur a
move k
k1) a
a1 Box (List (NEHeap k a))
h1 (k %1 -> Ur k
forall a. Movable a => a %1 -> Ur a
move k
k2) a
a2 Box (List (NEHeap k a))
h2 Pool
pool
  where
    --- XXX: this is a good example of why we need a working `case` and/or
    --- `let`.
    testAndRebuild :: Ur k %1 -> a %1 -> Box (List (NEHeap k a)) %1 -> Ur k %1 -> a %1 -> Box (List (NEHeap k a)) %1 -> Pool %1 -> NEHeap k a
    testAndRebuild :: Ur k
%1 -> a
%1 -> Box (List (NEHeap k a))
%1 -> Ur k
%1 -> a
%1 -> Box (List (NEHeap k a))
%1 -> Pool
%1 -> NEHeap k a
testAndRebuild (Ur k
k1') a
a1' Box (List (NEHeap k a))
h1' (Ur k
k2') a
a2' Box (List (NEHeap k a))
h2' =
      if k
k1' k %1 -> k %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
<= k
k2'
        then k
-> a
%1 -> k
-> a
%1 -> Box (List (NEHeap k a))
%1 -> Box (List (NEHeap k a))
%1 -> Pool
%1 -> NEHeap k a
helper k
k1' a
a1' k
k2' a
a2' Box (List (NEHeap k a))
h1' Box (List (NEHeap k a))
h2'
        else k
-> a
%1 -> k
-> a
%1 -> Box (List (NEHeap k a))
%1 -> Box (List (NEHeap k a))
%1 -> Pool
%1 -> NEHeap k a
helper k
k2' a
a2' k
k1' a
a1' Box (List (NEHeap k a))
h2' Box (List (NEHeap k a))
h1'

    helper :: k -> a %1 -> k -> a %1 -> Box (List (NEHeap k a)) %1 -> Box (List (NEHeap k a)) %1 -> Pool %1 -> NEHeap k a
    helper :: k
-> a
%1 -> k
-> a
%1 -> Box (List (NEHeap k a))
%1 -> Box (List (NEHeap k a))
%1 -> Pool
%1 -> NEHeap k a
helper k
k1'' a
a1'' k
k2'' a
a2'' Box (List (NEHeap k a))
h1'' Box (List (NEHeap k a))
h2'' Pool
pool'' = k -> a -> Box (List (NEHeap k a)) -> NEHeap k a
forall k a. k -> a -> Box (List (NEHeap k a)) -> NEHeap k a
Heap k
k1'' a
a1'' (List (NEHeap k a) %1 -> Pool %1 -> Box (List (NEHeap k a))
forall a. Representable a => a %1 -> Pool %1 -> Box a
Manual.alloc ((b -> Box (List b) -> List b
forall {b}. b -> Box (List b) -> List b
List.Cons :: b %1 -> Box (List b) %1 -> List b) ((c -> b -> Box (List (NEHeap c b)) -> NEHeap c b
forall k a. k -> a -> Box (List (NEHeap k a)) -> NEHeap k a
Heap :: c %1 -> b %1 -> Box (List (NEHeap c b)) %1 -> NEHeap c b) k
k2'' a
a2'' Box (List (NEHeap k a))
h2'') Box (List (NEHeap k a))
h1'') Pool
pool'')

-- XXX: the type signatures for List.Cons and Heap are necessary for certain
-- older versions of the compiler, and as such are temporary. See PR #38
-- and PR #380 in tweag/ghc/linear-types.

mergeN' :: forall k a. (Manual.Representable k, Manual.Representable a, Movable k, Ord k) => NEHeap k a %1 -> Heap k a %1 -> Pool %1 -> NEHeap k a
mergeN' :: forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
NEHeap k a %1 -> Heap k a %1 -> Pool %1 -> NEHeap k a
mergeN' NEHeap k a
h Heap k a
Empty Pool
pool = Pool
pool Pool %1 -> NEHeap k a %1 -> NEHeap k a
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` NEHeap k a
h
mergeN' NEHeap k a
h (NonEmpty Box (NEHeap k a)
h') Pool
pool = NEHeap k a %1 -> NEHeap k a %1 -> Pool %1 -> NEHeap k a
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
NEHeap k a %1 -> NEHeap k a %1 -> Pool %1 -> NEHeap k a
mergeN NEHeap k a
h (Box (NEHeap k a) %1 -> NEHeap k a
forall a. Representable a => Box a %1 -> a
Manual.deconstruct Box (NEHeap k a)
h') Pool
pool

extractMinN :: (Manual.Representable k, Manual.Representable a, Movable k, Ord k) => NEHeap k a %1 -> Pool %1 -> (k, a, Heap k a)
extractMinN :: forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
NEHeap k a %1 -> Pool %1 -> (k, a, Heap k a)
extractMinN (Heap k
k a
a Box (List (NEHeap k a))
h) Pool
pool = (k
k, a
a, List (NEHeap k a) %1 -> Pool %1 -> Heap k a
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
List (NEHeap k a) %1 -> Pool %1 -> Heap k a
pairUp (Box (List (NEHeap k a)) %1 -> List (NEHeap k a)
forall a. Representable a => Box a %1 -> a
Manual.deconstruct Box (List (NEHeap k a))
h) Pool
pool)

pairUp :: forall k a. (Manual.Representable k, Manual.Representable a, Movable k, Ord k) => List (NEHeap k a) %1 -> Pool %1 -> Heap k a
pairUp :: forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
List (NEHeap k a) %1 -> Pool %1 -> Heap k a
pairUp List (NEHeap k a)
List.Nil Pool
pool = Pool
pool Pool %1 -> Heap k a %1 -> Heap k a
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Heap k a
forall k a. Heap k a
Empty
pairUp (List.Cons NEHeap k a
h Box (List (NEHeap k a))
r) Pool
pool = NEHeap k a
%1 -> List (NEHeap k a) %1 -> (Pool, Pool) %1 -> Heap k a
pairOne NEHeap k a
h (Box (List (NEHeap k a)) %1 -> List (NEHeap k a)
forall a. Representable a => Box a %1 -> a
Manual.deconstruct Box (List (NEHeap k a))
r) (Pool %1 -> (Pool, Pool)
forall a. Dupable a => a %1 -> (a, a)
dup Pool
pool)
  where
    pairOne :: NEHeap k a %1 -> List (NEHeap k a) %1 -> (Pool, Pool) %1 -> Heap k a
    pairOne :: NEHeap k a
%1 -> List (NEHeap k a) %1 -> (Pool, Pool) %1 -> Heap k a
pairOne NEHeap k a
h' List (NEHeap k a)
r' (Pool
pool1, Pool
pool2) =
      Box (NEHeap k a) -> Heap k a
forall k a. Box (NEHeap k a) -> Heap k a
NonEmpty (Box (NEHeap k a) %1 -> Heap k a)
-> Box (NEHeap k a) %1 -> Heap k a
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ NEHeap k a %1 -> Pool %1 -> Box (NEHeap k a)
forall a. Representable a => a %1 -> Pool %1 -> Box a
Manual.alloc (NEHeap k a
%1 -> List (NEHeap k a) %1 -> (Pool, Pool, Pool) %1 -> NEHeap k a
pairOne' NEHeap k a
h' List (NEHeap k a)
r' (Pool %1 -> (Pool, Pool, Pool)
forall a. Dupable a => a %1 -> (a, a, a)
dup3 Pool
pool1)) Pool
pool2

    pairOne' :: NEHeap k a %1 -> List (NEHeap k a) %1 -> (Pool, Pool, Pool) %1 -> NEHeap k a
    pairOne' :: NEHeap k a
%1 -> List (NEHeap k a) %1 -> (Pool, Pool, Pool) %1 -> NEHeap k a
pairOne' NEHeap k a
h1 List (NEHeap k a)
List.Nil (Pool, Pool, Pool)
pools =
      (Pool, Pool, Pool)
pools (Pool, Pool, Pool) %1 -> NEHeap k a %1 -> NEHeap k a
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` NEHeap k a
h1
    pairOne' NEHeap k a
h1 (List.Cons NEHeap k a
h2 Box (List (NEHeap k a))
r') (Pool
pool1, Pool
pool2, Pool
pool3) =
      NEHeap k a %1 -> Heap k a %1 -> Pool %1 -> NEHeap k a
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
NEHeap k a %1 -> Heap k a %1 -> Pool %1 -> NEHeap k a
mergeN' (NEHeap k a %1 -> NEHeap k a %1 -> Pool %1 -> NEHeap k a
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
NEHeap k a %1 -> NEHeap k a %1 -> Pool %1 -> NEHeap k a
mergeN NEHeap k a
h1 NEHeap k a
h2 Pool
pool1) (List (NEHeap k a) %1 -> Pool %1 -> Heap k a
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
List (NEHeap k a) %1 -> Pool %1 -> Heap k a
pairUp (Box (List (NEHeap k a)) %1 -> List (NEHeap k a)
forall a. Representable a => Box a %1 -> a
Manual.deconstruct Box (List (NEHeap k a))
r') Pool
pool2) Pool
pool3

-- * Heap primitives

empty :: Heap k a
empty :: forall k a. Heap k a
empty = Heap k a
forall k a. Heap k a
Empty

singleton :: forall k a. (Manual.Representable k, Manual.Representable a) => k %1 -> a %1 -> Pool %1 -> Heap k a
singleton :: forall k a.
(Representable k, Representable a) =>
k %1 -> a %1 -> Pool %1 -> Heap k a
singleton k
k a
a Pool
pool = Box (NEHeap k a) -> Heap k a
forall k a. Box (NEHeap k a) -> Heap k a
NonEmpty (Box (NEHeap k a) %1 -> Heap k a)
-> Box (NEHeap k a) %1 -> Heap k a
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ k %1 -> a %1 -> (Pool, Pool) %1 -> Box (NEHeap k a)
singletonAlloc k
k a
a (Pool %1 -> (Pool, Pool)
forall a. Dupable a => a %1 -> (a, a)
dup Pool
pool)
  where
    singletonAlloc :: k %1 -> a %1 -> (Pool, Pool) %1 -> Box (NEHeap k a)
    singletonAlloc :: k %1 -> a %1 -> (Pool, Pool) %1 -> Box (NEHeap k a)
singletonAlloc k
k' a
a' (Pool
pool1, Pool
pool2) =
      NEHeap k a %1 -> Pool %1 -> Box (NEHeap k a)
forall a. Representable a => a %1 -> Pool %1 -> Box a
Manual.alloc (k %1 -> a %1 -> Pool %1 -> NEHeap k a
forall k a.
(Representable k, Representable a) =>
k %1 -> a %1 -> Pool %1 -> NEHeap k a
singletonN k
k' a
a' Pool
pool1) Pool
pool2

extractMin :: (Manual.Representable k, Manual.Representable a, Movable k, Ord k) => Heap k a %1 -> Pool %1 -> Maybe (k, a, Heap k a)
extractMin :: forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
Heap k a %1 -> Pool %1 -> Maybe (k, a, Heap k a)
extractMin Heap k a
Empty Pool
pool = Pool
pool Pool %1 -> Maybe (k, a, Heap k a) %1 -> Maybe (k, a, Heap k a)
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Maybe (k, a, Heap k a)
forall a. Maybe a
Nothing
extractMin (NonEmpty Box (NEHeap k a)
h) Pool
pool = (k, a, Heap k a) -> Maybe (k, a, Heap k a)
forall a. a -> Maybe a
Just ((k, a, Heap k a) %1 -> Maybe (k, a, Heap k a))
-> (k, a, Heap k a) %1 -> Maybe (k, a, Heap k a)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ NEHeap k a %1 -> Pool %1 -> (k, a, Heap k a)
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
NEHeap k a %1 -> Pool %1 -> (k, a, Heap k a)
extractMinN (Box (NEHeap k a) %1 -> NEHeap k a
forall a. Representable a => Box a %1 -> a
Manual.deconstruct Box (NEHeap k a)
h) Pool
pool

merge :: forall k a. (Manual.Representable k, Manual.Representable a, Movable k, Ord k) => Heap k a %1 -> Heap k a %1 -> Pool %1 -> Heap k a
merge :: forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
Heap k a %1 -> Heap k a %1 -> Pool %1 -> Heap k a
merge Heap k a
Empty Heap k a
h' Pool
pool = Pool
pool Pool %1 -> Heap k a %1 -> Heap k a
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Heap k a
h'
merge (NonEmpty Box (NEHeap k a)
h) Heap k a
h' Pool
pool = Box (NEHeap k a) -> Heap k a
forall k a. Box (NEHeap k a) -> Heap k a
NonEmpty (Box (NEHeap k a) %1 -> Heap k a)
-> Box (NEHeap k a) %1 -> Heap k a
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ NEHeap k a %1 -> Heap k a %1 -> (Pool, Pool) %1 -> Box (NEHeap k a)
neMerge (Box (NEHeap k a) %1 -> NEHeap k a
forall a. Representable a => Box a %1 -> a
Manual.deconstruct Box (NEHeap k a)
h) Heap k a
h' (Pool %1 -> (Pool, Pool)
forall a. Dupable a => a %1 -> (a, a)
dup Pool
pool)
  where
    neMerge :: NEHeap k a %1 -> Heap k a %1 -> (Pool, Pool) %1 -> Box (NEHeap k a)
    neMerge :: NEHeap k a %1 -> Heap k a %1 -> (Pool, Pool) %1 -> Box (NEHeap k a)
neMerge NEHeap k a
h1 Heap k a
h2 (Pool
pool1, Pool
pool2) =
      NEHeap k a %1 -> Pool %1 -> Box (NEHeap k a)
forall a. Representable a => a %1 -> Pool %1 -> Box a
Manual.alloc (NEHeap k a %1 -> Heap k a %1 -> Pool %1 -> NEHeap k a
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
NEHeap k a %1 -> Heap k a %1 -> Pool %1 -> NEHeap k a
mergeN' NEHeap k a
h1 Heap k a
h2 Pool
pool1) Pool
pool2

-- * Heap sort

-- | Guaranteed to yield pairs in ascending key order
foldl :: forall k a b. (Manual.Representable k, Manual.Representable a, Movable k, Ord k) => (b %1 -> k %1 -> a %1 -> b) -> b %1 -> Heap k a %1 -> Pool %1 -> b
foldl :: forall k a b.
(Representable k, Representable a, Movable k, Ord k) =>
(b %1 -> k %1 -> a %1 -> b) -> b %1 -> Heap k a %1 -> Pool %1 -> b
foldl b %1 -> k %1 -> a %1 -> b
f b
acc Heap k a
h Pool
pool = b %1 -> Heap k a %1 -> (Pool, Pool) %1 -> b
go b
acc Heap k a
h (Pool %1 -> (Pool, Pool)
forall a. Dupable a => a %1 -> (a, a)
dup Pool
pool)
  where
    go :: b %1 -> Heap k a %1 -> (Pool, Pool) %1 -> b
    go :: b %1 -> Heap k a %1 -> (Pool, Pool) %1 -> b
go b
acc' Heap k a
h' (Pool
pool1, Pool
pool2) = b %1 -> Maybe (k, a, Heap k a) %1 -> Pool %1 -> b
dispatch b
acc' (Heap k a %1 -> Pool %1 -> Maybe (k, a, Heap k a)
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
Heap k a %1 -> Pool %1 -> Maybe (k, a, Heap k a)
extractMin Heap k a
h' Pool
pool1) Pool
pool2

    dispatch :: b %1 -> Maybe (k, a, Heap k a) %1 -> Pool %1 -> b
    dispatch :: b %1 -> Maybe (k, a, Heap k a) %1 -> Pool %1 -> b
dispatch b
acc' Maybe (k, a, Heap k a)
Nothing Pool
pool' = Pool
pool' Pool %1 -> b %1 -> b
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` b
acc'
    dispatch b
acc' (Just (k
k, a
a, Heap k a
h')) Pool
pool' =
      (b %1 -> k %1 -> a %1 -> b) -> b %1 -> Heap k a %1 -> Pool %1 -> b
forall k a b.
(Representable k, Representable a, Movable k, Ord k) =>
(b %1 -> k %1 -> a %1 -> b) -> b %1 -> Heap k a %1 -> Pool %1 -> b
foldl b %1 -> k %1 -> a %1 -> b
f (b %1 -> k %1 -> a %1 -> b
f b
acc' k
k a
a) Heap k a
h' Pool
pool'

-- | Strict: stream must terminate.
unfold :: forall k a s. (Manual.Representable k, Manual.Representable a, Movable k, Ord k) => (s -> Maybe ((k, a), s)) -> s -> Pool %1 -> Heap k a
unfold :: forall k a s.
(Representable k, Representable a, Movable k, Ord k) =>
(s -> Maybe ((k, a), s)) -> s -> Pool %1 -> Heap k a
unfold s -> Maybe ((k, a), s)
step s
seed Pool
pool = Maybe ((k, a), s) -> Pool %1 -> Heap k a
dispatch (s -> Maybe ((k, a), s)
step s
seed) Pool
pool
  where
    dispatch :: (Maybe ((k, a), s)) -> Pool %1 -> Heap k a
    dispatch :: Maybe ((k, a), s) -> Pool %1 -> Heap k a
dispatch Maybe ((k, a), s)
Nothing Pool
pool' = Pool
pool' Pool %1 -> Heap k a %1 -> Heap k a
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Heap k a
forall k a. Heap k a
Empty
    dispatch (Just ((k
k, a
a), s
next)) Pool
pool' = k -> a -> s -> (Pool, Pool, Pool) %1 -> Heap k a
mkStep k
k a
a s
next (Pool %1 -> (Pool, Pool, Pool)
forall a. Dupable a => a %1 -> (a, a, a)
dup3 Pool
pool')

    mkStep :: k -> a -> s -> (Pool, Pool, Pool) %1 -> Heap k a
    mkStep :: k -> a -> s -> (Pool, Pool, Pool) %1 -> Heap k a
mkStep k
k a
a s
next (Pool
pool1, Pool
pool2, Pool
pool3) =
      Heap k a %1 -> Heap k a %1 -> Pool %1 -> Heap k a
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
Heap k a %1 -> Heap k a %1 -> Pool %1 -> Heap k a
merge (k %1 -> a %1 -> Pool %1 -> Heap k a
forall k a.
(Representable k, Representable a) =>
k %1 -> a %1 -> Pool %1 -> Heap k a
singleton k
k a
a Pool
pool1) ((s -> Maybe ((k, a), s)) -> s -> Pool %1 -> Heap k a
forall k a s.
(Representable k, Representable a, Movable k, Ord k) =>
(s -> Maybe ((k, a), s)) -> s -> Pool %1 -> Heap k a
unfold s -> Maybe ((k, a), s)
step s
next Pool
pool2) Pool
pool3

-- TODO: linear unfold: could apply to off-heap lists!

ofList :: (Manual.Representable k, Manual.Representable a, Movable k, Ord k) => [(k, a)] -> Pool %1 -> Heap k a
ofList :: forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
[(k, a)] -> Pool %1 -> Heap k a
ofList [(k, a)]
l Pool
pool = ([(k, a)] -> Maybe ((k, a), [(k, a)]))
-> [(k, a)] -> Pool %1 -> Heap k a
forall k a s.
(Representable k, Representable a, Movable k, Ord k) =>
(s -> Maybe ((k, a), s)) -> s -> Pool %1 -> Heap k a
unfold [(k, a)] -> Maybe ((k, a), [(k, a)])
forall a. [a] -> Maybe (a, [a])
List.uncons [(k, a)]
l Pool
pool

-- XXX: sorts in reverse
toList :: (Manual.Representable k, Manual.Representable a, Movable k, Ord k) => Heap k a %1 -> Pool %1 -> [(k, a)]
toList :: forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
Heap k a %1 -> Pool %1 -> [(k, a)]
toList Heap k a
h Pool
pool = ([(k, a)] %1 -> k %1 -> a %1 -> [(k, a)])
-> [(k, a)] %1 -> Heap k a %1 -> Pool %1 -> [(k, a)]
forall k a b.
(Representable k, Representable a, Movable k, Ord k) =>
(b %1 -> k %1 -> a %1 -> b) -> b %1 -> Heap k a %1 -> Pool %1 -> b
foldl (\[(k, a)]
l k
k a
a -> (k
k, a
a) (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: [(k, a)]
l) [] Heap k a
h Pool
pool

sort :: forall k a. (Manual.Representable k, Manual.Representable a, Movable k, Ord k, Movable a) => [(k, a)] -> [(k, a)]
sort :: forall k a.
(Representable k, Representable a, Movable k, Ord k, Movable a) =>
[(k, a)] -> [(k, a)]
sort [(k, a)]
l = Ur [(k, a)] %1 -> [(k, a)]
forall a. Ur a %1 -> a
unur (Ur [(k, a)] %1 -> [(k, a)]) -> Ur [(k, a)] %1 -> [(k, a)]
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ (Pool %1 -> Ur [(k, a)]) %1 -> Ur [(k, a)]
forall b. Movable b => (Pool %1 -> b) %1 -> b
Manual.withPool (\Pool
pool -> [(k, a)] %1 -> Ur [(k, a)]
forall a. Movable a => a %1 -> Ur a
move ([(k, a)] %1 -> Ur [(k, a)]) -> [(k, a)] %1 -> Ur [(k, a)]
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ [(k, a)] -> (Pool, Pool) %1 -> [(k, a)]
sort' [(k, a)]
l (Pool %1 -> (Pool, Pool)
forall a. Dupable a => a %1 -> (a, a)
dup Pool
pool))
  where
    -- XXX: can we avoid this call to `move`?

    sort' :: [(k, a)] -> (Pool, Pool) %1 -> [(k, a)]
    sort' :: [(k, a)] -> (Pool, Pool) %1 -> [(k, a)]
sort' [(k, a)]
l' (Pool
pool1, Pool
pool2) = Heap k a %1 -> Pool %1 -> [(k, a)]
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
Heap k a %1 -> Pool %1 -> [(k, a)]
toList ([(k, a)] -> Pool %1 -> Heap k a
forall k a.
(Representable k, Representable a, Movable k, Ord k) =>
[(k, a)] -> Pool %1 -> Heap k a
ofList [(k, a)]
l' Pool
pool1) Pool
pool2