(***********************************************************

  ralist.ml
  Implements a purely-functional Random Access list
  Copyright (C) 2001 Brock Wilcox
  [awwaiid@deathonastick.org]
  Released under the terms of the GNU GPL
  See www.gnu.org for more information

  HISTORY / NOTES
  2001.04.04.21.47
   - Created

***********************************************************)


(*** TYPES ***)

type 'a tree =
  | Leaf of 'a
  | Node of 'a * 'a tree * 'a tree

type 'a ralist = (int * 'a tree) list



(*** EXCEPTIONS ***)

exception Empty     (* raised by head, tail *)
exception Subscript (* raised by lookup, update *)



(*** FUNCTIONS ***)

let empty = []


let cons x xs =
  match xs with
  | (size1,t1) :: ((size2,t2) :: rest) ->
    if size1 = size2 then (1+size1+size2,Node(x,t1,t2)) :: rest
      else (1,Leaf x) :: xs
  | _ -> (1,Leaf x) :: xs


let head = function
  | [] -> raise Empty
  | (size,Leaf x) :: rest -> x
  | (size,Node (x,t1,t2)) :: rest -> x


let tail = function
  | [] -> raise Empty
  | (size,Leaf x) :: rest -> rest
  | (size,Node (x,t1,t2)) :: rest ->
    let size' = size / 2 in
    (size',t1) :: (size',t2) :: rest


let isempty = function
  | [] -> true
  | (size,t) :: rest -> false


let rec tree_lookup size = fun
  | (Leaf x),0 -> x
  | (Leaf x) i -> raise Subscript
  | (Node (x,t1,t2)) 0 -> x
  | (Node (x,t1,t2)) i ->
    let size' = size / 2 in
    if i<= size' then
      tree_lookup size' t1 (i-1)
    else
      tree_lookup size' t2 (i-1-size')
      
(* End of ralist.ml *)