-class ['a] history size =
- let unsome = function Some x -> x | None -> assert false in
- object (self)
-
- val history_data = Array.create (size + 1) None
-
- val mutable history_hd = 0 (* rightmost index *)
- val mutable history_cur = 0 (* current index *)
- val mutable history_tl = 0 (* leftmost index *)
-
- method private is_empty = history_data.(history_cur) = None
-
- method push (status: 'a) =
- if self#is_empty then
- history_data.(history_cur) <- Some status
- else begin
- history_cur <- (history_cur + 1) mod size;
- history_data.(history_cur) <- Some status;
- history_hd <- history_cur; (* throw away fake future line *)
- if history_hd = history_tl then (* tail overwritten *)
- history_tl <- (history_tl + 1) mod size
- end
-
- method undo = function
- | 0 -> unsome history_data.(history_cur)
- | steps when steps > 0 ->
- let max_undo_steps =
- if history_cur >= history_tl then
- history_cur - history_tl
- else
- history_cur + (size - history_tl)
- in
- if steps > max_undo_steps then
- raise History_failure;
- history_cur <- history_cur - steps;
- if history_cur < 0 then (* fix underflow *)
- history_cur <- size + history_cur;
- unsome history_data.(history_cur)
- | steps (* when steps > 0 *) -> self#redo ~-steps
-
- method redo = function
- | 0 -> unsome history_data.(history_cur)
- | steps when steps > 0 ->
- let max_redo_steps =
- if history_hd >= history_cur then
- history_hd - history_cur
- else
- history_hd + (size - history_cur)
- in
- if steps > max_redo_steps then
- raise History_failure;
- history_cur <- (history_cur + steps) mod size;
- unsome history_data.(history_cur)
- | steps (* when steps > 0 *) -> self#undo ~-steps
-
- end
-