# SCM Repository

# View of /sml/trunk/src/smlnj-lib/Util/plist.sml

Parent Directory | Revision Log

Revision

File size: 1893 byte(s)

**816**- (**download**) (**annotate**)*Fri May 4 16:37:36 2001 UTC*(18 years, 4 months ago) by*jhr*File size: 1893 byte(s)

Synchronizing with master repository.

(* 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 hasProps (ref []) = false | hasProps _ = true 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

root@smlnj-gforge.cs.uchicago.edu | ViewVC Help |

Powered by ViewVC 1.0.0 |