From 5985f04c09b203d0499a75dc0dc01662aa2b38f4 Mon Sep 17 00:00:00 2001
From: stolz <unknown>
Date: Fri, 22 Nov 2002 10:52:23 +0000
Subject: [PATCH] [project @ 2002-11-22 10:52:23 by stolz] Add 'mapException'
 as proposed in "A semantics for imprecise exceptions"

Reminded by: Lauri Alanko
---
 Control/Exception.hs |   16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/Control/Exception.hs b/Control/Exception.hs
index 5b653e2..b0a76b8 100644
--- a/Control/Exception.hs
+++ b/Control/Exception.hs
@@ -54,6 +54,9 @@ module Control.Exception (
 	-- ** The @evaluate@ function
 	evaluate,  -- :: a -> IO a
 
+	-- ** The @mapException@ function
+	mapException,		-- :: (Exception -> Exception) -> a -> a
+
 	-- ** Exception predicates
 	
 	-- $preds
@@ -123,6 +126,7 @@ import Hugs.Exception	as ExceptionBase
 
 import Prelude 		hiding ( catch )
 import System.IO.Error
+import System.IO.Unsafe (unsafePerformIO)
 import Data.Dynamic
 
 #include "Dynamic.h"
@@ -244,6 +248,18 @@ evaluate a = a `seq` return a	-- dummy implementation: to be fixed
 #endif
 
 -----------------------------------------------------------------------------
+-- 'mapException'
+
+-- | This function maps one exception into another as proposed in the
+-- paper "A semantics for imprecise exceptions".
+
+-- Notice that the usage of 'unsafePerformIO' is safe here.
+
+mapException :: (Exception -> Exception) -> a -> a
+mapException f v = unsafePerformIO (catch (evaluate v)
+                                          (\x -> throw (f x)))
+
+-----------------------------------------------------------------------------
 -- 'try' and variations.
 
 -- | Similar to 'catch', but returns an 'Either' result which is
-- 
1.7.10.4