Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * | |
4 | * MLton is released under a BSD-style license. | |
5 | * See the file MLton-LICENSE for details. | |
6 | *) | |
7 | ||
8 | functor CircularList(S: CIRCULAR_LIST_STRUCTS): CIRCULAR_LIST = | |
9 | struct | |
10 | ||
11 | open S | |
12 | ||
13 | type 'a t = 'a Elt.t Pointer.t | |
14 | ||
15 | val empty = Pointer.null | |
16 | ||
17 | fun makeEmpty p = Pointer.clear p | |
18 | ||
19 | fun isEmpty p = Pointer.isNull p | |
20 | ||
21 | fun isSingle p = | |
22 | case Pointer.follow p of | |
23 | NONE => false | |
24 | | SOME d => Elt.eqPrev(d, Elt.prev d) | |
25 | ||
26 | val first = Pointer.! | |
27 | ||
28 | fun insert(p,d) = | |
29 | case Pointer.follow p of | |
30 | SOME d' => Elt.insertR(d', d) | |
31 | | NONE => (Elt.link(d, d); Pointer.:=(p, d)) | |
32 | ||
33 | fun rotate p = | |
34 | case Pointer.follow p of | |
35 | SOME d => Pointer.:=(p, Elt.next d) | |
36 | | NONE => () | |
37 | ||
38 | fun deleteSafe(p, d) = | |
39 | (if Elt.eqPrev(Pointer.! p, d) | |
40 | then if isSingle p then makeEmpty p | |
41 | else Pointer.:=(p, Elt.next d) | |
42 | else () | |
43 | ; Elt.unlink d) | |
44 | ||
45 | fun delete(l, d) = | |
46 | if Elt.isLinked d then deleteSafe(l, d) | |
47 | else Error.bug "CircularList.delete" | |
48 | ||
49 | fun foreach(p, f) = | |
50 | if Pointer.isNull p then () | |
51 | else | |
52 | let | |
53 | val start = Pointer.! p | |
54 | fun foreach d = | |
55 | let val next = Elt.next d | |
56 | in (f d | |
57 | ; if Elt.eqPrev(start, next) | |
58 | then () | |
59 | else foreach next) | |
60 | end | |
61 | in foreach start | |
62 | end | |
63 | ||
64 | fun deleteEach(p, f) = foreach(p, fn d => (Elt.unlink d; f d)) | |
65 | ||
66 | fun splice(p, p') = | |
67 | if Pointer.isNull p then Pointer.copy(p, p') | |
68 | else if Pointer.isNull p' then () | |
69 | else let val e1 = Pointer.! p | |
70 | val e1' = Pointer.! p' | |
71 | val e2 = Elt.next e1 | |
72 | val e2' = Elt.next e1' | |
73 | in Elt.link(e1, e2') | |
74 | ; Elt.link(e1', e2) | |
75 | end | |
76 | ||
77 | end |