From: Jim Pryor <profjim@jimpryor.net>
Date: Sat, 11 Dec 2010 15:19:38 +0000 (-0500)
Subject: monads.ml: add TP to Error
X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=commitdiff_plain;h=77808abfd2b5033980938ba74b82a733e36ed4e4

monads.ml: add TP to Error

Signed-off-by: Jim Pryor <profjim@jimpryor.net>
---

diff --git a/code/monads.ml b/code/monads.ml
index 2ba851b3..7bb6894c 100644
--- 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
+  (* 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
@@ -674,6 +679,15 @@ end = struct
       | 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