File: fun-queue.sml

package info (click to toggle)
mlton 20041109-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 18,212 kB
  • ctags: 58,085
  • sloc: ansic: 10,386; makefile: 1,178; sh: 1,139; pascal: 256; asm: 97
file content (96 lines) | stat: -rw-r--r-- 2,536 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
(* fun-queue.sml
 * 2004 Matthew Fluet (mfluet@acm.org)
 *  Ported to MLton threads.
 *)

structure FunQueue : FUN_QUEUE =
   struct
      datatype 'a t = T of {front: 'a list, back: 'a list}

      local
	 fun filterPrefix (xs, p) =
	    case xs of
	       [] => []
	     | y::ys => if p y
			  then filterPrefix (ys, p)
			  else xs
	 fun filter (xs, p) = List.filter (not o p) xs
	 fun filterRevAcc ((xs, zs), p) =
	    case xs of
	       [] => zs
	     | y::ys => if p y
			  then filterRevAcc ((ys, zs), p)
			  else filterRevAcc ((ys, y::zs), p)
	 fun filterRev (xs, p) = filterRevAcc ((xs, []), p)
      in
	 fun cleanPrefix (T {front, back}, p) =
	    (case filterPrefix (front, p) of
		[] => T {front = filterPrefix (List.rev(back), p),
			 back = []}
	      | front' =>  T {front = front',
			      back = back})
	 fun clean (T {front, back}, p) =
	    (case filter (front, p) of
		[] => T {front = filterRev (back, p),
			 back = []}
	      | front' =>  T {front = front',
			      back = filter (back, p)})
	 fun cleanAndDeque (T {front, back}, p) =
	    (case filter (front, p) of
		[] => (case filterRev(back, p) of
			  [] => (NONE,
				 T {front = [],
				    back = []})
			| x::front' => (SOME x,
					T {front = front',
					   back = []}))
	      | [x] => (SOME x,
			T {front = filterRev (back, p),
			   back = []})
	      | x::front' => (SOME x,
			      T {front = front',
				 back = filter (back, p)}))
      end

      fun deque (T {front, back}) =
	 (case front of
	     [] => (case back of
		       [] => NONE
		     | l => let val l = List.rev l
			    in 
			       case l of
				  [] => raise Fail "FunQueue.deque:impossible"
				| x::front' => 
				     SOME (x,
					   T {front = front',
					      back = []})
			    end)
	   | x::front' => SOME (x, T {front = front', back = back}))
			  
      fun empty (T {front, back}) =
	 (case front of
	     [] => (case back of
		       [] => true
		     | _ => false)
	   | _ => false)
	     
      fun enque (T {front, back, ...}, x) = 
	 T {front = front, back = x::back}

      fun enqueAndClean (q, y, p) =
	 clean (enque (q, y), p)

      fun new () = T {front = [], back = []}

      fun peek (T {front, back}) =
	 (case front of
	     [] => (case back of
		       [] => NONE
		     | l => let val l = List.rev l
			    in 
			       case l of
				  [] => raise Fail "FunQueue.peek:impossible"
				| x::_ => SOME x
			    end)
	   | x::_ => SOME x)
   end