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/randlist.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/library/randlist.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 412 - (view) (download)

1 : monnier 245 (*
2 :     * Random Access Lists (due to Chris Okasaki)
3 : monnier 411 *
4 :     * -- Allen
5 : monnier 245 *)
6 :    
7 :     signature RANDOM_ACCESS_LIST =
8 :     sig
9 :    
10 :     type 'a rand_list
11 :    
12 :     (* O(1) operations *)
13 :     val empty : 'a rand_list
14 :     val length : 'a rand_list -> int
15 :     val null : 'a rand_list -> bool
16 :     val cons : 'a * 'a rand_list -> 'a rand_list
17 :     val hd : 'a rand_list -> 'a
18 :     val tl : 'a rand_list -> 'a rand_list
19 :    
20 :     (* O(log n) operations *)
21 :     val sub : 'a rand_list * int -> 'a
22 :     val update : 'a rand_list * int * 'a -> 'a rand_list
23 :    
24 :     (* O(n) operations *)
25 :     val fromList : 'a list -> 'a rand_list
26 :     val toList : 'a rand_list -> 'a list
27 :    
28 :     (* O(n) operations *)
29 :     val map : ('a -> 'b) -> 'a rand_list -> 'b rand_list
30 :     val app : ('a -> unit) -> 'a rand_list -> unit
31 :     val foldl : ('a * 'b -> 'b) -> 'b -> 'a rand_list -> 'b
32 :     val foldr : ('a * 'b -> 'b) -> 'b -> 'a rand_list -> 'b
33 :     end
34 :    
35 :     structure RandomAccessList :> RANDOM_ACCESS_LIST =
36 :     struct
37 :    
38 :     datatype 'a tree = LEAF of 'a | NODE of 'a tree * 'a * 'a tree
39 :    
40 :     type 'a rand_list = (int * 'a tree) list
41 :    
42 :     fun tree_sub (LEAF x,0,_) = x
43 :     | tree_sub (LEAF _,_,_) = raise Subscript
44 :     | tree_sub (NODE(_,x,_),0,_) = x
45 :     | tree_sub (NODE(l,x,r),i,N) =
46 :     let val N' = N div 2
47 :     in if i <= N' then tree_sub(l,i-1,N')
48 :     else tree_sub(r,i-1-N',N')
49 :     end
50 :    
51 :     fun tree_update (LEAF _,0,x,_) = LEAF x
52 :     | tree_update (LEAF _,_,_,_) = raise Subscript
53 :     | tree_update (NODE(l,_,r),0,x,_) = NODE(l,x,r)
54 :     | tree_update (NODE(l,y,r),i,x,N) =
55 :     let val N' = N div 2
56 :     in if i <= N' then NODE(tree_update(l,i-1,x,N'),y,r)
57 :     else NODE(l,y,tree_update(r,i-1-N',x,N'))
58 :     end
59 :    
60 :     val empty = []
61 :    
62 :     fun null [] = true | null _ = false
63 :    
64 :     fun length rl =
65 :     let fun f([],n) = n
66 :     | f((m,_)::l,n) = f(l,m+n)
67 :     in f(rl,0)
68 :     end
69 :    
70 :     fun cons (x, rl as ((m,t)::(n,u)::l)) =
71 :     if m = n then (m+n+1,NODE(t,x,u))::l
72 :     else (1,LEAF x)::rl
73 :     | cons (x, rl) = (1,LEAF x)::rl
74 :    
75 :     fun hd ((_,LEAF x)::_) = x
76 :     | hd ((_,NODE(_,x,_))::_) = x
77 :     | hd [] = raise Empty
78 :    
79 :     fun tl ((_,LEAF x)::rl) = rl
80 :     | tl ((n,NODE(l,x,r))::rl) =
81 :     let val n' = n div 2
82 :     in (n',l)::(n',r)::rl
83 :     end
84 :     | tl [] = raise Empty
85 :    
86 :     fun sub([],_) = raise Subscript
87 :     | sub((n,t)::rl,i) = if i < n then tree_sub(t,i,n)
88 :     else sub(rl,i-n)
89 :    
90 :     fun update([],_,_) = raise Subscript
91 :     | update((p as (n,t))::rl,i,x) =
92 :     if i < n then (n,tree_update(t,i,x,n))::rl
93 :     else p::update(rl,i-n,x)
94 :    
95 :     fun map f rl =
96 :     let fun g (LEAF x) = LEAF(f x)
97 :     | g (NODE(l,x,r)) = NODE(g l,f x,g r)
98 :     in List.map (fn (n,t) => (n,g t)) rl
99 :     end
100 :    
101 :     fun app f rl =
102 :     let fun g (LEAF x) = f x
103 :     | g (NODE(l,x,r)) = (f x; g l; g r)
104 :     in List.app (fn (_,t) => g t) rl
105 :     end
106 :    
107 :     fun foldl f u rl =
108 :     let fun g (LEAF x,u) = f(x,u)
109 :     | g (NODE(l,x,r),u) = g(r,g(l,f(x,u)))
110 :     in List.foldl (fn ((_,t),x) => g(t,x)) u rl
111 :     end
112 :    
113 :     fun foldr f u rl =
114 :     let fun g (LEAF x,u) = f(x,u)
115 :     | g (NODE(l,x,r),u) = f(x,g(l,g(r,u)))
116 :     in List.foldr (fn ((_,t),x) => g(t,x)) u rl
117 :     end
118 :    
119 :     fun fromList l = List.foldr cons empty l
120 :     fun toList rl = foldr op:: [] rl
121 :     end
122 :    

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