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

SCM Repository

[smlnj] Annotation of /smlnj-lib/trunk/Util/plist.sml
ViewVC logotype

Annotation of /smlnj-lib/trunk/Util/plist.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 467 - (view) (download)
Original Path: sml/trunk/src/smlnj-lib/Util/plist.sml

1 : monnier 467 (* plist.sml
2 :     *
3 :     * COPYRIGHT (c) 1999 Bell Labs, Lucent Technologies.
4 :     *
5 :     * Property lists using Stephen Weeks's implementation.
6 :     *)
7 :    
8 :     structure PropList :> PROP_LIST =
9 :     struct
10 :    
11 :     type holder = exn list ref
12 :    
13 :     fun newHolder() : holder = ref []
14 :    
15 :     fun clearHolder r = (r := [])
16 :    
17 :     fun mkProp () = let
18 :     exception E of 'a
19 :     fun cons(a, l) = E a :: l
20 :     fun peek [] = NONE
21 :     | peek (E a :: _) = SOME a
22 :     | peek (_ :: l) = peek l
23 :     fun delete [] = []
24 :     | delete (E a :: r) = r
25 :     | delete (x :: r) = x :: delete r
26 :     in
27 :     { cons = cons, peek = peek, delete = delete }
28 :     end
29 :    
30 :     fun mkFlag () = let
31 :     exception E
32 :     fun peek [] = false
33 :     | peek (E :: _) = true
34 :     | peek (_ :: l) = peek l
35 :     fun set (l, flg) = let
36 :     fun set ([], _) = if flg then E::l else l
37 :     | set (E::r, xs) = if flg then l else List.revAppend(xs, r)
38 :     | set (x::r, xs) = set (r, x::xs)
39 :     in
40 :     set (l, [])
41 :     end
42 :     in
43 :     { set = set, peek = peek }
44 :     end
45 :    
46 :     fun newProp (selHolder : 'a -> holder, init : 'a -> 'b) = let
47 :     val {peek, cons, delete} = mkProp()
48 :     fun getF a = let
49 :     val h = selHolder a
50 :     in
51 :     case peek(!h)
52 :     of NONE => let val b = init a in h := cons(b, !h); b end
53 :     | (SOME b) => b
54 :     (* end case *)
55 :     end
56 :     fun clrF a = let
57 :     val h = selHolder a
58 :     in
59 :     h := delete(!h)
60 :     end
61 :     in
62 :     {getFn = getF, clrFn = clrF}
63 :     end
64 :    
65 :     fun newFlag (selHolder : 'a -> holder) = let
66 :     val {peek, set} = mkFlag()
67 :     fun getF a = peek(!(selHolder a))
68 :     fun setF (a, flg) = let
69 :     val h = selHolder a
70 :     in
71 :     h := set(!h, flg)
72 :     end
73 :     in
74 :     {getFn = getF, setFn = setF}
75 :     end
76 :    
77 :     end
78 :    

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