Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/smlnj-lib/Controls/control-set.sml
ViewVC logotype

View of /sml/trunk/src/smlnj-lib/Controls/control-set.sml

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1193 - (download) (annotate)
Thu May 16 18:44:04 2002 UTC (18 years, 11 months ago) by jhr
File size: 1599 byte(s)
  Bringing the Yale repository upto date (see CHANGES file for details).
(* control-set.sml
 * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies

structure ControlSet : CONTROL_SET =

    structure Rep = ControlReps
    structure ATbl = AtomTable

    type 'a control = 'a Controls.control
    type ('a, 'b) control_set = ('a, 'b) ControlReps.control_set

    fun new () = ATbl.mkTable (16, Fail "control set")

    fun member (cset, name) = (case ATbl.find cset name
	   of NONE => false
	    | _ => true
	  (* end case *))

    fun find (cset, name) = ATbl.find cset name

    fun insert (cset, ctl as Rep.Ctl{name, ...}, info) =
	  ATbl.insert cset (name, {ctl=ctl, info=info})

    fun remove (cset, name) = (case ATbl.find cset name
	   of NONE => ()
	    | _ => ignore (ATbl.remove cset name)
	  (* end case *))

    fun infoOf (cset : ('a, 'b) control_set) (Rep.Ctl{name, ...}) =
	  Option.map #info (ATbl.find cset name)

  (* list the members; the list is ordered by descreasing priority.  The
   * listControls' function allows one to specify an obscurity level; controls
   * with equal or higher obscurioty are omitted from the list.
      fun priorityOf {ctl=Rep.Ctl{priority, ...}, info} = priority
      fun gt (a, b) = Rep.priorityGT(priorityOf a, priorityOf b)
    fun listControls cset = ListMergeSort.sort gt (ATbl.listItems cset)

    fun listControls' (cset, obs) = let
	  fun add (item as {ctl=Rep.Ctl{obscurity, ...}, info}, l) =
		if (obs > obscurity)
		  then item::l
		  else l
	    ListMergeSort.sort gt (ATbl.fold add [] cset)
    end (* local *)

    fun app f cset = ATbl.app f cset


ViewVC Help
Powered by ViewVC 1.0.0