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 6166 - (view) (download)

1 : jhr 967 (* hash-cons-map.sml
2 :     *
3 : jhr 3580 * COPYRIGHT (c) 2011 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 : jhr 967 *
6 :     * This is an implementation of the HASH_CONS_MAP signature that is built
7 :     * on top of the WordRedBlackMap structure. Eventually, it will be replaced
8 :     * by an implmementation that uses Patricia trees.
9 :     *)
10 :    
11 :     structure HashConsMap : HASH_CONS_MAP =
12 :     struct
13 :    
14 :     structure HC = HashCons
15 :     structure Map = WordRedBlackMap
16 :    
17 :     type 'a obj = 'a HC.obj
18 :    
19 :     type ('a, 'b) map = ('a obj * 'b) Map.map
20 :    
21 :     fun lift2 f ((_, a), (_, b)) = f(a, b)
22 :     fun lift2i f (_, (k, a), (_, b)) = f(k, a, b)
23 :    
24 :     val empty = Map.empty
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 : jhr 6159 fun lookup (map : ('a, 'b) map, obj) = #2 (Map.lookup(map, HC.tag obj))
48 : jhr 967 fun inDomain (map, obj) = Map.inDomain (map, HC.tag obj)
49 :     fun remove (map, obj) = let
50 :     val (map, (_, v)) = Map.remove (map, HC.tag obj)
51 :     in
52 :     (map, v)
53 :     end
54 : jhr 6166 val isEmpty = Map.isEmpty
55 : jhr 967 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 : jhr 6159 fun mergeWith join = let
69 :     fun result (k, SOME c) = SOME(k, c)
70 :     | result (_, NONE) = NONE
71 :     fun join' (SOME(k, a), SOME(_, b)) = result (k, join(SOME a, SOME b))
72 :     | join' (SOME(k, a), NONE) = result (k, join(SOME a, NONE))
73 :     | join' (NONE, SOME(k, b)) = result (k, join(NONE, SOME b))
74 :     | join' (NONE, NONE) = raise Fail "impossible"
75 :     in
76 :     Map.mergeWith join'
77 :     end
78 :     fun mergeWithi join = let
79 :     fun result (k, SOME c) = SOME(k, c)
80 :     | result (_, NONE) = NONE
81 :     fun join' (SOME(k, a), SOME(_, b)) = result (k, join(k, SOME a, SOME b))
82 :     | join' (SOME(k, a), NONE) = result (k, join(k, SOME a, NONE))
83 :     | join' (NONE, SOME(k, b)) = result (k, join(k, NONE, SOME b))
84 :     | join' (NONE, NONE) = raise Fail "impossible"
85 :     in
86 :     Map.mergeWith join'
87 :     end
88 : jhr 967 fun app f = Map.app (fn (_, v) => f v)
89 :     val appi = Map.app
90 :     fun map f = Map.map (fn (k, v) => (k, f v))
91 :     fun mapi f = Map.map (fn (k, v) => (k, f(k, v)))
92 : jhr 6159 fun fold f = Map.foldl (fn ((_, x), acc) => f(x, acc))
93 :     fun foldi f = Map.foldl (fn ((k, x), acc) => f(k, x, acc))
94 :     val foldl = fold (* DEPRECATED *)
95 :     val foldli = foldi (* DEPRECATED *)
96 :     val foldr = fold (* DEPRECATED *)
97 :     val foldri = foldi (* DEPRECATED *)
98 : jhr 967 fun filter pred = Map.filter (fn (_, x) => pred x)
99 :     val filteri = Map.filter
100 :     fun mapPartial f =
101 :     Map.mapPartial
102 :     (fn (k, v) => case f v of SOME v => SOME(k, v) | NONE => NONE)
103 :     fun mapPartiali f =
104 :     Map.mapPartial
105 :     (fn (k, v) => case f(k, v) of SOME v => SOME(k, v) | NONE => NONE)
106 : jhr 6159 fun exists f = Map.exists (fn (k, v) => f v)
107 :     fun existsi f = Map.exists f
108 :     fun all f = Map.all (fn (k, v) => f v)
109 :     fun alli f = Map.all f
110 : jhr 967
111 :     end

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