monads.ml: add TP to Error

[lambda.git] / code / monads.ml

diff --git a/code/monads.ml b/code/monads.ml
index 2ba851b..7bb6894 100644 (file)
--- a/code/monads.ml
+++ b/code/monads.ml
@@ -602,6 +602,11 @@ end) : sig
     val throw : err -> 'a m
     val catch : 'a m -> (err -> 'a m) -> 'a m
   end
     val throw : err -> 'a m
     val catch : 'a m -> (err -> 'a m) -> 'a m
   end

+  (* ErrorT transformer when wrapped monad has plus, zero *)
+  module TP : functor (Wrapped : Monad.P) -> sig
+    include module type of T(Wrapped)
+    include Monad.PLUS with type 'a m := 'a m
+  end

   module T2 : functor (Wrapped : Monad.S2) -> sig
     type ('x,'a) result = ('x,'a) Wrapped.result
     type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
   module T2 : functor (Wrapped : Monad.S2) -> sig
     type ('x,'a) result = ('x,'a) Wrapped.result
     type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn


@@ -674,6 +679,15 @@ end = struct
       | Success _ -> Wrapped.unit t
       | Error e -> handler e)
   end
       | Success _ -> Wrapped.unit t
       | Error e -> handler e)
   end

+  module TP(Wrapped : Monad.P) = struct
+    module TransP = struct
+      include T(Wrapped)
+      let plus u v = Wrapped.plus u v
+      let zero () = elevate (Wrapped.zero ())
+    end
+    include TransP
+    include (Monad.MakeDistrib(TransP) : Monad.PLUS with type 'a m := 'a m)
+  end

   module T2(Wrapped : Monad.S2) = struct
     module Trans = struct
       module Wrapped = Wrapped
   module T2(Wrapped : Monad.S2) = struct
     module Trans = struct
       module Wrapped = Wrapped