← Back to branch summary

~ubuntu-branches/debian/experimental/sks/experimental

« back to all changes in this revision

Viewing changes to fqueue.ml

  • Committer: Package Import Robot
  • Author(s): Daniel Kahn Gillmor
  • Date: 2013-06-27 16:39:02 UTC
  • mfrom: (1.1.4)
  • Revision ID: package-import@ubuntu.com-20130627163902-qqic4va2187boeji
Tags: 1.1.4-1
http://bugs.debian.org/690135
http://bugs.debian.org/709322
* New Upstream Release (Closes: #690135)
* added myself to Uploaders.
* convert to dh 9
* Standards-Version: bump to 3.9.4 (no changes needed)
* debian/rules: clean up
* refresh and clean up debian/patches
* switch packaging vcs to git
* avoid trying to upgrade DB_CONFIG (Closes: #709322)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fqueue.ml
1
 
(************************************************************************)
2
 
(* This file is part of SKS.  SKS is free software; you can
3
 
   redistribute it and/or modify it under the terms of the GNU General
4
 
   Public License as published by the Free Software Foundation; either
5
 
   version 2 of the License, or (at your option) any later version.
6
 
 
7
 
   This program is distributed in the hope that it will be useful, but
8
 
   WITHOUT ANY WARRANTY; without even the implied warranty of
9
 
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
10
 
   General Public License for more details.
11
 
 
12
 
   You should have received a copy of the GNU General Public License
13
 
   along with this program; if not, write to the Free Software
14
 
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
15
 
   USA *)
16
 
(***********************************************************************)
17
 
 
18
 
(** Simple implementation of a polymorphic functional queue *)
 
1
(***********************************************************************)
 
2
(* fqueue.ml - Simple implementation of a polymorphic functional queue *)
 
3
(*                                                                     *)
 
4
(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
 
5
(*               2011, 2012  Yaron Minsky and Contributors             *)
 
6
(*                                                                     *)
 
7
(* This file is part of SKS.  SKS is free software; you can            *)
 
8
(* redistribute it and/or modify it under the terms of the GNU General *)
 
9
(* Public License as published by the Free Software Foundation; either *)
 
10
(* version 2 of the License, or (at your option) any later version.    *)
 
11
(*                                                                     *)
 
12
(* This program is distributed in the hope that it will be useful, but *)
 
13
(* WITHOUT ANY WARRANTY; without even the implied warranty of          *)
 
14
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU   *)
 
15
(* General Public License for more details.                            *)
 
16
(*                                                                     *)
 
17
(* You should have received a copy of the GNU General Public License   *)
 
18
(* along with this program; if not, write to the Free Software         *)
 
19
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
 
20
(* USA or see <http://www.gnu.org/licenses/>.                          *)
 
21
(***********************************************************************)
 
22
 
19
23
open StdLabels
20
24
open MoreLabels
21
25
module Unix=UnixLabels
22
26
 
23
27
 
24
 
(** push and top are O(1).  
 
28
(** push and top are O(1).
25
29
   pop and take are O(1) amortized.
26
30
   to_list and length are O(n).
27
31
*)
28
32
 
29
 
(* Invariant:  
30
 
   if queue is not empty, outlist is not empty  
 
33
(* Invariant:
 
34
   if queue is not empty, outlist is not empty
31
35
   queue.length = List.length(queue.outlist) + List.length(queue.inlist)*)
32
36
 
33
37
exception Empty
34
38
 
35
39
type 'a t = { inlist: 'a list;
36
 
              outlist: 'a list;
37
 
              length: int;
38
 
            }
 
40
              outlist: 'a list;
 
41
              length: int;
 
42
            }
39
43
 
40
44
(*****************************************)
41
45
 
42
46
(*
43
 
let test_invariants queue = 
44
 
  assert 
45
 
    begin 
 
47
let test_invariants queue =
 
48
  assert
 
49
    begin
46
50
      queue.length = (List.length queue.outlist) + (List.length queue.inlist)
47
51
    end;
48
 
  assert 
49
 
    begin 
 
52
  assert
 
53
    begin
50
54
      (queue.length = 0) || List.length queue.outlist > 0
51
55
    end
52
56
*)
53
57
 
54
58
let empty = { inlist = [];
55
 
              outlist = [];
56
 
              length = 0;
57
 
            }
 
59
              outlist = [];
 
60
              length = 0;
 
61
            }
58
62
 
59
63
(*****************************************)
60
64
 
61
65
let push el queue =
62
66
  if queue.outlist = [] then
63
 
    let outlist = List.rev (el::queue.inlist) 
64
 
    in { inlist = []; 
65
 
         outlist = outlist;
66
 
         length = queue.length + 1;
 
67
    let outlist = List.rev (el::queue.inlist)
 
68
    in { inlist = [];
 
69
         outlist = outlist;
 
70
         length = queue.length + 1;
67
71
       }
68
72
  else
69
73
    { inlist = el::queue.inlist;
74
78
let enq = push
75
79
(*****************************************)
76
80
 
77
 
let top queue = 
 
81
let top queue =
78
82
  match queue.outlist with
79
 
      [] -> (if queue.inlist != [] 
80
 
             then failwith "FQueue.top: BUG. inlist should be empty but isn't"
81
 
             else raise Empty)
 
83
      [] -> (if queue.inlist != []
 
84
             then failwith "FQueue.top: BUG. inlist should be empty but isn't"
 
85
             else raise Empty)
82
86
    | hd::tl -> hd
83
87
 
84
88
(*****************************************)
85
89
 
86
90
let pop queue = match queue.outlist with
87
 
    hd::[] -> (hd, { inlist = []; 
88
 
                     outlist = (List.rev queue.inlist); 
89
 
                     length = queue.length - 1})
 
91
    hd::[] -> (hd, { inlist = [];
 
92
                     outlist = (List.rev queue.inlist);
 
93
                     length = queue.length - 1})
90
94
  | hd::tl -> (hd, { inlist = queue.inlist;
91
 
                     outlist = tl;
92
 
                     length = queue.length - 1;})
93
 
  | [] -> 
94
 
      if queue.inlist = [] 
 
95
                     outlist = tl;
 
96
                     length = queue.length - 1;})
 
97
  | [] ->
 
98
      if queue.inlist = []
95
99
      then raise Empty
96
100
      else (match List.rev queue.inlist with
97
 
                [] -> failwith "FQueue.top: BUG.  inlist should not be empty here"
98
 
              | hd::tl -> (hd, { inlist=[]; 
99
 
                                 outlist=tl; 
100
 
                                 length = queue.length - 1;
101
 
                               }))
 
101
                [] -> failwith "FQueue.top: BUG.  inlist should not be empty here"
 
102
              | hd::tl -> (hd, { inlist=[];
 
103
                                 outlist=tl;
 
104
                                 length = queue.length - 1;
 
105
                               }))
102
106
 
103
107
(*****************************************)
104
108
 
105
 
let discard queue = 
 
109
let discard queue =
106
110
  let (el,new_q) = pop queue in
107
111
    new_q
108
 
      
 
112
 
109
113
let deq = pop
110
114
 
111
115
(*****************************************)
112
116
 
113
 
let to_list queue = 
 
117
let to_list queue =
114
118
  queue.inlist @ (List.rev (queue.outlist))
115
119
 
116
 
(*****************************************)    
117
 
  
 
120
(*****************************************)
 
121
 
118
122
let length queue = queue.length
119
123
 
120
124
let is_empty queue = queue.length = 0