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

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.