(** Question 1 *)

(** List reversal, naive and quadratric. *)
let rec rev1 l =
  match l with
    | [] -> []
    | hd::tl -> List.rev tl @ [hd]

(** List reversal, made tailrec using continuations.
  * It is still quadratic. *)
let rec rev2 l k =
  match l with
    | [] -> k []
    | hd::tl -> rev2 tl (fun tl' -> k (tl' @ [hd]))

let rev2_top l = rev2 l (fun x -> x)

let () =
  assert (rev1 [1;2;3] = [3;2;1]) ;
  assert (rev2_top [1;2;3] = [3;2;1])

(** Defunctionalized version *)

type 'a k =
  | Id
  | Append of 'a k * 'a

let rec apply k x =
  match k with
    | Id -> x
    | Append (k,hd) -> apply k (x@[hd])

let rec rev3 l k =
  match l with
    | [] -> apply k []
    | hd::tl -> rev3 tl (Append (k,hd))

let rev3_top l = rev3 l Id

let () =
  assert (rev3_top [1;2;3] = [3;2;1])

(** Simplification.
  * We see that k is isomorphic to list, with Id = [] and
  * Append = ::, and apply is just append. *)

let rec rev4 l k =
  match l with
    | [] -> k
    | hd::tl -> rev4 tl (hd::k)

let rev4_top l = rev4 l []

let () =
  assert (rev4_top [1;2;3] = [3;2;1])



(** Question 2 *)

let rec irev_while l =
  let l = ref l in
  let r = ref [] in
    while !l <> [] do
      r := List.hd !l :: !r ;
      l := List.tl !l
    done ;
    !r

let rec irev l =
  let l = ref l in
  let r = ref [] in
  let rec w () =
    if !l <> [] then begin
      r := List.hd !l :: !r ;
      l := List.tl !l ;
      w ()
    end
  in
    w () ;
    !r

(** Comme on n'alloue qu'au début, on prend juste une paire
  * pour représenter la mémoire.
  * On ne fait pas une traduction complète, mais on utilise
  * et passe l'état là où il faut.
  * Des simplifications simples nous donneraient encore rev_append. *)
let rec irev' l =
  let s : 'a list * 'a list = (l,[]) in
  let rec w s =
    let l = fst s in
      if l <> [] then
        let l = fst s in           (* !l *)
        let r = snd s in           (* !r *)
        let v = List.hd l :: r in  (* List.hd !l :: !r *)
        let s = (fst s, v) in      (* r := ... *)
        let l = fst s in
        let v = List.tl l in
        let s = (v, snd s) in      (* l := List.tl !l *)
          w s
      else
        s
  in
  let s = w s in
    snd s

let () =
  assert (irev_while [1;2;3] = [3;2;1]) ;
  assert (irev [1;2;3] = [3;2;1]) ;
  assert (irev' [1;2;3] = [3;2;1])