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 2144 - (view) (download)

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 : jhr 816 fun hasProps (ref []) = false
16 :     | hasProps _ = true
17 :    
18 : monnier 467 fun clearHolder r = (r := [])
19 :    
20 : jhr 688 fun sameHolder (r1 : holder, r2) = (r1 = r2)
21 :    
22 : monnier 467 fun mkProp () = let
23 :     exception E of 'a
24 : jhr 688 fun cons (a, l) = E a :: l
25 : monnier 467 fun peek [] = NONE
26 :     | peek (E a :: _) = SOME a
27 :     | peek (_ :: l) = peek l
28 :     fun delete [] = []
29 :     | delete (E a :: r) = r
30 :     | delete (x :: r) = x :: delete r
31 :     in
32 :     { cons = cons, peek = peek, delete = delete }
33 :     end
34 :    
35 :     fun mkFlag () = let
36 :     exception E
37 :     fun peek [] = false
38 :     | peek (E :: _) = true
39 :     | peek (_ :: l) = peek l
40 :     fun set (l, flg) = let
41 :     fun set ([], _) = if flg then E::l else l
42 :     | set (E::r, xs) = if flg then l else List.revAppend(xs, r)
43 :     | set (x::r, xs) = set (r, x::xs)
44 :     in
45 :     set (l, [])
46 :     end
47 :     in
48 :     { set = set, peek = peek }
49 :     end
50 :    
51 :     fun newProp (selHolder : 'a -> holder, init : 'a -> 'b) = let
52 :     val {peek, cons, delete} = mkProp()
53 : monnier 475 fun peekFn a = peek(!(selHolder a))
54 : monnier 467 fun getF a = let
55 :     val h = selHolder a
56 :     in
57 :     case peek(!h)
58 :     of NONE => let val b = init a in h := cons(b, !h); b end
59 :     | (SOME b) => b
60 :     (* end case *)
61 :     end
62 :     fun clrF a = let
63 :     val h = selHolder a
64 :     in
65 :     h := delete(!h)
66 :     end
67 : jhr 688 fun setFn (a, x) = let
68 :     val h = selHolder a
69 :     in
70 :     h := cons(x, delete(!h))
71 :     end
72 : monnier 467 in
73 : jhr 688 {peekFn = peekFn, getFn = getF, clrFn = clrF, setFn = setFn}
74 : monnier 467 end
75 :    
76 :     fun newFlag (selHolder : 'a -> holder) = let
77 :     val {peek, set} = mkFlag()
78 :     fun getF a = peek(!(selHolder a))
79 :     fun setF (a, flg) = let
80 :     val h = selHolder a
81 :     in
82 :     h := set(!h, flg)
83 :     end
84 :     in
85 :     {getFn = getF, setFn = setF}
86 :     end
87 :    
88 :     end
89 :    

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