lib/mlton/basic/resizable-array.fun

   1 (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7
   8 functor ResizableArray (): RESIZABLE_ARRAY =
   9 struct
  10
  11 structure Array = Array
  12
  13 structure A' =
  14    struct
  15       datatype 'a t = T of {array: 'a option Array.t ref,
  16                             length: int ref}
  17
  18       fun getArray (T {array, ...}) = !array
  19       fun lengthRef (T {length, ...}) = length
  20       fun length a = ! (lengthRef a)
  21       val shape = length
  22
  23       fun maxLength a = Array.length (getArray a)
  24       fun minLength a = Int.quot (maxLength a, 4)
  25
  26       fun invariant a =
  27          maxLength a >= 1
  28          andalso minLength a <= length a
  29          andalso length a <= maxLength a
  30
  31       fun incLength a = Int.inc (lengthRef a)
  32       fun decLength a = Int.dec (lengthRef a)
  33       fun maxIndex a = length a - 1
  34
  35       exception New = Array.New
  36
  37       fun empty () =
  38          T {array = ref (Array.new (1, NONE)),
  39            length = ref 0}
  40
  41       fun new (s, x) =
  42          if s = 0 then empty ()
  43          else T {array = ref (Array.new (1, SOME x)),
  44                 length = ref s}
  45       val array = new
  46
  47       fun tabulate (s, f) =
  48          if s = 0 then empty ()
  49          else T {array = ref (Array.tabulate (s, fn i => SOME (f i))),
  50                 length = ref s}
  51
  52       fun subSafe (a, i) =
  53          case Array.sub (getArray a, i) of
  54             SOME x => x
  55           | NONE => Error.bug "ResizableArray.subSafe"
  56
  57       fun sub (a, i) =
  58          if i < length a then subSafe (a, i)
  59          else Error.bug "ResizableArray.sub"
  60
  61       fun updateSafe (a, i, x) =
  62          Array.update (getArray a, i, SOME x)
  63
  64       fun update (a, i, x) =
  65          if i < length a then updateSafe (a, i, x)
  66          else Error.bug "ResizableArray.update"
  67
  68       fun fromList l =
  69          let val a = Array.fromList (List.map (l, SOME))
  70          in T {array = ref a,
  71               length = ref (Array.length a)}
  72          end
  73    end
  74
  75 structure A'' =
  76    Array (open A'
  77           val unsafeSub = sub
  78           val unsafeUpdate = update
  79           val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b t * 'a =
  80              fn (n, ac, f) =>
  81              let
  82                 val (arr, z) =
  83                    Array.unfoldi (n, ac, fn (i, a) =>
  84                                   let
  85                                      val (b, a') = f (i, a)
  86                                   in (SOME b, a')
  87                                   end)
  88              in
  89                 (T {array = ref arr,
  90                     length = ref n},
  91                  z)
  92              end)
  93
  94 open A' A''
  95
  96 fun subOption (a, i) =
  97    if i < length a
  98       then Array.sub (getArray a, i)
  99    else NONE
 100
 101 fun grow (a as T {array, ...}) =
 102    array := Array.tabulate (maxLength a * 2,
 103                        fn i => subOption (a, i))
 104
 105 fun shrink (a as T {array, ...}) =
 106    array := Array.tabulate (maxLength a div 2,
 107                        fn i => subOption (a, i))
 108
 109 fun addToEnd (a, x) =
 110    (if length a = maxLength a then grow a else ()
 111     ; updateSafe (a, length a, x)
 112     ; incLength a)
 113
 114 fun deleteLast a =
 115    if length a = 0
 116       then Error.bug "ResizableArray.deleteLast"
 117    else let val x = subSafe (a, maxIndex a)
 118         in (if length a = minLength a then shrink a else ()
 119             ; decLength a
 120             ; x)
 121         end
 122
 123 end
 124
 125 structure ResizableArray = ResizableArray ()