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 /sml/branches/FLINT/src/comp-lib/ppqueue.sml
ViewVC logotype

Annotation of /sml/branches/FLINT/src/comp-lib/ppqueue.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 227 - (view) (download)

1 : monnier 89 (* ppqueue.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     signature PPQUEUE =
8 :     sig
9 :     type 'a queue
10 :     exception QUEUE_FULL
11 :     exception QUEUE_EMPTY
12 :     datatype Qend = Qback | Qfront
13 :     val is_empty : 'a queue -> bool
14 :     val mk_queue : int -> 'a -> 'a queue
15 :     val clear_queue : 'a queue -> unit
16 :     val queue_at : Qend -> 'a queue -> 'a
17 :     val en_queue : Qend -> 'a -> 'a queue -> unit
18 :     val de_queue : Qend -> 'a queue -> unit
19 :     end
20 :    
21 :     structure PPQueue: PPQUEUE =
22 :     struct
23 :    
24 :     open Array
25 :     infix 9 sub
26 :    
27 :     datatype Qend = Qfront | Qback
28 :    
29 :     exception QUEUE_FULL
30 :     exception QUEUE_EMPTY
31 :     exception REQUESTED_QUEUE_SIZE_TOO_SMALL
32 :    
33 :     fun ++ i n = (i + 1) mod n
34 :     fun -- i n = (i - 1) mod n
35 :    
36 :     abstype 'a queue = QUEUE of {elems: 'a array, (* the contents *)
37 :     front: int ref,
38 :     back: int ref,
39 :     size: int} (* fixed size of element array *)
40 :     with
41 :    
42 :     fun is_empty (QUEUE{front=ref ~1, back=ref ~1,...}) = true
43 :     | is_empty _ = false
44 :    
45 :     fun mk_queue n init_val =
46 :     if (n < 2)
47 :     then raise REQUESTED_QUEUE_SIZE_TOO_SMALL
48 :     else QUEUE{elems=array(n, init_val), front=ref ~1, back=ref ~1, size=n}
49 :    
50 :     fun clear_queue (QUEUE{front,back,...}) = (front := ~1; back := ~1)
51 :    
52 :     fun queue_at Qfront (QUEUE{elems,front,...}) = elems sub !front
53 :     | queue_at Qback (QUEUE{elems,back,...}) = elems sub !back
54 :    
55 :     fun en_queue Qfront item (Q as QUEUE{elems,front,back,size}) =
56 :     if (is_empty Q)
57 :     then (front := 0; back := 0;
58 :     update(elems,0,item))
59 :     else let val i = --(!front) size
60 :     in if (i = !back)
61 :     then raise QUEUE_FULL
62 :     else (update(elems,i,item); front := i)
63 :     end
64 :     | en_queue Qback item (Q as QUEUE{elems,front,back,size}) =
65 :     if (is_empty Q)
66 :     then (front := 0; back := 0;
67 :     update(elems,0,item))
68 :     else let val i = ++(!back) size
69 :     in if (i = !front)
70 :     then raise QUEUE_FULL
71 :     else (update(elems,i,item); back := i)
72 :     end
73 :    
74 :     fun de_queue Qfront (Q as QUEUE{front,back,size,...}) =
75 :     if (!front = !back) (* unitary queue *)
76 :     then clear_queue Q
77 :     else front := ++(!front) size
78 :     | de_queue Qback (Q as QUEUE{front,back,size,...}) =
79 :     if (!front = !back)
80 :     then clear_queue Q
81 :     else back := --(!back) size
82 :    
83 :     end (* abstype *)
84 :    
85 :     end (* structure PPQueue *)
86 :    
87 :     (*
88 : monnier 227 * $Log$
89 : monnier 89 *)

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