quick and dirty impl of floyd cycle detection algo

cydet.ml

(* quick and dirty impl of floyd cycle detection algo *)

type 'a llist = Nil | Cons of ('a * 'a llist)

let rec d = Cons ("d", a) and
    a = Cons ("a", Cons("b", Cons("c", d)));;

type 'a pointer = {value:'a; rest:'a llist}
let eq p1 p2 = p1.value = p2.value

let (%) f g x = f (g x)
let id a = a
let tuple a b c = (a, b, c)

exception Stop_iteration

let gen_loop3 pred mod_ret mod_a mod_b mod_c =
  let rec fnc a b c =
    if pred a b c then mod_ret a b c else fnc (mod_a a) (mod_b b) (mod_c c)
  in fnc

let floyd lst =
  let work () =
    let next p = match p.rest with
      | Cons(v, rest) -> {value=v;rest=rest}
      | Nil -> raise Stop_iteration
    in
    let eq a b _ = eq a b in
    let succ = (+) 1 in
    let loop mod_a mod_b mod_c = gen_loop3 eq tuple mod_a mod_b mod_c in
    let find_rep = loop next (next % next) id in
    let find_pos = loop next next succ in
    let find_len = loop id next succ in
    let x0 = {value=""; rest=lst} in
    let (tortoise, hare, _) = find_rep (next x0) (next (next x0)) None in
    let (tortoise, hare, pos) = find_pos x0 hare 0 in
    let (_, _, len) = find_len tortoise (next tortoise) 1
    in Some (pos, len)
  in try
       work ()
    with Stop_iteration -> None