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

Annotation of /sml/trunk/src/MLRISC/ra/raPriQueue.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1053 - (view) (download)

1 : george 1053 (*
2 :     * Priority Queue. Let's hope the compiler will inline it for performance
3 :     *)
4 :     functor RaPriQueue(type elem val less : elem * elem -> bool) : RA_PRIORITY_QUEUE = struct
5 :    
6 :     (* A leftist tree is a binary tree with priority ordering
7 :     * with the invariant that the left branch is always the taller one
8 :     *)
9 :     type elem = elem
10 :     datatype pri_queue = TREE of elem * int * pri_queue * pri_queue | EMPTY
11 :    
12 :     fun merge'(EMPTY, EMPTY) = (EMPTY, 0)
13 :     | merge'(EMPTY, a as TREE(_, d, _, _)) = (a, d)
14 :     | merge'(a as TREE(_, d, _, _), EMPTY) = (a, d)
15 :     | merge'(a as TREE(x, d, l, r), b as TREE(y, d', l', r')) =
16 :     let val (root, l, r1, r2) =
17 :     if less(x, y) then (x, l, r, b) else (y, l', r', a)
18 :     val (r, d_r) = merge'(r1, r2)
19 :     val d_l = case l of EMPTY => 0 | TREE(_, d, _, _) => d
20 :     val (l, r, d_t) = if d_l >= d_r then (l, r, d_l+1) else (r, l, d_r+1)
21 :     in (TREE(root, d_t, l, r), d_t) end
22 :    
23 :     fun merge(a, b) = #1(merge'(a, b))
24 :    
25 :     fun add (x, EMPTY) = TREE(x, 1, EMPTY, EMPTY)
26 :     | add (x, b as TREE(y, d', l', r')) =
27 :     if less(x,y) then TREE(x, d'+1, b, EMPTY)
28 :     else #1(merge'(TREE(x, 1, EMPTY, EMPTY), b))
29 :     end
30 :    

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