Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .ocamlformat
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
version=0.15.0
version=0.16.0
module-item-spacing=compact
break-struct=natural
break-infix=fit-or-vertical
Expand Down
5 changes: 4 additions & 1 deletion Makefile
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
.PHONY: all test clean
.PHONY: all test clean fmt

all:
dune build
Expand All @@ -8,3 +8,6 @@ test:

clean:
dune clean

fmt:
dune build @fmt --auto-promote
2 changes: 1 addition & 1 deletion src/carton-git/carton_git.ml
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,7 @@ struct
| x :: r -> (
f a x >>= function
| Ok a -> go a r
| Error x -> err x >>= fun () -> go a r )
| Error x -> err x >>= fun () -> go a r)
in
go a l

Expand Down
2 changes: 1 addition & 1 deletion src/carton-git/carton_git_unix.ml
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@ module Store = struct
| entry -> (
match Fpath.of_string entry with
| Ok x -> if Fpath.has_ext "pack" x then go (x :: acc) else go acc
| Error (`Msg _) -> (* ignore *) go acc ))
| Error (`Msg _) -> (* ignore *) go acc))
(function End_of_file -> Lwt.return acc | exn -> Lwt.fail exn)
in
go []
Expand Down
44 changes: 22 additions & 22 deletions src/carton/dec.ml
Original file line number Diff line number Diff line change
Expand Up @@ -121,15 +121,15 @@ module Fp (Uid : UID) = struct
Bigstringaf.blit d.i ~src_off:d.i_pos d.i ~dst_off:0 ~len:rem;
(* compress *)
let res = input_bigstring ic d.i rem (Bigstringaf.length d.i - rem) in
peek k (src d d.i 0 (rem + res)) )
peek k (src d d.i 0 (rem + res)))
else k d
| `Manual ->
let rem = i_rem d in

if rem < d.t_peek then (
Bigstringaf.blit d.i ~src_off:d.i_pos d.i ~dst_off:0 ~len:rem;
(* compress *)
`Peek { d with k = peek k; i_pos = 0; i_len = rem - 1 } )
`Peek { d with k = peek k; i_pos = 0; i_len = rem - 1 })
else k d

let t_need d n = { d with t_need = n }
Expand Down Expand Up @@ -467,7 +467,7 @@ module Fp (Uid : UID) = struct
let _, dst_len = variable_length d.o x len in
source := src_len;
target := dst_len;
first := false );
first := false);

go (Zl.Inf.flush z)
| `Malformed err -> `Malformed (Fmt.str "inflate: %s" err)
Expand All @@ -478,7 +478,7 @@ module Fp (Uid : UID) = struct
let _, dst_len = variable_length d.o x len in
source := src_len;
target := dst_len;
first := false );
first := false);

let len = i_rem d - Zl.Inf.src_rem z in
let crc = Checkseum.Crc32.digest_bigstring d.i d.i_pos len crc in
Expand Down Expand Up @@ -615,7 +615,7 @@ module W = struct
available according the given offset. *)
then (
slice := Some s;
raise_notrace Found )
raise_notrace Found)
| None -> ()
done;
heavy_load s ~map t w
Expand Down Expand Up @@ -686,7 +686,7 @@ let weight_of_delta :
let decoder = Zh.M.src decoder slice.W.payload off len in
(go [@tailcall])
Int64.(add slice.W.offset (of_int slice.W.length))
decoder )
decoder)
in
let off = Int64.(to_int (sub cursor slice.W.offset)) in
let len = slice.W.length - off in
Expand Down Expand Up @@ -716,7 +716,7 @@ let header_of_ref_delta ({ bind; return } as s) ~map t cursor slice =
(sub
(add !slice.W.offset (of_int !slice.W.length))
next_slice.W.offset)));
slice := next_slice )
slice := next_slice)
in
return consume
in
Expand All @@ -730,7 +730,7 @@ let header_of_ref_delta ({ bind; return } as s) ~map t cursor slice =
for _ = 0 to t.uid_ln - 1 do
consume ()
done;
uid )
uid)
else
let uid = Bytes.create t.uid_ln in
for i = 0 to t.uid_ln - 1 do
Expand Down Expand Up @@ -765,7 +765,7 @@ let header_of_ofs_delta ({ bind; return } as s) ~map t cursor slice =
(sub
(add !slice.W.offset (of_int !slice.W.length))
next_slice.W.offset)));
slice := next_slice )
slice := next_slice)
in
return consume
in
Expand Down Expand Up @@ -806,7 +806,7 @@ let header_of_entry ({ bind; return } as s) ~map t cursor slice0 =
(sub
(add !slice.W.offset (of_int !slice.W.length))
next_slice.W.offset)));
slice := next_slice )
slice := next_slice)
in
return consume
in
Expand Down Expand Up @@ -920,7 +920,7 @@ and weight_of_offset :
~visited
~cursor:Int64.(add slice.W.offset (of_int pos))
slice
| _ -> assert false )
| _ -> assert false)

type raw = { raw0 : Bigstringaf.t; raw1 : Bigstringaf.t; flip : bool }
type v = { kind : kind; raw : raw; len : int; depth : int }
Expand Down Expand Up @@ -997,7 +997,7 @@ let uncompress :
decoder
| None ->
let decoder = Zl.Inf.src decoder Bigstringaf.empty 0 0 in
(go [@tailcall]) l p cursor decoder )
(go [@tailcall]) l p cursor decoder)
in
let off = Int64.(to_int (sub cursor slice.W.offset)) in
let len = slice.W.length - off in
Expand Down Expand Up @@ -1044,7 +1044,7 @@ let of_delta :
let decoder = Zh.M.src decoder slice.W.payload off len in
(go [@tailcall])
Int64.(add slice.W.offset (of_int slice.W.length))
raw decoder )
raw decoder)
in
let off = Int64.(to_int (sub cursor slice.W.offset)) in
let len = slice.W.length - off in
Expand Down Expand Up @@ -1137,7 +1137,7 @@ and of_offset :
of_ref_delta s ~map t raw
~cursor:Int64.(add slice.W.offset (of_int pos))
slice
| _ -> assert false )
| _ -> assert false)

type path = { path : int64 array; depth : int; kind : [ `A | `B | `C | `D ] }

Expand Down Expand Up @@ -1227,7 +1227,7 @@ and fill_path_from_offset :
(fill_path_from_ref_delta [@tailcall]) s ~map t ~depth path
~cursor:Int64.(add slice.W.offset (of_int pos))
slice
| _ -> assert false )
| _ -> assert false)

let path_of_offset :
type fd uid s.
Expand Down Expand Up @@ -1300,7 +1300,7 @@ let of_offset_with_source :
of_delta s ~map t kind raw ~depth
~cursor:Int64.(add slice.W.offset (of_int pos))
slice
| _ -> assert false )
| _ -> assert false)

let base_of_offset :
type fd uid s.
Expand Down Expand Up @@ -1452,7 +1452,7 @@ let uid_of_offset_with_source :
slice
>>= fun ({ raw; _ } as v) ->
return (digest ~kind ~len:v.len (get_payload raw))
| _ -> assert false )
| _ -> assert false)

type 'uid node = Node of int64 * 'uid * 'uid node list | Leaf of int64 * 'uid

Expand Down Expand Up @@ -1557,7 +1557,7 @@ struct
| cursors ->
nodes_of_offsets ~map ~oracle t ~kind (flip raw) ~depth:(succ depth)
~cursors
>>= fun nodes -> IO.return [ Node (cursor, uid, nodes) ] )
>>= fun nodes -> IO.return [ Node (cursor, uid, nodes) ])
| cursors ->
let source = get_source raw in
let source =
Expand Down Expand Up @@ -1627,7 +1627,7 @@ struct
let raw' = make_raw ~weight:weight' in
Bigstringaf.blit (get_payload raw) ~src_off:0 (get_payload raw')
~dst_off:0 ~len:weight;
raw' )
raw')
else raw
in
nodes_of_offsets ~map ~oracle t ~kind (flip raw) ~depth:1 ~cursors
Expand Down Expand Up @@ -1687,7 +1687,7 @@ struct
done;
if mutex.v >= Array.length matrix then (
IO.Mutex.unlock mutex.m;
IO.return () )
IO.return ())
else
let root = mutex.v in
mutex.v <- mutex.v + 1;
Expand Down Expand Up @@ -1777,7 +1777,7 @@ struct
finish := true;
IO.Condition.broadcast signal;
IO.Mutex.unlock mutex;
return () )
return ())
else (
incr p;
let uid = Idx.get_uid idx v
Expand All @@ -1788,7 +1788,7 @@ struct

IO.Condition.signal signal;
IO.Mutex.unlock mutex;
go () )
go ())
in
go ()

Expand Down
23 changes: 12 additions & 11 deletions src/carton/enc.ml
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,8 @@ module Utils = struct
length_of_variable_length source
+ length_of_variable_length target
+ List.fold_left
(fun acc -> function Duff.Insert (_, len) -> 1 + len + acc
(fun acc -> function
| Duff.Insert (_, len) -> 1 + len + acc
| Duff.Copy (off, len) -> 1 + length_of_copy_code ~off ~len + acc)
0 hunks
end
Expand Down Expand Up @@ -143,7 +144,7 @@ let entry_to_target :
let ( >>= ) = bind in

load entry.uid >>= fun v ->
( match entry.delta with
(match entry.delta with
| From uid ->
load uid >>= fun s ->
let source = Bigstringaf.sub ~off:0 ~len:(Dec.len s) (Dec.raw s) in
Expand All @@ -160,7 +161,7 @@ let entry_to_target :
source = uid;
source_length = Dec.len s;
})
| Zero -> return None )
| Zero -> return None)
>>= fun patch -> return { patch; entry; v = W.create_with v }

let length_of_delta ~source ~target hunks = Utils.length ~source ~target hunks
Expand Down Expand Up @@ -322,7 +323,7 @@ struct
match window.(j) with
| Some m -> (
try try_delta j m >>= fun () -> (go [@tailcall]) (pred j)
with Break -> return () )
with Break -> return ())
| None -> return ()
(* TODO: check it! *)
in
Expand Down Expand Up @@ -358,11 +359,11 @@ struct
v := (!v + 1) mod weight
done;

window.(!v) <- swap );
window.(!v) <- swap);

if depth_of_target targets.(n) < _max_depth then
(iter [@tailcall]) (succ n) (if idx + 1 >= weight then 0 else idx + 1)
else (iter [@tailcall]) (succ n) idx )
else (iter [@tailcall]) (succ n) idx)
else return ()
in
iter 0 0
Expand All @@ -382,12 +383,12 @@ struct
mutex.v <- mutex.v + 1;
if v >= Array.length entries then (
IO.Mutex.unlock mutex.m;
IO.return () )
IO.return ())
else (
IO.Mutex.unlock mutex.m;
entry_to_target s ~load entries.(v) |> Scheduler.prj >>= fun target ->
targets.(v) <- Some target;
go () )
go ())
in
go ()

Expand Down Expand Up @@ -441,11 +442,11 @@ end = struct
| Z encoder -> (
match encode_zlib ~o encoder with
| `Flush (encoder, len) -> `Flush (Z encoder, len)
| `End -> `End )
| `End -> `End)
| H encoder -> (
match encode_hunk ~o encoder with
| `Flush (encoder, len) -> `Flush (H encoder, len)
| `End -> `End )
| `End -> `End)

let dst encoder s j l =
match encoder with
Expand Down Expand Up @@ -586,4 +587,4 @@ let encode_target :
>>= fun encoder ->
let off = off + uid.uid_ln in
let len = Bigstringaf.length b.o - off in
return (off, N.dst encoder b.o off len) )
return (off, N.dst encoder b.o off len))
Loading