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.