From e3fbbc15877be4cae22146f9fcaf4ff6ccf91fdb Mon Sep 17 00:00:00 2001
From: favonia <favonia@gmail.com>
Date: Sun, 16 Jun 2024 06:45:07 -0500
Subject: [PATCH] feat: re-expose union functions with the shadow effect
 handler

---
 src/Modifier.ml     | 14 +++++++++++-
 src/ModifierSigs.ml | 54 ++++++++++++++++++++++++++++++++++++---------
 2 files changed, 57 insertions(+), 11 deletions(-)

diff --git a/src/Modifier.ml b/src/Modifier.ml
index 46a911e0..6307dddc 100644
--- a/src/Modifier.ml
+++ b/src/Modifier.ml
@@ -37,6 +37,18 @@ struct
 
   open Perform
 
+  let union ?context ?(prefix=Emp) t1 t2 =
+    Trie.union ~prefix (shadow context) t1 t2
+
+  let union_subtree ?context ?(prefix=Emp) t1 (p, t2) =
+    Trie.union_subtree ~prefix (shadow context) t1 (p, t2)
+
+  let union_singleton ?context ?(prefix=Emp) t b =
+    Trie.union_singleton ~prefix (shadow context) t b
+
+  let union_root ?context ?(prefix=Emp) t v =
+    Trie.union_root ~prefix (shadow context) t v
+
   let modify ?context ?(prefix=Emp) =
     let module L = Language in
     let rec go prefix m t =
@@ -54,7 +66,7 @@ struct
       | L.M_union ms ->
         let f ts m =
           let ti = go prefix m t in
-          Trie.union ~prefix (shadow context) ts ti
+          union ?context ~prefix ts ti
         in
         List.fold_left f Trie.empty ms
       | L.M_hook id -> hook context prefix id t
diff --git a/src/ModifierSigs.ml b/src/ModifierSigs.ml
index 4a22671d..549772c8 100644
--- a/src/ModifierSigs.ml
+++ b/src/ModifierSigs.ml
@@ -37,14 +37,7 @@ sig
   module Param : Param
   open Param
 
-  module type Perform = Perform with module Param := Param
-  (** The signature of a module implementing all effect handlers for a modifier engine. *)
-
-  module Perform : Perform
-  (** The handlers that (re-)perform effects. *)
-
-  module Silence : Perform
-  (** The handlers that silence effects. All the triggers actually do nothing. *)
+  (** {1 Types of Effect Handlers} *)
 
   type not_found_handler = context option -> Trie.bwd_path -> unit
   (** The type of a handler of the {!val:Modifier.S.module-Perform.not_found} effect. *)
@@ -55,11 +48,24 @@ sig
   type hook_handler = context option -> Trie.bwd_path -> hook -> (data, tag) Trie.t -> (data, tag) Trie.t
   (** The type of a handler of the {!val:Modifier.S.module-Perform.hook} effect. *)
 
+  (** {1 The Modifier Engine} *)
+
   val modify : ?context:context -> ?prefix:Trie.bwd_path -> hook Language.t -> (data, tag) Trie.t -> (data, tag) Trie.t
   (** [modify modifier trie] runs the [modifier] on the [trie] and return the transformed trie.
 
-      @param context The context sent to the effect handlers. If unspecified, effects come with {!constructor:None} as their context.
-      @param prefix The prefix prepended to any path or prefix sent to the effect handlers. The default is the empty path ([Emp]). *)
+      @param context The context sent to the [shadow] effect handler. If unspecified, effects come with {!constructor:None} as their context.
+      @param prefix The prefix prepended to any path or prefix sent to the [shadow] effect handlers. The default is the empty path ([Emp]). *)
+
+  (** {1 Runners} *)
+
+  module type Perform = Perform with module Param := Param
+  (** The signature of a module implementing all effect handlers for a modifier engine. *)
+
+  module Perform : Perform
+  (** The handlers that (re-)perform effects. *)
+
+  module Silence : Perform
+  (** The handlers that silence effects. All the triggers actually do nothing. *)
 
   val run : ?not_found:not_found_handler -> ?shadow:shadow_handler -> ?hook:hook_handler -> (unit -> 'a) -> 'a
   (** [run f] initializes the engine and runs the thunk [f].
@@ -82,6 +88,34 @@ sig
       ]}
   *)
 
+  (** {1 Re-exposed Union Functions for Tries} *)
+
+  val union : ?context:context -> ?prefix:Trie.bwd_path -> (data, tag) Trie.t -> (data, tag) Trie.t -> (data, tag) Trie.t
+  (** Re-exposed {!val:Trie.union} with a merger that uses the [shadow] effect handler to resolve name conflicts. [union t1 t2] merges two tries [t1] and [t2]. If both tries have a binding at the same path [p], it will trigger the effect [shadow context p x y] to reconcile the values [x] from [t1] and [y] from [t2] that are both bound at the [path].
+
+      @param context The context sent to the [shadow] effect handler. If unspecified, effects come with {!constructor:None} as their context.
+      @param prefix The prefix prepended to any path or prefix sent to the [shadow] effect handler. The default is the empty path ([Emp]). *)
+
+  val union_subtree : ?context:context -> ?prefix:Trie.bwd_path -> (data, tag) Trie.t -> Trie.path * (data, tag) Trie.t -> (data, tag) Trie.t
+  (** Re-exposed {!val:Trie.union_subtree} with a merger that uses the [shadow] effect handler to resolve name conflicts. [union_subtree t1 (path, t2)] is equivalent to {!val:union}[ t1 (Trie.prefix path t2)], but potentially more efficient.
+
+      @param context The context sent to the [shadow] effect handler. If unspecified, effects come with {!constructor:None} as their context.
+      @param prefix The prefix prepended to any path or prefix sent to the [shadow] effect handler. The default is the empty path ([Emp]). *)
+
+  val union_singleton : ?context:context -> ?prefix:Trie.bwd_path -> (data, tag) Trie.t -> Trie.path * (data * tag) -> (data, tag) Trie.t
+  (** Re-exposed {!val:Trie.union_singleton} with a merger that uses the [shadow] effect handler to resolve name conflicts. [union_singleton t binding] is equivalent to {!val:union}[ t1 (Trie.singleton binding)], but potentially more efficient.
+
+      @param context The context sent to the [shadow] effect handler. If unspecified, effects come with {!constructor:None} as their context.
+      @param prefix The prefix prepended to any path or prefix sent to the [shadow] effect handler. The default is the empty path ([Emp]). *)
+
+  val union_root : ?context:context -> ?prefix:Trie.bwd_path -> (data, tag) Trie.t -> data * tag -> (data, tag) Trie.t
+  (** Re-exposed {!val:Trie.union_root} with a merger that uses the [shadow] effect handler to resolve name conflicts. [union_root t r] is equivalent to {!val:union_singleton}[ t ([], r)], but potentially more efficient.
+
+      @param context The context sent to the [shadow] effect handler. If unspecified, effects come with {!constructor:None} as their context.
+      @param prefix The prefix prepended to any path or prefix sent to the [shadow] effect handler. The default is the empty path ([Emp]). *)
+
+  (** {1 Debugging} *)
+
   val register_printer : ([ `NotFound of context option * Trie.bwd_path | `Shadow of context option * Trie.bwd_path * (data * tag) * (data * tag) | `Hook of context option * Trie.bwd_path * hook * (data, tag) Trie.t ] -> string option) -> unit
   (** [register_printer p] registers a printer [p] via {!val:Printexc.register_printer} to convert unhandled internal effects into strings for the OCaml runtime system to display. Ideally, all internal effects should have been handled by {!val:run} and there is no need to use this function, but when it is not the case, this function can be helpful for debugging. The functor {!module:Modifier.Make} always registers a simple printer to suggest using {!val:run}, but you can register new ones to override it. The return type of the printer [p] should return [Some s] where [s] is the resulting string, or [None] if it chooses not to convert a particular effect. The registered printers are tried in reverse order until one of them returns [Some s] for some [s]; that is, the last registered printer is tried first. Note that this function is a wrapper of {!val:Printexc.register_printer} and all the registered printers (via this function or {!val:Printexc.register_printer}) are put into the same list.