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 /sml/branches/SMLNJ/src/smlnj-lib/Util/int-list-map.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/smlnj-lib/Util/int-list-map.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (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 :     fun insert (l, key, item) = let
23 :     fun f [] = [(key, item)]
24 :     | f ((elem as (key', _))::r) = (case Key.compare(key, key')
25 :     of LESS => (key, item) :: elem :: r
26 :     | EQUAL => (key, item) :: r
27 :     | GREATER => elem :: (f r)
28 :     (* end case *))
29 :     in
30 :     f l
31 :     end
32 :    
33 :     (* Look for an item, return NONE if the item doesn't exist *)
34 :     fun find (l, key) = let
35 :     fun f [] = NONE
36 :     | f ((key', x) :: r) = (case Key.compare(key, key')
37 :     of LESS => NONE
38 :     | EQUAL => SOME x
39 :     | GREATER => f r
40 :     (* end case *))
41 :     in
42 :     f l
43 :     end
44 :    
45 :     (* Remove an item, returning new map and value removed.
46 :     * Raise LibBase.NotFound if not found.
47 :     *)
48 :     fun remove (l, key) = let
49 :     fun f (_, []) = raise LibBase.NotFound
50 :     | f (prefix, (elem as (key', x)) :: r) = (case Key.compare(key, key')
51 :     of LESS => raise LibBase.NotFound
52 :     | EQUAL => (List.revAppend(prefix, r), x)
53 :     | GREATER => f(elem :: prefix, r)
54 :     (* end case *))
55 :     in
56 :     f ([], l)
57 :     end
58 :    
59 :     (* Return the number of items in the map *)
60 :     fun numItems l = List.length l
61 :    
62 :     (* Return a list of the items (and their keys) in the map *)
63 :     fun listItems (l : 'a map) = List.map #2 l
64 :     fun listItemsi l = l
65 :    
66 :     fun collate cmpRng = let
67 :     fun cmp ([], []) = EQUAL
68 :     | cmp ([], _) = LESS
69 :     | cmp (_, []) = GREATER
70 :     | cmp ((x1, y1)::r1, (x2, y2)::r2) = (case Key.compare(x1, x2)
71 :     of EQUAL => (case cmpRng(y1, y2)
72 :     of EQUAL => cmp (r1, r2)
73 :     | order => order
74 :     (* end case *))
75 :     | order => order
76 :     (* end case *))
77 :     in
78 :     cmp
79 :     end
80 :    
81 :     (* return a map whose domain is the union of the domains of the two input
82 :     * maps, using the supplied function to define the map on elements that
83 :     * are in both domains.
84 :     *)
85 :     fun unionWith f (m1 : 'a map, m2 : 'a map) = let
86 :     fun merge ([], [], l) = List.rev l
87 :     | merge ([], m2, l) = List.revAppend(l, m2)
88 :     | merge (m1, [], l) = List.revAppend(l, m1)
89 :     | merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), l) = (
90 :     case Key.compare (k1, k2)
91 :     of LESS => merge (r1, m2, (k1, x1)::l)
92 :     | EQUAL => merge (r1, r2, (k1, f(x1, x2)) :: l)
93 :     | GREATER => merge (m1, r2, (k2, x2)::l)
94 :     (* end case *))
95 :     in
96 :     merge (m1, m2, [])
97 :     end
98 :     fun unionWithi f (m1 : 'a map, m2 : 'a map) = let
99 :     fun merge ([], [], l) = List.rev l
100 :     | merge ([], m2, l) = List.revAppend(l, m2)
101 :     | merge (m1, [], l) = List.revAppend(l, m1)
102 :     | merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), l) = (
103 :     case Key.compare (k1, k2)
104 :     of LESS => merge (r1, m2, (k1, x1)::l)
105 :     | EQUAL => merge (r1, r2, (k1, f(k1, x1, x2)) :: l)
106 :     | GREATER => merge (m1, r2, (k2, x2)::l)
107 :     (* end case *))
108 :     in
109 :     merge (m1, m2, [])
110 :     end
111 :    
112 :     (* return a map whose domain is the intersection of the domains of the
113 :     * two input maps, using the supplied function to define the range.
114 :     *)
115 :     fun intersectWith f (m1 : 'a map, m2 : 'b map) = let
116 :     fun merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), l) = (
117 :     case Key.compare (k1, k2)
118 :     of LESS => merge (r1, m2, l)
119 :     | EQUAL => merge (r1, r2, (k1, f(x1, x2)) :: l)
120 :     | GREATER => merge (m1, r2, l)
121 :     (* end case *))
122 :     | merge (_, _, l) = List.rev l
123 :     in
124 :     merge (m1, m2, [])
125 :     end
126 :     fun intersectWithi f (m1 : 'a map, m2 : 'b map) = let
127 :     fun merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), l) = (
128 :     case Key.compare (k1, k2)
129 :     of LESS => merge (r1, m2, l)
130 :     | EQUAL => merge (r1, r2, (k1, f(k1, x1, x2)) :: l)
131 :     | GREATER => merge (m1, r2, l)
132 :     (* end case *))
133 :     | merge (_, _, l) = List.rev l
134 :     in
135 :     merge (m1, m2, [])
136 :     end
137 :    
138 :     (* Apply a function to the entries of the map in map order. *)
139 :     val appi = List.app
140 :     fun app f l = appi (fn (_, item) => f item) l
141 :    
142 :     (* Create a new table by applying a map function to the
143 :     * name/value pairs in the table.
144 :     *)
145 :     fun mapi f l = List.map (fn (key, item) => (key, f(key, item))) l
146 :     fun map f l = List.map (fn (key, item) => (key, f item)) l
147 :    
148 :     (* Apply a folding function to the entries of the map
149 :     * in increasing map order.
150 :     *)
151 :     fun foldli f init l =
152 :     List.foldl (fn ((key, item), accum) => f(key, item, accum)) init l
153 :     fun foldl f init l = List.foldl (fn ((_, item), accum) => f(item, accum)) init l
154 :    
155 :     (* Apply a folding function to the entries of the map
156 :     * in decreasing map order.
157 :     *)
158 :     fun foldri f init l =
159 :     List.foldr (fn ((key, item), accum) => f(key, item, accum)) init l
160 :     fun foldr f init l = List.foldr (fn ((_, item), accum) => f(item, accum)) init l
161 :    
162 :     fun filter pred l = List.filter (fn (_, item) => pred item) l
163 :     fun filteri pred l = List.filter pred l
164 :    
165 :     fun mapPartiali f l = let
166 :     fun f' (key, item) = (case f (key, item)
167 :     of NONE => NONE
168 :     | SOME y => SOME(key, y)
169 :     (* end case *))
170 :     in
171 :     List.mapPartial f' l
172 :     end
173 :     fun mapPartial f l = mapPartiali (fn (_, item) => f item) l
174 :    
175 :     end (* IntListMap *)
176 :    

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