Re-jig SOURCE imports

* Do not have have an hs-boot file for Data.Typeable
* Instead make all the loops go through
     GHC.Err (just a couple of magic functions)
     GHC.Exception (some non-exceptional functions)

The main idea is
  a) don't involve classes in the hs-boot world
  b) loop through error cases where performance doesn't matter
  c) be careful not to SOURCE import things that are bottom,
     unless MkCore knows about them in eRROR_IDS, so that we
     see their strictness

Data/OldTypeable.hs

@@ -97,7 +97,6 @@ import Data.Maybe
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
-import GHC.Err          (undefined)
 
 import GHC.Fingerprint.Type
 import GHC.Fingerprint

Data/Typeable.hs

@@ -83,9 +83,7 @@ import Data.Typeable.Internal hiding (mkTyCon)
 
 import Unsafe.Coerce
 import Data.Maybe
-
 import GHC.Base
-import GHC.Err          (undefined)
 
 -------------------------------------------------------------
 --
@@ -100,14 +98,12 @@ cast x = if typeRep (Proxy :: Proxy a) == typeRep (Proxy :: Proxy b)
            else Nothing
 
 -- | A flexible variation parameterised in a type constructor
-gcast :: (Typeable (a :: *), Typeable b) => c a -> Maybe (c b)
+gcast :: forall a b c. (Typeable (a :: *), Typeable b) => c a -> Maybe (c b)
 gcast x = r
  where
-  r = if typeRep (getArg x) == typeRep (getArg (fromJust r))
+  r = if typeRep (Proxy :: Proxy a) == typeRep (Proxy :: Proxy b)
         then Just $ unsafeCoerce x
         else Nothing
-  getArg :: c x -> Proxy x 
-  getArg = undefined
 
 -- | Cast for * -> *
 gcast1 :: forall c t t' a. (Typeable (t :: * -> *), Typeable t')

Data/Typeable/Internal.hs

@@ -50,18 +50,17 @@ import GHC.Base
 import GHC.Word
 import GHC.Show
 import Data.Maybe
-import Data.List
 import GHC.Num
 import GHC.Real
-import GHC.IORef
-import GHC.IOArray
-import GHC.MVar
+-- import GHC.IORef
+-- import GHC.IOArray
+-- import GHC.MVar
 import GHC.ST           ( ST )
 import GHC.STRef        ( STRef )
 import GHC.Ptr          ( Ptr, FunPtr )
-import GHC.Stable
+-- import GHC.Stable
 import GHC.Arr          ( Array, STArray )
-import Data.Int
+-- import Data.Int
 
 import GHC.Fingerprint.Type
 import {-# SOURCE #-} GHC.Fingerprint
@@ -165,7 +164,7 @@ mkTyCon3 :: String       -- ^ package name
          -> String       -- ^ the name of the type constructor
          -> TyCon        -- ^ A unique 'TyCon' object
 mkTyCon3 pkg modl name =
-  TyCon (fingerprintString (unwords [pkg, modl, name])) pkg modl name
+  TyCon (fingerprintString (pkg ++ (' ':modl) ++ (' ':name))) pkg modl name
 
 ----------------- Observation ---------------------
 
@@ -249,7 +248,7 @@ instance Show TypeRep where
             showParen (p > 9) $
             showsPrec p tycon . 
             showChar ' '      . 
-            showArgs tys
+            showArgs (showChar ' ') tys
 
 showsTypeRep :: TypeRep -> ShowS
 showsTypeRep = shows
@@ -263,15 +262,14 @@ isTupleTyCon _                         = False
 
 -- Some (Show.TypeRep) helpers:
 
-showArgs :: Show a => [a] -> ShowS
-showArgs [] = id
-showArgs [a] = showsPrec 10 a
-showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as 
+showArgs :: Show a => ShowS -> [a] -> ShowS
+showArgs _   []     = id
+showArgs _   [a]    = showsPrec 10 a
+showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as 
 
 showTuple :: [TypeRep] -> ShowS
 showTuple args = showChar '('
-               . (foldr (.) id $ intersperse (showChar ',') 
-                               $ map (showsPrec 10) args)
+               . showArgs (showChar ',') args
                . showChar ')'
 
 listTc :: TyCon
@@ -297,11 +295,11 @@ INSTANCE_TYPEABLE1(IO,ioTc,"IO")
 
 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
 -- Types defined in GHC.MVar
-INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
+{- INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" ) -}
 #endif
 
 INSTANCE_TYPEABLE2(Array,arrayTc,"Array")
-INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")
+{- INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray") -}
 
 #ifdef __GLASGOW_HASKELL__
 -- Hugs has these too, but their Typeable<n> instances are defined
@@ -325,8 +323,10 @@ INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr")
 #ifndef __GLASGOW_HASKELL__
 INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
 #endif
+{-
 INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")
-INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef")
+INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef") 
+-}
 
 -------------------------------------------------------
 --
@@ -346,10 +346,12 @@ INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")
 INSTANCE_TYPEABLE0(Handle,handleTc,"Handle")
 #endif
 
+{-
 INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8")
 INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")
 INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")
 INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")
+-}
 
 INSTANCE_TYPEABLE0(Word8,word8Tc,"Word8" )
 INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")

Foreign/C/Types.hs

@@ -80,9 +80,7 @@ import Foreign.Storable
 import Data.Bits        ( Bits(..) )
 import Data.Int         ( Int8,  Int16,  Int32,  Int64  )
 import Data.Word        ( Word8, Word16, Word32, Word64 )
-import {-# SOURCE #-} Data.Typeable
-  -- loop: Data.Typeable -> Data.List -> Data.Char -> GHC.Unicode
-  --            -> Foreign.C.Type
+import Data.Typeable
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base

Foreign/ForeignPtr/Imp.hs

@@ -64,7 +64,6 @@ import Foreign.Storable ( Storable(sizeOf) )
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
 import GHC.Num
-import GHC.Err          ( undefined )
 import GHC.ForeignPtr
 #endif
 

Foreign/Marshal/Alloc.hs

@@ -74,7 +74,6 @@ import Foreign.ForeignPtr       ( FinalizerPtr )
 import GHC.IO.Exception
 import GHC.Real
 import GHC.Ptr
-import GHC.Err
 import GHC.Base
 #else
 import Control.Exception.Base   ( bracket )

Foreign/Marshal/Array.hs

@@ -72,7 +72,6 @@ import Foreign.Marshal.Utils (copyBytes, moveBytes)
 #ifdef __GLASGOW_HASKELL__
 import GHC.Num
 import GHC.List
-import GHC.Err
 import GHC.Base
 #else
 import Control.Monad (zipWithM_)

Foreign/Storable.hs

@@ -46,7 +46,7 @@ import GHC.Num
 import GHC.Int
 import GHC.Word
 import GHC.Ptr
-import GHC.Err
+import GHC.Exception
 import GHC.Base
 import GHC.Fingerprint.Type
 import Data.Bits

GHC/Arr.lhs

@@ -47,7 +47,7 @@ import GHC.Num
 import GHC.ST
 import GHC.Base
 import GHC.List
-import GHC.Real
+import GHC.Real( fromIntegral )
 import GHC.Show
 
 infixl 9  !, //
@@ -185,7 +185,7 @@ can do better, so we override the default method for index.
 -- Abstract these errors from the relevant index functions so that
 -- the guts of the function will be small enough to inline.
 
-{-# NOINLINE indexError #-}
+{- # NOINLINE indexError #-}
 indexError :: Show a => (a,a) -> a -> String -> b
 indexError rng i tp
   = error (showString "Ix{" . showString tp . showString "}.index: Index " .

GHC/Base.lhs

@@ -101,8 +101,8 @@ module GHC.Base
         module GHC.CString,
         module GHC.Magic,
         module GHC.Types,
-        module GHC.Prim,        -- Re-export GHC.Prim and GHC.Err, to avoid lots
-        module GHC.Err          -- of people having to import it explicitly
+        module GHC.Prim,    -- Re-export GHC.Prim and [boot] GHC.Err, to avoid lots
+        module GHC.Err      -- of people having to import it explicitly
   )
         where
 
@@ -111,7 +111,7 @@ import GHC.Classes
 import GHC.CString
 import GHC.Magic
 import GHC.Prim
-import {-# SOURCE #-} GHC.Err
+import GHC.Err
 import {-# SOURCE #-} GHC.IO (failIO)
 
 -- This is not strictly speaking required by this module, but is an

GHC/Err.lhs

@@ -1,6 +1,6 @@
 \begin{code}
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, NoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 -----------------------------------------------------------------------------
@@ -23,20 +23,10 @@
 -----------------------------------------------------------------------------
 
 -- #hide
-module GHC.Err
-       (
-         absentErr
-       , divZeroError
-       , ratioZeroDenominatorError
-       , overflowError
-
-       , error
-
-       , undefined
-       ) where
-
+module GHC.Err( absentErr, error, undefined ) where
 import GHC.Types
-import GHC.Exception
+import GHC.Prim
+import {-# SOURCE #-} GHC.Exception( errorCallException )
 \end{code}
 
 %*********************************************************
@@ -48,7 +38,7 @@ import GHC.Exception
 \begin{code}
 -- | 'error' stops execution and displays an error message.
 error :: [Char] -> a
-error s = throw (ErrorCall s)
+error s = raise# (errorCallException s)
 
 -- | A special case of 'error'.
 -- It is expected that compilers will recognize this and insert error
@@ -70,25 +60,6 @@ encoding saves bytes of string junk.
 
 \begin{code}
 absentErr :: a
-
 absentErr = error "Oops! The program has entered an `absent' argument!\n"
 \end{code}
 
-Divide by zero and arithmetic overflow.
-We put them here because they are needed relatively early
-in the libraries before the Exception type has been defined yet.
-
-\begin{code}
-{-# NOINLINE divZeroError #-}
-divZeroError :: a
-divZeroError = throw DivideByZero
-
-{-# NOINLINE ratioZeroDenominatorError #-}
-ratioZeroDenominatorError :: a
-ratioZeroDenominatorError = throw RatioZeroDenominator
-
-{-# NOINLINE overflowError #-}
-overflowError :: a
-overflowError = throw Overflow
-\end{code}
-

GHC/Err.lhs-boot

@@ -6,17 +6,17 @@
 --                  Ghc.Err.hs-boot
 ---------------------------------------------------------------------------
 
-module GHC.Err( error ) where
+module GHC.Err ( error, undefined ) where 
+import GHC.Types( Char )
 
--- The type signature for 'error' is a gross hack.
--- First, we can't give an accurate type for error, because it mentions 
+-- The type signature for 'error'/'undefined' is a gross hack:
+-- we can't give an accurate type for error, because it mentions 
 -- an open type variable.
--- Second, we can't even say error :: [Char] -> a, because Char is defined
--- in GHC.Base, and that would make Err.lhs-boot mutually recursive 
--- with GHC.Base.
 -- Fortunately it doesn't matter what type we give here because the 
 -- compiler will use its wired-in version.  But we have
 -- to mention 'error' so that it gets exported from this .hi-boot
 -- file.
-error    :: a
+
+error     :: [Char] -> a
+undefined :: a
 \end{code}

GHC/Event/Array.hs

@@ -33,7 +33,6 @@ import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
 import Foreign.Ptr (Ptr, nullPtr, plusPtr)
 import Foreign.Storable (Storable(..))
 import GHC.Base
-import GHC.Err (undefined)
 import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_)
 import GHC.Num (Num(..))
 import GHC.Real (fromIntegral)

GHC/Event/EPoll.hsc

@@ -52,7 +52,6 @@ import Foreign.Marshal.Utils (with)
 import Foreign.Ptr (Ptr)
 import Foreign.Storable (Storable(..))
 import GHC.Base
-import GHC.Err (undefined)
 import GHC.Num (Num(..))
 import GHC.Real (ceiling, fromIntegral)
 import GHC.Show (Show)

GHC/Event/Poll.hsc

@@ -37,7 +37,6 @@ import Foreign.Ptr (Ptr)
 import Foreign.Storable (Storable(..))
 import GHC.Base
 import GHC.Conc.Sync (withMVar)
-import GHC.Err (undefined)
 import GHC.Num (Num(..))
 import GHC.Real (ceiling, fromIntegral)
 import GHC.Show (Show)

GHC/Exception.lhs

@@ -22,10 +22,16 @@
 -----------------------------------------------------------------------------
 
 -- #hide
-module GHC.Exception where
+module GHC.Exception
+       ( Exception(..)    -- Class
+       , throw
+       , SomeException(..), ErrorCall(..), ArithException(..)
+       , divZeroException, overflowException, ratioZeroDenomException
+       , errorCallException
+       ) where
 
 import Data.Maybe
-import {-# SOURCE #-} Data.Typeable (Typeable, cast)
+import Data.Typeable (Typeable, cast)
    -- loop: Data.Typeable -> GHC.Err -> GHC.Exception
 import GHC.Base
 import GHC.Show
@@ -173,6 +179,9 @@ instance Exception ErrorCall
 instance Show ErrorCall where
     showsPrec _ (ErrorCall err) = showString err
 
+errorCallException :: String -> SomeException
+errorCallException s = toException (ErrorCall s)
+
 -----
 
 -- |Arithmetic exceptions.
@@ -185,6 +194,11 @@ data ArithException
   | RatioZeroDenominator
   deriving (Eq, Ord, Typeable)
 
+divZeroException, overflowException, ratioZeroDenomException  :: SomeException
+divZeroException  	= toException DivideByZero
+overflowException 	= toException Overflow
+ratioZeroDenomException = toException RatioZeroDenominator
+
 instance Exception ArithException
 
 instance Show ArithException where
@@ -194,5 +208,4 @@ instance Show ArithException where
   showsPrec _ DivideByZero    = showString "divide by zero"
   showsPrec _ Denormal        = showString "denormal"
   showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator"
-
 \end{code}