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/trunk/src/MLRISC/library/tree-map.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/library/tree-map.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 411 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/library/tree-map.sml

1 : monnier 411 (*
2 :     * This implements a functional map
3 :     *
4 :     * -- Allen
5 :     *)
6 :    
7 : monnier 245 signature TREE_MAP =
8 :     sig
9 :     type key
10 :     type 'a map
11 :     exception NotFound
12 :     val empty : 'a map
13 :     val insert : 'a map * key * 'a -> 'a map
14 :     val remove : 'a map * key -> 'a map
15 :     val lookup : 'a map * key -> 'a
16 :     val lookup' : 'a map * key -> key * 'a
17 :     val toList : 'a map -> (key * 'a) list
18 :     val fromList : (key * 'a) list -> 'a map
19 :     val foldl : (key * 'a * 'b -> 'b) -> 'b -> 'a map -> 'b
20 :     val foldr : (key * 'a * 'b -> 'b) -> 'b -> 'a map -> 'b
21 :     end
22 :    
23 :     functor TreeMapFn
24 :     (type key
25 :     exception NotFound
26 :     val compare : key * key -> order
27 :     ) : TREE_MAP =
28 :     struct
29 :     type key = key
30 :     datatype 'a map = NODE of key * 'a * 'a map * 'a map
31 :     | EMPTY
32 :    
33 :     exception NotFound = NotFound
34 :     val empty = EMPTY
35 :     fun insert(EMPTY,k',v') = NODE(k',v',EMPTY,EMPTY)
36 :     | insert(NODE(k,v,l,r),k',v') =
37 :     case compare(k',k) of
38 :     EQUAL => NODE(k,v',l,r)
39 :     | LESS => NODE(k,v,insert(l,k',v'),r)
40 :     | GREATER => NODE(k,v,l,insert(r,k',v'))
41 :     fun lookup'(EMPTY,k) = raise NotFound
42 :     | lookup'(NODE(k,v,l,r),k') =
43 :     case compare(k',k) of
44 :     EQUAL => (k,v)
45 :     | LESS => lookup'(l,k')
46 :     | GREATER => lookup'(r,k')
47 :     fun lookup(t,k) = #2(lookup'(t,k))
48 :     fun remove(EMPTY,k) = EMPTY
49 :     | remove(NODE(k,v,l,r),k') =
50 :     case compare(k',k) of
51 :     EQUAL =>
52 :     (case (l,r) of
53 :     (EMPTY,r) => r
54 :     | (l,EMPTY) => l
55 :     | (_,_) => let fun remove_succ EMPTY = EMPTY
56 :     | remove_succ(NODE(_,_,EMPTY,r)) = r
57 :     | remove_succ(NODE(k,v,l,r)) =
58 :     NODE(k,v,remove_succ l,r)
59 :     in NODE(k,v,l,remove_succ r)
60 :     end
61 :     )
62 :     | LESS => NODE(k,v,remove(l,k'),r)
63 :     | GREATER => NODE(k,v,l,remove(r,k'))
64 :    
65 :     fun foldl f x =
66 :     let fun g(EMPTY,x) = x
67 :     | g(NODE(k,v,l,r),x) = g(l,f(k,v,g(r,x)))
68 :     in fn t => g(t,x) end
69 :    
70 :     fun foldr f x =
71 :     let fun g(EMPTY,x) = x
72 :     | g(NODE(k,v,l,r),x) = g(r,f(k,v,g(l,x)))
73 :     in fn t => g(t,x) end
74 :    
75 :     fun toList m =
76 :     let fun collect(EMPTY,L) = L
77 :     | collect(NODE(k,v,l,r),L) = collect(l,collect(r,(k,v)::L))
78 :     in collect(m,[]) end
79 :    
80 :     fun fromList l =
81 :     let fun f([],m) = m
82 :     | f((k,v)::l,m) = f(l,insert(m,k,v))
83 :     in f(l,EMPTY) end
84 :    
85 :     end
86 :    

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