Re: Imperative list operations

[Christophe Raffalli <Christophe.Raffalli@univ-savoie.fr>]

Try this:

(************** dlist.mli ***********************)
type 'a dlist

val empty : unit -> 'a dlist
val move_left : 'a dlist -> 'a dlist
val move_right : 'a dlist -> 'a dlist
val get_content : 'a dlist -> 'a
val is_left_end : 'a dlist -> bool
val is_right_end : 'a dlist -> bool
val is_not_end : 'a dlist -> bool
val is_empty : 'a dlist -> bool
val insert_right : 'a -> 'a dlist -> unit


(************** dlist.ml ************************)


type 'a dlist =
  | Cell of 'a cell
  | End_Left of 'a end_left
  | End_Right of 'a end_right

and 'a cell = { 
    dlist_cell : 'a; 
    mutable dlist_left : 'a dlist;
    mutable dlist_right : 'a dlist 
  }

and 'a end_left = {
    mutable back_right : 'a dlist;
  } 

and 'a end_right = {
    mutable back_left : 'a dlist;
  } 

let empty () =
  let rec l = 
    End_Left { back_right = End_Right { back_left = l }}
  in l

let move_left l =
  match l with
  | End_Left sr ->
      raise (Invalid_argument "move_left")
  | End_Right sl ->
      sl.back_left
  | Cell s ->
      s.dlist_left

let move_right l =
  match l with
  | End_Left sr ->
      sr.back_right
  | End_Right sl ->
      raise (Invalid_argument "move_right")
  | Cell s ->
      s.dlist_right

let get_content l =
  match l with
  | End_Left sr ->
      raise (Invalid_argument "get_content")
  | End_Right sl ->
      raise (Invalid_argument "get_content")
  | Cell s ->
      s.dlist_cell

let is_left_end = function
    End_Left _ -> true
  | _ -> false

let is_right_end = function
    End_Right _ -> true
  | _ -> false

let is_not_end = function
    Cell _ -> true
  | _ -> false

let is_empty = function
    End_Left sr -> is_right_end sr.back_right
  | End_Right sl -> is_left_end sl.back_left
  | _ -> false

let insert_right a l = 
  let li, lr = match l with
    End_Left sr ->
      let lr = sr.back_right in
      let li = Cell {
	dlist_cell = a;
	dlist_left = l;
	dlist_right = lr;
      }	in
      sr.back_right <- li;
      li, lr
  | End_Right sl ->
      raise (Invalid_argument "insert_left")
  | Cell s ->
      let lr = s.dlist_right in
      let li = Cell {
	dlist_cell = a;
	dlist_left = l;
	dlist_right = lr;
      }	in
      s.dlist_right <- li;
      li, lr
  in
  match lr with
    End_Right sl -> sl.back_left <- li
  | Cell s -> s.dlist_left <- li
  | End_Left sr -> raise (Failure "impossible in insert_left")

let insert_left a l = 
  let li, ll = match l with
    End_Right sl ->
      let ll = sl.back_left in
      let li = Cell {
	dlist_cell = a;
	dlist_left = ll;
	dlist_right = l;
      }	in
      sl.back_left <- li;
      li, ll
  | End_Left sr ->
      raise (Invalid_argument "insert_right")
  | Cell s ->
      let ll = s.dlist_left in
      let li = Cell {
	dlist_cell = a;
	dlist_left = ll;
	dlist_right = l;
      }	in
      s.dlist_left <- li;
      li, ll
  in
  match ll with
    End_Left sr -> sr.back_right <- li
  | Cell s -> s.dlist_right <- li
  | End_Right sl -> raise (Failure "impossible in insert_left")

(*
  test

let x = empty ();;
insert_right 2 x;;
let x' = move_right x;;
insert_right 3 x';;
insert_left 1 x';;
get_content (move_left x');;
get_content (move_right x');;
insert_right 4 x';;
insert_left 0 x';;
get_content (move_left x');;
get_content (move_right x');;
get_content (move_left (move_left x'));;
get_content (move_right (move_right x'));;
*)