(* Vect: extensible arrays based on ropes as described in

   Boehm, H., Atkinson, R., and Plass, M. 1995. Ropes: an alternative to
   strings.  Softw. Pract. Exper. 25, 12 (Dec. 1995), 1315-1330.

   Motivated by Luca de Alfaro's extensible array implementation Vec.

   Copyright (C) 2007   Mauricio Fernandez <mfp@acm.org>
                        http://eigenclass.org

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Library General Public
   License as published by the Free Software Foundation; either
   version 2 of the License, or (at your option) any later version,
   with the following special exception:

   You may link, statically or dynamically, a "work that uses the
   Library" with a publicly distributed version of the Library to
   produce an executable file containing portions of the Library, and
   distribute that executable file under terms of your choice, without
   any of the additional requirements listed in clause 6 of the GNU
   Library General Public License.  By "a publicly distributed version
   of the Library", we mean either the unmodified Library as
   distributed by the author, or a modified version of the Library that is
   distributed under the conditions defined in clause 2 of the GNU
   Library General Public License.  This exception does not however
   invalidate any other reasons why the executable file might be
   covered by the GNU Library General Public License.

   This library is distributed in the hope that it will be useful, but
   WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Library General Public License for more details.

   The GNU Library General Public License is available at
   http://www.gnu.org/copyleft/lgpl.html; to obtain it, you can also
   write to the Free Software Foundation, Inc., 59 Temple Place -
   Suite 330, Boston, MA 02111-1307, USA.
 *)

type 'a t =
    Empty
  | Concat of 'a t * int * 'a t * int * int
  | Leaf of 'a array

type 'a forest_element = { mutable c : 'a t; mutable len : int }

let str_append = Array.append
let empty_str = [||]
let string_of_string_list = Array.concat

let singleton x = Leaf [|x|]

module STRING = Array

(* 48 limits max rope size to 236.10^9 elements on 64 bit,
 * ~ 734.10^6 on 32bit (length fields overflow after that) *)
let max_height = 48

(* actual size will be that plus 1 word header;
 * the code assumes it's an even num.
 * 32 gives up to 50% overhead in the worst case (all leaf nodes near
 * half-filled; 8 words for bookkeeping, 16 words worth of data per leaf node *)
let leaf_size = 16

__CHUNK__(code)


let of_array = of_string
let to_array = to_string
let append = append_char
let prepend = prepend_char

let rec map f = function
    Empty -> Empty
  | Leaf a -> Leaf (Array.map f a)
  | Concat(l,cl,r,cr,h) -> Concat(map f l, cl, map f r, cr, h)

let rec id_map f = function
    Empty -> Empty
  | Leaf a as leaf ->
      let changed = ref false in
      let a' = Array.init
                 (Array.length a)
                 (fun i ->
                    let v = Array.unsafe_get a i in
                    let v' = f v in if v <> v' then changed := true; v')
      in if !changed then Leaf a' else leaf
  | Concat(l,cl,r,cr,h) as v ->
      let l' = id_map f l in
      let r' = id_map f r in
        if l == l' && r == r' then v
        else Concat(l', cl, r', cr, h)

let to_list r =
  let rec aux acc = function
      Empty -> acc
    | Leaf a -> Array.fold_right (fun x l -> x :: l) a acc
    | Concat(l,_,r,_,_) -> aux (aux acc r) l
  in
    aux [] r

let filter f =
  fold (fun s x -> if f x then append x s else s) Empty

let fold_left = fold

let rec fold_right f v a = match v with
    Empty -> a
  | Leaf s -> Array.fold_right f s a
  | Concat(l,_,r,_,_) -> fold_right f l (fold_right f r a)

let rec destructive_set i v = function
    Empty -> raise Out_of_bounds
  | Leaf s ->
      if i >= 0 && i < STRING.length s then
        STRING.unsafe_set s i v
      else raise Out_of_bounds
  | Concat(l, cl, r, cr, _) ->
      if i < cl then destructive_set i v l
      else destructive_set (i - cl) v r

(* Functorial interface *)
module type RANDOMACCESS =
sig
  type 'a t
  val empty : 'a t
  val get : 'a t -> int -> 'a
  val unsafe_get : 'a t -> int -> 'a
  val set : 'a t -> int -> 'a -> unit
  val unsafe_set : 'a t -> int -> 'a -> unit
  val append : 'a t -> 'a t -> 'a t
  val concat : 'a t list -> 'a t
  val length : 'a t -> int
  val copy : 'a t -> 'a t
  val sub : 'a t -> int -> int -> 'a t
  val make : int -> 'a -> 'a t
  val iter : ('a -> unit) -> 'a t -> unit
  val map : ('a -> 'b) -> 'a t -> 'b t
  val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
end

module Make(R: RANDOMACCESS)
           (PARAM : sig
               val max_height : int
               val leaf_size : int
            end)=
struct
  type 'a t =
      Empty
    | Concat of 'a t * int * 'a t * int * int
    | Leaf of 'a R.t

  type 'a forest_element = { mutable c : 'a t; mutable len : int }

  let str_append = R.append
  let empty_str = R.empty
  let string_of_string_list = R.concat

  let singleton x = Leaf (R.make 1 x)

  module STRING = R

  let max_height = PARAM.max_height
  let leaf_size = PARAM.leaf_size

  __CHUNK__(code)

  let rec map f = function
      Empty -> Empty
    | Leaf a -> Leaf (R.map f a)
    | Concat(l,cl,r,cr,h) -> Concat(map f l, cl, map f r, cr, h)

  let of_array = of_string
  let of_container = of_string
  let to_container = to_string
  let append = append_char
  let prepend = prepend_char

  let to_list r =
    let rec aux acc = function
        Empty -> acc
      | Leaf a -> R.fold_right (fun x l -> x :: l) a acc
      | Concat(l,_,r,_,_) -> aux (aux acc r) l
    in
      aux [] r

  let filter f =
    fold (fun s x -> if f x then append x s else s) Empty

  let rec id_map f = function
      Empty -> Empty
    | Leaf a as leaf ->
        let changed = ref false in
        let len = R.length a in
        let a' = R.make len (R.get a 0) in
          for i = 0 to len - 1 do
            let v = R.unsafe_get a i in
            let v' = f v in
              if v <> v' then changed := true;
              R.unsafe_set a' i v'
          done;
          if !changed then Leaf a' else leaf
    | Concat(l,cl,r,cr,h) as v ->
        let l' = id_map f l in
        let r' = id_map f r in
          if l == l' && r == r' then v
          else Concat(l', cl, r', cr, h)

  let fold_left = fold

  let rec fold_right f v a = match v with
      Empty -> a
    | Leaf s -> R.fold_right f s a
    | Concat(l,_,r,_,_) -> fold_right f l (fold_right f r a)

end