# Discussion: Implementation of fromList for Data.Set and Data.Map

wren romano winterkoninkje at gmail.com
Sun Feb 12 21:52:33 UTC 2017

```On Sat, Feb 11, 2017 at 8:56 PM, David Feuer <david.feuer at gmail.com> wrote:
> spanIncreasing :: Ord a => [a] -> ([a], [a])
> spanIncreasing [] = ([], [])
> spanIncreasing (a : as) = first (a:) (go a as)
>   where
>     go _prev [] = ([], [])
>     go prev q@(a : as) = case compare prev a of
>       LT -> first (a :) \$ go a as
>       EQ -> go a as
>       GT -> ([], q)

Suggest CPSing away the intermediate list:

spanIncreasing :: Ord a => r -> (r -> a -> r) -> [a] -> (r, [a])
spanIncreasing z k [] = (z, [])
spanIncreasing z k (x:xs) = go z k x xs
case
go !z k !x [] = (z, [])
go z k x yys@(y:ys)
| x < y = go (k z x) y ys
| x == y = go z k x ys
| otherwise = (k z x, yys)

> spanDecreasing :: Ord a => [a] -> ([a], [a])
> spanDecreasing [] = ([], [])
> spanDecreasing (a : as) = first (a:) (go a as)
>   where
>     go _prev [] = ([], [])
>     go prev q@(a : as) = case compare prev a of
>       GT -> first (a :) (go a as)
>       EQ -> go a as
>       LT -> ([], q)

Ditto

> fromList :: Ord a => [a] -> Set a
> fromList = up empty
>   where
>     up !acc [] = acc
>     up acc xs = case spanIncreasing xs of
>       ([x], rest) -> down (insert x acc) rest
>       (ups, rest) -> down (union (fromDistinctAscList ups) acc) rest
>
>     down !acc [] = acc
>     down acc xs = case spanDecreasing xs of
>       ([x], rest) -> up (insert x acc) rest
>       (downs, rest) -> up (union (fromDistinctDescList downs) acc) rest

Here, I suggest inlining the above to dynamically choose whether to
call `up` or `down`. E.g., something like (untested):

fromList :: Ord a => [a] -> Set a
fromList [] = empty
fromList (x0:xs0) = start empty x0 xs0
where
start !acc !x [] = insert x acc
start acc x (y:ys) =
case compare x y of
LT -> up acc (singletonUp x) y ys
EQ -> start acc x ys
GT -> down acc (singletonDown x) y ys

up !acc1 !acc2 !x [] = union acc1 (upSet (insertUp x acc2))
up acc1 acc2 x (y:ys) =
case compare x y of
LT -> up acc1 (insertUp x acc2) y ys
EQ -> up acc1 acc2 x ys
GT -> start (union acc1 (upSet (insertUp x acc2))) y ys

down !acc1 !acc2 !x [] = union acc1 (downSet (insertDown x acc2))
down acc1 acc2 x (y:ys) =
case compare x y of
GT -> down acc1 (insertDown x acc2) y ys
EQ -> down acc1 acc2 x ys
LT -> start (union acc1 (downSet (insertDown x acc2))) y ys

where `insertUp` and `insertDown` are the incremental steps of
fromAscList/fromDescList, and `acc2` has whatever appropriate
intermediate type it needs for that to work, and upSet/downSet does
the conversion from that intermediate type into a standard Set.

A naive but workable intermediate type gives us:

singletonUp = (:[])
singletonDown = (:[])
insertUp = (:)
insertDown = (:)
upSet = fromAscList
downSet = fromDescList

Though we should be able to do better than that.

--
Live well,
~wren
```