2 * 2004 Matthew
Fluet (mfluet@acm
.org
)
3 * Ported to MLton threads
.
6 structure ImpQueue
: IMP_QUEUE
=
8 datatype 'a t
= T
of {front
: 'a list ref
, back
: 'a list ref
}
11 fun filterPrefix (xs
, p
) =
15 then filterPrefix (ys
, p
)
17 fun filter (xs
, p
) = List.filter (not
o p
) xs
18 fun filterRevAcc ((xs
, zs
), p
) =
22 then filterRevAcc ((ys
, zs
), p
)
23 else filterRevAcc ((ys
, y
::zs
), p
)
24 fun filterRev (xs
, p
) = filterRevAcc ((xs
, []), p
)
26 fun cleanPrefix (T
{front
, back
}, p
) =
27 (Assert
.assertAtomic
' ("ImpQueue.cleanPrefix", NONE
)
28 ; case filterPrefix (!front
, p
) of
29 [] => (front
:= filterPrefix (List.rev(!back
), p
)
31 | front
' => front
:= front
')
32 fun clean (T
{front
, back
}, p
) =
33 (Assert
.assertAtomic
' ("ImpQueue.clean", NONE
)
34 ; case filter (!front
, p
) of
35 [] => (front
:= filterRev (!back
, p
)
37 | front
' => (front
:= front
'
38 ; back
:= filter (!back
, p
)))
39 fun cleanAndDeque (T
{front
, back
}, p
) =
40 (Assert
.assertAtomic
' ("ImpQueue.cleanAndDeque", NONE
)
41 ; case filter (!front
, p
) of
42 [] => (case filterRev(!back
, p
) of
46 | x
::front
' => (front
:= front
'
49 |
[x
] => (front
:= filterRev (!back
, p
)
52 | x
::front
' => (front
:= front
'
53 ; back
:= filter (!back
, p
)
57 fun deque (T
{front
, back
}) =
58 (Assert
.assertAtomic
' ("ImpQueue.deque", NONE
)
62 | l
=> let val l
= List.rev l
64 [] => raise Fail
"ImpQueue.deque:impossible"
70 | x
::front
' => (front
:= front
'; SOME x
))
72 fun empty (T
{front
, back
}) =
73 (Assert
.assertAtomic
' ("ImpQueue.empty", NONE
)
80 fun enque (T
{back
, ...}, x
) =
81 (Assert
.assertAtomic
' ("ImpQueue.enque", NONE
)
84 fun enqueAndClean (q
, y
, p
) =
85 (enque (q
, y
); clean (q
, p
))
87 fun new () = T
{front
= ref
[], back
= ref
[]}
89 fun peek (T
{front
, back
}) =
90 (Assert
.assertAtomic
' ("ImpQueue.peek", NONE
)
94 | l
=> let val l
= List.rev l
96 [] => raise Fail
"ImpQueue.peek:impossible"
104 fun reset (T
{front
, back
}) =
105 (Assert
.assertAtomic
' ("ImpQueue.reset", NONE
)
110 val clean
= fn arg
=> TimeIt
.timeit
"ImpQueue.clean" clean arg
111 val cleanAndDeque
= fn arg
=> TimeIt
.timeit
"ImpQueue.cleanAndDeque" cleanAndDeque arg
112 val cleanPrefix
= fn arg
=> TimeIt
.timeit
"ImpQueue.cleanPrefix" cleanPrefix arg
113 val deque
= fn arg
=> TimeIt
.timeit
"ImpQueue.deque" deque arg
114 val empty
= fn arg
=> TimeIt
.timeit
"ImpQueue.empty" empty arg
115 val enque
= fn arg
=> TimeIt
.timeit
"ImpQueue.enque" enque arg
116 val enqueAndClean
= fn arg
=> TimeIt
.timeit
"ImpQueue.enqueAndClean" enqueAndClean arg
117 val new
= fn arg
=> TimeIt
.timeit
"ImpQueue.new" new arg
118 val peek
= fn arg
=> TimeIt
.timeit
"ImpQueue.peek" peek arg
119 val reset
= fn arg
=> TimeIt
.timeit
"ImpQueue.reset" reset arg