hamming.ml

type tree =
  T of int * child list
and
  child = unit -> tree

let rec mktree n = 
  let f i = fun () -> mktree i in
  (T (n, [f (n * 2); f (n * 3); f (n * 5)])) 

let less (T(v1, _)) (T(v2, _)) = v1 < v2
let eq   (T(v1, _)) (T(v2, _)) = v1 = v2

let mkfn k e = fun x -> k (e :: x)

let insertion l1 l2 = 
  let rec loop k = function
    h1::tl1 as l1 -> (function
      h2::tl2 when less h2 h1 -> loop (mkfn k h2) l1 tl2
    | h2::tl2 when eq h1 h2   -> loop (mkfn k h1) tl1 tl2
    | l2                      -> loop (mkfn k h1) tl1 l2)
  | []            -> (function
      h2::tl2 -> loop (mkfn k h2) [] tl2
    | []      -> k [])
  in
  loop (fun x -> x) l1 l2

let hamming n =
  let rec loop k = function
    i when i = n -> fun _ -> k []
  | i -> (function
      T(v, c)::tl -> loop (mkfn k v) (i + 1) (insertion tl (List.map (fun f -> f ()) c))
    | []          -> loop k 1 [(mktree 1)])
  in
  loop (fun x -> x) 0 [];;