(** It is represented by a "forward stack", that is a stack with "forward" ability, i.e. "pop" does not remove top-most element which remains accessible with the "forward" operation. *)



type 'a t = {
  data : 'a list ;
  f_data : 'a list ; 

(** forward data *)


  }
;;

exception No_more;;

let create v = { data = [v] ; f_data = [] };;
let push x t = { data = x :: t.data ; f_data = [] };;

let undo t =
  match t.data with
    [] | [_] -> raise No_more
  | x :: q ->
      let t = { data = q; f_data = x :: t.f_data } in
      (x, t)
;;

let redo t =
  match t.f_data with
    [] -> raise No_more
  | x :: q ->
      let t = { data = x :: t.data ; f_data = q } in
      (x, t)
;;

let can_redo t = t.f_data <> [];;
let get t =
  match t.data with
    [] -> assert false
  | x :: _ -> x
;;
let length t = List.length t.data;;
let forward_length t = List.length t.f_data;;

let as_list t = (List.rev t.data) @ t.f_data;;

type 'a imp_t = { mutable h : 'a t } ;;
let imp_create v = { h = create v } ;;
let imp_push x t = t.h <- push x t.h  ;;
let imp_get t = get t.h ;;
let imp_undo t = let (v, h2) = undo t.h in t.h <- h2; v ;;
let imp_redo t = let (v, h2) = redo t.h in t.h <- h2; v ;;
let imp_can_redo t = can_redo t.h ;;
let imp_as_list t = as_list t.h ;;
let t_to_imp t = { h = t } ;;
let imp_to_t t = t.h ;;