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/Util/int-list-map.sml
ViewVC logotype

Annotation of /smlnj-lib/trunk/Util/int-list-map.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2274 - (view) (download)

1 : monnier 2 (* int-list-map.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 by AT&T Research. See COPYRIGHT file for details.
4 :     *
5 :     * An implementation of finite maps on integer keys, which uses a sorted list
6 :     * representation.
7 :     *)
8 :    
9 :     structure IntListMap :> ORD_MAP where type Key.ord_key = Int.int =
10 :     struct
11 :    
12 :     structure Key =
13 :     struct
14 :     type ord_key = int
15 :     val compare = Int.compare
16 :     end
17 :    
18 :     type 'a map = (int * 'a) list
19 :    
20 :     val empty = []
21 :    
22 : monnier 289 fun isEmpty [] = true
23 :     | isEmpty _ = false
24 :    
25 :     (* return the first item in the map (or NONE if it is empty) *)
26 :     fun first [] = NONE
27 :     | first ((_, value)::_) = SOME value
28 :    
29 :     (* return the first item in the map and its key (or NONE if it is empty) *)
30 :     fun firsti [] = NONE
31 :     | firsti ((key, value)::_) = SOME(key, value)
32 :    
33 : monnier 411 fun singleton (key, item) = [(key, item)]
34 :    
35 : monnier 2 fun insert (l, key, item) = let
36 :     fun f [] = [(key, item)]
37 :     | f ((elem as (key', _))::r) = (case Key.compare(key, key')
38 :     of LESS => (key, item) :: elem :: r
39 :     | EQUAL => (key, item) :: r
40 :     | GREATER => elem :: (f r)
41 :     (* end case *))
42 :     in
43 :     f l
44 :     end
45 : monnier 29 fun insert' ((k, x), m) = insert(m, k, x)
46 : monnier 2
47 : monnier 411 (* return true if the key is in the map's domain *)
48 :     fun inDomain (l, key) = let
49 :     fun f [] = false
50 :     | f ((key', x) :: r) = (key' <= key) andalso ((key' = key) orelse f r)
51 :     in
52 :     f l
53 :     end
54 :    
55 : monnier 2 (* Look for an item, return NONE if the item doesn't exist *)
56 :     fun find (l, key) = let
57 :     fun f [] = NONE
58 : monnier 411 | f ((key', x) :: r) =
59 :     if (key < key') then NONE
60 :     else if (key = key') then SOME x
61 :     else f r
62 : monnier 2 in
63 :     f l
64 :     end
65 :    
66 : jhr 2274 (* Look for an item, raise NotFound if the item doesn't exist *)
67 :     fun lookup (l, key) = let
68 :     fun f [] = raise LibBase.NotFound
69 :     | f ((key', x) :: r) =
70 :     if (key < key') then raise LibBase.NotFound
71 :     else if (key = key') then x
72 :     else f r
73 :     in
74 :     f l
75 :     end
76 :    
77 : monnier 2 (* Remove an item, returning new map and value removed.
78 :     * Raise LibBase.NotFound if not found.
79 :     *)
80 :     fun remove (l, key) = let
81 :     fun f (_, []) = raise LibBase.NotFound
82 :     | f (prefix, (elem as (key', x)) :: r) = (case Key.compare(key, key')
83 :     of LESS => raise LibBase.NotFound
84 :     | EQUAL => (List.revAppend(prefix, r), x)
85 :     | GREATER => f(elem :: prefix, r)
86 :     (* end case *))
87 :     in
88 :     f ([], l)
89 :     end
90 :    
91 :     (* Return the number of items in the map *)
92 :     fun numItems l = List.length l
93 :    
94 :     (* Return a list of the items (and their keys) in the map *)
95 :     fun listItems (l : 'a map) = List.map #2 l
96 :     fun listItemsi l = l
97 :    
98 : monnier 411 fun listKeys (l : 'a map) = List.map #1 l
99 :    
100 : monnier 2 fun collate cmpRng = let
101 :     fun cmp ([], []) = EQUAL
102 :     | cmp ([], _) = LESS
103 :     | cmp (_, []) = GREATER
104 :     | cmp ((x1, y1)::r1, (x2, y2)::r2) = (case Key.compare(x1, x2)
105 :     of EQUAL => (case cmpRng(y1, y2)
106 :     of EQUAL => cmp (r1, r2)
107 :     | order => order
108 :     (* end case *))
109 :     | order => order
110 :     (* end case *))
111 :     in
112 :     cmp
113 :     end
114 :    
115 :     (* return a map whose domain is the union of the domains of the two input
116 :     * maps, using the supplied function to define the map on elements that
117 :     * are in both domains.
118 :     *)
119 :     fun unionWith f (m1 : 'a map, m2 : 'a map) = let
120 :     fun merge ([], [], l) = List.rev l
121 :     | merge ([], m2, l) = List.revAppend(l, m2)
122 :     | merge (m1, [], l) = List.revAppend(l, m1)
123 :     | merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), l) = (
124 :     case Key.compare (k1, k2)
125 :     of LESS => merge (r1, m2, (k1, x1)::l)
126 :     | EQUAL => merge (r1, r2, (k1, f(x1, x2)) :: l)
127 :     | GREATER => merge (m1, r2, (k2, x2)::l)
128 :     (* end case *))
129 :     in
130 :     merge (m1, m2, [])
131 :     end
132 :     fun unionWithi f (m1 : 'a map, m2 : 'a map) = let
133 :     fun merge ([], [], l) = List.rev l
134 :     | merge ([], m2, l) = List.revAppend(l, m2)
135 :     | merge (m1, [], l) = List.revAppend(l, m1)
136 :     | merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), l) = (
137 :     case Key.compare (k1, k2)
138 :     of LESS => merge (r1, m2, (k1, x1)::l)
139 :     | EQUAL => merge (r1, r2, (k1, f(k1, x1, x2)) :: l)
140 :     | GREATER => merge (m1, r2, (k2, x2)::l)
141 :     (* end case *))
142 :     in
143 :     merge (m1, m2, [])
144 :     end
145 :    
146 :     (* return a map whose domain is the intersection of the domains of the
147 :     * two input maps, using the supplied function to define the range.
148 :     *)
149 :     fun intersectWith f (m1 : 'a map, m2 : 'b map) = let
150 :     fun merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), l) = (
151 :     case Key.compare (k1, k2)
152 :     of LESS => merge (r1, m2, l)
153 :     | EQUAL => merge (r1, r2, (k1, f(x1, x2)) :: l)
154 :     | GREATER => merge (m1, r2, l)
155 :     (* end case *))
156 :     | merge (_, _, l) = List.rev l
157 :     in
158 :     merge (m1, m2, [])
159 :     end
160 :     fun intersectWithi f (m1 : 'a map, m2 : 'b map) = let
161 :     fun merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), l) = (
162 :     case Key.compare (k1, k2)
163 :     of LESS => merge (r1, m2, l)
164 :     | EQUAL => merge (r1, r2, (k1, f(k1, x1, x2)) :: l)
165 :     | GREATER => merge (m1, r2, l)
166 :     (* end case *))
167 :     | merge (_, _, l) = List.rev l
168 :     in
169 :     merge (m1, m2, [])
170 :     end
171 :    
172 : jhr 1193 fun mergeWith f (m1 : 'a map, m2 : 'b map) = let
173 :     fun merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), l) =
174 :     if (k1 < k2)
175 :     then mergef (k1, SOME x1, NONE, r1, m2, l)
176 :     else if (k1 = k2)
177 :     then mergef (k1, SOME x1, SOME x2, r1, r2, l)
178 :     else mergef (k2, NONE, SOME x2, m1, r2, l)
179 :     | merge ([], [], l) = List.rev l
180 :     | merge ((k1, x1)::r1, [], l) = mergef (k1, SOME x1, NONE, r1, [], l)
181 :     | merge ([], (k2, x2)::r2, l) = mergef (k2, NONE, SOME x2, [], r2, l)
182 :     and mergef (k, x1, x2, r1, r2, l) = (case f (x1, x2)
183 :     of NONE => merge (r1, r2, l)
184 :     | SOME y => merge (r1, r2, (k, y)::l)
185 :     (* end case *))
186 :     in
187 :     merge (m1, m2, [])
188 :     end
189 :     fun mergeWithi f (m1 : 'a map, m2 : 'b map) = let
190 :     fun merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), l) =
191 :     if (k1 < k2)
192 :     then mergef (k1, SOME x1, NONE, r1, m2, l)
193 :     else if (k1 = k2)
194 :     then mergef (k1, SOME x1, SOME x2, r1, r2, l)
195 :     else mergef (k2, NONE, SOME x2, m1, r2, l)
196 :     | merge ([], [], l) = List.rev l
197 :     | merge ((k1, x1)::r1, [], l) = mergef (k1, SOME x1, NONE, r1, [], l)
198 :     | merge ([], (k2, x2)::r2, l) = mergef (k2, NONE, SOME x2, [], r2, l)
199 :     and mergef (k, x1, x2, r1, r2, l) = (case f (k, x1, x2)
200 :     of NONE => merge (r1, r2, l)
201 :     | SOME y => merge (r1, r2, (k, y)::l)
202 :     (* end case *))
203 :     in
204 :     merge (m1, m2, [])
205 :     end
206 :    
207 : monnier 2 (* Apply a function to the entries of the map in map order. *)
208 :     val appi = List.app
209 :     fun app f l = appi (fn (_, item) => f item) l
210 :    
211 :     (* Create a new table by applying a map function to the
212 :     * name/value pairs in the table.
213 :     *)
214 :     fun mapi f l = List.map (fn (key, item) => (key, f(key, item))) l
215 :     fun map f l = List.map (fn (key, item) => (key, f item)) l
216 :    
217 :     (* Apply a folding function to the entries of the map
218 :     * in increasing map order.
219 :     *)
220 :     fun foldli f init l =
221 :     List.foldl (fn ((key, item), accum) => f(key, item, accum)) init l
222 :     fun foldl f init l = List.foldl (fn ((_, item), accum) => f(item, accum)) init l
223 :    
224 :     (* Apply a folding function to the entries of the map
225 :     * in decreasing map order.
226 :     *)
227 :     fun foldri f init l =
228 :     List.foldr (fn ((key, item), accum) => f(key, item, accum)) init l
229 :     fun foldr f init l = List.foldr (fn ((_, item), accum) => f(item, accum)) init l
230 :    
231 :     fun filter pred l = List.filter (fn (_, item) => pred item) l
232 :     fun filteri pred l = List.filter pred l
233 :    
234 :     fun mapPartiali f l = let
235 :     fun f' (key, item) = (case f (key, item)
236 :     of NONE => NONE
237 :     | SOME y => SOME(key, y)
238 :     (* end case *))
239 :     in
240 :     List.mapPartial f' l
241 :     end
242 :     fun mapPartial f l = mapPartiali (fn (_, item) => f item) l
243 :    
244 :     end (* IntListMap *)
245 :    

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