Home My Page Projects Code Snippets Project Openings 3D graphics for Standard ML
Summary Activity SCM

SCM Repository

[sml3d] View of /trunk/sml3d/src/raw-data/data-buffer.sml
ViewVC logotype

View of /trunk/sml3d/src/raw-data/data-buffer.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 849 - (download) (annotate)
Sat Apr 17 14:47:00 2010 UTC (9 years, 6 months ago) by jhr
File size: 20199 byte(s)
  Fixed type error on 64-bit builds
(* data-buffer.sml
 *
 * COPYRIGHT (c) 2010 John Reppy (http://cs.uchicago.edu/~jhr)
 * All rights reserved.
 *
 * This is an interface to arrays of scalar types that are allocated in the C heap.
 * It is designed to support the images, vertex arrays, draw buffers, etc.
 *
 * TODO:
 *    Think hard about memory management; we want finalization as a fallback to
 *    prevent space leaks, but we should also provide a reference-count-based
 *    mechanism for explicit memory management too.
 *
 *    Support buffer slices.
 *)

structure DataBuffer :> DATA_BUFFER =
  struct

    type float = Real32.real
    type double = Real64.real

    exception NullBuffer	(* raise when accessing a deleted buffer *)

    structure Ptr = CPtr
    structure PD = CPtrDiff
    structure Final = MLton.Finalizable

    fun deref ptr = let val ptr = !ptr in if (ptr = Ptr.null) then raise NullBuffer else ptr end

    type c_size = CSize.word

    datatype 'a buffer_rep = B of {
	size : c_size,			(* number of bytes in buffer *)
	len : c_size,			(* number of elements in buffer *)
	elemSz : c_size,		(* element size in bytes *)
	get : Ptr.t * PD.int -> 'a,	(* get an element *)
	set : Ptr.t * PD.int * 'a -> unit, (* set an element *)
	free : Ptr.t -> unit,		(* free the data *)
	data : Ptr.t ref		(* pointer to data in C heap *)
      }

    type 'a buffer = 'a buffer_rep Final.t
    type 'a buffer2 = ('a * 'a) buffer
    type 'a buffer3 = ('a * 'a * 'a) buffer
    type 'a buffer4 = ('a * 'a * 'a * 'a) buffer

  (* element types *)
    datatype 'a ty = TY of {
	elemSz : c_size,		(* element size in bytes (including all channels) *)
	get : Ptr.t * PD.int -> 'a,	(* get an element *)
	set : Ptr.t * PD.int * 'a -> unit (* set an element *)
      }

    fun sizeOf (TY{elemSz, ...}) = elemSz

    fun ty2 (TY{elemSz, get, set}) = TY{
	    elemSz = 0w2 * elemSz,
	    get = fn (p, i) => let
		    val j = i+i
		    in
		      (get(p, j), get(p, j+1))
		    end,
	    set = fn (p, i, (a, b)) => let
		    val j = i+i
		    in
		      set(p, j, a); set(p, j+1, b)
		    end
	  }
    fun ty3 (TY{elemSz, get, set}) = TY{
	    elemSz = 0w3 * elemSz,
	    get = fn (p, i) => let
		    val j = 3*i
		    in
		      (get(p, j), get(p, j+1), get(p, j+2))
		    end,
	    set = fn (p, i, (a, b, c)) => let
		    val j = 3*i
		    in
		      set(p, j, a); set(p, j+1, b); set(p, j+2, c)
		    end
	  }
    fun ty4 (TY{elemSz, get, set}) = TY{
	    elemSz = 0w4 * elemSz,
	    get = fn (p, i) => let
		    val j = 4*i
		    in
		      (get(p, j), get(p, j+1), get(p, j+2), get(p, j+3))
		    end,
	    set = fn (p, i, (a, b, c, d)) => let
		    val j = 4*i
		    in
		      set(p, j, a); set(p, j+1, b); set(p, j+2, c); set(p, j+3, d)
		    end
	  }

  (* fixed tys *)
    val tyb   = TY{elemSz = 0w1, get = Ptr.getInt8, set = Ptr.setInt8}
    val ty2b  = ty2 tyb
    val ty3b  = ty3 tyb
    val ty4b  = ty4 tyb
    val tyub  = TY{elemSz = 0w1, get = Ptr.getWord8, set = Ptr.setWord8}
    val ty2ub = ty2 tyub
    val ty3ub = ty3 tyub
    val ty4ub = ty4 tyub
    val tys   = TY{elemSz = 0w2, get = Ptr.getInt16, set = Ptr.setInt16}
    val ty2s  = ty2 tys
    val ty3s  = ty3 tys
    val ty4s  = ty4 tys
    val tyus  = TY{elemSz = 0w2, get = Ptr.getWord16, set = Ptr.setWord16}
    val ty2us = ty2 tyus
    val ty3us = ty3 tyus
    val ty4us = ty4 tyus
    val tyi   = TY{elemSz = 0w4, get = Ptr.getInt32, set = Ptr.setInt32}
    val ty2i  = ty2 tyi
    val ty3i  = ty3 tyi
    val ty4i  = ty4 tyi
    val tyui  = TY{elemSz = 0w4, get = Ptr.getWord32, set = Ptr.setWord32}
    val ty2ui = ty2 tyui
    val ty3ui = ty3 tyui
    val ty4ui = ty4 tyui
    val tyf   = TY{elemSz = 0w4, get = Ptr.getReal32, set = Ptr.setReal32}
    val ty2f  = ty2 tyf
    val ty3f  = ty3 tyf
    val ty4f  = ty4 tyf
    val tyd   = TY{elemSz = 0w8, get = Ptr.getReal64, set = Ptr.setReal64}
    val ty2d  = ty2 tyd
    val ty3d  = ty3 tyd
    val ty4d  = ty4 tyd

  (* a "cstruct" element type is a C struct type of some size and alignment; it is up to the
   * user to get these right!.  The only way to get/set values in a cstruct buffer is by using
   * the withPtr function.
   *)
    datatype cstruct = CSTRUCT (* phantom type *)
    fun tyStruct {szb, align} = TY{
	    elemSz = let val alignM1 = align - 0w1
		in
		  CSize.andb(szb + alignM1, CSize.notb alignM1)
		end,
	    get = fn _ => raise Fail "get on cstruct buffer",
	    set = fn _ => raise Fail "set on cstruct buffer"
	  }

    fun destroy (B{free, data, ...}) = if (!data = Ptr.null)
	  then ()
	  else (free (!data); data := Ptr.null)

  (* wrap pre-existing C data *)
    fun wrapCData free (TY{elemSz, get, set}, nelems, ptr) = let
	  val len = CSize.fromInt nelems
	  val nbytes = len * elemSz
	  val buf = Final.new(B{
		  size = nbytes, len = len, elemSz = elemSz,
		  get = get, set = set, free = free, data = ref ptr
		})
	  in
	    Final.addFinalizer (buf, destroy);
	    buf
	  end

    fun make {alloc, free} (TY{elemSz, get, set}, nelems) = if (nelems <= 0)
	  then raise Size
	  else let
	    val len = CSize.fromInt nelems
	    val nbytes = len * elemSz
	    val ptr = alloc nbytes
	    val buf = Final.new(B{
		    size = nbytes, len = len, elemSz = elemSz,
		    get = get, set = set, free = free, data = ref ptr
		  })
	    in
	      Final.addFinalizer (buf, destroy);
	      buf
	    end

    fun new (TY{elemSz, get, set}, nelems) = if (nelems <= 0)
	  then raise Size
	  else let
	    val len = CSize.fromInt nelems
	    val nbytes = len * elemSz
	    val ptr = CAlloc.malloc nbytes
	    val buf = Final.new(B{
		    size = nbytes, len = len, elemSz = elemSz,
		    get = get, set = set, free = CAlloc.free, data = ref ptr
		  })
	    in
	      Final.addFinalizer (buf, destroy);
	      buf
	    end

    fun delete buf = Final.withValue (buf, destroy)

    fun valid buf = Final.withValue (buf, fn (B{data, ...}) => (!data <> Ptr.null))

    fun length buf = Final.withValue (buf, fn (B{len, ...}) => CSize.toInt len)

    fun typeOf buf = Final.withValue (buf, fn (B{elemSz, get, set, ...}) => TY{
	    elemSz = elemSz,
	    get = get,
	    set = set
	  })

    fun getFn get (buf, i) = Final.withValue (buf, fn (B{len, data, ...}) => let
	  val data = deref data
	  in
	    if (CSize.<=(len, CSize.fromInt i)) then raise Subscript
	    else get(data, PD.fromInt i)
	  end)
    fun setFn (set : (Ptr.t * PD.int * 'a) -> unit) (buf, i, v) =
	  Final.withValue (buf, fn (B{len, data, ...}) => let
	    val data = deref data
	    in
	      if (CSize.<=(len, CSize.fromInt i)) then raise Subscript
	      else set(data, PD.fromInt i, v)
	    end)

    val getb  = getFn Ptr.getInt8
    val setb  = setFn Ptr.setInt8
    val getub = getFn Ptr.getWord8
    val setub = setFn Ptr.setWord8
    val gets  = getFn Ptr.getInt16
    val sets  = setFn Ptr.setInt16
    val getus = getFn Ptr.getWord16
    val setus = setFn Ptr.setWord16
    val geti  = getFn Ptr.getInt32
    val seti  = setFn Ptr.setInt32
    val getui = getFn Ptr.getWord32
    val setui = setFn Ptr.setWord32
    val getf  = getFn Ptr.getReal32
    val setf  = setFn Ptr.setReal32
    val getd  = getFn Ptr.getReal64
    val setd  = setFn Ptr.setReal64

    fun get2 get (ptr, i) = let
	  val j = i+i
	  in
	    (get(ptr, j), get(ptr, j+1))
	  end
    fun get2Fn get = getFn (get2 get)
    fun set2 (set : (Ptr.t * PD.int * 'a) -> unit) (ptr, i, (a, b)) = let
	  val j = i+i
	  in
	    set(ptr, j, a); set(ptr, j+1, b)
	  end
    fun set2Fn set = setFn (set2 set)

    val get2b  = get2Fn Ptr.getInt8
    val set2b  = set2Fn Ptr.setInt8
    val get2ub = get2Fn Ptr.getWord8
    val set2ub = set2Fn Ptr.setWord8
    val get2s  = get2Fn Ptr.getInt16
    val set2s  = set2Fn Ptr.setInt16
    val get2us = get2Fn Ptr.getWord16
    val set2us = set2Fn Ptr.setWord16
    val get2i  = get2Fn Ptr.getInt32
    val set2i  = set2Fn Ptr.setInt32
    val get2ui = get2Fn Ptr.getWord32
    val set2ui = set2Fn Ptr.setWord32
    val get2f  = get2Fn Ptr.getReal32
    val set2f  = set2Fn Ptr.setReal32
    val get2d  = get2Fn Ptr.getReal64
    val set2d  = set2Fn Ptr.setReal64

    fun get3 get (ptr, i) = let
	  val j = 3*i
	  in
	    (get(ptr, j), get(ptr, j+1), get(ptr, j+2))
	  end
    fun get3Fn get = getFn (get3 get)
    fun set3 (set : (Ptr.t * PD.int * 'a) -> unit) (ptr, i, (a, b, c)) = let
	  val j = 3*i
	  in
	    set(ptr, j, a); set(ptr, j+1, b); set(ptr, j+2, c)
	  end
    fun set3Fn set = setFn (set3 set)

    val get3b  = get3Fn Ptr.getInt8
    val set3b  = set3Fn Ptr.setInt8
    val get3ub = get3Fn Ptr.getWord8
    val set3ub = set3Fn Ptr.setWord8
    val get3s  = get3Fn Ptr.getInt16
    val set3s  = set3Fn Ptr.setInt16
    val get3us = get3Fn Ptr.getWord16
    val set3us = set3Fn Ptr.setWord16
    val get3i  = get3Fn Ptr.getInt32
    val set3i  = set3Fn Ptr.setInt32
    val get3ui = get3Fn Ptr.getWord32
    val set3ui = set3Fn Ptr.setWord32
    val get3f  = get3Fn Ptr.getReal32
    val set3f  = set3Fn Ptr.setReal32
    val get3d  = get3Fn Ptr.getReal64
    val set3d  = set3Fn Ptr.setReal64

    fun get4 get (ptr, i) = let
	  val j = 4*i
	  in
	    (get(ptr, j), get(ptr, j+1), get(ptr, j+2), get(ptr, j+3))
	  end
    fun get4Fn get = getFn (get4 get)
    fun set4 (set : (Ptr.t * PD.int * 'a) -> unit) (ptr, i, (a, b, c, d)) = let
	  val j = 4*i
	  in
	    set(ptr, j, a); set(ptr, j+1, b); set(ptr, j+2, c); set(ptr, j+3, d)
	  end
    fun set4Fn set = setFn (set4 set)

    val get4b  = get4Fn Ptr.getInt8
    val set4b  = set4Fn Ptr.setInt8
    val get4ub = get4Fn Ptr.getWord8
    val set4ub = set4Fn Ptr.setWord8
    val get4s  = get4Fn Ptr.getInt16
    val set4s  = set4Fn Ptr.setInt16
    val get4us = get4Fn Ptr.getWord16
    val set4us = set4Fn Ptr.setWord16
    val get4i  = get4Fn Ptr.getInt32
    val set4i  = set4Fn Ptr.setInt32
    val get4ui = get4Fn Ptr.getWord32
    val set4ui = set4Fn Ptr.setWord32
    val get4f  = get4Fn Ptr.getReal32
    val set4f  = set4Fn Ptr.setReal32
    val get4d  = get4Fn Ptr.getReal64
    val set4d  = set4Fn Ptr.setReal64

  (* linear interpolation *)
    local
      fun lerp (f, get, put : Ptr.t * PD.int * 'a -> unit) = let
	    fun lerp' {a, t, b, dst} =
		  Final.withValue (a, fn (B{len=aLen, data=aData, ...}) =>
		  Final.withValue (b, fn (B{len=bLen, data=bData, ...}) =>
		  Final.withValue (dst, fn (B{len, data, ...}) => let
		    val aData = deref aData
		    val bData = deref bData
		    val data = deref data
		    in
		      if (aLen <> bLen) orelse (bLen <> len)
			then raise Size
			else let
			  val len = PD.fromLarge(CSize.toLargeIntX len)
			  fun lp i = if (i < len)
				then (put(data, i, f(get(aData, i), t, get(bData, i))); lp(i+1))
				else ()
			  in
			    lp 0
			  end
		    end)))
	    in
	      lerp'
	    end
    fun lerp1 (v1, t : float, v2) = (1.0-t)*v1 + t*v2
    fun lerp2 ((x1, y1), t : float, (x2, y2)) = let
	  val t' = 1.0 - t
	  in
	    (t'*x1 + t*x2, t'*y1 + t*y2)
	  end
    fun lerp3 ((x1, y1, z1), t : float, (x2, y2, z2)) = let
	  val t' = 1.0 - t
	  in
	    (t'*x1 + t*x2, t'*y1 + t*y2, t'*z1 + t*z2)
	  end
    fun lerp4 ((x1, y1, z1, w1), t : float, (x2, y2, z2, w2)) = let
	  val t' = 1.0 - t
	  in
	    (t'*x1 + t*x2, t'*y1 + t*y2, t'*z1 + t*z2, t'*w1 + t*w2)
	  end
    in
    val lerpf  = lerp (lerp1, Ptr.getReal32, Ptr.setReal32)
    val lerp2f = lerp (lerp2, get2 Ptr.getReal32, set2 Ptr.setReal32)
    val lerp3f = lerp (lerp3, get3 Ptr.getReal32, set3 Ptr.setReal32)
    val lerp4f = lerp (lerp4, get4 Ptr.getReal32, set4 Ptr.setReal32)
    end (* local *)

(* NOTE: we probably need to add reference counting to make this work,
 * since there are two views of the same underlying data.
 *)
(*
  (* return a flat view of a buffer *)
    local
      fun flat2 (get, set) buf = Final.withValue (buf,
	    fn (B{size, len, elemSz, free, data, ...}) => B{
		size = size, len = 0w2*len, elemSz = len div 0w2,
		get = get, set = set, free = free,
		data = data
	      })
    in
    val flat2b  = flat2 (Ptr.getInt8,   Ptr.setInt8)
    val flat2ub = flat2 (Ptr.getWord8,  Ptr.setWord8)
    val flat2s  = flat2 (Ptr.getInt16,  Ptr.setInt16)
    val flat2us = flat2 (Ptr.getWord16, Ptr.setWord16)
    val flat2i  = flat2 (Ptr.getInt32,  Ptr.setInt32)
    val flat2ui = flat2 (Ptr.getWord32, Ptr.setWord32)
    val flat2f  = flat2 (Ptr.getReal32, Ptr.setReal32)
    val flat2d  = flat2 (Ptr.getReal64, Ptr.setReal64)
    end (* local *)

    local
      fun flat3 (get, set) buf = Final.withValue (buf,
	    fn (B{size, len, elemSz, free, data, ...}) => B{
		size = size, len = 0w3*len, elemSz = len div 0w3,
		get = get, set = set, free = free,
		data = data
	      })
    in
    val flat3b  = flat3 (Ptr.getInt8,   Ptr.setInt8)
    val flat3ub = flat3 (Ptr.getWord8,  Ptr.setWord8)
    val flat3s  = flat3 (Ptr.getInt16,  Ptr.setInt16)
    val flat3us = flat3 (Ptr.getWord16, Ptr.setWord16)
    val flat3i  = flat3 (Ptr.getInt32,  Ptr.setInt32)
    val flat3ui = flat3 (Ptr.getWord32, Ptr.setWord32)
    val flat3f  = flat3 (Ptr.getReal32, Ptr.setReal32)
    val flat3d  = flat3 (Ptr.getReal64, Ptr.setReal64)
    end (* local *)

    local
      fun flat4 (get, set) buf = Final.withValue (buf,
	    fn (B{size, len, elemSz, free, data, ...}) => B{
		size = size, len = 0w4*len, elemSz = len div 0w4,
		get = get, set = set, free = free,
		data = data
	      })
    in
    val flat4b  = flat4 (Ptr.getInt8,   Ptr.setInt8)
    val flat4ub = flat4 (Ptr.getWord8,  Ptr.setWord8)
    val flat4s  = flat4 (Ptr.getInt16,  Ptr.setInt16)
    val flat4us = flat4 (Ptr.getWord16, Ptr.setWord16)
    val flat4i  = flat4 (Ptr.getInt32,  Ptr.setInt32)
    val flat4ui = flat4 (Ptr.getWord32, Ptr.setWord32)
    val flat4f  = flat4 (Ptr.getReal32, Ptr.setReal32)
    val flat4d  = flat4 (Ptr.getReal64, Ptr.setReal64)
    end (* local *)
*)


  (* polymorphic operations on buffers *)

    fun size2ptrdiff w = PD.fromLarge(CSize.toLargeIntX w)
    fun size2int w = Int.fromLarge(CSize.toLargeIntX w)

    fun get (buf, i) = Final.withValue (buf, fn (B{len, data, get=g, ...}) => let
	  val p = deref data
	  in
	    if (CSize.<=(len, CSize.fromInt i)) then raise Subscript
	    else g(p, PD.fromInt i)
	  end)

    fun set (buf, i, v) = Final.withValue (buf, fn (B{len, data, set=s, ...}) => let
	  val p = deref data
	  in
	    if (CSize.<=(len, CSize.fromInt i)) then raise Subscript
	    else s(p, PD.fromInt i, v)
	  end)

    fun update (buf, i, f) = Final.withValue (buf, fn (B{len, data, get, set, ...}) => let
	  val p = deref data
	  in
	    if (CSize.<=(len, CSize.fromInt i)) then raise Subscript
	    else set(p, PD.fromInt i, f(get(!data, PD.fromInt i)))
	  end)

    fun app (f : 'a -> unit) buf = Final.withValue (buf, fn (B{len, data, get, ...}) => let
	  val len = size2ptrdiff len
	  val p = deref data
	  fun appf i = if (i < len) then (f(get(p, i)); appf (i+1)) else ()
	  in
	    appf 0
	  end)

    fun appi (f : (int * 'a) -> unit) buf = Final.withValue (buf, fn (B{len, data, get, ...}) => let
	  val len = size2ptrdiff len
	  val p = deref data
	  fun appf i = if (i < len) then (f(PD.toInt i, get(p, i)); appf (i+1)) else ()
	  in
	    appf 0
	  end)

    fun foldl f init buf = Final.withValue (buf, fn (B{len, data, get, ...}) => let
	  val len = size2ptrdiff len
	  val p = deref data
	  fun fold (i, acc) = if (i < len) then fold (i+1, f(get(p, i), acc)) else acc
	  in
	    fold (0, init)
	  end)

    fun foldr f init buf = Final.withValue (buf, fn (B{len, data, get, ...}) => let
	  val len = size2ptrdiff len
	  val p = deref data
	  fun fold (i, acc) = if (0 <= i) then fold (i-1, f(get(p, i), acc)) else acc
	  in
	    fold (len-1, init)
	  end)

    fun modify f buf = Final.withValue (buf, fn (B{len, data, get, set, ...}) => let
	  val len = size2ptrdiff len
	  val p = deref data
	  fun modifyf i = if (i < len) then (set(p, i, f(get(p, i))); modifyf (i+1)) else ()
	  in
	    modifyf 0
	  end)

    fun modifyi f buf = Final.withValue (buf, fn (B{len, data, get, set, ...}) => let
	  val len = size2ptrdiff len
	  val p = deref data
	  fun modifyf i = if (i < len)
		then (set(p, i, f(PD.toInt i, get(p, i))); modifyf (i+1))
		else ()
	  in
	    modifyf 0
	  end)

    fun init (buf, f) = Final.withValue (buf, fn (B{len, data, set, ...}) => let
	  val len = size2ptrdiff len
	  val p = deref data
	  fun tabf i = if (i < len) then (set(p, i, f(PD.toInt i)); tabf (i+1)) else ()
	  in
	    tabf 0
	  end)

  (* moving data in and out of SML *)
    fun mapToVector (buf, cvt) = Final.withValue (buf, fn (B{len, data, get, ...}) => let
	  val p = deref data
	  in
	    Vector.tabulate (size2int len, fn i => cvt(get(p, PD.fromInt i)))
	  end)

    fun mapToArray (buf, cvt) = Final.withValue (buf, fn (B{len, data, get, ...}) => let
	  val p = deref data
	  in
	    Array.tabulate (size2int len, fn i => cvt(get(p, PD.fromInt i)))
	  end)
  
    fun mapFromVector cvt (v, buf) = Final.withValue (buf, fn (B{len, data, set, ...}) => let
	  val p = deref data
	  in
	    if (size2int len <> Vector.length v) then raise Subscript
	    else Vector.appi (fn (i, x) => set(p, PD.fromInt i, cvt x)) v
	  end)

    fun mapFromArray cvt (v, buf) = Final.withValue (buf, fn (B{len, data, set, ...}) => let
	  val p = deref data
	  in
	    if (size2int len <> Array.length v) then raise Subscript
	    else Array.appi (fn (i, x) => set(p, PD.fromInt i, cvt x)) v
    	  end)

    fun copyFromVector (v, buf) = Final.withValue (buf, fn (B{len, data, set, ...}) => let
	  val p = deref data
	  in
	    if (size2int len <> Vector.length v) then raise Subscript
	    else Vector.appi (fn (i, x) => set(p, PD.fromInt i, x)) v
    	  end)

    fun copyFromArray (v, buf) = Final.withValue (buf, fn (B{len, data, set, ...}) => let
	  val p = deref data
	  in
	    if (size2int len <> Array.length v) then raise Subscript
	    else Array.appi (fn (i, x) => set(p, PD.fromInt i, x)) v
    	  end)

    fun fromVector sz v = let
	  val buf = new (sz, Vector.length v)
	  in
	    copyFromVector (v, buf);
	    buf
	  end

    fun fromArray sz arr = let
	  val buf = new (sz, Array.length arr)
	  in
	    copyFromArray (arr, buf);
	    buf
	  end

    fun tabulate (ty, len, f) = let
	  val buf = new (ty, len)
	  in
	    init (buf, f);
	    buf
	  end

  (* support for passing buffers to C code *)
    fun withPtr (buf, f) =
	  Final.withValue (buf, fn (B{data, size, elemSz, ...}) => let
	    val p = deref data
	    in
	      f{data = p, szb=size, elemSzb=elemSz}
	    end)

    val touch = Final.touch

  (* apply an operation to a given element in a cstruct buffer *)

  (* operations on C struct buffers *)
    structure CStruct =
      struct

      (* compute the pointer offset for a given index *)
	fun addrOf elemSz (p, i) =
	      Ptr.add (p, size2ptrdiff(CSize.fromInt i * elemSz))

      (* apply an operation to a given element in a cstruct buffer *)
	fun withElemPtr (buf, f) i =
	      Final.withValue (buf, fn (B{data, size, elemSz, ...}) => let
		val p = deref data
		val addrOf = addrOf elemSz
		in
		  f (addrOf (p, i))
		end)

      (* apply an operation to every element of a cstruct buffer *)
	fun app (f : Ptr.t -> unit) buf =
	      Final.withValue (buf, fn (B{len, data, elemSz, ...}) => let
		val len = CSize.toInt len
		val p = deref data
		val addrOf = addrOf elemSz
		fun appf i = if (i < len) then (f(addrOf(p, i)); appf (i+1)) else ()
		in
		  appf 0
		end)

	fun appi (f : (int * Ptr.t) -> unit) buf =
	      Final.withValue (buf, fn (B{len, data, elemSz, ...}) => let
		val len = CSize.toInt len
		val p = deref data
		val addrOf = addrOf elemSz
		fun appf i = if (i < len) then (f(i, addrOf(p, i)); appf (i+1)) else ()
		in
		  appf 0
		end)

	fun foldl f init buf =
	      Final.withValue (buf, fn (B{len, data, elemSz, ...}) => let
		val len = size2int len
		val p = deref data
		val addrOf = addrOf elemSz
		fun fold (i, acc) = if (i < len) then fold (i+1, f(addrOf(p, i), acc)) else acc
		in
		  fold (0, init)
		end)
    
	fun foldr f init buf =
	      Final.withValue (buf, fn (B{len, data, elemSz, ...}) => let
		val len = size2int len
		val p = deref data
		val addrOf = addrOf elemSz
		fun fold (i, acc) = if (0 <= i) then fold (i-1, f(addrOf(p, i), acc)) else acc
		in
		  fold (len-1, init)
		end)

      end

  end


root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0