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

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