Skip to content

Instantly share code, notes, and snippets.

@zwilias
Created March 13, 2018 20:47
Show Gist options
  • Save zwilias/ad9a53a01cad5f1cf4c88ee326632625 to your computer and use it in GitHub Desktop.
Save zwilias/ad9a53a01cad5f1cf4c88ee326632625 to your computer and use it in GitHub Desktop.
Tail recursive `map` for Dict.LLRB. Slow, but hey, it works.
map : (k -> a -> b) -> Dict k a -> Dict k b
map f dict =
case dict of
Leaf ->
Leaf
Node c k v l r ->
mapHelper f { key = k, color = c, value = f k v, state = Both l r } []
type Todo k a b
= Both (Dict k a) (Dict k a)
| TRight (Dict k b) (Dict k a)
| Done (Dict k b) (Dict k b)
type Doing k a b
= DLeft (Dict k a)
| DRight (Dict k b)
type alias MapAcc k b c =
{ key : k
, color : Color
, value : b
, state : c
}
type alias TodoMapAcc k a b =
MapAcc k b (Todo k a b)
type alias DoingMapAcc k a b =
MapAcc k b (Doing k a b)
mapHelper : (k -> a -> b) -> TodoMapAcc k a b -> List (DoingMapAcc k a b) -> Dict k b
mapHelper f acc stack =
case acc.state of
Both Leaf Leaf ->
let
node =
Node acc.color acc.key acc.value Leaf Leaf
in
case stack of
[] ->
node
top :: rest ->
mapHelper f { top | state = markDone node top.state } rest
Both Leaf (Node c k v l r) ->
mapHelper f
{ key = k, color = c, value = f k v, state = Both l r }
({ acc | state = DRight Leaf } :: stack)
Both (Node c k v l r) right ->
mapHelper f
{ key = k, color = c, value = f k v, state = Both l r }
({ acc | state = DLeft right } :: stack)
TRight l Leaf ->
let
node =
Node acc.color acc.key acc.value l Leaf
in
case stack of
[] ->
node
top :: rest ->
mapHelper f { top | state = markDone node top.state } rest
TRight left (Node c k v l r) ->
mapHelper f
{ key = k, color = c, value = f k v, state = Both l r }
({ acc | state = DRight left } :: stack)
Done l r ->
let
node =
Node acc.color acc.key acc.value l r
in
case stack of
[] ->
node
top :: rest ->
mapHelper f { top | state = markDone node top.state } rest
markDone : Dict k b -> Doing k a b -> Todo k a b
markDone node state =
case state of
DLeft r ->
TRight node r
DRight l ->
Done l node
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment