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

Annotation of /smlnj-lib/trunk/Util/splaytree.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)
Original Path: sml/trunk/src/smlnj-lib/Util/splaytree.sml

1 : monnier 2 (* splaytree.sml
2 :     *
3 :     * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *
5 :     * Splay tree structure.
6 :     *
7 :     *)
8 :    
9 :     structure SplayTree : SPLAY_TREE =
10 :     struct
11 :    
12 :     datatype 'a splay =
13 :     SplayObj of {
14 :     value : 'a,
15 :     right : 'a splay,
16 :     left : 'a splay
17 :     }
18 :     | SplayNil
19 :    
20 :     datatype 'a ans_t = No | Eq of 'a | Lt of 'a | Gt of 'a
21 :    
22 :     fun splay (compf, root) = let
23 :     fun adj SplayNil = (No,SplayNil,SplayNil)
24 :     | adj (arg as SplayObj{value,left,right}) =
25 :     (case compf value of
26 :     EQUAL => (Eq value, left, right)
27 :     | GREATER =>
28 :     (case left of
29 :     SplayNil => (Gt value,SplayNil,right)
30 :     | SplayObj{value=value',left=left',right=right'} =>
31 :     (case compf value' of
32 :     EQUAL => (Eq value',left',
33 :     SplayObj{value=value,left=right',right=right})
34 :     | GREATER =>
35 :     (case left' of
36 :     SplayNil => (Gt value',left',SplayObj{value=value,left=right',right=right})
37 :     | _ =>
38 :     let val (V,L,R) = adj left'
39 :     val rchild = SplayObj{value=value,left=right',right=right}
40 :     in
41 :     (V,L,SplayObj{value=value',left=R,right=rchild})
42 :     end
43 :     ) (* end case *)
44 :     | _ =>
45 :     (case right' of
46 :     SplayNil => (Lt value',left',SplayObj{value=value,left=right',right=right})
47 :     | _ =>
48 :     let val (V,L,R) = adj right'
49 :     val rchild = SplayObj{value=value,left=R,right=right}
50 :     val lchild = SplayObj{value=value',left=left',right=L}
51 :     in
52 :     (V,lchild,rchild)
53 :     end
54 :     ) (* end case *)
55 :     ) (* end case *)
56 :     ) (* end case *)
57 :     | _ =>
58 :     (case right of
59 :     SplayNil => (Lt value,left,SplayNil)
60 :     | SplayObj{value=value',left=left',right=right'} =>
61 :     (case compf value' of
62 :     EQUAL =>
63 :     (Eq value',SplayObj{value=value,left=left,right=left'},right')
64 :     | LESS =>
65 :     (case right' of
66 :     SplayNil => (Lt value',SplayObj{value=value,left=left,right=left'},right')
67 :     | _ =>
68 :     let val (V,L,R) = adj right'
69 :     val lchild = SplayObj{value=value,left=left,right=left'}
70 :     in
71 :     (V,SplayObj{value=value',left=lchild,right=L},R)
72 :     end
73 :     ) (* end case *)
74 :     | _ =>
75 :     (case left' of
76 :     SplayNil => (Gt value',SplayObj{value=value,left=left,right=left'},right')
77 :     | _ =>
78 :     let val (V,L,R) = adj left'
79 :     val rchild = SplayObj{value=value',left=R,right=right'}
80 :     val lchild = SplayObj{value=value,left=left,right=L}
81 :     in
82 :     (V,lchild,rchild)
83 :     end
84 :     ) (* end case *)
85 :     ) (* end case *)
86 :     ) (* end case *)
87 :     ) (* end case *)
88 :     in
89 :     case adj root of
90 :     (No,_,_) => (GREATER,SplayNil)
91 :     | (Eq v,l,r) => (EQUAL,SplayObj{value=v,left=l,right=r})
92 :     | (Lt v,l,r) => (LESS,SplayObj{value=v,left=l,right=r})
93 :     | (Gt v,l,r) => (GREATER,SplayObj{value=v,left=l,right=r})
94 :     end
95 :    
96 :     fun lrotate SplayNil = SplayNil
97 :     | lrotate (arg as SplayObj{value,left,right=SplayNil}) = arg
98 :     | lrotate (SplayObj{value,left,right=SplayObj{value=v,left=l,right=r}}) =
99 :     lrotate (SplayObj{value=v,left=SplayObj{value=value,left=left,right=l},right=r})
100 :    
101 :     fun join (SplayNil,SplayNil) = SplayNil
102 :     | join (SplayNil,t) = t
103 :     | join (t,SplayNil) = t
104 :     | join (l,r) =
105 :     case lrotate l of
106 :     SplayNil => r (* impossible as l is not SplayNil *)
107 :     | SplayObj{value,left,right} => SplayObj{value=value,left=left,right=r}
108 :    
109 :     end (* SplayTree *)
110 :    

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