Learning OCAML: A Circular Double Link List Implementation.

I’m learning OCAML these days. I just finished reading the chapter on imperative programming in OCAML so I thought I could implement a circular double link list.

This is a first attempt, and its not quite what I wanted, but I think it’ll work.

(* Ch03 Doubly Linked Lists *)

(* 3.1 *) 

type 'a cell = 
    {
      data : 'a;
      mutable prev : 'a dlinklist;
      mutable next : 'a dlinklist
    }
and 
  'a dlinklist = Empty | Cell of 'a cell
;;

(* 3.2 Circular link list *)

let add_head x cll = 
  match cll with 
    | Empty -> 
    let new_cell = 
      { data = x; prev = Empty ; next = Empty} in
    let new_cll = Cell new_cell in
    new_cell.prev <- new_cll;
    new_cell.next <- new_cll;
    new_cll
    | Cell head_cell ->
    let new_cell = 
      { data = x ; prev = Empty; next = Empty } in
    let new_list = Cell new_cell in
    let tail_cell = head_cell.prev in
    (match tail_cell with
      | Empty -> ()
      | Cell pl -> pl.next <- new_list);
    new_cell.next <- cll;
    new_cell.prev <- head_cell.prev;
    head_cell.prev <- new_list;
    new_list


;;

let add_tail x cll = 
  match cll with
    | Empty -> add_head x Empty
    | Cell head_cell ->
    let tail_cell = 
      match head_cell.prev with
        | Empty -> failwith "Incorrect State"
        | Cell tc -> tc
    in
    let new_cell = { data = x ; prev = Empty ; next = Empty } in
    let new_list = Cell new_cell in
    tail_cell.next <- new_list;
    new_cell.prev <- head_cell.prev ;
    head_cell.prev <- new_list;
    cll
;;


let get_head_cell (cll:'a dlinklist) = 
  match cll with 
    | Empty -> failwith "Empty List"
    | Cell head_cell -> head_cell
;;

let get_tail_cell cll = 
  get_head_cell ((get_head_cell cll).prev)
;;

let remove_head cll = 
  let head_cell = get_head_cell cll in
  let tail_cell = get_tail_cell cll in
  let new_head_cell = get_head_cell (head_cell.next) in
  let new_list = Cell new_head_cell in
  if head_cell.prev = Empty 
    && head_cell.next = Empty 
  then
    Empty
  else
    begin
      new_head_cell.prev <- Cell tail_cell;
      tail_cell.next <- new_list;
      new_list
    end
;;

let remove_tail cll = 
  let head_cell = get_head_cell cll in
  let tail_cell = get_tail_cell cll in
  let new_tail_cell = get_head_cell (tail_cell.prev) in
  let new_list = Cell head_cell in
  new_tail_cell.next <- new_list;
  head_cell.prev <- Cell new_tail_cell;
  new_list
;;
      

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: