Skip to content

Commit

Permalink
Merge pull request #455 from Julow/preview-ocamlformat-0.26.1
Browse files Browse the repository at this point in the history
Upgrade OCamlformat to 0.26.1
  • Loading branch information
NathanReb committed Feb 1, 2024
2 parents 3473e52 + 4bc92e4 commit 6da73c1
Show file tree
Hide file tree
Showing 19 changed files with 384 additions and 406 deletions.
3 changes: 3 additions & 0 deletions .git-blame-ignore-revs
Original file line number Diff line number Diff line change
Expand Up @@ -6,3 +6,6 @@

#The commit upgrading to ocamlformat 0.24.1
0970c3a7f91291bd92eb277331b5b6af20b608e9

#The commit upgrading to ocamlformat.0.26.1
dab938d3e6f316c20cc141aaff534a0f5f0ab70f
2 changes: 1 addition & 1 deletion .ocamlformat
Original file line number Diff line number Diff line change
@@ -1,3 +1,3 @@
version=0.24.1
version=0.26.1
profile=conventional
parse-docstrings=true
181 changes: 90 additions & 91 deletions ast/ast.ml

Large diffs are not rendered by default.

90 changes: 45 additions & 45 deletions bench/drivers/identity/inputs/bap_knowledge.ml
Original file line number Diff line number Diff line change
Expand Up @@ -137,7 +137,7 @@ end = struct
let m = one lsl to_int bit in
let y = k' lor (m - one) land lnot m in
if x = y then if k' land m = zero then LB else RB else NA
[@@inline]
[@@inline]

let equal { key = k1 } { key = k2 } = equal k1 k2 [@@inline]

Expand Down Expand Up @@ -196,7 +196,7 @@ end = struct
| NA -> join (Tip (k, nil ())) k t (Key.payload k')
| LB -> Bin (k', update_with l k ~has ~nil, r)
| RB -> Bin (k', l, update_with r k ~has ~nil))
[@@specialise]
[@@specialise]

let rec update t k ~f =
match t with
Expand All @@ -208,7 +208,7 @@ end = struct
| NA -> join (Tip (k, f None)) k t (Key.payload k')
| LB -> Bin (k', update l k f, r)
| RB -> Bin (k', l, update r k f))
[@@specialise]
[@@specialise]

let rec set t k v =
match t with
Expand Down Expand Up @@ -248,7 +248,7 @@ end = struct
| LB ->
if is_zero ~bit:b2 k1 then Bin (p2, merge t1 l2 ~f, r2)
else Bin (p2, l2, merge t1 r2 ~f))
[@@specialise]
[@@specialise]

let rec iter t ~f =
match t with
Expand All @@ -257,14 +257,14 @@ end = struct
| Bin (_, l, r) ->
iter l ~f;
iter r ~f
[@@specialise]
[@@specialise]

let rec fold t ~init ~f =
match t with
| Nil -> init
| Tip (k, v) -> f k v init
| Bin (_, l, r) -> fold r ~f ~init:(fold l ~init ~f)
[@@specialise]
[@@specialise]

let rec max_elt = function
| Nil -> None
Expand Down Expand Up @@ -1164,7 +1164,7 @@ module Dict = struct
let compare k1 k2 =
let k1 = uid k1 and k2 = uid k2 in
(Uid.compare [@inlined]) k1 k2
[@@inline]
[@@inline]

let name x = x.name
let to_sexp x = x.show
Expand Down Expand Up @@ -1240,7 +1240,7 @@ module Dict = struct
| () when contains a b c d -> Contains
| () when equals a b c d -> Equals
| () -> assert false
[@@inline]
[@@inline]
end

(** Extension of the Allen's Algebra over points.
Expand Down Expand Up @@ -1268,7 +1268,7 @@ module Dict = struct
| () when finishes p a b -> Finishes
| () when after p a b -> After
| () -> assert false
[@@inline]
[@@inline]
end
end

Expand Down Expand Up @@ -1354,7 +1354,7 @@ module Dict = struct
let ( <$ ) k1 k2 =
let k1 = Key.uid k1 and k2 = Key.uid k2 in
(Key.Uid.( < ) [@inlined]) k1 k2
[@@inline]
[@@inline]

let make0 = T0 [@@inlined]
let make1 k a = T1 (k, a) [@@inline]
Expand All @@ -1364,27 +1364,27 @@ module Dict = struct

let make5 ka a kb b kc c kd d ke e =
EQ (make2 ka a kb b, kc, c, make2 kd d ke e)
[@@inline]
[@@inline]

let make6 ka a kb b kc c kd d ke e kf f =
EQ (T2 (ka, a, kb, b), kc, c, T3 (kd, d, ke, e, kf, f))
[@@inline]
[@@inline]

let make7 ka a kb b kc c kd d ke e kf f kg g =
EQ (T3 (ka, a, kb, b, kc, c), kd, d, T3 (ke, e, kf, f, kg, g))
[@@inline]
[@@inline]

let make8 ka a kb b kc c kd d ke e kf f kg g kh h =
EQ (T3 (ka, a, kb, b, kc, c), kd, d, T4 (ke, e, kf, f, kg, g, kh, h))
[@@inline]
[@@inline]

let make9 ka a kb b kc c kd d ke e kf f kg g kh h ki i =
EQ (T4 (ka, a, kb, b, kc, c, kd, d), ke, e, T4 (kf, f, kg, g, kh, h, ki, i))
[@@inline]
[@@inline]

let make10 ka a kb b kc c kd d ke e kf f kg g kh h ki i kj j =
LL (make4 ka a kb b kc c kd d, ke, e, make5 kf f kg g kh h ki i kj j)
[@@inline]
[@@inline]

type 'r visitor = { visit : 'a. 'a key -> 'a -> 'r -> 'r }

Expand Down Expand Up @@ -1475,7 +1475,7 @@ module Dict = struct
*)
EQ (EQ (w, ka, a, x), kb, b, LL (y, kc, c, z))
| r -> raise (Rol_wrong_rank r)
[@@inline]
[@@inline]

let ror = function
| LR (LR (x, ka, a, y), kb, b, z) ->
Expand Down Expand Up @@ -1540,7 +1540,7 @@ module Dict = struct
*)
EQ (LR (w, ka, a, x), kb, b, EQ (y, kc, c, z))
| r -> raise (Ror_wrong_rank r)
[@@inline]
[@@inline]

let rank_increases was now =
match (was, now) with
Expand All @@ -1551,7 +1551,7 @@ module Dict = struct
| EQ _, LL _ | EQ _, LR _ -> true
| LR _, LL _ | LL _, LR _ -> false
| _ -> false
[@@inline]
[@@inline]

(* [p += c] updates the right subtree of [p] with [c].
pre: rank p > 1 /\ rank c > 1 *)
Expand All @@ -1564,7 +1564,7 @@ module Dict = struct
| EQ (b, k, x, c) ->
if rank_increases c c' then LL (b, k, x, c') else EQ (b, k, x, c')
| _ -> failwith "+=: rank < 2"
[@@inline]
[@@inline]

(* [b =+ p] updates the left subtree of [p] with [b].
pre: rank p > 1 /\ rank b > 1 *)
Expand All @@ -1577,7 +1577,7 @@ module Dict = struct
| EQ (b, k, x, c) ->
if rank_increases b b' then LR (b', k, x, c) else EQ (b', k, x, c)
| _ -> failwith "=+: rank < 2"
[@@inline]
[@@inline]

(* pre:
- a is not in t;
Expand Down Expand Up @@ -1695,7 +1695,7 @@ module Dict = struct
upsert ka a x
~update:(fun k -> ret @@ fun f -> LR (k f, kb, b, y))
~insert:(fun x -> add (x =+ t)))
[@@specialise]
[@@specialise]

let monomorphic_merge : type t. t key -> (t -> t -> t) -> merge =
fun k f ->
Expand All @@ -1705,12 +1705,12 @@ module Dict = struct
let T = Key.same k kb in
f b a);
}
[@@specialise]
[@@specialise]

let update f ka a x =
let f = monomorphic_merge ka f in
upsert ka a x ~update:(fun k -> k f) ~insert:(fun x -> x)
[@@specialise]
[@@specialise]

let set ka a x =
let f = monomorphic_merge ka (fun _ x -> x) in
Expand All @@ -1721,7 +1721,7 @@ module Dict = struct
let return (type a b) (k : a key) (ka : b key) (a : b) : a =
let T = Key.same k ka in
a
[@@inline]
[@@inline]

let rec get k = function
| T0 -> raise Field_not_found
Expand Down Expand Up @@ -1767,7 +1767,7 @@ module Dict = struct
| 0 -> make1 ka (app m ka kb b a)
| 1 -> make2 kb b ka a
| _ -> make2 ka a kb b
[@@inline]
[@@inline]

let merge_12 m ka a kb b kc c =
match Key.Point.relate ka kb kc with
Expand All @@ -1776,7 +1776,7 @@ module Dict = struct
| During -> make3 kb b ka a kc c
| Finishes -> make2 kb b ka (app m ka kc c a)
| After -> make3 kb b kc c ka a
[@@inline]
[@@inline]

let merge_13 m ka a kb b kc c kd d =
match Key.Point.relate ka kb kd with
Expand All @@ -1789,7 +1789,7 @@ module Dict = struct
| 0 -> make3 kb b kc (app m kc ka a c) kd d
| 1 -> make4 kb b kc c ka a kd d
| _ -> make4 kb b ka a kc c kd d)
[@@inline]
[@@inline]

let merge_22 m ka a kb b kc c kd d =
match Key.Interval.relate ka kb kc kd with
Expand All @@ -1806,7 +1806,7 @@ module Dict = struct
| During -> make4 kc c ka a kb b kd d
| Contains -> make4 ka a kc c kd d kb b
| Equals -> make2 ka (app m ka kc c a) kb (app m kb kd d b)
[@@inline]
[@@inline]

let merge m x y =
if phys_equal x y then x
Expand All @@ -1820,7 +1820,7 @@ module Dict = struct
| T3 (kb, b, kc, c, kd, d), T1 (ka, a) -> merge_13 m ka a kb b kc c kd d
| T2 (ka, a, kb, b), T2 (kc, c, kd, d) -> merge_22 m ka a kb b kc c kd d
| _ -> fold_merge m x y
[@@inline]
[@@inline]

let sexp_of_t dict =
Sexp.List
Expand Down Expand Up @@ -2127,21 +2127,21 @@ module Knowledge = struct
type _ error = conflict

let fail p : 'a t = { run = (fun ~reject ~accept:_ _ -> reject p) }
[@@inline]
[@@inline]

let catch x err =
{
run =
(fun ~reject ~accept s ->
x.run s ~accept ~reject:(fun p -> (err p).run ~reject ~accept s));
}
[@@inline]
[@@inline]

include Monad.Make (struct
type 'a t = 'a knowledge

let return x : 'a t = { run = (fun ~reject:_ ~accept s -> accept x s) }
[@@inline]
[@@inline]

let bind : 'a t -> ('a -> 'b t) -> 'b t =
fun x f ->
Expand All @@ -2150,7 +2150,7 @@ module Knowledge = struct
(fun ~reject ~accept s ->
x.run s ~reject ~accept:(fun x s -> (f x).run ~reject ~accept s));
}
[@@inline]
[@@inline]

let map : 'a t -> f:('a -> 'b) -> 'b t =
fun x ~f ->
Expand All @@ -2159,7 +2159,7 @@ module Knowledge = struct
(fun ~reject ~accept s ->
x.run s ~reject ~accept:(fun x s -> accept (f x) s));
}
[@@inline]
[@@inline]

let map = `Custom map
end)
Expand Down Expand Up @@ -2352,22 +2352,22 @@ module Knowledge = struct

let get () : state knowledge =
{ run = (fun ~reject:_ ~accept s -> accept s s) }
[@@inline]
[@@inline]

let put s = { run = (fun ~reject:_ ~accept _ -> accept () s) } [@@inline]

let gets f = { run = (fun ~reject:_ ~accept s -> accept (f s) s) }
[@@inline] [@@specialise]
[@@inline] [@@specialise]

let update f = { run = (fun ~reject:_ ~accept s -> accept () (f s)) }
[@@inline] [@@specialise]
[@@inline] [@@specialise]

let objects { Class.name } =
get () >>| fun { classes } ->
match Map.find classes name with
| None -> Env.empty_class
| Some objs -> objs
[@@inline]
[@@inline]

let update_objects { Class.name } f =
update @@ fun state ->
Expand All @@ -2379,7 +2379,7 @@ module Knowledge = struct
| Some objs -> objs
in
{ state with classes = Map.set state.classes name objs }
[@@specialise]
[@@specialise]

let map_update_objects { Class.name } f =
get () >>= fun state ->
Expand All @@ -2391,7 +2391,7 @@ module Knowledge = struct
f objs @@ fun objs res ->
put { state with classes = Map.set state.classes name objs } >>| fun () ->
res
[@@specialise]
[@@specialise]

module Object = struct
type +'a t = 'a obj
Expand Down Expand Up @@ -2692,7 +2692,7 @@ module Knowledge = struct
type slot_status = Sleep | Awoke | Ready of Dict.record

let is_empty { Slot.dom; key } v = Domain.is_empty dom (Record.get key dom v)
[@@inline]
[@@inline]

let status : ('a, _) slot -> 'a obj -> slot_status knowledge =
fun slot obj ->
Expand Down Expand Up @@ -2974,7 +2974,7 @@ module Knowledge = struct
| None -> accept None s
| Some x -> (f x).run ~accept ~reject s));
}
[@@inline] [@@specialise]
[@@inline] [@@specialise]

let ( >>|? ) x f =
{
Expand All @@ -2983,7 +2983,7 @@ module Knowledge = struct
x.run s ~reject ~accept:(fun x s ->
match x with None -> accept None s | Some x -> accept (f x) s));
}
[@@inline] [@@specialise]
[@@inline] [@@specialise]

let ( let*? ) = ( >>=? )
let ( let+? ) = ( >>|? )
Expand All @@ -2995,7 +2995,7 @@ module Knowledge = struct
x.run s ~reject ~accept:(fun x s ->
y.run s ~reject ~accept:(fun y s -> accept (x, y) s)));
}
[@@inline] [@@specialise]
[@@inline] [@@specialise]

let ( and* ) = ( and+ )
let ( .$[] ) v s = Value.get s v
Expand Down

0 comments on commit 6da73c1

Please sign in to comment.