dll ocaml

type 'a ref = Nil | Cons of 'a tail * 'a * 'a tail
and 'a tail = unit -> 'a ref

type 'a element = {
  content : 'a;
  mutable next : 'a element option;
  mutable prev : 'a element option
}

let create () = Nil

let is_empty t = !t = None

let insert_first l c =
  let n = {content = c; next = !l; prev = None} in
  let _ = match !l with
    | Some o -> (o.prev <- Some n)
    | None -> () in
  let _ = (l := Some n) in
  n

let insert_after n c =
  let n' = {content = c; next = n.next; prev = Some n} in
  let _ =  match n.next with
    | Some o -> (o.prev <- (Some n'))
    | None -> () in
  let _ = (n.next <- (Some n')) in
  n'

let remove t elt =
  let prev, next = elt.prev, elt.next in
  let _ = match prev with
    | Some prev -> (prev.next <- next)
    | None -> t := next in
  let _ =  match next with
    | Some next -> (next.prev <- prev)
    | None -> () in
  let _ = (elt.prev <- None) in
  let _ = (elt.next <- None) in
  ()      (* return void *)

let iter t f =
  let rec loop node =
    match node with
      | None -> ()
      | Some el ->
        let next = el.next in
        let _ = f el in
        loop (next)
  in
  loop !t

  (*Helper functions*)
  let rec start x =
  begin match x with
    | Nil -> x
    | Cons(t,_,_) ->
      begin match t() with
        | Nil -> x
        | prev -> start prev
      end
  end

  let rec create_new_rev prev xs =
  begin match xs with
    | Nil -> Nil
    | Cons(_,x,next) ->
      let next' = next () in
      let rec xs' =
        Cons((fun () -> prev), x, fun () -> create_new_rev xs' next')
      in xs'
  end

  let cons x xs =
    begin match start xs with
      | Nil -> Cons((fun () -> Nil),x,(fun () -> Nil))
      | Cons(prev,y,next) ->
        (* [prev] should be thunked [Nil] *)
        let next' = next() in
        let rec new1 =
          Cons(prev, x, (fun () -> new2))
        and new2 =
          Cons((fun () -> new1), y, (fun () -> create_new_rev new2 next'))
        in new1
    end

  let rec foldl_aux f acc xs =
  begin match xs with
    | Nil -> acc
    | Cons(_,x,t) -> foldl_aux f (f acc x) (t())
  end

  let rec foldr_aux f xs acc k =
    begin match xs with
      | Nil -> k acc
      | Cons(_,x,t) -> foldr_aux f (t()) acc (fun z -> k (f x z))
    end
  let foldr f xs acc =
    foldr_aux f (start xs) acc (fun x -> x)

  let foldl f acc xs =
  foldl_aux f acc (start xs)

  let foldr f xs acc =
  foldr_aux f (start xs) acc (fun x -> x)


(*create dll from list *)
let dll_of_list l =
  let singly_linked =
    List.fold_left (fun acc x ->
      Cons((fun () -> Nil), x, (fun () -> acc))) (create ()) (List.rev l)
  in
  begin match singly_linked with
    | Nil -> Nil
    | Cons(_,x,next_thunk) ->
      let next = next_thunk () in
      let rec l' =
        Cons((fun () -> Nil),x,(fun () -> create_new_rev l' next))
      in l'
  end

(*Create list from dll*)
let list_of_dll l =
  foldr (fun x acc -> x :: acc) l []

(*length of dll*)
let length l =
  foldl (fun acc _ -> 1 + acc) 0 l

(*turn a dll like (1; 2; 3) into (1; 1; 2; 2; 3; 3)*)
let duplicate l =
  (*copied length to avoid errors while testing*)
  foldl (fun acc _ -> 1 + acc) 0 l

(*inplace reversal of dll*)
let reverse l =
  foldl (fun acc x -> cons x acc) (create ()) l