Commits

Yaron Minsky  committed eef43de

yet more small tweaks

  • Participants
  • Parent commits 3bf2ce9

Comments (0)

Files changed (5)

 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open StdLabels
-open MoreLabels
-open Printf
-module Unix = UnixLabels
-module Map = PMap.Map
-module Set = PSet.Set
+open Core.Std
 
 (** Argument parsing *)
 
 
 let dirname =
   Arg.parse parse_spec anon_options usage_string;
-  if List.length !anonymous <> 1
-  then (
+  match !anonymous with
+  | [x] -> Filename.concat x "messages"
+  | _ ->
     printf "Wrong number (%d) of arguments given.  %s\n"
-          (List.length !anonymous)
-          usage_string;
+      (List.length !anonymous)
+      usage_string;
     exit (-1)
-  ) else
-    Filename.concat (List.hd !anonymous) "messages"
 
 (** dumps contents of one file into another *)
 let pipe_file =
   pipe_file
 
 let run () =
-  if not (Sys.file_exists dirname)
-  then Unix.mkdir dirname 0o700;
+  (* create the directory if it doesn't exist *)
+  begin match Sys.file_exists dirname with
+  | `No -> Unix.mkdir dirname ~perm:0o700;
+  | `Yes -> ()
+  | `Unknown ->
+    failwithf "existence check of directory <%s> failed" dirname ()
+  end;
   let fname = sprintf "msg-%08d" (Random.int 100000000) in
   let fname = Filename.concat dirname fname in
   let f = open_out fname in
   pipe_file stdin f;
-  close_out f;
+  Out_channel.close f;
   Sys.rename fname (fname ^ ".ready")
 
 let () =

File bitstring.ml

 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open StdLabels
-open MoreLabels
-
-module Unix=UnixLabels
+open Core.Std
 
 exception Error of string
 exception LengthError of string

File build_all.sh

     ehandlers.cmo \
     prime.cmo \
     rMisc.cmo \
+    bitstring.cmo \
+    add_mail.cmo \
+    linearAlg.cmo \
+    decode_test.cmo \
 
 
 

File decode_test.ml

 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open StdLabels
-open MoreLabels
-open Printf
+open Common
+open Core.Std
 open Decode
-open Common
 open ZZp.Infix
-module ZSet = ZZp.Set
 
 let rand_int = Random.State.int RMisc.det_rng
 let rand_bits () = Random.State.bits RMisc.det_rng
 (*************************************************************************)
 (** Simple counter table *)
 
-let ctr_table = Hashtbl.create 0
+let ctr_table = String.Table.create ()
 
 let incr_count name =
-  try
-    let ctr_ref = Hashtbl.find ctr_table name in
-    incr ctr_ref
-  with
-      Not_found ->
-        Hashtbl.add ctr_table ~key:name ~data:(ref 1)
+  let count = Hashtbl.find_or_add ctr_table name ~default:(fun () -> ref 0) in
+  incr count
 
 let read_count name =
-  try !(Hashtbl.find ctr_table name)
-  with Not_found -> 0
+  match Hashtbl.find ctr_table name with
+  | Some x -> !x
+  | None -> 0
 
 (*************************************************************************)
 
   let num = rand_poly num_deg in
   let denom = rand_poly denom_deg in
   test "poly construction"
-    (Poly.degree num == num_deg && Poly.degree denom = denom_deg );
+    (Poly.degree num = num_deg
+     && Poly.degree denom = denom_deg );
 
   let mbar = rand_int 9 + 1 in
   let n = mbar + 1 in
 let set_init ~f n =
   let rec loop n set =
     if n = 0 then set
-    else loop (n - 1) (ZSet.add (f ()) set)
+    else loop (n - 1) (Set.add set (f ()))
   in
-  loop n ZSet.empty
+  loop n ZZp.Set.empty
 
 let ( &> ) f g x = f (g x)
 let ( &< ) g f x = f (g x)
   let set1 = set_init m1 ~f:(fun () -> ZZp.rand rand_bits) in
   let set2 = set_init m2 ~f:(fun () -> ZZp.rand rand_bits) in
   (* printf "mbar: %d, m: %d, m1: %d, m2: %d\n%!" mbar m m1 m2; *)
-  test "full sets" (ZSet.cardinal set1 = m1 && ZSet.cardinal set2 = m2);
-  test "empty intersection" (ZSet.is_empty @@ ZSet.inter set1 set2);
-  ZSet.iter ~f:(fun x -> ZZp.add_el ~svalues:svalues1 ~points x) set1;
-  ZSet.iter ~f:(fun x -> ZZp.add_el ~svalues:svalues2 ~points x) set2;
+  test "full sets" (Set.length set1 = m1 && Set.length set2 = m2);
+  test "empty intersection" (Set.is_empty @@ Set.inter set1 set2);
+  Set.iter set1 ~f:(fun x -> ZZp.add_el ~svalues:svalues1 ~points x);
+  Set.iter set2 ~f:(fun x -> ZZp.add_el ~svalues:svalues2 ~points x);
   let values = ZZp.mut_array_div svalues1 svalues2 in
   try
     let (diff1,diff2) =
       Decode.reconcile ~values ~points ~d:(m1 - m2)
     in
     test "size equality set1"
-      (ZSet.cardinal set1 = ZSet.cardinal diff1);
+      (Set.length set1 = Set.length diff1);
     test "size equality set2"
-      (ZSet.cardinal set2 = ZSet.cardinal diff2);
-    test "recon compare" (ZSet.equal diff1 set1 && ZSet.equal diff2 set2)
+      (Set.length set2 = Set.length diff2);
+    test "recon compare" (Set.equal diff1 set1 && Set.equal diff2 set2)
   with
       Low_mbar -> test "low mbar" (m > mbar)
 
 let factorization_test () =
   let deg = rand_int 10 + 1 in
-  let terms = Array.to_list (Array.init deg (fun _ -> rand_poly 1)) in
+  let terms = Array.to_list (Array.init deg ~f:(fun _ -> rand_poly 1)) in
   let poly = List.fold_left ~init:Poly.one ~f:Poly.mult terms in
   let roots = Decode.factor poly in
   let orig_roots =
     ZZp.zset_of_list (List.map ~f:(fun p -> ZZp.neg (Poly.to_array p).(0)) terms)
   in
-  test "factor equality" (ZSet.equal orig_roots roots)
+  test "factor equality" (Set.equal orig_roots roots)
 
 let interp_run () =
   let deg = rand_int 10 + 1 in
   let denom_deg = deg - num_deg in
   let num = rand_poly num_deg in
   let denom = rand_poly denom_deg in
-  if not (Poly.degree num == num_deg && Poly.degree denom = denom_deg )
+  if not (Poly.degree num = num_deg
+          && Poly.degree denom = denom_deg )
   then `poly_gen_falure (deg,num_deg,denom_deg,num,denom)
   else
 
 
 let run () =
   begin
-    for i = 1 to 100 do factorization_test () done;
-    for i = 1 to 100 do interp_test () done;
-    for i = 1 to 100 do reconcile_test () done;
+    for _i = 1 to 100 do factorization_test () done;
+    for _i = 1 to 100 do interp_test () done;
+    for _i = 1 to 100 do reconcile_test () done;
   end

File linearAlg.ml

 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open StdLabels
-open MoreLabels
-module Unix=UnixLabels
-open Printf
+open Core.Std
 open ZZp.Infix
 
 exception Bug of string
 
   type t = { columns: int;
              rows: int;
-             array: ZZp.zz array;
+             array: ZZp.t array;
            }
 
   let columns m = m.columns
   let copy m = { m with array = Array.copy m.array; }
 
   let make ~columns ~rows init =
-    let array = Array.create (columns * rows) init in
+    let array = Array.create ~len:(columns * rows) init in
     { columns = columns;
       rows = rows;
       array = array;
 
   type t = { columns: int;
              rows: int;
-             array: ZZp.zzref array;
+             array: ZZp.tref array;
            }
 
   let columns m = m.columns
     }
 
   let make ~columns ~rows x =
-    init ~columns ~rows ~f:(fun i j -> x)
+    init ~columns ~rows ~f:(fun _ _ -> x)
 
   let lget m i j =
     ZZp.look (m.array.(i + j * m.columns))
   with
       Exit -> ()
 
-let reduce m =
-  let (columns,rows) = Matrix.dims m in
-  if columns  < rows then raise (Bug "Matrix is too narrow to reduce");
-  for j = 0 to Matrix.rows m - 1 do
-    process_row m j;
-  done
-
-
 (****** Gaussian Reduction *****************)
 
 let process_row_forward m j =