Return to redblack.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / doc / examples

Annotation of researchv10no/cmd/sml/doc/examples/redblack.sml, revision 1.1

1.1     ! root        1: (* redblack.sml *)
        !             2: 
        !             3: functor RedBlack(B : sig type key
        !             4:                         val > : key*key->bool
        !             5:                     end):
        !             6:            sig type tree
        !             7:                type key
        !             8:                val empty : tree
        !             9:                val insert : key * tree -> tree
        !            10:                val lookup : key * tree -> key
        !            11:                exception Notfound of key
        !            12:            end =
        !            13: struct
        !            14:  open B
        !            15:  datatype color = RED | BLACK
        !            16:  datatype tree = empty | tree of key * color * tree * tree
        !            17:  exception Notfound of key
        !            18: 
        !            19:  fun insert (key,t) =
        !            20:   let fun f empty = tree(key,RED,empty,empty)
        !            21:         | f (tree(k,BLACK,l,r)) =
        !            22:            if key>k
        !            23:            then case f r
        !            24:                 of r as tree(rk,RED, rl as tree(rlk,RED,rll,rlr),rr) =>
        !            25:                        (case l
        !            26:                         of tree(lk,RED,ll,lr) =>
        !            27:                                tree(k,RED,tree(lk,BLACK,ll,lr),
        !            28:                                           tree(rk,BLACK,rl,rr))
        !            29:                          | _ => tree(rlk,BLACK,tree(k,RED,l,rll),
        !            30:                                                tree(rk,RED,rlr,rr)))
        !            31:                  | r as tree(rk,RED,rl, rr as tree(rrk,RED,rrl,rrr)) =>
        !            32:                        (case l
        !            33:                         of tree(lk,RED,ll,lr) =>
        !            34:                                tree(k,RED,tree(lk,BLACK,ll,lr),
        !            35:                                           tree(rk,BLACK,rl,rr))
        !            36:                          | _ => tree(rk,BLACK,tree(k,RED,l,rl),rr))
        !            37:                  | r => tree(k,BLACK,l,r)
        !            38:            else if k>key
        !            39:            then case f l
        !            40:                 of l as tree(lk,RED,ll, lr as tree(lrk,RED,lrl,lrr)) =>
        !            41:                        (case r
        !            42:                         of tree(rk,RED,rl,rr) =>
        !            43:                                tree(k,RED,tree(lk,BLACK,ll,lr),
        !            44:                                           tree(rk,BLACK,rl,rr))
        !            45:                          | _ => tree(lrk,BLACK,tree(lk,RED,ll,lrl),
        !            46:                                                tree(k,RED,lrr,r)))
        !            47:                  | l as tree(lk,RED, ll as tree(llk,RED,lll,llr), lr) =>
        !            48:                        (case r
        !            49:                         of tree(rk,RED,rl,rr) =>
        !            50:                                tree(k,RED,tree(lk,BLACK,ll,lr),
        !            51:                                           tree(rk,BLACK,rl,rr))
        !            52:                          | _ => tree(lk,BLACK,ll,tree(k,RED,lr,r)))
        !            53:                  | l => tree(k,BLACK,l,r)
        !            54:            else tree(key,BLACK,l,r)
        !            55:         | f (tree(k,RED,l,r)) =
        !            56:            if key>k then tree(k,RED,l, f r)
        !            57:            else if k>key then tree(k,RED, f l, r)
        !            58:            else tree(key,RED,l,r)
        !            59:    in case f t
        !            60:       of tree(k,RED, l as tree(_,RED,_,_), r) => tree(k,BLACK,l,r)
        !            61:        | tree(k,RED, l, r as tree(_,RED,_,_)) => tree(k,BLACK,l,r)
        !            62:        | t => t
        !            63:   end
        !            64: 
        !            65:  fun lookup (key,t) =
        !            66:   let fun look empty = raise (Notfound key)
        !            67:        | look (tree(k,_,l,r)) =
        !            68:                if k>key then look l
        !            69:                else if key>k then look r
        !            70:                else k
        !            71:    in look t
        !            72:   end
        !            73: 
        !            74: end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.