Permalink
Browse files

make it more interesting with a combination of functors and objects

  • Loading branch information...
1 parent 626a4d9 commit 579aae7778f732345d3b67f70ce770bf595ba936 romain committed Dec 8, 2011
Showing with 323 additions and 263 deletions.
  1. +2 −0 .gitignore
  2. +140 −140 algo.ml
  3. +12 −0 compile.sh
  4. +25 −0 hash.ml
  5. +1 −0 report.sh
  6. +120 −109 signature.ml
  7. +6 −3 syncer.ml
  8. +17 −11 test.ml
View
@@ -2,6 +2,8 @@
*.*~
bisect*.out
+syncer.native
+syncer.byte
_build/
coverage/
View
@@ -1,13 +1,10 @@
-module Weak = Adler
-module Strong = Digest
-
type action =
| Match of int * int
| Miss of Buffer.t
| Start of int
| Stop
-
+
let output_action oc = function
| Match (b,e) ->
Io.write_byte oc 1;
@@ -20,7 +17,7 @@ let output_action oc = function
Io.write_byte oc 3;
Io.write_int oc s
| Stop -> Io.write_byte oc 4
-
+
let input_action ic =
match input_byte ic with
| 1 ->
@@ -37,144 +34,147 @@ let input_action ic =
Start s
| 4 -> Stop
| _ -> failwith "unknown action"
-
+
+open Hash
open Signature
+module Rsync = functor (W:WEAK) -> functor (S:STRONG) -> struct
+ module MySig = Signature(W)(S)
-
-class delta_emitter signature new_fn handler =
- let bs = signature.bs in
- let buffer_size = 8 * bs in
- let buffer = String.create buffer_size in
-object(self)
- val mutable _read = 0
- val mutable _first_free = 0
- val mutable _n_free = buffer_size
- val mutable _first_todo = 0
- val mutable _previous_action = Start bs
- val mutable _finished = false
- val mutable _weak_ok = false
- val _weak = Weak.make ()
-
- method _examine_block buffer offset length =
- let wd = Weak.digest _weak in
- match lookup_weak signature wd with
- | None -> None
- | Some block ->
- let strong = Strong.substring buffer offset length in
- if strong = block.strong
- then Some block.index
- else None
-
- method _miss char =
- match _previous_action with
- | Miss b when Buffer.length b < bs -> Buffer.add_char b char
- | other ->
- let () = handler _previous_action in
- let b = Buffer.create bs in
- let () = Buffer.add_char b char in
- _previous_action <- Miss b
-
- method _match index =
- match _previous_action with
- | Match (b,e) when e + 1 = index -> _previous_action <- Match(b,index)
- | other -> let () = handler _previous_action in
- _previous_action <- Match(index,index)
-
- method run () =
- let ic = open_in new_fn in
- while not _finished do
- begin
- let read = input ic buffer _first_free _n_free in
- if read = 0 then
- _finished <- true
- else
- let () = _first_free <- _first_free + read in
- let () = _n_free <- _n_free - read in
- ()
- end;
- while _first_todo + bs < _first_free do
- if not _weak_ok then
+ class delta_emitter signature new_fn handler =
+ let bs = MySig.block_size signature in
+ let buffer_size = 8 * bs in
+ let buffer = String.create buffer_size in
+ object(self)
+ val mutable _read = 0
+ val mutable _first_free = 0
+ val mutable _n_free = buffer_size
+ val mutable _first_todo = 0
+ val mutable _previous_action = Start bs
+ val mutable _finished = false
+ val mutable _weak_ok = false
+ val _weak = W.make ()
+
+ method _examine_block buffer offset length =
+ let wd = W.digest _weak in
+ match MySig.lookup_weak signature wd with
+ | None -> None
+ | Some bs ->
+ let strong = S.substring buffer offset length in
+ if strong = MySig.bs_strong bs
+ then Some (MySig.bs_index bs)
+ else None
+
+ method _miss char =
+ match _previous_action with
+ | Miss b when Buffer.length b < bs -> Buffer.add_char b char
+ | other ->
+ let () = handler _previous_action in
+ let b = Buffer.create bs in
+ let () = Buffer.add_char b char in
+ _previous_action <- Miss b
+
+ method _match index =
+ match _previous_action with
+ | Match (b,e) when e + 1 = index -> _previous_action <- Match(b,index)
+ | other -> let () = handler _previous_action in
+ _previous_action <- Match(index,index)
+
+ method run () =
+ let ic = open_in new_fn in
+ while not _finished do
+ begin
+ let read = input ic buffer _first_free _n_free in
+ if read = 0 then
+ _finished <- true
+ else
+ let () = _first_free <- _first_free + read in
+ let () = _n_free <- _n_free - read in
+ ()
+ end;
+ while _first_todo + bs < _first_free do
+ if not _weak_ok then
+ begin
+ W.update _weak buffer _first_todo bs;
+ _weak_ok <- true
+ end;
begin
- Weak.update _weak buffer _first_todo bs;
- _weak_ok <- true
- end;
- begin
- match self # _examine_block buffer _first_todo bs with
- | None ->
- self # _miss buffer.[_first_todo];
- Weak.rotate _weak buffer.[_first_todo] buffer.[_first_todo + bs];
- _first_todo <- _first_todo + 1
- | Some i ->
- self # _match i;
- _first_todo <- _first_todo + bs;
- _weak_ok <- false;
- Weak.reset _weak
- end
+ match self # _examine_block buffer _first_todo bs with
+ | None ->
+ self # _miss buffer.[_first_todo];
+ W.rotate _weak buffer.[_first_todo] buffer.[_first_todo + bs];
+ _first_todo <- _first_todo + 1
+ | Some i ->
+ self # _match i;
+ _first_todo <- _first_todo + bs;
+ _weak_ok <- false;
+ W.reset _weak
+ end
+ done;
+ if _first_todo + bs >= _first_free
+ then
+ begin
+ let length = _first_free - _first_todo in
+ String.blit buffer _first_todo buffer 0 length;
+ _first_todo <- 0;
+ _first_free <- length;
+ _n_free <- buffer_size - length
+ end
done;
- if _first_todo + bs >= _first_free
- then
- begin
- let length = _first_free - _first_todo in
- String.blit buffer _first_todo buffer 0 length;
- _first_todo <- 0;
- _first_free <- length;
- _n_free <- buffer_size - length
- end
- done;
- let rec loop i =
- if i = _first_free
- then ()
- else
- let () = self # _miss (buffer.[i]) in
- loop (i+1)
- in
- loop _first_todo;
- handler _previous_action;
- handler Stop;
- close_in ic
-end
-
-
-class delta_applier ic (old_fn:string) oc =
- let fd = Unix.openfile old_fn [Unix.O_RDONLY] 0o640 in
- let really_read buffer bs =
- let rec loop pos todo =
- if todo = 0 then ()
- else
- let read = Unix.read fd buffer pos todo in
- loop (pos+ read) (todo - read)
- in
- loop 0 bs
- in
-object(self)
- method run () =
- let bs = match input_action ic with
- | Start s -> s
- | _ -> failwith "start @ beginning"
- in
- let rec loop () =
- let action = input_action ic in
- match action with
- | Match(b,e) -> self # apply_match bs b e ; loop ()
- | Miss b -> self # apply_miss b ; loop ()
- | Start s -> failwith "can't restart"
- | Stop -> ()
- in
- loop ();
- Unix.close fd
-
- method apply_match bs b e =
- let buffer = String.create bs in
- let n = e + 1 - b in
- let rec loop i =
- if i = 0 then ()
- else
- let () = really_read buffer bs in
- let () = output_string oc buffer in
- loop (i-1)
+ let rec loop i =
+ if i = _first_free
+ then ()
+ else
+ let () = self # _miss (buffer.[i]) in
+ loop (i+1)
+ in
+ loop _first_todo;
+ handler _previous_action;
+ handler Stop;
+ close_in ic
+ end
+
+
+ class delta_applier ic (old_fn:string) oc =
+ let fd = Unix.openfile old_fn [Unix.O_RDONLY] 0o640 in
+ let really_read buffer bs =
+ let rec loop pos todo =
+ if todo = 0 then ()
+ else
+ let read = Unix.read fd buffer pos todo in
+ loop (pos+ read) (todo - read)
+ in
+ loop 0 bs
in
- let _ = Unix.lseek fd (bs * b) Unix.SEEK_SET in
- loop n
-
- method apply_miss b = output_string oc (Buffer.contents b)
+ object(self)
+ method run () =
+ let bs = match input_action ic with
+ | Start s -> s
+ | _ -> failwith "start @ beginning"
+ in
+ let rec loop () =
+ let action = input_action ic in
+ match action with
+ | Match(b,e) -> self # apply_match bs b e ; loop ()
+ | Miss b -> self # apply_miss b ; loop ()
+ | Start s -> failwith "can't restart"
+ | Stop -> ()
+ in
+ loop ();
+ Unix.close fd
+
+ method apply_match bs b e =
+ let buffer = String.create bs in
+ let n = e + 1 - b in
+ let rec loop i =
+ if i = 0 then ()
+ else
+ let () = really_read buffer bs in
+ let () = output_string oc buffer in
+ loop (i-1)
+ in
+ let _ = Unix.lseek fd (bs * b) Unix.SEEK_SET in
+ loop n
+
+ method apply_miss b = output_string oc (Buffer.contents b)
+ end
end
View
@@ -0,0 +1,12 @@
+#ocamlbuild -use-ocamlfind test.native
+
+ocamlbuild -use-ocamlfind \
+ -tag 'package(bisect)' \
+ -tag 'syntax(camlp4o)' \
+ -tag 'syntax(bisect_pp)' \
+ syncer.byte
+
+#ocamlbuild -use-ocamlfind -tag 'package(ocamlviz)' \
+# -tag 'pp(camlp4 pa_o.cmo str.cma pa_ocamlviz.cmo pr_o.cmo)' \
+# profile_test.native
+
View
@@ -0,0 +1,25 @@
+module type WEAK = sig
+ type t
+ val make : unit -> t
+ val from : string -> int -> int -> t
+ val reset: t -> unit
+ val digest: t -> int
+ val rotate: t -> char -> char -> unit
+ val update: t -> string -> int -> int -> unit
+end
+
+module type STRONG = sig
+ type t
+ val to_hex : t -> string
+ val file : string -> t
+ val substring: string -> int -> int -> t
+ val write : out_channel -> t -> unit
+ val read : in_channel -> t
+end
+
+module SDigest = (struct
+ include Digest
+ let read ic = Io.read_string ic
+ let write oc t = Io.write_string oc t
+
+end : STRONG)
View
@@ -0,0 +1 @@
+bisect-report -I _build -html coverage $1
Oops, something went wrong.

0 comments on commit 579aae7

Please sign in to comment.