Skip to content
Browse files

Infinite array added to BatArray.ml(from cdk)

  • Loading branch information...
1 parent 772799c commit 7a5b5be15feae5d723fcedf6d6d0e494d95ec29d @thelema thelema committed Mar 3, 2011
Showing with 66 additions and 0 deletions.
  1. +66 −0 src/batArray.ml
View
66 src/batArray.ml
@@ -513,3 +513,69 @@ end
+module Infinite =
+struct
+(**************************************************************************)
+(* *)
+(* Menhir *)
+(* *)
+(* François Pottier, INRIA Rocquencourt *)
+(* Yann Régis-Gianas, PPS, Université Paris Diderot *)
+(* *)
+(* Copyright 2005-2008 Institut National de Recherche en Informatique *)
+(* et en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the GNU Library General Public License, with the *)
+(* special exception on linking described in file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* $Id: infiniteArray.ml,v 1.6 2007/09/10 21:09:37 fpottier Exp $ *)
+
+(** This module implements infinite arrays, that is, arrays that grow
+ transparently upon demand. *)
+
+type 'a t = {
+ default: 'a;
+ mutable table: 'a array;
+ mutable extent: int; (* the index of the greatest [set] ever, plus one *)
+ }
+
+let default_size =
+ 16384 (* must be non-zero *)
+
+let make x = {
+ default = x;
+ table = Array.make default_size x;
+ extent = 0;
+}
+
+let rec new_length length i =
+ if i < length then
+ length
+ else
+ new_length (2 * length) i
+
+let ensure a i =
+ let table = a.table in
+ let length = Array.length table in
+ if i >= length then begin
+ let table' = Array.make (new_length (2 * length) i) a.default in
+ Array.blit table 0 table' 0 length;
+ a.table <- table'
+ end
+
+let get a i =
+ ensure a i;
+ a.table.(i)
+
+let set a i x =
+ ensure a i;
+ a.table.(i) <- x;
+ a.extent <- Pervasives.max (i + 1) a.extent
+
+let extent a =
+ a.extent
+
+let domain a =
+ Array.sub a.table 0 a.extent
+end

0 comments on commit 7a5b5be

Please sign in to comment.
Something went wrong with that request. Please try again.