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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 245 (*
2 :     * Priority queues implemented as leftist trees
3 : monnier 411 *
4 :     * -- Allen
5 : monnier 245 *)
6 :    
7 :     structure PriorityQueue :> PRIORITY_QUEUE =
8 :     struct
9 :    
10 :    
11 :     (* A leftist tree is a binary tree with priority ordering
12 :     * with the invariant that the left branch is always the taller one
13 :     *)
14 :     datatype 'a leftist = NODE of 'a * int * 'a leftist * 'a leftist
15 :     | EMPTY
16 :    
17 :     datatype 'a priority_queue = PQ of { less : 'a * 'a -> bool,
18 :     root : 'a leftist ref
19 :     }
20 :    
21 :     exception EmptyPriorityQueue
22 :    
23 :     (* assume a is smaller than b *)
24 :     fun mergeTrees less (a,b) =
25 :     let fun dist EMPTY = 0
26 :     | dist (NODE(_,d,_,_)) = d
27 :    
28 :     fun m (EMPTY,a) = a
29 :     | m (a, EMPTY) = a
30 :     | m (a as NODE(x,d,l,r), b as NODE(y,d',l',r')) =
31 :     let val (root,l,r) =
32 :     if less(x,y) then (x,l,m(r,b)) else (y,l',m(r',a))
33 :     val d_l = dist l
34 :     val d_r = dist r
35 :     val (l,r) = if d_l >= d_r then (l,r) else (r,l)
36 :     in
37 :     NODE(root,1+Int.max(d_l,d_r),l,r)
38 :     end
39 :     in m (a, b)
40 :     end
41 :    
42 :     fun create less = PQ { less = less, root = ref EMPTY }
43 : monnier 498 fun createN (less,_,_) = create less
44 : monnier 245
45 :     fun min (PQ { root = ref(NODE(x,_,_,_)), ... }) = x
46 :     | min _ = raise EmptyPriorityQueue
47 :    
48 :     fun isEmpty (PQ { root = ref EMPTY, ... }) = true
49 :     | isEmpty _ = false
50 :    
51 :     fun clear (PQ { root, ... }) = root := EMPTY
52 :    
53 :     fun deleteMin (PQ { root = root as ref(NODE(x,_,l,r)), less }) =
54 :     (root := mergeTrees less (l,r); x)
55 :     | deleteMin _ = raise EmptyPriorityQueue
56 :    
57 :     fun merge (PQ { root = r1, less }, PQ { root = r2, ...}) =
58 :     PQ { root = ref(mergeTrees less (!r1,!r2)), less = less }
59 :    
60 :     fun mergeInto { src = PQ { root = ref t1, less },
61 :     dst = PQ { root = r as ref t2, ...} } =
62 :     r := mergeTrees less (t1,t2)
63 :    
64 :     fun mergeElems (less, q, elements) =
65 :     let fun m (q,[]) = q
66 :     | m (q,e::es) = m(mergeTrees less (q, NODE(e,1,EMPTY,EMPTY)), es)
67 :     in m(q, elements)
68 :     end
69 :    
70 :     fun insert (PQ { root = r as ref t1, less}) x =
71 :     r := mergeTrees less (t1,NODE(x,1,EMPTY,EMPTY))
72 :    
73 :     fun fromList less list =
74 :     PQ { root = ref(mergeElems(less, EMPTY, list)), less = less }
75 :    
76 :     fun collect (EMPTY, e) = e
77 :     | collect (NODE(x,_,l,r),e) = collect(l,collect(r,x::e))
78 :    
79 :     fun toList (PQ { root = ref t, ... }) = collect (t, [])
80 :    
81 :     end
82 :    

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