diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 24222352..c8b17b05 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -27,7 +27,7 @@ jobs: - run: opam exec -- dune build @install # install some depopts - - run: opam install thread-local-storage trace hmap + - run: opam install thread-local-storage trace hmap ambient-context.0.2 - run: opam exec -- dune build --profile=release --force @install @runtest compat: diff --git a/dune-project b/dune-project index fe1a05c9..8c243126 100644 --- a/dune-project +++ b/dune-project @@ -60,6 +60,7 @@ :with-test))) (depopts hmap + (ambient-context (>= 0.2)) (trace (>= 0.6))) (tags diff --git a/moonpool.opam b/moonpool.opam index 8a3d5b8a..53f44548 100644 --- a/moonpool.opam +++ b/moonpool.opam @@ -24,6 +24,7 @@ depends: [ ] depopts: [ "hmap" + "ambient-context" {>= "0.2"} "trace" {>= "0.6"} ] build: [ diff --git a/src/ambient-context/dune b/src/ambient-context/dune new file mode 100644 index 00000000..b50d8853 --- /dev/null +++ b/src/ambient-context/dune @@ -0,0 +1,5 @@ +(library + (name moonpool_ambient_context) + (public_name moonpool.ambient-context) + (optional) ; ambient-context + (libraries moonpool hmap ambient-context)) diff --git a/src/ambient-context/moonpool_ambient_context.ml b/src/ambient-context/moonpool_ambient_context.ml new file mode 100644 index 00000000..3b4fef76 --- /dev/null +++ b/src/ambient-context/moonpool_ambient_context.ml @@ -0,0 +1,21 @@ +open struct + module TLS = Moonpool.Task_local_storage +end + +let storage : Ambient_context.Storage.t = + { + name = "moonpool"; + get_context = TLS.get_local_hmap; + with_context = + (fun new_hmap f -> + let old = TLS.get_local_hmap () in + TLS.set_local_hmap new_hmap; + match f () with + | x -> + TLS.set_local_hmap old; + x + | exception exn -> + let bt = Printexc.get_raw_backtrace () in + TLS.set_local_hmap old; + Printexc.raise_with_backtrace exn bt); + }