From 5e9477816edebc896933d6b112584c7203606c9a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 30 Aug 2024 09:53:45 -0400 Subject: [PATCH 01/13] refactor: adapt to newer picos+moonpool --- src/log/log_ctx.ml | 25 +++++++++---------------- src/log/trace_async.ml | 22 ++++++++-------------- src/thread/fiber.ml | 13 ++++++------- src/thread/fut.ml | 6 +++--- 4 files changed, 26 insertions(+), 40 deletions(-) diff --git a/src/log/log_ctx.ml b/src/log/log_ctx.ml index 21f66c75..fbe73d05 100644 --- a/src/log/log_ctx.ml +++ b/src/log/log_ctx.ml @@ -3,25 +3,18 @@ module LS = Moonpool.Task_local_storage type 'a tag = 'a Logs.Tag.def (** Storage key for the ambient context. *) -let ctx_k : Logs.Tag.t Str_map.t LS.key = - LS.new_key ~init:(fun () -> Str_map.empty) () +let ctx_k : Logs.Tag.t Str_map.t LS.t = LS.create () let create_tag ?doc name pp : _ tag = Logs.Tag.def ?doc name pp let get_tags_from_ctx () : Logs.Tag.set = - match LS.get ctx_k with - | exception Failure _ -> Logs.Tag.empty - | map -> - (* build the current set of tags *) - Str_map.fold - (fun _ (Logs.Tag.V (tag, v)) set -> Logs.Tag.add tag v set) - map Logs.Tag.empty + let map = LS.get ~default:Str_map.empty ctx_k in + (* build the current set of tags *) + Str_map.fold + (fun _ (Logs.Tag.V (tag, v)) set -> Logs.Tag.add tag v set) + map Logs.Tag.empty let with_tag (tag : _ tag) v (f : unit -> 'b) : 'b = - match LS.get ctx_k with - | exception Failure _ -> f () - | old_map -> - let new_map = - Str_map.add (Logs.Tag.name tag) (Logs.Tag.V (tag, v)) old_map - in - LS.with_value ctx_k new_map f + let old_map = LS.get ~default:Str_map.empty ctx_k in + let new_map = Str_map.add (Logs.Tag.name tag) (Logs.Tag.V (tag, v)) old_map in + LS.with_value ctx_k new_map f diff --git a/src/log/trace_async.ml b/src/log/trace_async.ml index 32103e16..01cf24b6 100644 --- a/src/log/trace_async.ml +++ b/src/log/trace_async.ml @@ -2,12 +2,11 @@ module Trace = Trace_core module LS = Moonpool.Task_local_storage (** Current parent scope for async spans *) -let k_parent_scope : Trace.explicit_span option LS.key = - LS.new_key ~init:(fun () -> None) () +let k_parent_scope : Trace.explicit_span Hmap.key = Hmap.Key.create () (** Set the parent scope by hand *) -let set_parent_scope (sp : Trace.explicit_span) = - LS.set k_parent_scope (Some sp) +let[@inline] set_parent_scope (sp : Trace.explicit_span) = + LS.set_in_local_hmap k_parent_scope sp let add_exn_to_span (sp : Trace.explicit_span) (exn : exn) = Trace.add_data_to_manual_span sp @@ -19,12 +18,7 @@ let add_bt_to_span (sp : Trace.explicit_span) (bt : Printexc.raw_backtrace) = open struct let with_span_real_ ~level ?data ?__FUNCTION__ ~__FILE__ ~__LINE__ name f = - let storage = LS.get_current () in - let parent = - CCOption.flat_map - (fun store -> LS.Direct.get store k_parent_scope) - storage - in + let parent = LS.get_in_local_hmap_opt k_parent_scope in let span = match parent with | None -> @@ -36,14 +30,14 @@ open struct in (* set current span as parent, for children *) - LS.set k_parent_scope (Some span); + LS.set_in_local_hmap k_parent_scope span; (* cleanup *) let finally () = (* restore previous parent span *) - Option.iter - (fun store -> LS.Direct.set store k_parent_scope parent) - storage; + (match parent with + | None -> LS.remove_in_local_hmap k_parent_scope + | Some p -> LS.set_in_local_hmap k_parent_scope p); Trace.exit_manual_span span in diff --git a/src/thread/fiber.ml b/src/thread/fiber.ml index 0d56c7fb..bc1a61a2 100644 --- a/src/thread/fiber.ml +++ b/src/thread/fiber.ml @@ -1,19 +1,18 @@ include Moonpool_fib module FLS = Moonpool_fib.Fls -(** Access the context *) -let k_rcontext : Hmap.t FLS.key = FLS.new_key ~init:(fun () -> Hmap.empty) () +(** Access the context (inheritable hmap) *) +let k_rcontext : Hmap.t FLS.t = FLS.k_local_hmap (** Access the current rcontext *) -let[@inline] get_rcontext () : Hmap.t = FLS.get k_rcontext +let[@inline] get_rcontext () : Hmap.t = FLS.get ~default:Hmap.empty k_rcontext let[@inline] get_from_rcontext (k : 'a Hmap.key) : 'a option = - FLS.get_opt k_rcontext |> CCOption.flat_map (Hmap.find k) + FLS.get_in_local_hmap_opt k (** Add some k/v to the context *) -let add_to_rcontext (k : 'a Hmap.key) (x : 'a) : unit = - let ctx = get_rcontext () in - FLS.set k_rcontext (Hmap.add k x ctx) +let[@inline] add_to_rcontext (k : 'a Hmap.key) (x : 'a) : unit = + FLS.set_in_local_hmap k x (** An easy starting point to mimic future-returning APIs *) let spawn_top_and_return_fut ~on (f : unit -> 'a) : 'a Fut.t = diff --git a/src/thread/fut.ml b/src/thread/fut.ml index 0a988b9b..6c4eb02e 100644 --- a/src/thread/fut.ml +++ b/src/thread/fut.ml @@ -9,8 +9,8 @@ let pp ppx out (self : _ t) : unit = match peek self with | None -> Fmt.fprintf out "" | Some (Ok x) -> Fmt.fprintf out "<@[future res=%a@]>" ppx x - | Some (Error (e, _)) -> - Fmt.fprintf out "<@[future err=%S@]>" (Printexc.to_string e) + | Some (Error ebt) -> + Fmt.fprintf out "<@[future err=%S@]>" (Printexc.to_string ebt.exn) let[@inline] unwrap = function | Ok x -> x @@ -19,7 +19,7 @@ let[@inline] unwrap = function let peek_exn self : _ option = match peek self with | Some (Ok x) -> Some x - | Some (Error (e, bt)) -> raise_with_bt e bt + | Some (Error ebt) -> Exn_bt.raise ebt | None -> None let map_iter ~f (it : _ Iter.t) : _ Iter.t t = From 7e9e1be154d2e8517a27265f5c81b72f38e9f5ba Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 30 Aug 2024 13:07:36 -0400 Subject: [PATCH 02/13] chore: CI --- .github/workflows/gh-pages.yml | 4 ++++ .github/workflows/main.yml | 9 ++++++++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 4e4fedc9..49f3b6da 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -19,6 +19,10 @@ jobs: dune-cache: true allow-prerelease-opam: true + # temporary until it's in a release + - run: opam pin https://github.com/c-cube/picos.git#simon/split-package -y -n + - run: opam pin https://github.com/c-cube/moonpool.git#simon/move-to-picos -y -n + - run: opam pin . -y -n - run: opam install odig imandrakit imandrakit-thread imandrakit-io imandrakit-log - run: opam exec -- odig odoc --cache-dir=_doc/ imandrakit imandrakit-thread imandrakit-io imandrakit-log diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 8282a31d..fd1dd0ab 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -31,6 +31,10 @@ jobs: dune-cache: true allow-prerelease-opam: true + # temporary until it's in a release + - run: opam pin https://github.com/c-cube/picos.git#simon/split-package -y -n + - run: opam pin https://github.com/c-cube/moonpool.git#simon/move-to-picos -y -n + - run: opam install -t imandrakit imandrakit-log imandrakit-io --deps-only - run: opam exec -- dune build @install -p imandrakit,imandrakit-log,imandrakit-io - run: opam exec -- dune build @runtest -p imandrakit,imandrakit-log,imandrakit-io @@ -63,7 +67,10 @@ jobs: dune-cache: true allow-prerelease-opam: true - - run: opam pin moonpool --dev -y -n + # temporary until it's in a release + - run: opam pin https://github.com/c-cube/picos.git#simon/split-package -y -n + - run: opam pin https://github.com/c-cube/moonpool.git#simon/move-to-picos -y -n + - run: opam install -t imandrakit imandrakit-log imandrakit-io imandrakit-thread --deps-only - run: opam exec -- dune build @install -p imandrakit,imandrakit-io,imandrakit-log,imandrakit-thread - run: opam exec -- dune build @runtest -p imandrakit,imandrakit-io,imandrakit-log,imandrakit-thread From 163b79bb22bfcd4cc49d7e6a4f556972c7cf8c89 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 30 Aug 2024 13:19:33 -0400 Subject: [PATCH 03/13] require OCaml 4.14 (because picos does) :( --- .github/workflows/main.yml | 2 +- dune-project | 6 +++--- imandrakit-io.opam | 2 +- imandrakit-log.opam | 2 +- imandrakit.opam | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index fd1dd0ab..21c1b331 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -18,7 +18,7 @@ jobs: #- macos-latest #- windows-latest ocaml-compiler: - - '4.12' + - '4.14' - '5.2' runs-on: ${{ matrix.os }} diff --git a/dune-project b/dune-project index 78815a13..34558e38 100644 --- a/dune-project +++ b/dune-project @@ -22,7 +22,7 @@ (synopsis "Core utils library for Imandra") (depends (ocaml - (>= 4.12)) + (>= 4.14)) dune (containers (>= 3.4)) @@ -67,7 +67,7 @@ (synopsis "Logging utils for Imandra") (depends (ocaml - (>= 4.12)) + (>= 4.14)) (imandrakit (= :version)) hmap @@ -84,7 +84,7 @@ (synopsis "IO utils for Imandra") (depends (ocaml - (>= 4.12)) + (>= 4.14)) (imandrakit (= :version)) (imandrakit-log diff --git a/imandrakit-io.opam b/imandrakit-io.opam index a3c593e3..d70a6840 100644 --- a/imandrakit-io.opam +++ b/imandrakit-io.opam @@ -9,7 +9,7 @@ homepage: "https://github.com/imandra-ai/imandrakit" bug-reports: "https://github.com/imandra-ai/imandrakit/issues" depends: [ "dune" {>= "3.0"} - "ocaml" {>= "4.12"} + "ocaml" {>= "4.14"} "imandrakit" {= version} "imandrakit-log" {= version} "moonpool" {>= "0.6"} diff --git a/imandrakit-log.opam b/imandrakit-log.opam index 47bf7d0c..a00c76a3 100644 --- a/imandrakit-log.opam +++ b/imandrakit-log.opam @@ -8,7 +8,7 @@ license: "MIT" homepage: "https://github.com/imandra-ai/imandrakit" bug-reports: "https://github.com/imandra-ai/imandrakit/issues" depends: [ - "ocaml" {>= "4.12"} + "ocaml" {>= "4.14"} "imandrakit" {= version} "hmap" "dune" {>= "3.0"} diff --git a/imandrakit.opam b/imandrakit.opam index 93b4c89f..f5f065ab 100644 --- a/imandrakit.opam +++ b/imandrakit.opam @@ -9,7 +9,7 @@ tags: ["moonpool" "multicore" "thread" "logs" "logging"] homepage: "https://github.com/imandra-ai/imandrakit" bug-reports: "https://github.com/imandra-ai/imandrakit/issues" depends: [ - "ocaml" {>= "4.12"} + "ocaml" {>= "4.14"} "dune" {>= "3.0"} "containers" {>= "3.4"} "iter" {>= "1.0"} From 38d07b71272f8e4e8e1b2090e41b8e1bab02d6c7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 30 Aug 2024 13:32:13 -0400 Subject: [PATCH 04/13] add Error.of_exn_bt --- dune-project | 1 + src/error/dune | 2 +- src/error/error.ml | 2 ++ src/error/error.mli | 3 +++ 4 files changed, 7 insertions(+), 1 deletion(-) diff --git a/dune-project b/dune-project index 34558e38..421e5a2e 100644 --- a/dune-project +++ b/dune-project @@ -33,6 +33,7 @@ ptime atomic hmap + exn_bt (yojson (>= 1.6)) (mtime diff --git a/src/error/dune b/src/error/dune index 8086f2f7..f0eee7c6 100644 --- a/src/error/dune +++ b/src/error/dune @@ -5,4 +5,4 @@ (pps ppx_deriving.std imandrakit.twine.ppx imandrakit.typereg.ppx)) (flags :standard -open Imandrakit_common) (synopsis "Error library for imandrakit") - (libraries imandrakit.common imandrakit.twine hmap logs containers)) + (libraries exn_bt imandrakit.common imandrakit.twine hmap logs containers)) diff --git a/src/error/error.ml b/src/error/error.ml index 6559dac0..5b591405 100644 --- a/src/error/error.ml +++ b/src/error/error.ml @@ -32,6 +32,8 @@ let of_exn ?bt ~kind exn : t = let bt = Option.map Printexc.raw_backtrace_to_string bt in mk_error ?bt ~kind (Printexc.to_string exn) +let[@inline] of_exn_bt ~kind { Exn_bt.exn; bt } : t = of_exn ~bt ~kind exn + let[@inline] guardf ?let_pass k f = guard ?let_pass (fun () -> k (fun fmt -> Fmt.kasprintf message fmt)) f diff --git a/src/error/error.mli b/src/error/error.mli index 07c4a402..ea61ef87 100644 --- a/src/error/error.mli +++ b/src/error/error.mli @@ -56,5 +56,8 @@ val guardf : val of_exn : ?bt:Printexc.raw_backtrace -> kind:Kind.t -> exn -> t (** Turn exception into an error. *) +val of_exn_bt : kind:Kind.t -> Exn_bt.t -> t +(** Turn exception into an error. *) + val try_catch : kind:Kind.t -> unit -> (unit -> 'a) -> 'a result val unwrap_opt : 'a option -> 'a From b3fc0746974891923b62a4fa205618898ce6408c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 3 Sep 2024 09:42:01 -0400 Subject: [PATCH 05/13] update to more recent picos/moonpool --- src/error/dune | 2 +- src/error/error.ml | 3 ++- src/error/error.mli | 2 +- src/thread/fut.ml | 5 +++-- 4 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/error/dune b/src/error/dune index f0eee7c6..d2131159 100644 --- a/src/error/dune +++ b/src/error/dune @@ -5,4 +5,4 @@ (pps ppx_deriving.std imandrakit.twine.ppx imandrakit.typereg.ppx)) (flags :standard -open Imandrakit_common) (synopsis "Error library for imandrakit") - (libraries exn_bt imandrakit.common imandrakit.twine hmap logs containers)) + (libraries imandrakit.common imandrakit.twine moonpool hmap logs containers)) diff --git a/src/error/error.ml b/src/error/error.ml index 5b591405..6b8afd29 100644 --- a/src/error/error.ml +++ b/src/error/error.ml @@ -32,7 +32,8 @@ let of_exn ?bt ~kind exn : t = let bt = Option.map Printexc.raw_backtrace_to_string bt in mk_error ?bt ~kind (Printexc.to_string exn) -let[@inline] of_exn_bt ~kind { Exn_bt.exn; bt } : t = of_exn ~bt ~kind exn +let[@inline] of_exn_bt ~kind (ebt : Moonpool.Exn_bt.t) : t = + of_exn ~bt:(Moonpool.Exn_bt.bt ebt) ~kind (Moonpool.Exn_bt.exn ebt) let[@inline] guardf ?let_pass k f = guard ?let_pass (fun () -> k (fun fmt -> Fmt.kasprintf message fmt)) f diff --git a/src/error/error.mli b/src/error/error.mli index ea61ef87..87089700 100644 --- a/src/error/error.mli +++ b/src/error/error.mli @@ -56,7 +56,7 @@ val guardf : val of_exn : ?bt:Printexc.raw_backtrace -> kind:Kind.t -> exn -> t (** Turn exception into an error. *) -val of_exn_bt : kind:Kind.t -> Exn_bt.t -> t +val of_exn_bt : kind:Kind.t -> Moonpool.Exn_bt.t -> t (** Turn exception into an error. *) val try_catch : kind:Kind.t -> unit -> (unit -> 'a) -> 'a result diff --git a/src/thread/fut.ml b/src/thread/fut.ml index 6c4eb02e..4db40056 100644 --- a/src/thread/fut.ml +++ b/src/thread/fut.ml @@ -10,7 +10,8 @@ let pp ppx out (self : _ t) : unit = | None -> Fmt.fprintf out "" | Some (Ok x) -> Fmt.fprintf out "<@[future res=%a@]>" ppx x | Some (Error ebt) -> - Fmt.fprintf out "<@[future err=%S@]>" (Printexc.to_string ebt.exn) + Fmt.fprintf out "<@[future err=%S@]>" + (Printexc.to_string @@ Moonpool.Exn_bt.exn ebt) let[@inline] unwrap = function | Ok x -> x @@ -19,7 +20,7 @@ let[@inline] unwrap = function let peek_exn self : _ option = match peek self with | Some (Ok x) -> Some x - | Some (Error ebt) -> Exn_bt.raise ebt + | Some (Error ebt) -> Moonpool.Exn_bt.raise ebt | None -> None let map_iter ~f (it : _ Iter.t) : _ Iter.t t = From 222f833703bb73182310216f4cc95628a1734808 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 4 Sep 2024 12:30:37 -0400 Subject: [PATCH 06/13] catch errors from select --- src/thread/timer.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/thread/timer.ml b/src/thread/timer.ml index 91cd183c..e6202636 100644 --- a/src/thread/timer.ml +++ b/src/thread/timer.ml @@ -105,9 +105,9 @@ let next_step_ (self : state) : next_step = let wait_ (self : state) delay = assert (delay > 0.); - let _ = Unix.select [ self.p_read ] [] [ self.p_read ] delay in - (* drain pipe *) try + let _ = Unix.select [ self.p_read ] [] [ self.p_read ] delay in + (* drain pipe *) while Unix.read self.p_read self.buf4 0 4 > 0 do () done From 1d28da13e9712d99754e4b49f286e7907be1cb3a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 4 Sep 2024 12:54:39 -0400 Subject: [PATCH 07/13] fix thread pool: remove signal handling, now done by picos_io --- src/thread/thread_pool.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/thread/thread_pool.ml b/src/thread/thread_pool.ml index 19e4ca7b..72bfae32 100644 --- a/src/thread/thread_pool.ml +++ b/src/thread/thread_pool.ml @@ -16,8 +16,8 @@ let start ?(active = Switch.create ()) ?(on_exn = Executor.default_exn_handler) let around_task = (fun p () -> p), after_task in let on_init_thread ~dom_id:_ ~t_id () = let name_thread = spf "%s.%d" name t_id in - Trace.set_thread_name name_thread; - ignore (Thread.sigmask Unix.SIG_BLOCK [ Sys.sigint; Sys.sigpipe ] : _ list) + Trace.set_thread_name name_thread + (* ignore (Thread.sigmask Unix.SIG_BLOCK [ Sys.sigint; Sys.sigpipe ] : _ list) *) in let pool = From e085978b9210f6ef0a601a417ce6737aa6d92097 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 4 Sep 2024 13:51:28 -0400 Subject: [PATCH 08/13] feat: make imandrakit.zip lighter in deps --- src/zip/dune | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/zip/dune b/src/zip/dune index 729f3986..bf273cae 100644 --- a/src/zip/dune +++ b/src/zip/dune @@ -5,5 +5,5 @@ (optional) ; camlzip (preprocess (pps ppx_deriving.std imandrakit.ser-pack.ppx imandrakit.twine.ppx)) - (flags :standard -open Imandrakit_common) - (libraries imandrakit.common imandrakit camlzip)) + (flags :standard) + (libraries camlzip)) From ab30731cbf99807c86c5610b2bd049728084cd12 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 5 Sep 2024 13:32:26 -0400 Subject: [PATCH 09/13] fix test --- test/zip/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/zip/dune b/test/zip/dune index d1d78268..8e2bfff8 100644 --- a/test/zip/dune +++ b/test/zip/dune @@ -2,5 +2,5 @@ (name run_tests) (package imandrakit) (enabled_if %{lib-available:imandrakit.zip}) - (libraries imandrakit.zip imandrakit.testlib containers) + (libraries imandrakit imandrakit.zip imandrakit.testlib containers) (flags :standard -open Imandrakit -open Imandrakit_zip)) From 1bcff7f1606ba6391523a25402fedc0bf7e58d87 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 5 Sep 2024 15:01:47 -0400 Subject: [PATCH 10/13] chore: dune-project --- dune-project | 1 - 1 file changed, 1 deletion(-) diff --git a/dune-project b/dune-project index 421e5a2e..34558e38 100644 --- a/dune-project +++ b/dune-project @@ -33,7 +33,6 @@ ptime atomic hmap - exn_bt (yojson (>= 1.6)) (mtime From c137f5fd706c53946de322312eeaff4e95c80511 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 12 Sep 2024 12:11:14 -0400 Subject: [PATCH 11/13] ocamlformat --- .ocamlformat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.ocamlformat b/.ocamlformat index 2124d7dd..78183459 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version = 0.24.1 +version = 0.26.2 profile=conventional margin=80 if-then-else=k-r From 31fd8268378fb30905b18be48666b63392ccccae Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 12 Sep 2024 12:11:26 -0400 Subject: [PATCH 12/13] format --- src/core/core_classes.ml | 18 ++++++++---------- src/core/util.ml | 10 +++++----- src/leb128/imandrakit_leb128.ml | 4 ++-- src/log/log_reader.ml | 17 ++++++++--------- src/log/log_reader.mli | 19 +++++++++---------- src/ser-pack/ppx/imandrakit_ser_pack_ppx.ml | 12 ++++++------ src/twine/encode.mli | 2 +- src/twine/ppx/imandrakit_twine_ppx.ml | 12 ++++++------ 8 files changed, 45 insertions(+), 49 deletions(-) diff --git a/src/core/core_classes.ml b/src/core/core_classes.ml index 0555df53..664cc110 100644 --- a/src/core/core_classes.ml +++ b/src/core/core_classes.ml @@ -1,11 +1,10 @@ (** Some fundamental base classes *) (** Named object *) -class type named = - object - method name : string - (** Name of this thing. *) - end +class type named = object + method name : string + (** Name of this thing. *) +end class virtual named' = object @@ -16,11 +15,10 @@ class virtual named' = let () = ignore (fun (_x : named') : named -> (_x :> named)) (** Statistics *) -class type with_stats = - object - method add_stats : Stats.t -> unit - (** Add statistics. *) - end +class type with_stats = object + method add_stats : Stats.t -> unit + (** Add statistics. *) +end (** Default class for {!with_stats} *) class with_stats' : with_stats = diff --git a/src/core/util.ml b/src/core/util.ml index 6b8778a3..d4ef1140 100644 --- a/src/core/util.ml +++ b/src/core/util.ml @@ -111,11 +111,11 @@ let format_duration_s (f : float) : string = print_aux "d" n_day ^ print_aux "h" n_hour ^ print_aux "m" n_min ^ string_of_int n ^ (if f -. floor f >= 0.01 then ( - let s = Printf.sprintf "%.1f" (f -. floor f) in - (* remove the leading "0." *) - "." ^ snd @@ CCString.Split.left_exn ~by:"." s - ) else - "") + let s = Printf.sprintf "%.1f" (f -. floor f) in + (* remove the leading "0." *) + "." ^ snd @@ CCString.Split.left_exn ~by:"." s + ) else + "") ^ "s" ) else if f < 0.010 then spf "%.2fms" (f *. 1000.) diff --git a/src/leb128/imandrakit_leb128.ml b/src/leb128/imandrakit_leb128.ml index 9a578e48..3eacf28f 100644 --- a/src/leb128/imandrakit_leb128.ml +++ b/src/leb128/imandrakit_leb128.ml @@ -78,12 +78,12 @@ module Encode = struct external varint_size : (int64[@unboxed]) -> int = "caml_ix_leb128_varint_size_byte" "caml_ix_leb128_varint_size" - [@@noalloc] + [@@noalloc] (** Compute how many bytes this int would occupy as varint *) external varint_slice : bytes -> (int[@untagged]) -> (int64[@unboxed]) -> unit = "caml_ix_leb128_varint_byte" "caml_ix_leb128_varint" - [@@noalloc] + [@@noalloc] (** Write this int as varint into the given slice *) let[@inline] u64 (buf : Buf.t) (i : int64) = diff --git a/src/log/log_reader.ml b/src/log/log_reader.ml index 1d68a0fe..c3ace4ab 100644 --- a/src/log/log_reader.ml +++ b/src/log/log_reader.ml @@ -1,16 +1,15 @@ module Log = (val Logger.mk_log_str "x.log-reader") module Err = Imandrakit_error.Error -class type t = - object - inherit Core_classes.named +class type t = object + inherit Core_classes.named - method read_events : - only_above_level:Logger.level option -> - filter_meta:(string * string) list -> - unit -> - Logger.Log_event.t Iter.t - end + method read_events : + only_above_level:Logger.level option -> + filter_meta:(string * string) list -> + unit -> + Logger.Log_event.t Iter.t +end class dummy : t = object diff --git a/src/log/log_reader.mli b/src/log/log_reader.mli index b0e9a2b9..1fae63f2 100644 --- a/src/log/log_reader.mli +++ b/src/log/log_reader.mli @@ -4,20 +4,19 @@ some storage (typically, to display them in the web UI). *) -class type t = - object - inherit Core_classes.named +class type t = object + inherit Core_classes.named - method read_events : - only_above_level:Logger.level option -> - filter_meta:(string * string) list -> - unit -> - Logger.Log_event.t Iter.t - (** Read events, in order, from the underlying log source. + method read_events : + only_above_level:Logger.level option -> + filter_meta:(string * string) list -> + unit -> + Logger.Log_event.t Iter.t + (** Read events, in order, from the underlying log source. @param only_above_level if [Some lvl], only events more important than this level (inclusive) are returned @param filter_meta a list of key/value pairs that must match *) - end +end val pp : t Fmt.printer diff --git a/src/ser-pack/ppx/imandrakit_ser_pack_ppx.ml b/src/ser-pack/ppx/imandrakit_ser_pack_ppx.ml index aacb70ce..de7519ac 100644 --- a/src/ser-pack/ppx/imandrakit_ser_pack_ppx.ml +++ b/src/ser-pack/ppx/imandrakit_ser_pack_ppx.ml @@ -193,9 +193,9 @@ let rec ser_expr_of_ty (e : expression) ~(ty : core_type) : expression = in by_full_ser (if args = [] then - f - else - A.Exp.apply f args) + f + else + A.Exp.apply f args) | { ptyp_desc = Ptyp_tuple args; ptyp_loc = loc; _ } -> let ser_args = args @@ -314,9 +314,9 @@ let rec deser_expr_of_ty (e : expression) ~(ty : core_type) : expression = in by_full_deser (if args = [] then - f - else - A.Exp.apply f args) + f + else + A.Exp.apply f args) | { ptyp_desc = Ptyp_tuple args; ptyp_loc = loc; _ } -> let deser_args = args diff --git a/src/twine/encode.mli b/src/twine/encode.mli index 7663b26a..4ef2ee5c 100644 --- a/src/twine/encode.mli +++ b/src/twine/encode.mli @@ -59,7 +59,7 @@ val encode_to_string : 'a encoder -> 'a -> string (** Full entrypoint *) val to_string : 'a encoder -> 'a -> string - [@@deprecated "use encode_to_string instead"] +[@@deprecated "use encode_to_string instead"] (** {2 Caching} diff --git a/src/twine/ppx/imandrakit_twine_ppx.ml b/src/twine/ppx/imandrakit_twine_ppx.ml index 0582fd09..29dc4888 100644 --- a/src/twine/ppx/imandrakit_twine_ppx.ml +++ b/src/twine/ppx/imandrakit_twine_ppx.ml @@ -172,9 +172,9 @@ let rec immediate_expr_of_ty (e : expression) ~(ty : core_type) : expression = in by_encode (if args = [] then - f - else - A.Exp.apply f args) + f + else + A.Exp.apply f args) | { ptyp_desc = Ptyp_tuple args; ptyp_loc = loc; _ } -> let ser_args = args @@ -297,9 +297,9 @@ let rec decode_expr_of_ty (e : expression) ~(ty : core_type) : expression = in by_full_dec (if args = [] then - f - else - A.Exp.apply f args) + f + else + A.Exp.apply f args) | { ptyp_desc = Ptyp_tuple args; ptyp_loc = loc; _ } -> let arity = List.length args in From ac2057d8da1aa1d8e2e51e37dd63243a8db07f86 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 12 Sep 2024 12:13:18 -0400 Subject: [PATCH 13/13] chore: update to released moonpool and picos --- .github/workflows/gh-pages.yml | 4 ---- .github/workflows/main.yml | 10 +--------- dune-project | 6 ++++-- imandrakit-log.opam | 2 +- imandrakit-thread.opam | 2 +- imandrakit.opam | 1 + 6 files changed, 8 insertions(+), 17 deletions(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 49f3b6da..4e4fedc9 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -19,10 +19,6 @@ jobs: dune-cache: true allow-prerelease-opam: true - # temporary until it's in a release - - run: opam pin https://github.com/c-cube/picos.git#simon/split-package -y -n - - run: opam pin https://github.com/c-cube/moonpool.git#simon/move-to-picos -y -n - - run: opam pin . -y -n - run: opam install odig imandrakit imandrakit-thread imandrakit-io imandrakit-log - run: opam exec -- odig odoc --cache-dir=_doc/ imandrakit imandrakit-thread imandrakit-io imandrakit-log diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 21c1b331..531d9dd9 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -31,10 +31,6 @@ jobs: dune-cache: true allow-prerelease-opam: true - # temporary until it's in a release - - run: opam pin https://github.com/c-cube/picos.git#simon/split-package -y -n - - run: opam pin https://github.com/c-cube/moonpool.git#simon/move-to-picos -y -n - - run: opam install -t imandrakit imandrakit-log imandrakit-io --deps-only - run: opam exec -- dune build @install -p imandrakit,imandrakit-log,imandrakit-io - run: opam exec -- dune build @runtest -p imandrakit,imandrakit-log,imandrakit-io @@ -67,10 +63,6 @@ jobs: dune-cache: true allow-prerelease-opam: true - # temporary until it's in a release - - run: opam pin https://github.com/c-cube/picos.git#simon/split-package -y -n - - run: opam pin https://github.com/c-cube/moonpool.git#simon/move-to-picos -y -n - - run: opam install -t imandrakit imandrakit-log imandrakit-io imandrakit-thread --deps-only - run: opam exec -- dune build @install -p imandrakit,imandrakit-io,imandrakit-log,imandrakit-thread - run: opam exec -- dune build @runtest -p imandrakit,imandrakit-io,imandrakit-log,imandrakit-thread @@ -91,7 +83,7 @@ jobs: dune-cache: true allow-prerelease-opam: true - - run: opam install ocamlformat.0.24.1 + - run: opam install ocamlformat.0.26.2 - run: opam exec -- make format-check # vim:foldmethod=indent diff --git a/dune-project b/dune-project index 34558e38..25c4fc53 100644 --- a/dune-project +++ b/dune-project @@ -33,6 +33,8 @@ ptime atomic hmap + (moonpool + (>= 0.7)) (yojson (>= 1.6)) (mtime @@ -73,7 +75,7 @@ hmap dune (moonpool - (>= 0.6)) + (>= 0.7)) logs thread-local-storage (trace-tef :with-test) @@ -106,7 +108,7 @@ hmap dune (moonpool - (>= 0.6)) + (>= 0.7)) thread-local-storage (trace-tef :with-test) (odoc :with-doc))) diff --git a/imandrakit-log.opam b/imandrakit-log.opam index a00c76a3..19386c1f 100644 --- a/imandrakit-log.opam +++ b/imandrakit-log.opam @@ -12,7 +12,7 @@ depends: [ "imandrakit" {= version} "hmap" "dune" {>= "3.0"} - "moonpool" {>= "0.6"} + "moonpool" {>= "0.7"} "logs" "thread-local-storage" "trace-tef" {with-test} diff --git a/imandrakit-thread.opam b/imandrakit-thread.opam index c5cd7524..2a87b2fc 100644 --- a/imandrakit-thread.opam +++ b/imandrakit-thread.opam @@ -13,7 +13,7 @@ depends: [ "logs" "hmap" "dune" {>= "3.0"} - "moonpool" {>= "0.6"} + "moonpool" {>= "0.7"} "thread-local-storage" "trace-tef" {with-test} "odoc" {with-doc} diff --git a/imandrakit.opam b/imandrakit.opam index f5f065ab..d958853b 100644 --- a/imandrakit.opam +++ b/imandrakit.opam @@ -18,6 +18,7 @@ depends: [ "ptime" "atomic" "hmap" + "moonpool" {>= "0.7"} "yojson" {>= "1.6"} "mtime" {>= "2.0"} "ppx_deriving"