Move error-ids to MkCore (from PrelRules)

and adjust imports accordingly

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 1984633..774c919 100644 (file)
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -26,10 +26,7 @@ module MkId (
         -- And some particular Ids; see below for why they are wired in
         wiredInIds, ghcPrimIds,
         unsafeCoerceName, unsafeCoerceId, realWorldPrimId, 
         -- And some particular Ids; see below for why they are wired in
         wiredInIds, ghcPrimIds,
         unsafeCoerceName, unsafeCoerceId, realWorldPrimId, 

-        voidArgId, nullAddrId, seqId, lazyId, lazyIdKey,
-
-       -- Re-export error Ids
-       module PrelRules
+        voidArgId, nullAddrId, seqId, lazyId, lazyIdKey

     ) where
 
 #include "HsVersions.h"
     ) where
 
 #include "HsVersions.h"

@@ -107,24 +104,9 @@ is right here.
 \begin{code}
 wiredInIds :: [Id]
 wiredInIds
 \begin{code}
 wiredInIds :: [Id]
 wiredInIds

-  = [   
-
-    eRROR_ID,   -- This one isn't used anywhere else in the compiler
-                -- But we still need it in wiredInIds so that when GHC
-                -- compiles a program that mentions 'error' we don't
-                -- import its type from the interface file; we just get
-                -- the Id defined here.  Which has an 'open-tyvar' type.
-
-    rUNTIME_ERROR_ID,
-    iRREFUT_PAT_ERROR_ID,
-    nON_EXHAUSTIVE_GUARDS_ERROR_ID,
-    nO_METHOD_BINDING_ERROR_ID,
-    pAT_ERROR_ID,
-    rEC_CON_ERROR_ID,
-    rEC_SEL_ERROR_ID,
-
-    lazyId
-    ] ++ ghcPrimIds
+  =  [lazyId]
+  ++ errorIds          -- Defined in MkCore
+  ++ ghcPrimIds

 
 -- These Ids are exported from GHC.Prim
 ghcPrimIds :: [Id]
 
 -- These Ids are exported from GHC.Prim
 ghcPrimIds :: [Id]

diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index 3e0ad62..a497747 100644 (file)
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -33,12 +33,19 @@ module MkCore (
         
         -- * Constructing list expressions
         mkNilExpr, mkConsExpr, mkListExpr, 
         
         -- * Constructing list expressions
         mkNilExpr, mkConsExpr, mkListExpr, 

-        mkFoldrExpr, mkBuildExpr
+        mkFoldrExpr, mkBuildExpr,
+
+       -- * Error Ids 
+       mkRuntimeErrorApp, mkImpossibleExpr, errorIds,
+       rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
+       nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
+       pAT_ERROR_ID, eRROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID

     ) where
 
 #include "HsVersions.h"
 
 import Id
     ) where
 
 #include "HsVersions.h"
 
 import Id

+import IdInfo

 import Var      ( EvVar, mkWildCoVar, setTyVarUnique )
 
 import CoreSyn
 import Var      ( EvVar, mkWildCoVar, setTyVarUnique )
 
 import CoreSyn

@@ -49,10 +56,12 @@ import HscTypes
 import TysWiredIn
 import PrelNames
 
 import TysWiredIn
 import PrelNames
 

+import TcType          ( mkSigmaTy )

 import Type
 import Type

-import TysPrim          ( alphaTyVar )
+import TysPrim

 import DataCon          ( DataCon, dataConWorkId )
 import DataCon          ( DataCon, dataConWorkId )

-
+import Demand
+import Name

 import Outputable
 import FastString
 import UniqSupply
 import Outputable
 import FastString
 import UniqSupply

@@ -552,4 +561,154 @@ mkBuildExpr elt_ty mk_build_inside = do
     newTyVars tyvar_tmpls = do
       uniqs <- getUniquesM
       return (zipWith setTyVarUnique tyvar_tmpls uniqs)
     newTyVars tyvar_tmpls = do
       uniqs <- getUniquesM
       return (zipWith setTyVarUnique tyvar_tmpls uniqs)

-\end{code}
\ No newline at end of file
+\end{code}
+
+
+%************************************************************************
+%*                                                                      *
+                      Error expressions
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+mkRuntimeErrorApp 
+        :: Id           -- Should be of type (forall a. Addr# -> a)
+                        --      where Addr# points to a UTF8 encoded string
+        -> Type         -- The type to instantiate 'a'
+        -> String       -- The string to print
+        -> CoreExpr
+
+mkRuntimeErrorApp err_id res_ty err_msg 
+  = mkApps (Var err_id) [Type res_ty, err_string]
+  where
+    err_string = Lit (mkMachString err_msg)
+
+mkImpossibleExpr :: Type -> CoreExpr
+mkImpossibleExpr res_ty
+  = mkRuntimeErrorApp rUNTIME_ERROR_ID res_ty "Impossible case alternative"
+\end{code}
+
+%************************************************************************
+%*                                                                      *
+                     Error Ids
+%*                                                                      *
+%************************************************************************
+
+GHC randomly injects these into the code.
+
+@patError@ is just a version of @error@ for pattern-matching
+failures.  It knows various ``codes'' which expand to longer
+strings---this saves space!
+
+@absentErr@ is a thing we put in for ``absent'' arguments.  They jolly
+well shouldn't be yanked on, but if one is, then you will get a
+friendly message from @absentErr@ (rather than a totally random
+crash).
+
+@parError@ is a special version of @error@ which the compiler does
+not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
+templates, but we don't ever expect to generate code for it.
+
+\begin{code}
+errorIds :: [Id]
+errorIds 
+  = [ eRROR_ID,   -- This one isn't used anywhere else in the compiler
+                  -- But we still need it in wiredInIds so that when GHC
+                  -- compiles a program that mentions 'error' we don't
+                  -- import its type from the interface file; we just get
+                  -- the Id defined here.  Which has an 'open-tyvar' type.
+
+      rUNTIME_ERROR_ID,
+      iRREFUT_PAT_ERROR_ID,
+      nON_EXHAUSTIVE_GUARDS_ERROR_ID,
+      nO_METHOD_BINDING_ERROR_ID,
+      pAT_ERROR_ID,
+      rEC_CON_ERROR_ID,
+      rEC_SEL_ERROR_ID,
+      aBSENT_ERROR_ID ]
+
+recSelErrorName, runtimeErrorName, absentErrorName :: Name
+irrefutPatErrorName, recConErrorName, patErrorName :: Name
+nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name
+
+recSelErrorName     = err_nm "recSelError"     recSelErrorIdKey     rEC_SEL_ERROR_ID
+absentErrorName     = err_nm "absentError"     absentErrorIdKey     aBSENT_ERROR_ID
+runtimeErrorName    = err_nm "runtimeError"    runtimeErrorIdKey    rUNTIME_ERROR_ID
+irrefutPatErrorName = err_nm "irrefutPatError" irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID
+recConErrorName     = err_nm "recConError"     recConErrorIdKey     rEC_CON_ERROR_ID
+patErrorName        = err_nm "patError"        patErrorIdKey        pAT_ERROR_ID
+
+noMethodBindingErrorName     = err_nm "noMethodBindingError"
+                                  noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID
+nonExhaustiveGuardsErrorName = err_nm "nonExhaustiveGuardsError" 
+                                  nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID
+
+err_nm :: String -> Unique -> Id -> Name
+err_nm str uniq id = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit str) uniq id
+
+rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, iRREFUT_PAT_ERROR_ID, rEC_CON_ERROR_ID :: Id
+pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id
+rEC_SEL_ERROR_ID                = mkRuntimeErrorId recSelErrorName
+rUNTIME_ERROR_ID                = mkRuntimeErrorId runtimeErrorName
+iRREFUT_PAT_ERROR_ID            = mkRuntimeErrorId irrefutPatErrorName
+rEC_CON_ERROR_ID                = mkRuntimeErrorId recConErrorName
+pAT_ERROR_ID                    = mkRuntimeErrorId patErrorName
+nO_METHOD_BINDING_ERROR_ID      = mkRuntimeErrorId noMethodBindingErrorName
+nON_EXHAUSTIVE_GUARDS_ERROR_ID  = mkRuntimeErrorId nonExhaustiveGuardsErrorName
+
+aBSENT_ERROR_ID :: Id
+-- Not bottoming; no unfolding!  See Note [Absent error Id] in WwLib
+aBSENT_ERROR_ID = mkVanillaGlobal absentErrorName runtimeErrorTy
+
+mkRuntimeErrorId :: Name -> Id
+mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy
+
+runtimeErrorTy :: Type
+-- The runtime error Ids take a UTF8-encoded string as argument
+runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
+\end{code}
+
+\begin{code}
+errorName :: Name
+errorName = mkWiredInIdName gHC_ERR (fsLit "error") errorIdKey eRROR_ID
+
+eRROR_ID :: Id
+eRROR_ID = pc_bottoming_Id errorName errorTy
+
+errorTy  :: Type
+errorTy  = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
+    -- Notice the openAlphaTyVar.  It says that "error" can be applied
+    -- to unboxed as well as boxed types.  This is OK because it never
+    -- returns, so the return type is irrelevant.
+\end{code}
+
+
+%************************************************************************
+%*                                                                      *
+\subsection{Utilities}
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+pc_bottoming_Id :: Name -> Type -> Id
+-- Function of arity 1, which diverges after being given one argument
+pc_bottoming_Id name ty
+ = mkVanillaGlobalWithInfo name ty bottoming_info
+ where
+    bottoming_info = vanillaIdInfo `setStrictnessInfo` Just strict_sig
+                                  `setArityInfo`         1
+                       -- Make arity and strictness agree
+
+        -- Do *not* mark them as NoCafRefs, because they can indeed have
+        -- CAF refs.  For example, pAT_ERROR_ID calls GHC.Err.untangle,
+        -- which has some CAFs
+        -- In due course we may arrange that these error-y things are
+        -- regarded by the GC as permanently live, in which case we
+        -- can give them NoCaf info.  As it is, any function that calls
+        -- any pc_bottoming_Id will itself have CafRefs, which bloats
+        -- SRTs.
+
+    strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
+        -- These "bottom" out, no matter what their arguments
+\end{code}
+

diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs
index 45fbf07..c55d6a4 100644 (file)
--- a/compiler/deSugar/DsArrows.lhs
+++ b/compiler/deSugar/DsArrows.lhs
@@ -34,7 +34,6 @@ import MkCore
 import Name
 import Var
 import Id
 import Name
 import Var
 import Id

-import PrelInfo

 import DataCon
 import TysWiredIn
 import BasicTypes
 import DataCon
 import TysWiredIn
 import BasicTypes

diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index 9df432b..03e009d 100644 (file)
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -52,7 +52,6 @@ import CostCentre
 import Id
 import Var
 import VarSet
 import Id
 import Var
 import VarSet

-import PrelInfo

 import DataCon
 import TysWiredIn
 import BasicTypes
 import DataCon
 import TysWiredIn
 import BasicTypes

diff --git a/compiler/deSugar/DsGRHSs.lhs b/compiler/deSugar/DsGRHSs.lhs
index 24086a2..be697fa 100644 (file)
--- a/compiler/deSugar/DsGRHSs.lhs
+++ b/compiler/deSugar/DsGRHSs.lhs
@@ -21,13 +21,13 @@ import {-# SOURCE #-} DsExpr  ( dsLExpr, dsLocalBinds )
 import {-# SOURCE #-} Match   ( matchSinglePat )
 
 import HsSyn
 import {-# SOURCE #-} Match   ( matchSinglePat )
 
 import HsSyn

+import MkCore

 import CoreSyn
 import Var
 import Type
 
 import DsMonad
 import DsUtils
 import CoreSyn
 import Var
 import Type
 
 import DsMonad
 import DsUtils

-import PrelInfo

 import TysWiredIn
 import PrelNames
 import Name
 import TysWiredIn
 import PrelNames
 import Name

diff --git a/compiler/deSugar/DsListComp.lhs b/compiler/deSugar/DsListComp.lhs
index 46ae129..166bfc2 100644 (file)
--- a/compiler/deSugar/DsListComp.lhs
+++ b/compiler/deSugar/DsListComp.lhs
@@ -34,7 +34,6 @@ import Type
 import TysWiredIn
 import Match
 import PrelNames
 import TysWiredIn
 import Match
 import PrelNames

-import PrelInfo

 import SrcLoc
 import Outputable
 import FastString
 import SrcLoc
 import Outputable
 import FastString

diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index e148cf7..d64a649 100644 (file)
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -35,7 +35,6 @@ import Id
 import DataCon
 import MatchCon
 import MatchLit
 import DataCon
 import MatchCon
 import MatchLit

-import PrelInfo

 import Type
 import TysWiredIn
 import ListSetOps
 import Type
 import TysWiredIn
 import ListSetOps

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 31e5875..e92a160 100644 (file)
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -31,6 +31,7 @@ import TcRnMonad
 
 import PrelNames
 import PrelInfo
 
 import PrelNames
 import PrelInfo

+import MkId    ( seqId )

 import Rules
 import Annotations
 import InstEnv
 import Rules
 import Annotations
 import InstEnv

diff --git a/compiler/prelude/PrelInfo.lhs b/compiler/prelude/PrelInfo.lhs
index dbeb6de..48981b3 100644 (file)
--- a/compiler/prelude/PrelInfo.lhs
+++ b/compiler/prelude/PrelInfo.lhs
@@ -5,7 +5,8 @@
 
 \begin{code}
 module PrelInfo (
 
 \begin{code}
 module PrelInfo (

-       module MkId,
+        wiredInIds, ghcPrimIds,
+        primOpRules, builtinRules,

 
        ghcPrimExports,
        wiredInThings, basicKnownKeyNames,
 
        ghcPrimExports,
        wiredInThings, basicKnownKeyNames,

@@ -24,7 +25,7 @@ module PrelInfo (
 import PrelNames       ( basicKnownKeyNames, 
                          hasKey, charDataConKey, intDataConKey,
                          numericClassKeys, standardClassKeys )
 import PrelNames       ( basicKnownKeyNames, 
                          hasKey, charDataConKey, intDataConKey,
                          numericClassKeys, standardClassKeys )

-
+import PrelRules

 import PrimOp          ( PrimOp, allThePrimOps, primOpOcc, primOpTag, maxPrimOpTag )
 import DataCon         ( DataCon )
 import Id              ( Id, idName )
 import PrimOp          ( PrimOp, allThePrimOps, primOpOcc, primOpTag, maxPrimOpTag )
 import DataCon         ( DataCon )
 import Id              ( Id, idName )

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 2df4012..a10ee2d 100644 (file)
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -1113,7 +1113,7 @@ rightDataConKey                           = mkPreludeDataConUnique 26
 
 \begin{code}
 absentErrorIdKey, augmentIdKey, appendIdKey, buildIdKey, errorIdKey,
 
 \begin{code}
 absentErrorIdKey, augmentIdKey, appendIdKey, buildIdKey, errorIdKey,

-    foldlIdKey, foldrIdKey, recSelErrorIdKey,
+    foldlIdKey, foldrIdKey, recSelErrorIdKey, 

     integerMinusOneIdKey, integerPlusOneIdKey,
     integerPlusTwoIdKey, integerZeroIdKey,
     int2IntegerIdKey, seqIdKey, irrefutPatErrorIdKey, eqStringIdKey,
     integerMinusOneIdKey, integerPlusOneIdKey,
     integerPlusTwoIdKey, integerZeroIdKey,
     int2IntegerIdKey, seqIdKey, irrefutPatErrorIdKey, eqStringIdKey,

diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index c148753..59562a2 100644 (file)
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -12,35 +12,22 @@ ToDo:
    (i1 + i2) only if it results        in a valid Float.
 
 \begin{code}
    (i1 + i2) only if it results        in a valid Float.
 
 \begin{code}

-

 {-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
 
 {-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
 

-module PrelRules ( 
-    primOpRules, builtinRules,
-
-    -- Error Ids defined here because may be called here
-    mkRuntimeErrorApp, mkImpossibleExpr, 
-    rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
-    nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
-    pAT_ERROR_ID, eRROR_ID, rEC_SEL_ERROR_ID,
- ) where
+module PrelRules ( primOpRules, builtinRules ) where

 
 #include "HsVersions.h"
 
 import CoreSyn
 
 #include "HsVersions.h"
 
 import CoreSyn

-import MkCore          ( mkWildCase )
+import MkCore

 import Id
 import Id

-import IdInfo
-import Demand

 import Literal
 import PrimOp          ( PrimOp(..), tagToEnumKey )
 import TysWiredIn
 import Literal
 import PrimOp          ( PrimOp(..), tagToEnumKey )
 import TysWiredIn

-import TysPrim

 import TyCon           ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
 import DataCon         ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
 import CoreUtils       ( cheapEqExpr )
 import CoreUnfold      ( exprIsConApp_maybe )
 import TyCon           ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
 import DataCon         ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
 import CoreUtils       ( cheapEqExpr )
 import CoreUnfold      ( exprIsConApp_maybe )

-import TcType          ( mkSigmaTy )

 import Type
 import OccName         ( occNameFS )
 import PrelNames
 import Type
 import OccName         ( occNameFS )
 import PrelNames

@@ -614,116 +601,3 @@ match_inline _ (Type _ : e : _)
 match_inline _ _ = Nothing
 \end{code}
 
 match_inline _ _ = Nothing
 \end{code}
 

-%************************************************************************
-%*                                                                      *
-\subsection[PrelVals-error-related]{@error@ and friends; @trace@}
-%*                                                                      *
-%************************************************************************
-b
-GHC randomly injects these into the code.
-
-@patError@ is just a version of @error@ for pattern-matching
-failures.  It knows various ``codes'' which expand to longer
-strings---this saves space!
-
-@absentErr@ is a thing we put in for ``absent'' arguments.  They jolly
-well shouldn't be yanked on, but if one is, then you will get a
-friendly message from @absentErr@ (rather than a totally random
-crash).
-
-@parError@ is a special version of @error@ which the compiler does
-not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
-templates, but we don't ever expect to generate code for it.
-
-\begin{code}
-mkRuntimeErrorApp 
-        :: Id           -- Should be of type (forall a. Addr# -> a)
-                        --      where Addr# points to a UTF8 encoded string
-        -> Type         -- The type to instantiate 'a'
-        -> String       -- The string to print
-        -> CoreExpr
-
-mkRuntimeErrorApp err_id res_ty err_msg 
-  = mkApps (Var err_id) [Type res_ty, err_string]
-  where
-    err_string = Lit (mkMachString err_msg)
-
-mkImpossibleExpr :: Type -> CoreExpr
-mkImpossibleExpr res_ty
-  = mkRuntimeErrorApp rUNTIME_ERROR_ID res_ty "Impossible case alternative"
-
-errorName, recSelErrorName, runtimeErrorName :: Name
-irrefutPatErrorName, recConErrorName, patErrorName :: Name
-nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name
-errorName                = mkWiredInIdName gHC_ERR (fsLit "error")            errorIdKey eRROR_ID
-recSelErrorName          = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "recSelError")     recSelErrorIdKey rEC_SEL_ERROR_ID
-runtimeErrorName         = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "runtimeError")    runtimeErrorIdKey rUNTIME_ERROR_ID
-irrefutPatErrorName      = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID
-recConErrorName          = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "recConError")     recConErrorIdKey rEC_CON_ERROR_ID
-patErrorName             = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "patError")         patErrorIdKey pAT_ERROR_ID
-noMethodBindingErrorName = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "noMethodBindingError")
-                                           noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID
-nonExhaustiveGuardsErrorName 
-  = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit "nonExhaustiveGuardsError") 
-                    nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID
-
-rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, iRREFUT_PAT_ERROR_ID, rEC_CON_ERROR_ID :: Id
-pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id
-rEC_SEL_ERROR_ID                = mkRuntimeErrorId recSelErrorName
-rUNTIME_ERROR_ID                = mkRuntimeErrorId runtimeErrorName
-iRREFUT_PAT_ERROR_ID            = mkRuntimeErrorId irrefutPatErrorName
-rEC_CON_ERROR_ID                = mkRuntimeErrorId recConErrorName
-pAT_ERROR_ID                    = mkRuntimeErrorId patErrorName
-nO_METHOD_BINDING_ERROR_ID      = mkRuntimeErrorId noMethodBindingErrorName
-nON_EXHAUSTIVE_GUARDS_ERROR_ID  = mkRuntimeErrorId nonExhaustiveGuardsErrorName
-
--- The runtime error Ids take a UTF8-encoded string as argument
-
-mkRuntimeErrorId :: Name -> Id
-mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy
-
-runtimeErrorTy :: Type
-runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
-\end{code}
-
-\begin{code}
-eRROR_ID :: Id
-eRROR_ID = pc_bottoming_Id errorName errorTy
-
-errorTy  :: Type
-errorTy  = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
-    -- Notice the openAlphaTyVar.  It says that "error" can be applied
-    -- to unboxed as well as boxed types.  This is OK because it never
-    -- returns, so the return type is irrelevant.
-\end{code}
-
-
-%************************************************************************
-%*                                                                      *
-\subsection{Utilities}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
-pc_bottoming_Id :: Name -> Type -> Id
--- Function of arity 1, which diverges after being given one argument
-pc_bottoming_Id name ty
- = mkVanillaGlobalWithInfo name ty bottoming_info
- where
-    bottoming_info = vanillaIdInfo `setStrictnessInfo` Just strict_sig
-                                  `setArityInfo`         1
-                       -- Make arity and strictness agree
-
-        -- Do *not* mark them as NoCafRefs, because they can indeed have
-        -- CAF refs.  For example, pAT_ERROR_ID calls GHC.Err.untangle,
-        -- which has some CAFs
-        -- In due course we may arrange that these error-y things are
-        -- regarded by the GC as permanently live, in which case we
-        -- can give them NoCaf info.  As it is, any function that calls
-        -- any pc_bottoming_Id will itself have CafRefs, which bloats
-        -- SRTs.
-
-    strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
-        -- These "bottom" out, no matter what their arguments
-\end{code}
-

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index fd8981a..effd245 100644 (file)
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -15,7 +15,8 @@ import SimplEnv
 import SimplUtils
 import FamInstEnv      ( FamInstEnv )
 import Id
 import SimplUtils
 import FamInstEnv      ( FamInstEnv )
 import Id

-import MkId            ( mkImpossibleExpr, seqId )
+import MkId            ( seqId, realWorldPrimId )
+import MkCore          ( mkImpossibleExpr )

 import Var
 import IdInfo
 import Name            ( mkSystemVarName, isExternalName )
 import Var
 import IdInfo
 import Name            ( mkSystemVarName, isExternalName )

@@ -36,7 +37,6 @@ import Rules            ( lookupRule, getRules )
 import BasicTypes       ( isMarkedStrict, Arity )
 import CostCentre       ( currentCCS, pushCCisNop )
 import TysPrim          ( realWorldStatePrimTy )
 import BasicTypes       ( isMarkedStrict, Arity )
 import CostCentre       ( currentCCS, pushCCisNop )
 import TysPrim          ( realWorldStatePrimTy )

-import PrelInfo         ( realWorldPrimId )

 import BasicTypes       ( TopLevelFlag(..), isTopLevel, RecFlag(..) )
 import MonadUtils      ( foldlM, mapAccumLM )
 import Maybes           ( orElse )
 import BasicTypes       ( TopLevelFlag(..), isTopLevel, RecFlag(..) )
 import MonadUtils      ( foldlM, mapAccumLM )
 import Maybes           ( orElse )

diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index a9e9136..f214f0c 100644 (file)
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -31,7 +31,7 @@ import Coercion
 import Rules
 import Type            hiding( substTy )
 import Id
 import Rules
 import Type            hiding( substTy )
 import Id

-import MkId            ( mkImpossibleExpr )
+import MkCore          ( mkImpossibleExpr )

 import Var
 import VarEnv
 import VarSet
 import Var
 import VarEnv
 import VarSet

diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index 3676671..4e95ad3 100644 (file)
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -41,6 +41,7 @@ import Name
 
 import HscTypes
 import PrelInfo
 
 import HscTypes
 import PrelInfo

+import MkCore  ( eRROR_ID )

 import PrelNames
 import PrimOp
 import SrcLoc
 import PrelNames
 import PrimOp
 import SrcLoc

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 571cd70..2e74b6a 100644 (file)
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -19,6 +19,7 @@ import Inst
 import InstEnv
 import FamInst
 import FamInstEnv
 import InstEnv
 import FamInst
 import FamInstEnv

+import MkCore  ( nO_METHOD_BINDING_ERROR_ID )

 import TcDeriv
 import TcEnv
 import RnSource ( addTcgDUs )
 import TcDeriv
 import TcEnv
 import RnSource ( addTcgDUs )

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 6a6304f..f009637 100644 (file)
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -30,7 +30,8 @@ import Class
 import TyCon
 import DataCon
 import Id
 import TyCon
 import DataCon
 import Id

-import MkId            ( rEC_SEL_ERROR_ID, mkDefaultMethodId )
+import MkId            ( mkDefaultMethodId )
+import MkCore          ( rEC_SEL_ERROR_ID )

 import IdInfo
 import Var
 import VarSet
 import IdInfo
 import Var
 import VarSet