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
 [smlnj] / smlnj-lib / trunk / Util / int-list-map.sml

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

Original Path: sml/trunk/src/smlnj-lib/Util/int-list-map.sml

 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 :