{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
module PlutusTx.List (
uncons,
null,
map,
and,
or,
any,
all,
elem,
notElem,
find,
filter,
listToMaybe,
uniqueElement,
findIndices,
findIndex,
foldr,
foldl,
revAppend,
reverse,
concat,
concatMap,
zip,
unzip,
(++),
(!!),
indexBuiltinList,
head,
last,
tail,
take,
drop,
splitAt,
nub,
nubBy,
zipWith,
dropWhile,
replicate,
partition,
sort,
sortBy,
) where
import PlutusTx.Bool (Bool (..), not, otherwise, (||))
import PlutusTx.Builtins (Integer)
import PlutusTx.Builtins qualified as Builtins
import PlutusTx.Builtins.Internal qualified as BI
import PlutusTx.Eq (Eq, (/=), (==))
import PlutusTx.ErrorCodes
import PlutusTx.Ord (Ord, Ordering (..), compare, (<), (<=))
import PlutusTx.Trace (traceError)
import Prelude (Maybe (..), (.))
{-# INLINABLE uncons #-}
uncons :: [a] -> Maybe (a, [a])
uncons :: forall a. [a] -> Maybe (a, [a])
uncons = \case
[] -> Maybe (a, [a])
forall a. Maybe a
Nothing
a
x:[a]
xs -> (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
x, [a]
xs)
{-# INLINABLE null #-}
null :: [a] -> Bool
null :: forall a. [a] -> Bool
null = \case
[] -> Bool
True
[a]
_ -> Bool
False
{-# INLINABLE map #-}
map :: forall a b. (a -> b) -> [a] -> [b]
map :: forall a b. (a -> b) -> [a] -> [b]
map a -> b
f = [a] -> [b]
go
where
go :: [a] -> [b]
go :: [a] -> [b]
go = \case
[] -> []
a
x:[a]
xs -> a -> b
f a
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [a] -> [b]
go [a]
xs
{-# INLINABLE and #-}
and :: [Bool] -> Bool
and :: [Bool] -> Bool
and = \case
[] -> Bool
True
Bool
x : [Bool]
xs -> if Bool
x then [Bool] -> Bool
and [Bool]
xs else Bool
False
{-# INLINABLE or #-}
or :: [Bool] -> Bool
or :: [Bool] -> Bool
or = \case
[] -> Bool
False
Bool
x : [Bool]
xs -> if Bool
x then Bool
True else [Bool] -> Bool
or [Bool]
xs
{-# INLINABLE any #-}
any :: forall a. (a -> Bool) -> [a] -> Bool
any :: forall a. (a -> Bool) -> [a] -> Bool
any a -> Bool
f = [a] -> Bool
go
where
go :: [a] -> Bool
go :: [a] -> Bool
go = \case
[] -> Bool
False
a
x : [a]
xs -> if a -> Bool
f a
x then Bool
True else [a] -> Bool
go [a]
xs
{-# INLINABLE all #-}
all :: forall a. (a -> Bool) -> [a] -> Bool
all :: forall a. (a -> Bool) -> [a] -> Bool
all a -> Bool
f = [a] -> Bool
go
where
go :: [a] -> Bool
go :: [a] -> Bool
go = \case
[] -> Bool
True
a
x : [a]
xs -> if a -> Bool
f a
x then [a] -> Bool
go [a]
xs else Bool
False
{-# INLINABLE elem #-}
elem :: Eq a => a -> [a] -> Bool
elem :: forall a. Eq a => a -> [a] -> Bool
elem = (a -> Bool) -> [a] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
any ((a -> Bool) -> [a] -> Bool)
-> (a -> a -> Bool) -> a -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINABLE notElem #-}
notElem :: Eq a => a -> [a] -> Bool
notElem :: forall a. Eq a => a -> [a] -> Bool
notElem a
a = Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
elem a
a
{-# INLINABLE find #-}
find :: forall a. (a -> Bool) -> [a] -> Maybe a
find :: forall a. (a -> Bool) -> [a] -> Maybe a
find a -> Bool
f = [a] -> Maybe a
go
where
go :: [a] -> Maybe a
go :: [a] -> Maybe a
go = \case
[] -> Maybe a
forall a. Maybe a
Nothing
a
x : [a]
xs -> if a -> Bool
f a
x then a -> Maybe a
forall a. a -> Maybe a
Just a
x else [a] -> Maybe a
go [a]
xs
{-# INLINABLE foldr #-}
foldr :: forall a b. (a -> b -> b) -> b -> [a] -> b
foldr :: forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> b -> b
f b
acc = [a] -> b
go
where
go :: [a] -> b
go :: [a] -> b
go = \case
[] -> b
acc
a
x:[a]
xs -> a -> b -> b
f a
x ([a] -> b
go [a]
xs)
{-# INLINABLE foldl #-}
foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b
foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b
foldl b -> a -> b
f = b -> [a] -> b
go
where
go :: b -> [a] -> b
go :: b -> [a] -> b
go b
acc = \case
[] -> b
acc
a
x:[a]
xs -> b -> [a] -> b
go (b -> a -> b
f b
acc a
x) [a]
xs
{-# INLINABLE (++) #-}
infixr 5 ++
(++) :: [a] -> [a] -> [a]
++ :: forall a. [a] -> [a] -> [a]
(++) [a]
l [a]
r = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (:) [a]
r [a]
l
{-# INLINABLE concat #-}
concat :: [[a]] -> [a]
concat :: forall a. [[a]] -> [a]
concat = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) []
{-# INLINABLE concatMap #-}
concatMap :: (a -> [b]) -> [a] -> [b]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
concatMap a -> [b]
f = (a -> [b] -> [b]) -> [b] -> [a] -> [b]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\a
x [b]
ys -> a -> [b]
f a
x [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b]
ys) []
{-# INLINABLE filter #-}
filter :: (a -> Bool) -> [a] -> [a]
filter :: forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\a
e [a]
xs -> if a -> Bool
p a
e then a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs else [a]
xs) []
{-# INLINABLE listToMaybe #-}
listToMaybe :: [a] -> Maybe a
listToMaybe :: forall a. [a] -> Maybe a
listToMaybe [] = Maybe a
forall a. Maybe a
Nothing
listToMaybe (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
{-# INLINABLE uniqueElement #-}
uniqueElement :: [a] -> Maybe a
uniqueElement :: forall a. [a] -> Maybe a
uniqueElement [a
x] = a -> Maybe a
forall a. a -> Maybe a
Just a
x
uniqueElement [a]
_ = Maybe a
forall a. Maybe a
Nothing
{-# INLINABLE findIndices #-}
findIndices :: (a -> Bool) -> [a] -> [Integer]
findIndices :: forall a. (a -> Bool) -> [a] -> [Integer]
findIndices a -> Bool
p = Integer -> [a] -> [Integer]
go Integer
0
where
go :: Integer -> [a] -> [Integer]
go Integer
i [a]
l = case [a]
l of
[] -> []
(a
x:[a]
xs) -> let indices :: [Integer]
indices = Integer -> [a] -> [Integer]
go (Integer -> Integer -> Integer
Builtins.addInteger Integer
i Integer
1) [a]
xs in if a -> Bool
p a
x then Integer
iInteger -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
indices else [Integer]
indices
{-# INLINABLE findIndex #-}
findIndex :: (a -> Bool) -> [a] -> Maybe Integer
findIndex :: forall a. (a -> Bool) -> [a] -> Maybe Integer
findIndex a -> Bool
f = Integer -> [a] -> Maybe Integer
go Integer
0
where
go :: Integer -> [a] -> Maybe Integer
go Integer
i = \case
[] -> Maybe Integer
forall a. Maybe a
Nothing
a
x : [a]
xs -> if a -> Bool
f a
x then Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i else Integer -> [a] -> Maybe Integer
go (Integer -> Integer -> Integer
Builtins.addInteger Integer
i Integer
1) [a]
xs
{-# INLINABLE (!!) #-}
infixl 9 !!
(!!) :: forall a. [a] -> Integer -> a
[a]
_ !! :: forall a. [a] -> Integer -> a
!! Integer
n0 | Integer
n0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = BuiltinString -> a
forall a. BuiltinString -> a
traceError BuiltinString
negativeIndexError
[a]
xs0 !! Integer
n0 = Integer -> [a] -> a
go Integer
n0 [a]
xs0
where
go :: Integer -> [a] -> a
go :: Integer -> [a] -> a
go Integer
_ [] = BuiltinString -> a
forall a. BuiltinString -> a
traceError BuiltinString
indexTooLargeError
go Integer
n (a
x : [a]
xs) =
if Integer -> Integer -> Bool
Builtins.equalsInteger Integer
n Integer
0
then a
x
else Integer -> [a] -> a
go (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
n Integer
1) [a]
xs
indexBuiltinList :: forall a. BI.BuiltinList a -> Integer -> a
indexBuiltinList :: forall a. BuiltinList a -> Integer -> a
indexBuiltinList BuiltinList a
xs0 Integer
i0
| Integer
i0 Integer -> Integer -> Bool
`Builtins.lessThanInteger` Integer
0 = BuiltinString -> a
forall a. BuiltinString -> a
traceError BuiltinString
builtinListNegativeIndexError
| Bool
otherwise = BuiltinList a -> Integer -> a
go BuiltinList a
xs0 Integer
i0
where
go :: BI.BuiltinList a -> Integer -> a
go :: BuiltinList a -> Integer -> a
go BuiltinList a
xs Integer
i =
BuiltinList a
-> (() -> () -> a) -> (a -> BuiltinList a -> () -> a) -> () -> a
forall a r.
BuiltinList a -> (() -> r) -> (a -> BuiltinList a -> r) -> r
Builtins.matchList
BuiltinList a
xs
(\()
_ -> BuiltinString -> () -> a
forall a. BuiltinString -> a
traceError BuiltinString
builtinListIndexTooLargeError)
( \a
hd BuiltinList a
tl ()
_ ->
if Integer
i Integer -> Integer -> Bool
`Builtins.equalsInteger` Integer
0
then a
hd
else BuiltinList a -> Integer -> a
go BuiltinList a
tl (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
i Integer
1)
)
()
{-# INLINABLE revAppend #-}
revAppend :: forall a. [a] -> [a] -> [a]
revAppend :: forall a. [a] -> [a] -> [a]
revAppend = [a] -> [a] -> [a]
rev where
rev :: [a] -> [a] -> [a]
rev :: [a] -> [a] -> [a]
rev [] [a]
a = [a]
a
rev (a
x:[a]
xs) [a]
a = [a] -> [a] -> [a]
rev [a]
xs (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a)
{-# INLINABLE reverse #-}
reverse :: [a] -> [a]
reverse :: forall a. [a] -> [a]
reverse [a]
l = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
revAppend [a]
l []
{-# INLINABLE zip #-}
zip :: [a] -> [b] -> [(a,b)]
zip :: forall a b. [a] -> [b] -> [(a, b)]
zip [] [b]
_bs = []
zip [a]
_as [] = []
zip (a
a:[a]
as) (b
b:[b]
bs) = (a
a,b
b) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [b]
bs
{-# INLINABLE unzip #-}
unzip :: [(a,b)] -> ([a], [b])
unzip :: forall a b. [(a, b)] -> ([a], [b])
unzip [] = ([], [])
unzip ((a
x, b
y) : [(a, b)]
xys) = case [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
xys of
([a]
xs, [b]
ys) -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys)
{-# INLINABLE head #-}
head :: [a] -> a
head :: forall a. [a] -> a
head [] = BuiltinString -> a
forall a. BuiltinString -> a
traceError BuiltinString
headEmptyListError
head (a
x : [a]
_) = a
x
{-# INLINABLE last #-}
last :: [a] -> a
last :: forall a. [a] -> a
last [] = BuiltinString -> a
forall a. BuiltinString -> a
traceError BuiltinString
lastEmptyListError
last [a
x] = a
x
last (a
_:[a]
xs) = [a] -> a
forall a. [a] -> a
last [a]
xs
{-# INLINABLE tail #-}
tail :: [a] -> [a]
tail :: forall a. [a] -> [a]
tail (a
_:[a]
as) = [a]
as
tail [] = BuiltinString -> [a]
forall a. BuiltinString -> a
traceError BuiltinString
tailEmptyListError
{-# INLINABLE take #-}
take :: Integer -> [a] -> [a]
take :: forall a. Integer -> [a] -> [a]
take Integer
n [a]
_ | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = []
take Integer
_ [] = []
take Integer
n (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Integer -> [a] -> [a]
forall a. Integer -> [a] -> [a]
take (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
n Integer
1) [a]
xs
{-# INLINABLE drop #-}
drop :: Integer -> [a] -> [a]
drop :: forall a. Integer -> [a] -> [a]
drop Integer
n [a]
xs | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = [a]
xs
drop Integer
_ [] = []
drop Integer
n (a
_:[a]
xs) = Integer -> [a] -> [a]
forall a. Integer -> [a] -> [a]
drop (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
n Integer
1) [a]
xs
{-# INLINABLE splitAt #-}
splitAt :: Integer -> [a] -> ([a], [a])
splitAt :: forall a. Integer -> [a] -> ([a], [a])
splitAt Integer
n [a]
xs
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = ([], [a]
xs)
| Bool
otherwise = Integer -> [a] -> ([a], [a])
forall a. Integer -> [a] -> ([a], [a])
go Integer
n [a]
xs
where
go :: Integer -> [a] -> ([a], [a])
go :: forall a. Integer -> [a] -> ([a], [a])
go Integer
_ [] = ([], [])
go Integer
m (a
y:[a]
ys)
| Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = ([a
y], [a]
ys)
| Bool
otherwise = case Integer -> [a] -> ([a], [a])
forall a. Integer -> [a] -> ([a], [a])
go (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
m Integer
1) [a]
ys of
([a]
zs, [a]
ws) -> (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs, [a]
ws)
{-# INLINABLE nub #-}
nub :: (Eq a) => [a] -> [a]
nub :: forall a. Eq a => [a] -> [a]
nub = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINABLE elemBy #-}
elemBy :: forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elemBy :: forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elemBy a -> a -> Bool
eq a
y = [a] -> Bool
go
where
go :: [a] -> Bool
go :: [a] -> Bool
go [] = Bool
False
go (a
x:[a]
xs) = a
x a -> a -> Bool
`eq` a
y Bool -> Bool -> Bool
|| [a] -> Bool
go [a]
xs
{-# INLINABLE nubBy #-}
nubBy :: (a -> a -> Bool) -> [a] -> [a]
nubBy :: forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy a -> a -> Bool
eq [a]
l = [a] -> [a] -> [a]
nubBy' [a]
l []
where
nubBy' :: [a] -> [a] -> [a]
nubBy' [] [a]
_ = []
nubBy' (a
y:[a]
ys) [a]
xs
| (a -> a -> Bool) -> a -> [a] -> Bool
forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elemBy a -> a -> Bool
eq a
y [a]
xs = [a] -> [a] -> [a]
nubBy' [a]
ys [a]
xs
| Bool
otherwise = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
nubBy' [a]
ys (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
{-# INLINABLE zipWith #-}
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
f = [a] -> [b] -> [c]
go
where
go :: [a] -> [b] -> [c]
go :: [a] -> [b] -> [c]
go [] [b]
_ = []
go [a]
_ [] = []
go (a
x:[a]
xs) (b
y:[b]
ys) = a -> b -> c
f a
x b
y c -> [c] -> [c]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [c]
go [a]
xs [b]
ys
{-# INLINABLE dropWhile #-}
dropWhile :: forall a. (a -> Bool) -> [a] -> [a]
dropWhile :: forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p = [a] -> [a]
go
where
go :: [a] -> [a]
go :: [a] -> [a]
go [] = []
go xs :: [a]
xs@(a
x:[a]
xs')
| a -> Bool
p a
x = [a] -> [a]
go [a]
xs'
| Bool
otherwise = [a]
xs
{-# INLINABLE replicate #-}
replicate :: forall a. Integer -> a -> [a]
replicate :: forall a. Integer -> a -> [a]
replicate Integer
n0 a
x = Integer -> [a]
go Integer
n0 where
go :: Integer -> [a]
go Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = []
go Integer
n = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Integer -> [a]
go (Integer -> Integer -> Integer
Builtins.subtractInteger Integer
n Integer
1)
{-# INLINABLE partition #-}
partition :: (a -> Bool) -> [a] -> ([a],[a])
partition :: forall a. (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
p [a]
xs = (a -> ([a], [a]) -> ([a], [a])) -> ([a], [a]) -> [a] -> ([a], [a])
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr ((a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
forall a. (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select a -> Bool
p) ([],[]) [a]
xs
select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select :: forall a. (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select a -> Bool
p a
x ~([a]
ts,[a]
fs) | a -> Bool
p a
x = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ts,[a]
fs)
| Bool
otherwise = ([a]
ts, a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
fs)
{-# INLINABLE sort #-}
sort :: Ord a => [a] -> [a]
sort :: forall a. Ord a => [a] -> [a]
sort = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINABLE sortBy #-}
sortBy :: (a -> a -> Ordering) -> [a] -> [a]
sortBy :: forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
cmp [a]
l = [[a]] -> [a]
mergeAll ([a] -> [[a]]
sequences [a]
l)
where
sequences :: [a] -> [[a]]
sequences (a
a:a
b:[a]
xs)
| a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a -> [a] -> [a] -> [[a]]
descending a
b [a
a] [a]
xs
| Bool
otherwise = a -> ([a] -> [a]) -> [a] -> [[a]]
ascending a
b (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [a]
xs
sequences [a]
xs = [[a]
xs]
descending :: a -> [a] -> [a] -> [[a]]
descending a
a [a]
as (a
b:[a]
bs)
| a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a -> [a] -> [a] -> [[a]]
descending a
b (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as) [a]
bs
descending a
a [a]
as [a]
bs = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
sequences [a]
bs
ascending :: a -> ([a] -> [a]) -> [a] -> [[a]]
ascending a
a [a] -> [a]
as (a
b:[a]
bs)
| a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = a -> ([a] -> [a]) -> [a] -> [[a]]
ascending a
b (\[a]
ys -> [a] -> [a]
as (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)) [a]
bs
ascending a
a [a] -> [a]
as [a]
bs = let x :: [a]
x = [a] -> [a]
as [a
a]
in [a]
x [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
sequences [a]
bs
mergeAll :: [[a]] -> [a]
mergeAll [[a]
x] = [a]
x
mergeAll [[a]]
xs = [[a]] -> [a]
mergeAll ([[a]] -> [[a]]
mergePairs [[a]]
xs)
mergePairs :: [[a]] -> [[a]]
mergePairs ([a]
a:[a]
b:[[a]]
xs) = let x :: [a]
x = [a] -> [a] -> [a]
merge [a]
a [a]
b
in [a]
x [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
mergePairs [[a]]
xs
mergePairs [[a]]
xs = [[a]]
xs
merge :: [a] -> [a] -> [a]
merge as :: [a]
as@(a
a:[a]
as') bs :: [a]
bs@(a
b:[a]
bs')
| a
a a -> a -> Ordering
`cmp` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a]
merge [a]
as [a]
bs'
| Bool
otherwise = a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a]
merge [a]
as' [a]
bs
merge [] [a]
bs = [a]
bs
merge [a]
as [] = [a]
as