Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /smlnj-lib/trunk/HashCons/hash-cons-map.sml
ViewVC logotype

Annotation of /smlnj-lib/trunk/HashCons/hash-cons-map.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 967 - (view) (download)
Original Path: sml/trunk/src/smlnj-lib/HashCons/hash-cons-map.sml

1 : jhr 967 (* hash-cons-map.sml
2 :     *
3 :     * COPYRIGHT (c) 2001 Bell Labs, Lucent Technologies
4 :     *
5 :     * This is an implementation of the HASH_CONS_MAP signature that is built
6 :     * on top of the WordRedBlackMap structure. Eventually, it will be replaced
7 :     * by an implmementation that uses Patricia trees.
8 :     *)
9 :    
10 :     structure HashConsMap : HASH_CONS_MAP =
11 :     struct
12 :    
13 :     structure HC = HashCons
14 :     structure Map = WordRedBlackMap
15 :    
16 :     type 'a obj = 'a HC.obj
17 :    
18 :     type ('a, 'b) map = ('a obj * 'b) Map.map
19 :    
20 :     fun lift2 f ((_, a), (_, b)) = f(a, b)
21 :     fun lift2i f (_, (k, a), (_, b)) = f(k, a, b)
22 :    
23 :     val empty = Map.empty
24 :     val isEmpty = Map.isEmpty
25 :     fun singleton (obj, v) = Map.singleton (HC.tag obj, (obj, v))
26 :     fun insert (m, obj, v) = Map.insert(m, HC.tag obj, (obj, v))
27 :     fun insert' (p as (obj, v), m) = Map.insert(m, HC.tag obj, p)
28 :    
29 :     fun insertWith merge (m, obj, v) = let
30 :     val tag = HC.tag obj
31 :     in
32 :     case Map.find(m, tag)
33 :     of NONE => Map.insert(m, tag, (obj, v))
34 :     | SOME(_, v') => Map.insert(m, tag, (obj, merge(v', v)))
35 :     (* end case *)
36 :     end
37 :     fun insertWithi merge (m, obj, v) = let
38 :     val tag = HC.tag obj
39 :     in
40 :     case Map.find(m, tag)
41 :     of NONE => Map.insert(m, tag, (obj, v))
42 :     | SOME(_, v') => Map.insert(m, tag, (obj, merge(obj, v', v)))
43 :     (* end case *)
44 :     end
45 :    
46 :     fun find (map : ('a, 'b) map, obj) = Option.map #2 (Map.find(map, HC.tag obj))
47 :     fun inDomain (map, obj) = Map.inDomain (map, HC.tag obj)
48 :     fun remove (map, obj) = let
49 :     val (map, (_, v)) = Map.remove (map, HC.tag obj)
50 :     in
51 :     (map, v)
52 :     end
53 :     fun first (map : ('a, 'b) map) = Option.map #2 (Map.first map)
54 :     val firsti = Map.first
55 :     val numItems = Map.numItems
56 :     fun listItems map = Map.foldr (fn ((_, v), vs) => v::vs) [] map
57 :     val listItemsi = Map.listItems
58 :     fun listKeys map = Map.foldr (fn ((k, _), ks) => k::ks) [] map
59 :     fun collate cmp = Map.collate (lift2 cmp)
60 :     fun unionWith merge =
61 :     Map.unionWith (fn ((k, a), (_, b)) => (k, merge(a, b)))
62 :     fun unionWithi merge =
63 :     Map.unionWithi (lift2i (fn (k, a, b) => (k, merge(k, a, b))))
64 :     fun intersectWith join =
65 :     Map.intersectWith (fn ((k, a), (_, b)) => (k, join(a, b)))
66 :     fun intersectWithi join =
67 :     Map.intersectWithi (lift2i (fn (k, a, b) => (k, join(k, a, b))))
68 :     fun app f = Map.app (fn (_, v) => f v)
69 :     val appi = Map.app
70 :     fun map f = Map.map (fn (k, v) => (k, f v))
71 :     fun mapi f = Map.map (fn (k, v) => (k, f(k, v)))
72 :     fun foldl f = Map.foldl (fn ((_, x), acc) => f(x, acc))
73 :     fun foldli f = Map.foldl (fn ((k, x), acc) => f(k, x, acc))
74 :     fun foldr f = Map.foldr (fn ((_, x), acc) => f(x, acc))
75 :     fun foldri f = Map.foldr (fn ((k, x), acc) => f(k, x, acc))
76 :     fun filter pred = Map.filter (fn (_, x) => pred x)
77 :     val filteri = Map.filter
78 :     fun mapPartial f =
79 :     Map.mapPartial
80 :     (fn (k, v) => case f v of SOME v => SOME(k, v) | NONE => NONE)
81 :     fun mapPartiali f =
82 :     Map.mapPartial
83 :     (fn (k, v) => case f(k, v) of SOME v => SOME(k, v) | NONE => NONE)
84 :    
85 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0