+
+recSelError, recConError, irrefutPatError, runtimeError,
+ nonExhaustiveGuardsError, patError, noMethodBindingError
+ :: Addr# -> a -- All take a UTF8-encoded C string
+
+recSelError s = throw (RecSelError (unpackCStringUtf8# s)) -- No location info unfortunately
+runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately
+
+nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
+irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
+recConError s = throw (RecConError (untangle s "Missing field in record construction"))
+noMethodBindingError s = throw (NoMethodError (untangle s "No instance nor default method for class operation"))
+patError s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
+
+-----
+
+data PatternMatchFail = PatternMatchFail String
+INSTANCE_TYPEABLE0(PatternMatchFail,patternMatchFailTc,"PatternMatchFail")
+
+instance Exception PatternMatchFail
+
+instance Show PatternMatchFail where
+ showsPrec _ (PatternMatchFail err) = showString err
+
+-----
+
+data RecSelError = RecSelError String
+INSTANCE_TYPEABLE0(RecSelError,recSelErrorTc,"RecSelError")
+
+instance Exception RecSelError
+
+instance Show RecSelError where
+ showsPrec _ (RecSelError err) = showString err
+
+-----
+
+data RecConError = RecConError String
+INSTANCE_TYPEABLE0(RecConError,recConErrorTc,"RecConError")
+
+instance Exception RecConError
+
+instance Show RecConError where
+ showsPrec _ (RecConError err) = showString err
+
+-----
+
+data RecUpdError = RecUpdError String
+INSTANCE_TYPEABLE0(RecUpdError,recUpdErrorTc,"RecUpdError")
+
+instance Exception RecUpdError
+
+instance Show RecUpdError where
+ showsPrec _ (RecUpdError err) = showString err
+
+-----
+
+data NoMethodError = NoMethodError String
+INSTANCE_TYPEABLE0(NoMethodError,noMethodErrorTc,"NoMethodError")
+
+instance Exception NoMethodError
+
+instance Show NoMethodError where
+ showsPrec _ (NoMethodError err) = showString err
+
+-----
+
+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")
+
+instance Exception NonTermination
+
+instance Show NonTermination where
+ showsPrec _ NonTermination = showString "<<loop>>"
+
+-- GHC's RTS calls this
+nonTermination :: SomeException
+nonTermination = toException NonTermination
+
+-----
+
+data Deadlock = Deadlock
+INSTANCE_TYPEABLE0(Deadlock,deadlockTc,"Deadlock")
+
+instance Exception Deadlock
+
+instance Show Deadlock where
+ showsPrec _ Deadlock = showString "<<deadlock>>"
+
+-----
+
+data NestedAtomically = NestedAtomically
+INSTANCE_TYPEABLE0(NestedAtomically,nestedAtomicallyTc,"NestedAtomically")
+
+instance Exception NestedAtomically
+
+instance Show NestedAtomically where
+ showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"
+
+-- GHC's RTS calls this
+nestedAtomically :: SomeException
+nestedAtomically = toException NestedAtomically
+
+-----
+
+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 ->
+ case (killThread# id (toException ex) s) of s1 -> (# s1, () #)
+