{-
(c) The University of Glasgow 2006
(c) The AQUA Project, Glasgow University, 1993-1998


-}
{-# LANGUAGE DeriveFunctor #-}

{-# LANGUAGE BangPatterns #-}

-- | Provide trees (of instructions), so that lists of instructions can be
-- appended in linear time.
module GHC.Data.OrdList (
        OrdList,
        nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL,
        headOL,
        mapOL, fromOL, toOL, foldrOL, foldlOL, reverseOL, fromOLReverse,
        strictlyEqOL, strictlyOrdOL
) where

import GHC.Prelude
import Data.Foldable

import GHC.Utils.Outputable

import qualified Data.Semigroup as Semigroup

infixl 5  `appOL`
infixl 5  `snocOL`
infixr 5  `consOL`

data OrdList a
  = None
  | One a
  | Many [a]          -- Invariant: non-empty
  | Cons a (OrdList a)
  | Snoc (OrdList a) a
  | Two (OrdList a) -- Invariant: non-empty
        (OrdList a) -- Invariant: non-empty
  deriving ((forall a b. (a -> b) -> OrdList a -> OrdList b)
-> (forall a b. a -> OrdList b -> OrdList a) -> Functor OrdList
forall a b. a -> OrdList b -> OrdList a
forall a b. (a -> b) -> OrdList a -> OrdList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> OrdList b -> OrdList a
$c<$ :: forall a b. a -> OrdList b -> OrdList a
fmap :: forall a b. (a -> b) -> OrdList a -> OrdList b
$cfmap :: forall a b. (a -> b) -> OrdList a -> OrdList b
Functor)

instance Outputable a => Outputable (OrdList a) where
  ppr :: OrdList a -> SDoc
ppr OrdList a
ol = [a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OrdList a -> [a]
forall a. OrdList a -> [a]
fromOL OrdList a
ol)  -- Convert to list and print that

instance Semigroup (OrdList a) where
  <> :: OrdList a -> OrdList a -> OrdList a
(<>) = OrdList a -> OrdList a -> OrdList a
forall a. OrdList a -> OrdList a -> OrdList a
appOL

instance Monoid (OrdList a) where
  mempty :: OrdList a
mempty = OrdList a
forall a. OrdList a
nilOL
  mappend :: OrdList a -> OrdList a -> OrdList a
mappend = OrdList a -> OrdList a -> OrdList a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
  mconcat :: [OrdList a] -> OrdList a
mconcat = [OrdList a] -> OrdList a
forall a. [OrdList a] -> OrdList a
concatOL

instance Foldable OrdList where
  foldr :: forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldr   = (a -> b -> b) -> b -> OrdList a -> b
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL
  foldl' :: forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldl'  = (b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL
  toList :: forall a. OrdList a -> [a]
toList  = OrdList a -> [a]
forall a. OrdList a -> [a]
fromOL
  null :: forall a. OrdList a -> Bool
null    = OrdList a -> Bool
forall a. OrdList a -> Bool
isNilOL
  length :: forall a. OrdList a -> Int
length  = OrdList a -> Int
forall a. OrdList a -> Int
lengthOL

instance Traversable OrdList where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdList a -> f (OrdList b)
traverse a -> f b
f OrdList a
xs = [b] -> OrdList b
forall a. [a] -> OrdList a
toOL ([b] -> OrdList b) -> f [b] -> f (OrdList b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f (OrdList a -> [a]
forall a. OrdList a -> [a]
fromOL OrdList a
xs)

nilOL    :: OrdList a
isNilOL  :: OrdList a -> Bool

unitOL   :: a           -> OrdList a
snocOL   :: OrdList a   -> a         -> OrdList a
consOL   :: a           -> OrdList a -> OrdList a
appOL    :: OrdList a   -> OrdList a -> OrdList a
concatOL :: [OrdList a] -> OrdList a
headOL   :: OrdList a   -> a
lastOL   :: OrdList a   -> a
lengthOL :: OrdList a   -> Int

nilOL :: forall a. OrdList a
nilOL        = OrdList a
forall a. OrdList a
None
unitOL :: forall a. a -> OrdList a
unitOL a
as    = a -> OrdList a
forall a. a -> OrdList a
One a
as
snocOL :: forall a. OrdList a -> a -> OrdList a
snocOL OrdList a
as   a
b    = OrdList a -> a -> OrdList a
forall a. OrdList a -> a -> OrdList a
Snoc OrdList a
as a
b
consOL :: forall a. a -> OrdList a -> OrdList a
consOL a
a    OrdList a
bs   = a -> OrdList a -> OrdList a
forall a. a -> OrdList a -> OrdList a
Cons a
a OrdList a
bs
concatOL :: forall a. [OrdList a] -> OrdList a
concatOL [OrdList a]
aas = (OrdList a -> OrdList a -> OrdList a)
-> OrdList a -> [OrdList a] -> OrdList a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr OrdList a -> OrdList a -> OrdList a
forall a. OrdList a -> OrdList a -> OrdList a
appOL OrdList a
forall a. OrdList a
None [OrdList a]
aas

headOL :: forall a. OrdList a -> a
headOL OrdList a
None        = String -> a
forall a. String -> a
panic String
"headOL"
headOL (One a
a)     = a
a
headOL (Many [a]
as)   = [a] -> a
forall a. [a] -> a
head [a]
as
headOL (Cons a
a OrdList a
_)  = a
a
headOL (Snoc OrdList a
as a
_) = OrdList a -> a
forall a. OrdList a -> a
headOL OrdList a
as
headOL (Two OrdList a
as OrdList a
_)  = OrdList a -> a
forall a. OrdList a -> a
headOL OrdList a
as

lastOL :: forall a. OrdList a -> a
lastOL OrdList a
None        = String -> a
forall a. String -> a
panic String
"lastOL"
lastOL (One a
a)     = a
a
lastOL (Many [a]
as)   = [a] -> a
forall a. [a] -> a
last [a]
as
lastOL (Cons a
_ OrdList a
as) = OrdList a -> a
forall a. OrdList a -> a
lastOL OrdList a
as
lastOL (Snoc OrdList a
_ a
a)  = a
a
lastOL (Two OrdList a
_ OrdList a
as)  = OrdList a -> a
forall a. OrdList a -> a
lastOL OrdList a
as

lengthOL :: forall a. OrdList a -> Int
lengthOL OrdList a
None        = Int
0
lengthOL (One a
_)     = Int
1
lengthOL (Many [a]
as)   = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as
lengthOL (Cons a
_ OrdList a
as) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ OrdList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OrdList a
as
lengthOL (Snoc OrdList a
as a
_) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ OrdList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OrdList a
as
lengthOL (Two OrdList a
as OrdList a
bs) = OrdList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OrdList a
as Int -> Int -> Int
forall a. Num a => a -> a -> a
+ OrdList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OrdList a
bs

isNilOL :: forall a. OrdList a -> Bool
isNilOL OrdList a
None = Bool
True
isNilOL OrdList a
_    = Bool
False

OrdList a
None  appOL :: forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList a
b     = OrdList a
b
OrdList a
a     `appOL` OrdList a
None  = OrdList a
a
One a
a `appOL` OrdList a
b     = a -> OrdList a -> OrdList a
forall a. a -> OrdList a -> OrdList a
Cons a
a OrdList a
b
OrdList a
a     `appOL` One a
b = OrdList a -> a -> OrdList a
forall a. OrdList a -> a -> OrdList a
Snoc OrdList a
a a
b
OrdList a
a     `appOL` OrdList a
b     = OrdList a -> OrdList a -> OrdList a
forall a. OrdList a -> OrdList a -> OrdList a
Two OrdList a
a OrdList a
b

fromOL :: OrdList a -> [a]
fromOL :: forall a. OrdList a -> [a]
fromOL OrdList a
a = OrdList a -> [a] -> [a]
forall {a}. OrdList a -> [a] -> [a]
go OrdList a
a []
  where go :: OrdList a -> [a] -> [a]
go OrdList a
None       [a]
acc = [a]
acc
        go (One a
a)    [a]
acc = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
        go (Cons a
a OrdList a
b) [a]
acc = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: OrdList a -> [a] -> [a]
go OrdList a
b [a]
acc
        go (Snoc OrdList a
a a
b) [a]
acc = OrdList a -> [a] -> [a]
go OrdList a
a (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)
        go (Two OrdList a
a OrdList a
b)  [a]
acc = OrdList a -> [a] -> [a]
go OrdList a
a (OrdList a -> [a] -> [a]
go OrdList a
b [a]
acc)
        go (Many [a]
xs)  [a]
acc = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc

fromOLReverse :: OrdList a -> [a]
fromOLReverse :: forall a. OrdList a -> [a]
fromOLReverse OrdList a
a = OrdList a -> [a] -> [a]
forall {a}. OrdList a -> [a] -> [a]
go OrdList a
a []
        -- acc is already in reverse order
  where go :: OrdList a -> [a] -> [a]
        go :: forall {a}. OrdList a -> [a] -> [a]
go OrdList a
None       [a]
acc = [a]
acc
        go (One a
a)    [a]
acc = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
        go (Cons a
a OrdList a
b) [a]
acc = OrdList a -> [a] -> [a]
forall {a}. OrdList a -> [a] -> [a]
go OrdList a
b (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)
        go (Snoc OrdList a
a a
b) [a]
acc = a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: OrdList a -> [a] -> [a]
forall {a}. OrdList a -> [a] -> [a]
go OrdList a
a [a]
acc
        go (Two OrdList a
a OrdList a
b)  [a]
acc = OrdList a -> [a] -> [a]
forall {a}. OrdList a -> [a] -> [a]
go OrdList a
b (OrdList a -> [a] -> [a]
forall {a}. OrdList a -> [a] -> [a]
go OrdList a
a [a]
acc)
        go (Many [a]
xs)  [a]
acc = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc

mapOL :: (a -> b) -> OrdList a -> OrdList b
mapOL :: forall a b. (a -> b) -> OrdList a -> OrdList b
mapOL = (a -> b) -> OrdList a -> OrdList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

foldrOL :: (a->b->b) -> b -> OrdList a -> b
foldrOL :: forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL a -> b -> b
_ b
z OrdList a
None        = b
z
foldrOL a -> b -> b
k b
z (One a
x)     = a -> b -> b
k a
x b
z
foldrOL a -> b -> b
k b
z (Cons a
x OrdList a
xs) = a -> b -> b
k a
x ((a -> b -> b) -> b -> OrdList a -> b
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL a -> b -> b
k b
z OrdList a
xs)
foldrOL a -> b -> b
k b
z (Snoc OrdList a
xs a
x) = (a -> b -> b) -> b -> OrdList a -> b
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL a -> b -> b
k (a -> b -> b
k a
x b
z) OrdList a
xs
foldrOL a -> b -> b
k b
z (Two OrdList a
b1 OrdList a
b2) = (a -> b -> b) -> b -> OrdList a -> b
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL a -> b -> b
k ((a -> b -> b) -> b -> OrdList a -> b
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL a -> b -> b
k b
z OrdList a
b2) OrdList a
b1
foldrOL a -> b -> b
k b
z (Many [a]
xs)   = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
k b
z [a]
xs

-- | Strict left fold.
foldlOL :: (b->a->b) -> b -> OrdList a -> b
foldlOL :: forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
_ b
z OrdList a
None        = b
z
foldlOL b -> a -> b
k b
z (One a
x)     = b -> a -> b
k b
z a
x
foldlOL b -> a -> b
k b
z (Cons a
x OrdList a
xs) = let !z' :: b
z' = (b -> a -> b
k b
z a
x) in (b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
k b
z' OrdList a
xs
foldlOL b -> a -> b
k b
z (Snoc OrdList a
xs a
x) = let !z' :: b
z' = ((b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
k b
z OrdList a
xs) in b -> a -> b
k b
z' a
x
foldlOL b -> a -> b
k b
z (Two OrdList a
b1 OrdList a
b2) = let !z' :: b
z' = ((b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
k b
z OrdList a
b1) in (b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
k b
z' OrdList a
b2
foldlOL b -> a -> b
k b
z (Many [a]
xs)   = (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
k b
z [a]
xs

toOL :: [a] -> OrdList a
toOL :: forall a. [a] -> OrdList a
toOL [] = OrdList a
forall a. OrdList a
None
toOL [a
x] = a -> OrdList a
forall a. a -> OrdList a
One a
x
toOL [a]
xs = [a] -> OrdList a
forall a. [a] -> OrdList a
Many [a]
xs

reverseOL :: OrdList a -> OrdList a
reverseOL :: forall a. OrdList a -> OrdList a
reverseOL OrdList a
None = OrdList a
forall a. OrdList a
None
reverseOL (One a
x) = a -> OrdList a
forall a. a -> OrdList a
One a
x
reverseOL (Cons a
a OrdList a
b) = OrdList a -> a -> OrdList a
forall a. OrdList a -> a -> OrdList a
Snoc (OrdList a -> OrdList a
forall a. OrdList a -> OrdList a
reverseOL OrdList a
b) a
a
reverseOL (Snoc OrdList a
a a
b) = a -> OrdList a -> OrdList a
forall a. a -> OrdList a -> OrdList a
Cons a
b (OrdList a -> OrdList a
forall a. OrdList a -> OrdList a
reverseOL OrdList a
a)
reverseOL (Two OrdList a
a OrdList a
b)  = OrdList a -> OrdList a -> OrdList a
forall a. OrdList a -> OrdList a -> OrdList a
Two (OrdList a -> OrdList a
forall a. OrdList a -> OrdList a
reverseOL OrdList a
b) (OrdList a -> OrdList a
forall a. OrdList a -> OrdList a
reverseOL OrdList a
a)
reverseOL (Many [a]
xs)  = [a] -> OrdList a
forall a. [a] -> OrdList a
Many ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs)

-- | Compare not only the values but also the structure of two lists
strictlyEqOL :: Eq a => OrdList a   -> OrdList a -> Bool
strictlyEqOL :: forall a. Eq a => OrdList a -> OrdList a -> Bool
strictlyEqOL OrdList a
None         OrdList a
None       = Bool
True
strictlyEqOL (One a
x)     (One a
y)     = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
strictlyEqOL (Cons a
a OrdList a
as) (Cons a
b OrdList a
bs) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b Bool -> Bool -> Bool
&& OrdList a
as OrdList a -> OrdList a -> Bool
forall a. Eq a => OrdList a -> OrdList a -> Bool
`strictlyEqOL` OrdList a
bs
strictlyEqOL (Snoc OrdList a
as a
a) (Snoc OrdList a
bs a
b) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b Bool -> Bool -> Bool
&& OrdList a
as OrdList a -> OrdList a -> Bool
forall a. Eq a => OrdList a -> OrdList a -> Bool
`strictlyEqOL` OrdList a
bs
strictlyEqOL (Two OrdList a
a1 OrdList a
a2) (Two OrdList a
b1 OrdList a
b2) = OrdList a
a1 OrdList a -> OrdList a -> Bool
forall a. Eq a => OrdList a -> OrdList a -> Bool
`strictlyEqOL` OrdList a
b1 Bool -> Bool -> Bool
&& OrdList a
a2 OrdList a -> OrdList a -> Bool
forall a. Eq a => OrdList a -> OrdList a -> Bool
`strictlyEqOL` OrdList a
b2
strictlyEqOL (Many [a]
as)   (Many [a]
bs)   = [a]
as [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
bs
strictlyEqOL OrdList a
_            OrdList a
_          = Bool
False

-- | Compare not only the values but also the structure of two lists
strictlyOrdOL :: Ord a => OrdList a   -> OrdList a -> Ordering
strictlyOrdOL :: forall a. Ord a => OrdList a -> OrdList a -> Ordering
strictlyOrdOL OrdList a
None         OrdList a
None       = Ordering
EQ
strictlyOrdOL OrdList a
None         OrdList a
_          = Ordering
LT
strictlyOrdOL (One a
x)     (One a
y)     = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y
strictlyOrdOL (One a
_)      OrdList a
_          = Ordering
LT
strictlyOrdOL (Cons a
a OrdList a
as) (Cons a
b OrdList a
bs) =
  a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` OrdList a -> OrdList a -> Ordering
forall a. Ord a => OrdList a -> OrdList a -> Ordering
strictlyOrdOL OrdList a
as OrdList a
bs
strictlyOrdOL (Cons a
_ OrdList a
_)   OrdList a
_          = Ordering
LT
strictlyOrdOL (Snoc OrdList a
as a
a) (Snoc OrdList a
bs a
b) =
  a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` OrdList a -> OrdList a -> Ordering
forall a. Ord a => OrdList a -> OrdList a -> Ordering
strictlyOrdOL OrdList a
as OrdList a
bs
strictlyOrdOL (Snoc OrdList a
_ a
_)   OrdList a
_          = Ordering
LT
strictlyOrdOL (Two OrdList a
a1 OrdList a
a2) (Two OrdList a
b1 OrdList a
b2) =
  (OrdList a -> OrdList a -> Ordering
forall a. Ord a => OrdList a -> OrdList a -> Ordering
strictlyOrdOL OrdList a
a1 OrdList a
b1) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (OrdList a -> OrdList a -> Ordering
forall a. Ord a => OrdList a -> OrdList a -> Ordering
strictlyOrdOL OrdList a
a2 OrdList a
b2)
strictlyOrdOL (Two OrdList a
_ OrdList a
_)    OrdList a
_          = Ordering
LT
strictlyOrdOL (Many [a]
as)   (Many [a]
bs)   = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [a]
as [a]
bs
strictlyOrdOL (Many [a]
_ )   OrdList a
_           = Ordering
GT