2012-10-18 09:19:50 +00:00
|
|
|
module Dict (empty,singleton,insert
|
2012-10-21 11:52:46 +00:00
|
|
|
,lookup,findWithDefault
|
2012-10-18 09:19:50 +00:00
|
|
|
,remove,member
|
2012-10-19 07:13:28 +00:00
|
|
|
,foldl,foldr,map
|
2012-10-18 09:19:50 +00:00
|
|
|
,union,intersect,diff
|
|
|
|
,keys,values
|
|
|
|
,toList,fromList
|
|
|
|
) where
|
2012-10-05 02:01:20 +00:00
|
|
|
|
2013-09-10 06:07:49 +00:00
|
|
|
{-| A dictionary mapping unique keys to values. The keys can be any comparable
|
2013-09-10 02:12:27 +00:00
|
|
|
type. This includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or
|
|
|
|
lists of comparable types.
|
|
|
|
|
|
|
|
Insert, remove, and query operations all take *O(log n)* time.
|
|
|
|
|
|
|
|
# Build
|
|
|
|
@docs empty, singleton, insert, remove
|
|
|
|
|
|
|
|
# Query
|
|
|
|
@docs member, lookup, findWithDefault
|
|
|
|
|
|
|
|
# Combine
|
|
|
|
@docs union, intersect, diff
|
|
|
|
|
|
|
|
# Lists
|
|
|
|
@docs keys, values, toList, fromList
|
|
|
|
|
|
|
|
# Transform
|
|
|
|
@docs map, foldl, foldr
|
|
|
|
|
|
|
|
-}
|
|
|
|
|
|
|
|
|
2013-07-26 14:38:11 +00:00
|
|
|
import open Basics
|
|
|
|
import open Maybe
|
|
|
|
import Native.Error
|
2013-03-17 05:24:18 +00:00
|
|
|
import List as List
|
2013-07-29 21:23:04 +00:00
|
|
|
import Native.Utils
|
2012-10-05 02:01:20 +00:00
|
|
|
|
2013-09-17 06:39:36 +00:00
|
|
|
-- BBlack and NBlack should only be used during the deletion
|
|
|
|
-- algorithm. Any other occurrence is a bug and should fail an assert.
|
2012-10-10 21:37:42 +00:00
|
|
|
data NColor = Red | Black
|
2013-09-17 06:39:36 +00:00
|
|
|
| BBlack | NBlack
|
2012-10-05 02:01:20 +00:00
|
|
|
|
2013-09-17 06:39:36 +00:00
|
|
|
data LeafColor = LBlack | LBBlack
|
|
|
|
|
|
|
|
data Dict k v = RBNode NColor k v (Dict k v) (Dict k v)
|
|
|
|
| RBEmpty LeafColor
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Create an empty dictionary. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
empty : Dict comparable v
|
2013-09-17 06:39:36 +00:00
|
|
|
empty = RBEmpty LBlack
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-03-17 05:24:18 +00:00
|
|
|
min : Dict k v -> (k,v)
|
2012-10-10 21:37:42 +00:00
|
|
|
min t =
|
2013-05-11 20:42:45 +00:00
|
|
|
case t of
|
2013-09-17 06:39:36 +00:00
|
|
|
RBNode _ k v (RBEmpty LBlack) _ -> (k,v)
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode _ _ _ l _ -> min l
|
2013-09-17 06:39:36 +00:00
|
|
|
RBEmpty LBlack -> Native.Error.raise "(min Empty) is not defined"
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-09-17 06:39:36 +00:00
|
|
|
max : Dict k v -> (k, v)
|
2012-10-10 21:37:42 +00:00
|
|
|
max t =
|
2013-05-11 20:42:45 +00:00
|
|
|
case t of
|
2013-09-17 06:39:36 +00:00
|
|
|
RBNode _ k v _ (RBEmpty _) -> (k,v)
|
|
|
|
RBNode _ _ _ _ r -> max r
|
|
|
|
RBEmpty _ -> Native.Error.raise "(max Empty) is not defined"
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Lookup the value associated with a key. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
lookup : comparable -> Dict comparable v -> Maybe v
|
2012-10-10 21:37:42 +00:00
|
|
|
lookup k t =
|
|
|
|
case t of
|
2013-09-17 06:39:36 +00:00
|
|
|
RBEmpty LBlack -> Nothing
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode _ k' v l r ->
|
2013-07-29 21:23:04 +00:00
|
|
|
case Native.Utils.compare k k' of
|
2012-12-02 05:18:25 +00:00
|
|
|
LT -> lookup k l
|
2013-07-26 14:38:11 +00:00
|
|
|
EQ -> Just v
|
2012-12-02 05:18:25 +00:00
|
|
|
GT -> lookup k r
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Find the value associated with a key. If the key is not found,
|
|
|
|
return the default value. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
findWithDefault : v -> comparable -> Dict comparable v -> v
|
2012-10-18 09:19:50 +00:00
|
|
|
findWithDefault base k t =
|
|
|
|
case t of
|
2013-09-17 06:39:36 +00:00
|
|
|
RBEmpty LBlack -> base
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode _ k' v l r ->
|
2013-07-29 21:23:04 +00:00
|
|
|
case Native.Utils.compare k k' of
|
2012-12-02 05:18:25 +00:00
|
|
|
LT -> findWithDefault base k l
|
|
|
|
EQ -> v
|
|
|
|
GT -> findWithDefault base k r
|
2012-10-18 09:19:50 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Determine if a key is in a dictionary. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
member : comparable -> Dict comparable v -> Bool
|
2013-03-24 12:45:56 +00:00
|
|
|
-- Does t contain k?
|
2013-07-26 14:38:11 +00:00
|
|
|
member k t = isJust <| lookup k t
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-03-17 05:24:18 +00:00
|
|
|
rotateLeft : Dict k v -> Dict k v
|
2012-10-10 21:37:42 +00:00
|
|
|
rotateLeft t =
|
|
|
|
case t of
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c
|
2013-07-26 14:38:11 +00:00
|
|
|
_ -> Native.Error.raise "rotateLeft of a node without enough children"
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-05-11 20:42:45 +00:00
|
|
|
-- rotateRight -- the reverse, and
|
2012-10-10 21:37:42 +00:00
|
|
|
-- makes Y have Z's color, and makes Z Red.
|
2013-03-17 05:24:18 +00:00
|
|
|
rotateRight : Dict k v -> Dict k v
|
2012-10-10 21:37:42 +00:00
|
|
|
rotateRight t =
|
|
|
|
case t of
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)
|
2013-07-26 14:38:11 +00:00
|
|
|
_ -> Native.Error.raise "rotateRight of a node without enough children"
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-03-17 05:24:18 +00:00
|
|
|
rotateLeftIfNeeded : Dict k v -> Dict k v
|
2012-10-10 21:37:42 +00:00
|
|
|
rotateLeftIfNeeded t =
|
2013-05-11 20:42:45 +00:00
|
|
|
case t of
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode _ _ _ _ (RBNode Red _ _ _ _) -> rotateLeft t
|
2012-12-02 05:18:25 +00:00
|
|
|
_ -> t
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-03-17 05:24:18 +00:00
|
|
|
rotateRightIfNeeded : Dict k v -> Dict k v
|
2012-10-10 21:37:42 +00:00
|
|
|
rotateRightIfNeeded t =
|
2013-05-11 20:42:45 +00:00
|
|
|
case t of
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode _ _ _ (RBNode Red _ _ (RBNode Red _ _ _ _) _) _ -> rotateRight t
|
2012-12-02 05:18:25 +00:00
|
|
|
_ -> t
|
2012-10-10 21:37:42 +00:00
|
|
|
|
|
|
|
otherColor c = case c of { Red -> Black ; Black -> Red }
|
|
|
|
|
2013-03-17 05:24:18 +00:00
|
|
|
color_flip : Dict k v -> Dict k v
|
2012-10-10 21:37:42 +00:00
|
|
|
color_flip t =
|
|
|
|
case t of
|
2013-05-11 20:42:45 +00:00
|
|
|
RBNode c1 bk bv (RBNode c2 ak av la ra) (RBNode c3 ck cv lc rc) ->
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode (otherColor c1) bk bv
|
|
|
|
(RBNode (otherColor c2) ak av la ra)
|
|
|
|
(RBNode (otherColor c3) ck cv lc rc)
|
2013-07-26 14:38:11 +00:00
|
|
|
_ -> Native.Error.raise "color_flip called on a Empty or Node with a Empty child"
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-03-17 05:24:18 +00:00
|
|
|
color_flipIfNeeded : Dict k v -> Dict k v
|
2013-05-11 20:42:45 +00:00
|
|
|
color_flipIfNeeded t =
|
2012-10-10 21:37:42 +00:00
|
|
|
case t of
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode _ _ _ (RBNode Red _ _ _ _) (RBNode Red _ _ _ _) -> color_flip t
|
2012-12-02 05:18:25 +00:00
|
|
|
_ -> t
|
2012-10-10 21:37:42 +00:00
|
|
|
|
|
|
|
fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
|
|
|
|
|
2013-03-17 05:24:18 +00:00
|
|
|
ensureBlackRoot : Dict k v -> Dict k v
|
2013-05-11 20:42:45 +00:00
|
|
|
ensureBlackRoot t =
|
2012-10-10 21:37:42 +00:00
|
|
|
case t of
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode Red k v l r -> RBNode Black k v l r
|
2013-09-17 06:39:36 +00:00
|
|
|
RBNode Black _ _ _ _ -> t
|
|
|
|
RBEmpty LBlack -> t
|
2013-05-11 20:42:45 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Insert a key-value pair into a dictionary. Replaces value when there is
|
|
|
|
a collision. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
insert : comparable -> v -> Dict comparable v -> Dict comparable v
|
2013-04-10 05:15:06 +00:00
|
|
|
insert k v t = -- Invariant: t is a valid left-leaning rb tree
|
2012-10-10 21:37:42 +00:00
|
|
|
let ins t =
|
|
|
|
case t of
|
2013-09-17 06:39:36 +00:00
|
|
|
RBEmpty LBlack -> RBNode Red k v (RBEmpty LBlack) (RBEmpty LBlack)
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode c k' v' l r ->
|
2013-07-29 21:23:04 +00:00
|
|
|
let h = case Native.Utils.compare k k' of
|
2013-04-10 05:15:06 +00:00
|
|
|
LT -> RBNode c k' v' (ins l) r
|
|
|
|
EQ -> RBNode c k' v l r -- replace
|
|
|
|
GT -> RBNode c k' v' l (ins r)
|
2012-12-02 05:18:25 +00:00
|
|
|
in fixUp h
|
2012-10-19 07:13:28 +00:00
|
|
|
in ensureBlackRoot (ins t)
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Create a dictionary with one key-value pair. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
singleton : comparable -> v -> Dict comparable v
|
2013-09-17 06:39:36 +00:00
|
|
|
singleton k v = insert k v (RBEmpty LBlack)
|
|
|
|
|
2013-09-18 08:48:39 +00:00
|
|
|
{- Remove helpers: everything from here to remove should only be used
|
|
|
|
internally by remove as they would otherwise break rb-invariants -}
|
|
|
|
|
2013-09-17 06:39:36 +00:00
|
|
|
isBBlack : Dict k v -> Bool
|
|
|
|
isBBlack t = case t of
|
|
|
|
RBNode c _ _ _ _ -> case c of
|
|
|
|
BBlack -> True
|
|
|
|
_ -> False
|
|
|
|
RBEmpty LBBlack -> True
|
|
|
|
_ -> False
|
|
|
|
|
|
|
|
moreBlack : NColor -> NColor
|
|
|
|
moreBlack c = case c of
|
|
|
|
BBlack -> BBlack
|
|
|
|
Black -> BBlack
|
|
|
|
Red -> Black
|
|
|
|
NBlack -> Red
|
|
|
|
lessBlack : NColor -> NColor
|
|
|
|
lessBlack c = case c of
|
|
|
|
BBlack -> Black
|
|
|
|
Black -> Red
|
|
|
|
Red -> NBlack
|
|
|
|
NBlack -> NBlack
|
|
|
|
|
|
|
|
moreBlackTree : Dict k v -> Dict k v
|
|
|
|
moreBlackTree t = case t of
|
|
|
|
RBNode c k v l r -> RBNode (moreBlack c) k v l r
|
|
|
|
RBEmpty _ -> RBEmpty LBBlack
|
|
|
|
|
|
|
|
lessBlackTree : Dict k v -> Dict k v
|
|
|
|
lessBlackTree t = case t of
|
|
|
|
RBNode c k v l r -> RBNode (lessBlack c) k v l r
|
|
|
|
RBEmpty _ -> RBEmpty LBlack
|
|
|
|
|
2013-09-18 08:48:39 +00:00
|
|
|
-- Finds and deletes k in t
|
|
|
|
del : comparable -> Dict comparable v -> Dict comparable v
|
|
|
|
del k t = case t of
|
|
|
|
RBEmpty _ -> t
|
|
|
|
RBNode c k' v l r -> case Native.Utils.compare k k' of
|
|
|
|
LT -> bubble c k' v (del k l) r
|
|
|
|
EQ -> rem t
|
|
|
|
GT -> bubble c k' v l (del k r)
|
|
|
|
|
|
|
|
-- Remove the top node from the tree, may leave behind BBlacks
|
|
|
|
rem : Dict k v -> Dict k v
|
|
|
|
rem t = case t of
|
|
|
|
RBNode c k v (RBEmpty _) (RBEmpty _) -> case c of
|
|
|
|
Red -> RBEmpty LBlack
|
|
|
|
Black -> RBEmpty LBBlack
|
|
|
|
RBNode Black _ _ (RBEmpty _) (RBNode _ k v l r) ->
|
|
|
|
RBNode Black k v l r
|
|
|
|
RBNode Black _ _ (RBNode _ k v l r) (RBEmpty _) ->
|
|
|
|
RBNode Black k v l r
|
|
|
|
-- l and r are both RBNodes
|
|
|
|
RBNode c _ _ l r ->
|
|
|
|
let (k, v) = max l
|
|
|
|
l' = remove_max l
|
|
|
|
in bubble c k v l' r
|
|
|
|
|
2013-09-17 06:39:36 +00:00
|
|
|
-- Kills a BBlack or moves it upward, may leave behind NBlack
|
|
|
|
bubble : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
|
|
|
|
bubble c k v l r = if isBBlack l || isBBlack r
|
|
|
|
then balance (moreBlack c) k v (lessBlackTree l) (lessBlackTree r)
|
|
|
|
else RBNode c k v l r
|
|
|
|
|
|
|
|
-- Removes rightmost node, may leave root as BBlack
|
|
|
|
remove_max : Dict k v -> Dict k v
|
|
|
|
remove_max t = case t of
|
|
|
|
RBNode c k v l (RBEmpty _) -> rem t
|
|
|
|
RBNode c k v l r -> bubble c k v l (remove_max r)
|
|
|
|
|
|
|
|
-- generalized tree balancing act
|
|
|
|
balance : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
|
|
|
|
balance c k v l r = balance_node (RBNode c k v l r)
|
|
|
|
|
|
|
|
blackish : Dict k v -> Bool
|
|
|
|
blackish (RBNode c _ _ _ _) = c == Black || c == BBlack
|
|
|
|
|
|
|
|
balance_node : Dict k v -> Dict k v
|
|
|
|
balance_node t =
|
|
|
|
let assemble col xk xv yk yv zk zv a b c d =
|
|
|
|
RBNode (lessBlack col) yk yv (RBNode Black xk xv a b) (RBNode Black zk zv c d)
|
|
|
|
in
|
|
|
|
if blackish t
|
|
|
|
then case t of
|
|
|
|
RBNode col zk zv (RBNode Red yk yv (RBNode Red xk xv a b) c) d ->
|
|
|
|
assemble col xk xv yk yv zk zv a b c d
|
|
|
|
RBNode col zk zv (RBNode Red xk xv a (RBNode Red yk yv b c)) d ->
|
|
|
|
assemble col xk xv yk yv zk zv a b c d
|
|
|
|
RBNode col xk xv a (RBNode Red zk zv (RBNode Red yk yv b c) d) ->
|
|
|
|
assemble col xk xv yk yv zk zv a b c d
|
|
|
|
RBNode col xk xv a (RBNode Red yk yv b (RBNode Red zk zv c d)) ->
|
|
|
|
assemble col xk xv yk yv zk zv a b c d
|
|
|
|
|
|
|
|
RBNode BBlack xk xv a (RBNode NBlack zk zv (RBNode Black yk yv b c) d) ->
|
|
|
|
case d of
|
|
|
|
(RBNode Black _ _ _ _) ->
|
|
|
|
RBNode Black yk yv (RBNode Black xk xv a b) (balance Black zk zv c (redden d))
|
|
|
|
_ -> t
|
|
|
|
|
|
|
|
RBNode BBlack zk zv (RBNode NBlack xk xv a (RBNode Black yk yv b c)) d ->
|
|
|
|
case a of
|
|
|
|
(RBNode Black _ _ _ _) ->
|
|
|
|
RBNode Black yk yv (balance Black xk xv (redden a) b) (RBNode Black zk zv c d)
|
|
|
|
_ -> t
|
|
|
|
|
|
|
|
_ -> t
|
|
|
|
|
|
|
|
else t
|
|
|
|
|
|
|
|
-- make the top node black
|
|
|
|
blacken : Dict k v -> Dict k v
|
|
|
|
blacken t = case t of
|
|
|
|
RBEmpty _ -> RBEmpty LBlack
|
|
|
|
RBNode _ k v l r -> RBNode Black k v l r
|
|
|
|
|
|
|
|
-- make the top node red
|
|
|
|
redden : Dict k v -> Dict k v
|
|
|
|
redden t = case t of
|
|
|
|
RBEmpty _ -> Native.Error.raise "can't make a Leaf red"
|
|
|
|
RBNode _ k v l r -> RBNode Red k v l r
|
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Remove a key-value pair from a dictionary. If the key is not found,
|
|
|
|
no changes are made. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
remove : comparable -> Dict comparable v -> Dict comparable v
|
2013-09-17 06:39:36 +00:00
|
|
|
remove k t = blacken <| del k t
|
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Apply a function to all values in a dictionary. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
map : (a -> b) -> Dict comparable a -> Dict comparable b
|
2012-10-18 09:19:50 +00:00
|
|
|
map f t =
|
|
|
|
case t of
|
2013-09-17 06:39:36 +00:00
|
|
|
RBEmpty LBlack -> RBEmpty LBlack
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)
|
2012-10-10 21:37:42 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Fold over the key-value pairs in a dictionary, in order from lowest
|
|
|
|
key to highest key. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
foldl : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b
|
2012-10-19 07:13:28 +00:00
|
|
|
foldl f acc t =
|
|
|
|
case t of
|
2013-09-17 06:39:36 +00:00
|
|
|
RBEmpty LBlack -> acc
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r
|
2012-10-19 07:13:28 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Fold over the key-value pairs in a dictionary, in order from highest
|
|
|
|
key to lowest key. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
foldr : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b
|
2012-10-19 07:13:28 +00:00
|
|
|
foldr f acc t =
|
2012-10-10 21:37:42 +00:00
|
|
|
case t of
|
2013-09-17 06:39:36 +00:00
|
|
|
RBEmpty LBlack -> acc
|
2013-04-10 05:15:06 +00:00
|
|
|
RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l
|
2012-10-18 09:19:50 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Combine two dictionaries. If there is a collision, preference is given
|
|
|
|
to the first dictionary. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
union : Dict comparable v -> Dict comparable v -> Dict comparable v
|
2012-12-13 06:52:32 +00:00
|
|
|
union t1 t2 = foldl insert t2 t1
|
2013-02-05 11:22:02 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Keep a key-value pair when its key appears in the second dictionary.
|
|
|
|
Preference is given to values in the first dictionary. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
intersect : Dict comparable v -> Dict comparable v -> Dict comparable v
|
2013-03-17 05:24:18 +00:00
|
|
|
intersect t1 t2 =
|
|
|
|
let combine k v t = if k `member` t2 then insert k v t else t
|
|
|
|
in foldl combine empty t1
|
2013-02-05 11:22:02 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Keep a key-value pair when its key does not appear in the second dictionary.
|
|
|
|
Preference is given to the first dictionary. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
diff : Dict comparable v -> Dict comparable v -> Dict comparable v
|
2012-12-13 06:52:32 +00:00
|
|
|
diff t1 t2 = foldl (\k v t -> remove k t) t1 t2
|
2012-10-18 09:19:50 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Get all of the keys in a dictionary. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
keys : Dict comparable v -> [comparable]
|
2013-02-05 11:22:02 +00:00
|
|
|
keys t = foldr (\k v acc -> k :: acc) [] t
|
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Get all of the values in a dictionary. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
values : Dict comparable v -> [v]
|
2013-02-05 11:22:02 +00:00
|
|
|
values t = foldr (\k v acc -> v :: acc) [] t
|
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Convert a dictionary into an association list of key-value pairs. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
toList : Dict comparable v -> [(comparable,v)]
|
2013-02-05 11:22:02 +00:00
|
|
|
toList t = foldr (\k v acc -> (k,v) :: acc) [] t
|
2012-10-18 09:19:50 +00:00
|
|
|
|
2013-09-10 02:12:27 +00:00
|
|
|
{-| Convert an association list into a dictionary. -}
|
2013-07-26 14:38:11 +00:00
|
|
|
fromList : [(comparable,v)] -> Dict comparable v
|
2013-04-10 05:15:06 +00:00
|
|
|
fromList assocs = List.foldl (\(k,v) d -> insert k v d) empty assocs
|