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