Re: Imperative list operations

From: Christophe Raffalli (Christophe.Raffalli@univ-savoie.fr)
Date: Thu Sep 16 1999 - 16:06:09 MET DST

Date: Thu, 16 Sep 1999 14:06:09 +0000
From: Christophe Raffalli <Christophe.Raffalli@univ-savoie.fr>
To: Steve Stevenson <steve@cs.clemson.edu>
Subject: Re: Imperative list operations

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'));;
*)

This archive was generated by hypermail 2b29 : Sun Jan 02 2000 - 11:58:25 MET