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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3759 - (view) (download)

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

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