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

SCM Repository

[sml3d] View of /src/common/object-id-fn.sml
ViewVC logotype

View of /src/common/object-id-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 159 - (download) (annotate)
Tue Jun 3 13:52:52 2008 UTC (11 years, 4 months ago) by jhr
File size: 4046 byte(s)
  Added tracking of retained IDs
(* object-id-fn.sml
 *
 * COPYRIGHT (c) 2008 John Reppy (http://cs.uchicago.edu/~jhr)
 * All rights reserved.
 *
 * This functor provides common behavior for managing object IDs that are allocated
 * by the underlying C libraries (e.g., display lists, textures, shaders, ...).  The
 * goal is to prevent IDs from being used after they have been deleted and to support
 * finalization of IDs.
 *
 * TODO:
 *	implement finalization
 *	error checking on gen1 and genn calls
 *)

functor ObjectIdFn (

    val name : string

    eqtype id		(* Int32.int or Word32.word *)

    val toString : id -> string
    val hash : id -> word

    structure A : MONO_ARRAY where type elem = id

    val dummy : id	(* dummy value for array initialization *)
    val gen1 : id ref -> unit
    val genn : (Int32.int * A.array) -> unit
    val delete : (Int32.int * A.array) -> unit

  ) : sig

    exception InvalidObjectId

    eqtype id
    eqtype object_id

    val noId : object_id

    val gen : unit -> object_id
    val genList : int -> object_id list
    val deleteList : object_id list -> unit

  (* operations for tracking IDs that are live in the C library *)
    val retain : object_id -> unit (* mark object_id that is being retained by C *)
    val release : object_id -> unit (* release object_id that was retained *)
    val makeId : id -> object_id (* assumes that the ID is retained *)
    val retained : object_id -> bool (* returns true if the ID is retained *)

    val isValid : object_id -> bool
    val withId : object_id * (id -> 'a) -> 'a

  end = struct

    exception InvalidObjectId

    type id = id

    fun error (id, msg) = raise Fail(concat[name, " ", toString id, ": ", msg])

    datatype tracked_id = NoID | ID of {cnt : int, id : id}

  (* a tracked ID: the ref is set to NoID when the ID has been deleted, otherwise it is
   * ID{cnt, id}, where cnt is the number of times the ID is being retained by the
   * library.
   *)
    type object_id = tracked_id ref

    val noId = ref NoID

  (* a hash table mapping ids to object_ids *)
    structure Tbl = HashTableFn (
      struct
	type hash_key = id
	val hashVal = hash
	fun sameKey (x : id, y) = (x = y)
      end)

    val tbl : object_id Tbl.hash_table = Tbl.mkTable (128, Fail "IdTable")
    val findId = Tbl.find tbl
    val insertId = Tbl.insert tbl
    val removeId = ignore o (Tbl.remove tbl)
    val retained = Tbl.inDomain tbl

    fun mkObjectId id = ref(ID{cnt=0, id=id})

    fun gen () = let
	  val cell = ref dummy
	  in
	    gen1 cell;
	    mkObjectId(!cell)
	  end

    fun genList n = if (n < 0)
	  then raise Size
	  else if (n = 0) then []
	  else let
	    val arr = A.array(n, dummy)
	    in
	      genn (Int32.fromInt n, arr);
	      List.tabulate (n, fn i => mkObjectId(A.sub(arr, i)))
	    end

    fun deleteList [] = ()
      | deleteList l = let
	  val arr = A.array(List.length l, dummy)
	  fun extract ([], i) = i
	    | extract ((ref NoID)::r, i) = extract (r, i)
	    | extract ((objId as ref(ID{cnt, id}))::r, i) = (
		if (cnt > 0) then raise error(id, "deleting retained ID") else ();
		objId := NoID;
		A.update(arr, i, id);
		extract (r, i+1))
	  val n = extract (l, 0)
	  in
	    delete (Int32.fromInt n, arr)
	  end

  (* operations for tracking IDs that are live in the C library *)
    fun retain (objId as ref(ID{cnt, id})) = (
	  objId := ID{cnt=cnt+1, id=id};
	  insertId (id, objId))
      | retain _ = raise Fail(name ^ ": retain of deallocated ID")

    fun release (objId as ref(ID{cnt, id})) = (
	  if (cnt = 1) then removeId id else ();
	  objId := ID{cnt=cnt-1, id=id})
      | release _ = () (* this case should only happen when release is called on noId *)

    fun makeId id = (case findId id
	   of SOME objId => objId
	    | NONE => error(id, "makeId failed")
	  (* end case *))

    fun retained (ref(ID{cnt, ...})) = (cnt > 0)
      | retained _ = false

    fun isValid (ref NoID) = false
      | isValid _ = true

    fun withId (ref NoID, _) = raise InvalidObjectId
      | withId (ref(ID{id, ...}), f) = f id

  end

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