plist.sml

这是我们参加06年全国开源软件的竞赛作品

(* plist.sml
 *
 * COPYRIGHT (c) 1999 Bell Labs, Lucent Technologies.
 *
 * Property lists using Stephen Weeks's implementation.
 *)

structure PropList :> PROP_LIST =
  struct 

    type holder = exn list ref 

    fun newHolder() : holder = ref []

    fun clearHolder r = (r := [])

    fun sameHolder (r1 : holder, r2) = (r1 = r2)

    fun mkProp () = let
	  exception E of 'a 
	  fun cons (a, l) = E a :: l 
	  fun peek [] = NONE
	    | peek (E a :: _) = SOME a
	    | peek (_ :: l) = peek l
	  fun delete [] = []
	    | delete (E a :: r) = r
	    | delete (x :: r) = x :: delete r
	  in
	    { cons = cons, peek = peek, delete = delete }
	  end

    fun mkFlag () = let
	  exception E
	  fun peek [] = false
	    | peek (E :: _) = true
	    | peek (_ :: l) = peek l
	  fun set (l, flg) = let
		fun set ([], _) = if flg then E::l else l
		  | set (E::r, xs) = if flg then l else List.revAppend(xs, r)
		  | set (x::r, xs) = set (r, x::xs)
		in
		  set (l, [])
		end
	  in
	    { set = set, peek = peek }
	  end

    fun newProp (selHolder : 'a -> holder, init : 'a -> 'b) = let
	  val {peek, cons, delete} = mkProp() 
	  fun peekFn a = peek(!(selHolder a))
	  fun getF a = let
		val h = selHolder a
		in
		  case peek(!h)
		   of NONE => let val b = init a in h := cons(b, !h); b end
		    | (SOME b) => b
		  (* end case *)
		end
	  fun clrF a = let
		val h = selHolder a
		in
		  h := delete(!h)
		end
	  fun setFn (a, x) = let
		val h = selHolder a
		in
		  h := cons(x, delete(!h))
		end
	  in
	    {peekFn = peekFn, getFn = getF, clrFn = clrF, setFn = setFn}
	  end

    fun newFlag (selHolder : 'a -> holder) = let
	  val {peek, set} = mkFlag() 
	  fun getF a = peek(!(selHolder a))
	  fun setF (a, flg) = let
		val h = selHolder a
		in
		  h := set(!h, flg)
		end
	  in
	    {getFn = getF, setFn = setF}
	  end

  end