From: Ian Lynagh <igloo@earth.li>
Date: Sun, 3 Aug 2008 14:10:40 +0000 (+0000)
Subject: Move assertError into GHC.IOBase
X-Git-Tag: 6_10_branch_has_been_forked~98
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=72a1110579475f3815a067d8bfd5b2883bebe870;p=ghc-base.git

Move assertError into GHC.IOBase
---

diff --git a/Control/Exception.hs b/Control/Exception.hs
index c1dd408..8d5aa2d 100644
--- a/Control/Exception.hs
+++ b/Control/Exception.hs
@@ -558,16 +558,6 @@ instance Show NoMethodError where
 
 -----
 
-data AssertionFailed = AssertionFailed String
-INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
-
-instance Exception AssertionFailed
-
-instance Show AssertionFailed where
-    showsPrec _ (AssertionFailed err) = showString err
-
------
-
 data NonTermination = NonTermination
 INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
 
@@ -600,35 +590,6 @@ instance Exception Dynamic
 
 -----
 
-assertError :: Addr# -> Bool -> a -> a
-assertError str pred v
-  | pred      = v
-  | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
-
-{-
-(untangle coded message) expects "coded" to be of the form
-        "location|details"
-It prints
-        location message details
--}
-untangle :: Addr# -> String -> String
-untangle coded message
-  =  location
-  ++ ": " 
-  ++ message
-  ++ details
-  ++ "\n"
-  where
-    coded_str = unpackCStringUtf8# coded
-
-    (location, details)
-      = case (span not_bar coded_str) of { (loc, rest) ->
-        case rest of
-          ('|':det) -> (loc, ' ' : det)
-          _         -> (loc, "")
-        }
-    not_bar c = c /= '|'
-
 -- XXX From GHC.Conc
 throwTo :: Exception e => ThreadId -> e -> IO ()
 throwTo (ThreadId id) ex = IO $ \ s ->
diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs
index ea4abf4..aa4af69 100644
--- a/GHC/IOBase.lhs
+++ b/GHC/IOBase.lhs
@@ -46,7 +46,7 @@ module GHC.IOBase(
     ExitCode(..),
     throwIO, block, unblock, blocked, catchAny, catchException,
     evaluate,
-    ErrorCall(..),
+    ErrorCall(..), AssertionFailed(..), assertError, untangle,
     BlockedOnDeadMVar(..), BlockedIndefinitely(..), Deadlock(..)
   ) where
 
@@ -670,6 +670,16 @@ instance Show Deadlock where
 
 -----
 
+data AssertionFailed = AssertionFailed String
+    deriving Typeable
+
+instance Exception AssertionFailed
+
+instance Show AssertionFailed where
+    showsPrec _ (AssertionFailed err) = showString err
+
+-----
+
 -- |The type of arithmetic exceptions
 data ArithException
   = Overflow
@@ -1006,3 +1016,34 @@ evaluate a = IO $ \s -> case a `seq` () of () -> (# s, a #)
         -- because we can't have an unboxed tuple as a function argument
 \end{code}
 
+\begin{code}
+assertError :: Addr# -> Bool -> a -> a
+assertError str pred v
+  | pred      = v
+  | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
+
+{-
+(untangle coded message) expects "coded" to be of the form
+        "location|details"
+It prints
+        location message details
+-}
+untangle :: Addr# -> String -> String
+untangle coded message
+  =  location
+  ++ ": "
+  ++ message
+  ++ details
+  ++ "\n"
+  where
+    coded_str = unpackCStringUtf8# coded
+
+    (location, details)
+      = case (span not_bar coded_str) of { (loc, rest) ->
+        case rest of
+          ('|':det) -> (loc, ' ' : det)
+          _         -> (loc, "")
+        }
+    not_bar c = c /= '|'
+\end{code}
+