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


This is useful, general stuff for the Native Code Generator.

Provide trees (of instructions), so that lists of instructions
can be appended in linear time.
-}

module OrdList (
        OrdList,
        nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL,
        mapOL, fromOL, toOL, foldrOL, foldlOL, reverseOL
) where

import GhcPrelude

import 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

instance Outputable a => Outputable (OrdList a) where
  ppr :: OrdList a -> SDoc
ppr ol :: 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 Functor OrdList where
  fmap :: (a -> b) -> OrdList a -> OrdList b
fmap = (a -> b) -> OrdList a -> OrdList b
forall a b. (a -> b) -> OrdList a -> OrdList b
mapOL

instance Foldable OrdList where
  foldr :: (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

instance Traversable OrdList where
  traverse :: (a -> f b) -> OrdList a -> f (OrdList b)
traverse f :: a -> f b
f xs :: 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
lastOL   :: OrdList a   -> a

nilOL :: OrdList a
nilOL        = OrdList a
forall a. OrdList a
None
unitOL :: a -> OrdList a
unitOL as :: a
as    = a -> OrdList a
forall a. a -> OrdList a
One a
as
snocOL :: OrdList a -> a -> OrdList a
snocOL as :: OrdList a
as   b :: a
b    = OrdList a -> a -> OrdList a
forall a. OrdList a -> a -> OrdList a
Snoc OrdList a
as a
b
consOL :: a -> OrdList a -> OrdList a
consOL a :: a
a    bs :: OrdList a
bs   = a -> OrdList a -> OrdList a
forall a. a -> OrdList a -> OrdList a
Cons a
a OrdList a
bs
concatOL :: [OrdList a] -> OrdList a
concatOL aas :: [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

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

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

None  appOL :: OrdList a -> OrdList a -> OrdList a
`appOL` b :: OrdList a
b     = OrdList a
b
a :: OrdList a
a     `appOL` None  = OrdList a
a
One a :: a
a `appOL` b :: OrdList a
b     = a -> OrdList a -> OrdList a
forall a. a -> OrdList a -> OrdList a
Cons a
a OrdList a
b
a :: OrdList a
a     `appOL` One b :: a
b = OrdList a -> a -> OrdList a
forall a. OrdList a -> a -> OrdList a
Snoc OrdList a
a a
b
a :: OrdList a
a     `appOL` b :: 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 :: OrdList a -> [a]
fromOL a :: OrdList a
a = OrdList a -> [a] -> [a]
forall a. OrdList a -> [a] -> [a]
go OrdList a
a []
  where go :: OrdList a -> [a] -> [a]
go None       acc :: [a]
acc = [a]
acc
        go (One a :: a
a)    acc :: [a]
acc = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
        go (Cons a :: a
a b :: OrdList a
b) acc :: [a]
acc = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: OrdList a -> [a] -> [a]
go OrdList a
b [a]
acc
        go (Snoc a :: OrdList a
a b :: a
b) acc :: [a]
acc = OrdList a -> [a] -> [a]
go OrdList a
a (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)
        go (Two a :: OrdList a
a b :: OrdList a
b)  acc :: [a]
acc = OrdList a -> [a] -> [a]
go OrdList a
a (OrdList a -> [a] -> [a]
go OrdList a
b [a]
acc)
        go (Many xs :: [a]
xs)  acc :: [a]
acc = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc

mapOL :: (a -> b) -> OrdList a -> OrdList b
mapOL :: (a -> b) -> OrdList a -> OrdList b
mapOL _ None = OrdList b
forall a. OrdList a
None
mapOL f :: a -> b
f (One x :: a
x) = b -> OrdList b
forall a. a -> OrdList a
One (a -> b
f a
x)
mapOL f :: a -> b
f (Cons x :: a
x xs :: OrdList a
xs) = b -> OrdList b -> OrdList b
forall a. a -> OrdList a -> OrdList a
Cons (a -> b
f a
x) ((a -> b) -> OrdList a -> OrdList b
forall a b. (a -> b) -> OrdList a -> OrdList b
mapOL a -> b
f OrdList a
xs)
mapOL f :: a -> b
f (Snoc xs :: OrdList a
xs x :: a
x) = OrdList b -> b -> OrdList b
forall a. OrdList a -> a -> OrdList a
Snoc ((a -> b) -> OrdList a -> OrdList b
forall a b. (a -> b) -> OrdList a -> OrdList b
mapOL a -> b
f OrdList a
xs) (a -> b
f a
x)
mapOL f :: a -> b
f (Two x :: OrdList a
x y :: OrdList a
y) = OrdList b -> OrdList b -> OrdList b
forall a. OrdList a -> OrdList a -> OrdList a
Two ((a -> b) -> OrdList a -> OrdList b
forall a b. (a -> b) -> OrdList a -> OrdList b
mapOL a -> b
f OrdList a
x) ((a -> b) -> OrdList a -> OrdList b
forall a b. (a -> b) -> OrdList a -> OrdList b
mapOL a -> b
f OrdList a
y)
mapOL f :: a -> b
f (Many xs :: [a]
xs) = [b] -> OrdList b
forall a. [a] -> OrdList a
Many ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)

foldrOL :: (a->b->b) -> b -> OrdList a -> b
foldrOL :: (a -> b -> b) -> b -> OrdList a -> b
foldrOL _ z :: b
z None        = b
z
foldrOL k :: a -> b -> b
k z :: b
z (One x :: a
x)     = a -> b -> b
k a
x b
z
foldrOL k :: a -> b -> b
k z :: b
z (Cons x :: a
x xs :: 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 k :: a -> b -> b
k z :: b
z (Snoc xs :: OrdList a
xs x :: 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 k :: a -> b -> b
k z :: b
z (Two b1 :: OrdList a
b1 b2 :: 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 k :: a -> b -> b
k z :: b
z (Many xs :: [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

foldlOL :: (b->a->b) -> b -> OrdList a -> b
foldlOL :: (b -> a -> b) -> b -> OrdList a -> b
foldlOL _ z :: b
z None        = b
z
foldlOL k :: b -> a -> b
k z :: b
z (One x :: a
x)     = b -> a -> b
k b
z a
x
foldlOL k :: b -> a -> b
k z :: b
z (Cons x :: a
x xs :: OrdList a
xs) = (b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
k (b -> a -> b
k b
z a
x) OrdList a
xs
foldlOL k :: b -> a -> b
k z :: b
z (Snoc xs :: OrdList a
xs x :: a
x) = b -> a -> b
k ((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) a
x
foldlOL k :: b -> a -> b
k z :: b
z (Two b1 :: OrdList a
b1 b2 :: OrdList a
b2) = (b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
k ((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) OrdList a
b2
foldlOL k :: b -> a -> b
k z :: b
z (Many xs :: [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 :: [a] -> OrdList a
toOL [] = OrdList a
forall a. OrdList a
None
toOL [x :: a
x] = a -> OrdList a
forall a. a -> OrdList a
One a
x
toOL xs :: [a]
xs = [a] -> OrdList a
forall a. [a] -> OrdList a
Many [a]
xs

reverseOL :: OrdList a -> OrdList a
reverseOL :: OrdList a -> OrdList a
reverseOL None = OrdList a
forall a. OrdList a
None
reverseOL (One x :: a
x) = a -> OrdList a
forall a. a -> OrdList a
One a
x
reverseOL (Cons a :: a
a b :: 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 a :: OrdList a
a b :: 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 a :: OrdList a
a b :: 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 xs :: [a]
xs)  = [a] -> OrdList a
forall a. [a] -> OrdList a
Many ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs)