lib/mlton/basic/buffer.sml

   1 (* Copyright (C) 1999-2006 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 structure Buffer: BUFFER =
   9 struct
  10
  11 datatype 'a t = T of {dummy: 'a,
  12                       elts: 'a array ref,
  13                       length: int ref}
  14
  15 fun new {dummy} =
  16    T {dummy = dummy,
  17       elts = ref (Array.array (1, dummy)),
  18       length = ref 0}
  19
  20 fun length (T {length, ...}) = !length
  21
  22 fun reset (T {length, ...}) = length := 0
  23
  24 fun last (T {elts, length = ref n, ...}) =
  25    if 0 = n
  26       then NONE
  27    else SOME (Array.sub (!elts, n - 1))
  28
  29 val growFactor: int = 2
  30
  31 fun ensureFree (T {dummy, elts, length, ...}, amount: int): unit =
  32    let
  33       val maxLength = Array.length (!elts)
  34    in
  35       if amount <= maxLength - !length
  36          then ()
  37       else
  38          let
  39             val n = Int.max (maxLength * growFactor, !length + amount)
  40             val e = !elts
  41          in
  42             elts := Array.tabulate (n, fn i =>
  43                                     if i < maxLength
  44                                        then Array.sub (e, i)
  45                                     else dummy)
  46          end
  47    end
  48
  49 fun add (v as T {elts, length, ...}, e) =
  50    (ensureFree (v, 1)
  51     ; Array.update (!elts, !length, e)
  52     ; Int.inc length)
  53
  54 fun toVector (T {elts, length, ...}): 'a vector =
  55    let
  56       val elts = !elts
  57    in
  58       Vector.tabulate (!length, fn i => Array.sub (elts, i))
  59    end
  60
  61 fun layout layoutElt b = Vector.layout layoutElt (toVector b)
  62
  63 end