From: als@bohra.cpg.oz.au (Anthony Shipman)
Newsgroups: alt.lang.ml
Subject: Advice wanted on a program
Date: 30 Jul 92 13:17:49 GMT
Organization: Computer Power Software


I am learning SML using the sml2c compiler.  I would like some feedback
on this small program below.  It implements a simple binary tree lookup table.

I tried initially to use type variables for the key and value types and
I had < and > as operators in the insert function.  But SML coudn't find 
a typing for these operators.  

I ended up adopting an Ada-like style using a functor parameterised
by a domain structure (analogous to generic parameters in Ada).  It is
important that the module work for any key type for which a total ordering
is possible.

I would like some comments on whether my approach is reasonable.  How could
it have been done using polymorphism, if this is possible?

Thanks

===================================================================
(*  
    This signature specifies the domain overwhich BinTree operates.  These
    are the properties of the key and value types.
*)
signature BinTreeDomain =
sig
    type    key
    val     lt: key * key ->bool    (* less-than operation *)
    val     gt: key * key ->bool    (* greater-than *)
    val     eq: key * key ->bool    (* equality *)

    type    value                   (* nothing req'd except copying *)

end




signature BinTree =
sig
    type    bintree
    type    key
    type    value

    exception Duplicate         (* duplicate entry on inserting *)
    exception NotFound of key   (* the entry was not found *)

    val     empty: unit -> bintree
    val     insert: bintree * key * value -> bintree
    val     lookup: bintree * key -> value

    (* val print: bintree -> unit *) 
end




functor BinTree(dom:BinTreeDomain) : BinTree =
struct
    
    type    key = dom.key
    type    value = dom.value

    val say = outputc std_out

    exception Duplicate         (* duplicate entry on inserting *)
    exception NotFound of key   (* entry not found *)

    datatype bintree =  EMPTY 
                      | NODE of { key:key, value:value, 
                                    left: bintree, right:bintree}

    fun empty () = EMPTY

    fun insert (EMPTY, k, v) = 
                NODE{key=k, value=v, left=EMPTY, right=EMPTY}

      | insert (NODE{key, value, left, right}, k, v) =
                if dom.lt(k, key)
                then
                    NODE{key=key, value=value, 
                            left=insert(left, k, v), right=right}
                else if dom.gt(k, key)
                    then
                        NODE{key=key, value=value, 
                                    left=left, right=insert(right, k, v)}
                    else
                        raise Duplicate

    fun lookup (EMPTY, k) = raise NotFound(k)
      | lookup (NODE{key, value, left, right}, k) =
                if dom.eq(key, k)
                then
                    value
                else if dom.lt(k, key)
                    then
                        lookup(left, k)
                    else
                        lookup(right, k)

end



structure Main =
struct

    structure domain =          (* nature of our trees *)
    struct
        type key = string
        type value = int
        val lt = String.<
        val gt = String.>
        val eq = op = :(string * string -> bool) (* select an equality op *)
    end

    structure bt = BinTree(domain)  (* instantiate the module *)
    open bt

    val say = outputc std_out

    val t = ref (empty ())

    val _ = (t := insert(!t, "entry1", 1); t := insert(!t, "entry2", 2))

    fun test k = say (k ^ " -> " ^ makestring(lookup(!t,k)) ^ "\n")
                        handle NotFound kk => say (kk ^ " not found\n")

    val _ = test "entry1"
    val _ = test "entry2"
    val _ = test "bad"
end

-- 
Anthony Shipman                 "You've got to be taught before it's too late,
CP Software Export Pty Ltd,      Before you are six or seven or eight,
19 Cato St., East Hawthorn,      To hate all the people your relatives hate,
Melbourne, Australia, 3121       You've got to be carefully taught."  R&H
Newsgroups: uiuc.cs.sml,alt.lang.ml