Fun with data structures, continuations and call/cc

Prompted by exercise 2.3 in Purely Functional Data Structures, by Chris Okasaki.

type Tree<'a> = Empty | Elem of 'a Tree * 'a * 'a Tree

let empty = Empty

Recursive

let rec insert x t =
    match t with
    | Empty ->  Elem(empty,x,empty)
    | Elem (left,e,right) when x < e -> Elem (insert x left,e,right)
    | Elem (left,e,right) when x > e -> Elem (left,e, insert x right)
    | Elem _ –> t

Tail Recursive

let insert' x t =
    let rec cont x t k =
        match t with
        | Empty -> k (Elem(empty,x,empty))
        | Elem (left,e,right) when x < e -> cont x left (fun t' -> k <| Elem (t',e,right))
        | Elem (left,e,right) when x > e -> cont x right (fun t' -> k <| Elem (left,e,t'))
        | Elem _ -> k t
    cont x t id

Using a continuation monad

type Cont<'a,'r> = ('a -> 'r) -> 'r

type ContBuilder() =
    member x.Return (a):Cont<'a,'r> = fun k -> k a
    member x.Bind (c:Cont<'a,'r>, f:'a -> Cont<'b,_>) =
        (fun k -> c (fun a -> f a k))
    member this.Delay(f) = f()

let cont = ContBuilder()

let insertM x t =
    let rec insertRecM x t =
        match t with
        | Empty ->  cont { return Elem(empty,x,empty) }
        | Elem (left,e,right) when x < e -> 
            cont {  let! t' = insertRecM x left
                    return Elem(t',e,right) }
        | Elem (left,e,right) when x > e -> 
            cont {  let! t' = insertRecM x right
                    return Elem(left,e,t') }
        | Elem _ -> cont { return t }
    insertRecM x t id

Using call with current continuation

let callCC (f:('a -> Cont<'b,'r>) -> Cont<'a,'r>) : Cont<'a,'r> = fun k -> f (fun a _ -> k a) k

let insertCallCC x t =
    callCC (fun alreadyExists ->
        let rec insertRecCallCC x t =
            match t with
            | Empty ->  cont { return Elem(empty,x,empty) }
            | Elem (left,e,right) when x < e -> 
                cont {  let! t' = insertRecCallCC x left
                        return Elem(t',e,right) }
            | Elem (left,e,right) when x > e -> 
                cont {  let! t' = insertRecCallCC x right
                        return Elem(left,e,t') }
            | Elem _ -> alreadyExists t
        insertRecCallCC x t
    ) id

Please note that the complexity of the last implementation is not obfuscation – it avoids recreating nodes on the path to an already existing element (exercise 2.3 actually asks to do it using exceptions, which works just as well).

Share this post :

Technet!

del.icio.us it!

del.iri.ous!

digg it!

dotnetkicks it!

reddit!

technorati!