Skip to content

Commit

Permalink
Comments
Browse files Browse the repository at this point in the history
  • Loading branch information
Simon Peyton Jones committed Jun 6, 2013
1 parent 2227e5e commit a97ebe3
Showing 1 changed file with 21 additions and 2 deletions.
23 changes: 21 additions & 2 deletions GHC/Exception.lhs-boot
@@ -1,3 +1,24 @@
This SOURCE-imported hs-boot module cuts a big dependency loop:

GHC.Exception
imports Data.Maybe
imports GHC.Base
imports GHC.Err
imports {-# SOURCE #-} GHC.Exception

More dramatically

GHC.Exception
imports Data.Typeable
imports Data.Typeable.Internals
imports GHC.Arr (fingerprint representation etc)
imports GHC.Real
imports {-# SOURCE #-} GHC.Exception

However, GHC.Exceptions loop-breaking exports are all nice,
well-behaved, non-bottom values. The clients use 'raise#'
to get a visibly-bottom value.

\begin{code}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
Expand All @@ -11,8 +32,6 @@ module GHC.Exception ( SomeException, errorCallException,
) where
import GHC.Types( Char )

-- These exports are nice, well-behaved, non-bottom values

data SomeException
divZeroException, overflowException, ratioZeroDenomException :: SomeException
errorCallException :: [Char] -> SomeException
Expand Down

0 comments on commit a97ebe3

Please sign in to comment.