Friday 25 September 2009

Tail Recursive QuickSort using Continuation Passing Style

//val qsort: 'a list -> 'a list
let rec qsort = function
| [] -> []
| x::xs' -> let (l, r) = List.partition ((>) x) xs'
List.concat [(qsort l);[x];(qsort r)]

//val qsortCPS: 'a list -> 'a list
let qsortCPS xs =
let rec loop xs cont =
match xs with
| [] -> cont []
| x::xs' -> let (l, r) = List.partition ((>) x) xs'
loop l (fun lacc ->
loop r (fun racc -> cont (lacc @ x :: racc)))
loop xs (fun x -> x)

Thursday 10 September 2009

Catamorphism (generalised fold on type)

// Catamorphism
// Generalised Fold on a datatype

type exp = | Var of string
| Lambda of string * exp
| Apply of exp * exp

// This fold was made Tail Recursive using continuations.
let foldExpr varF lamF appF exp =
let rec Loop e cont =
match e with
| Var x -> cont (varF x)
| Lambda (x, body) -> Loop body (fun bodyAcc -> cont (lamF x bodyAcc))
| Apply (l, r) -> Loop l (fun lAcc ->
Loop r (fun rAcc ->
cont (appF lAcc rAcc)))
Loop exp (fun x -> x)


let toString =
foldExpr
(fun x -> sprintf "%s" x)
(fun x y -> sprintf "(λ%s.%s)" x y)
(fun x y -> sprintf "(%s %s)" x y)

printf "%s" (toString (Apply(Lambda("x", Var "x"), Lambda("y", Var "y"))))