From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: weis
Received: (from weis@localhost) by pauillac.inria.fr (8.7.6/8.7.3) id OAA24050 for caml-redistribution; Fri, 17 Sep 1999 14:11:14 +0200 (MET DST)
Received: from nez-perce.inria.fr (nez-perce.inria.fr [192.93.2.78]) by pauillac.inria.fr (8.7.6/8.7.3) with ESMTP id QAA26111 for <caml-list@pauillac.inria.fr>; Thu, 16 Sep 1999 16:06:57 +0200 (MET DST)
Received: from julie.univ-savoie.fr (univax.univ-savoie.fr [193.48.120.32])
	by nez-perce.inria.fr (8.8.7/8.8.7) with ESMTP id QAA12117
	for <caml-list@inria.fr>; Thu, 16 Sep 1999 16:06:56 +0200 (MET DST)
Received: from univ-savoie.fr (bppp3.univ-savoie.fr [193.48.120.22])
          by julie.univ-savoie.fr (8.9.3/jtpda-5.3.1) with ESMTP id QAA60183
          ; Thu, 16 Sep 1999 16:06:18 +0200 (CEST)
Sender: weis
Message-ID: <37E0F951.2D3E07C7@univ-savoie.fr>
Date: Thu, 16 Sep 1999 14:06:09 +0000
From: Christophe Raffalli <Christophe.Raffalli@univ-savoie.fr>
Organization: =?iso-8859-1?Q?Université?= de Savoie
X-Mailer: Mozilla 4.61 [en] (X11; I; Linux 2.2.9-27mdk i686)
X-Accept-Language: en
MIME-Version: 1.0
To: Steve Stevenson <steve@cs.clemson.edu>
CC: caml-list@inria.fr
Subject: Re: Imperative list operations
References: <14302.41638.913957.615588@merlin.cs.clemson.edu>
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit


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