Commit 7fc01c46 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Move error-ids to MkCore (from PrelRules)

and adjust imports accordingly
parent 1285cf63
......@@ -26,10 +26,7 @@ module MkId (
-- 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"
......@@ -107,24 +104,9 @@ is right here.
\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]
......
......@@ -33,12 +33,19 @@ module MkCore (
-- * 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
import IdInfo
import Var ( EvVar, mkWildCoVar, setTyVarUnique )
import CoreSyn
......@@ -49,10 +56,12 @@ import HscTypes
import TysWiredIn
import PrelNames
import TcType ( mkSigmaTy )
import Type
import TysPrim ( alphaTyVar )
import TysPrim
import DataCon ( DataCon, dataConWorkId )
import Demand
import Name
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)
\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}
......@@ -34,7 +34,6 @@ import MkCore
import Name
import Var
import Id
import PrelInfo
import DataCon
import TysWiredIn
import BasicTypes
......
......@@ -52,7 +52,6 @@ import CostCentre
import Id
import Var
import VarSet
import PrelInfo
import DataCon
import TysWiredIn
import BasicTypes
......
......@@ -21,13 +21,13 @@ import {-# SOURCE #-} DsExpr ( dsLExpr, dsLocalBinds )
import {-# SOURCE #-} Match ( matchSinglePat )
import HsSyn
import MkCore
import CoreSyn
import Var
import Type
import DsMonad
import DsUtils
import PrelInfo
import TysWiredIn
import PrelNames
import Name
......
......@@ -34,7 +34,6 @@ import Type
import TysWiredIn
import Match
import PrelNames
import PrelInfo
import SrcLoc
import Outputable
import FastString
......
......@@ -35,7 +35,6 @@ import Id
import DataCon
import MatchCon
import MatchLit
import PrelInfo
import Type
import TysWiredIn
import ListSetOps
......
......@@ -31,6 +31,7 @@ import TcRnMonad
import PrelNames
import PrelInfo
import MkId ( seqId )
import Rules
import Annotations
import InstEnv
......
......@@ -5,7 +5,8 @@
\begin{code}
module PrelInfo (
module MkId,
wiredInIds, ghcPrimIds,
primOpRules, builtinRules,
ghcPrimExports,
wiredInThings, basicKnownKeyNames,
......@@ -24,7 +25,7 @@ module PrelInfo (
import PrelNames ( basicKnownKeyNames,
hasKey, charDataConKey, intDataConKey,
numericClassKeys, standardClassKeys )
import PrelRules
import PrimOp ( PrimOp, allThePrimOps, primOpOcc, primOpTag, maxPrimOpTag )
import DataCon ( DataCon )
import Id ( Id, idName )
......
......@@ -1113,7 +1113,7 @@ rightDataConKey = mkPreludeDataConUnique 26
\begin{code}
absentErrorIdKey, augmentIdKey, appendIdKey, buildIdKey, errorIdKey,
foldlIdKey, foldrIdKey, recSelErrorIdKey,
foldlIdKey, foldrIdKey, recSelErrorIdKey,
integerMinusOneIdKey, integerPlusOneIdKey,
integerPlusTwoIdKey, integerZeroIdKey,
int2IntegerIdKey, seqIdKey, irrefutPatErrorIdKey, eqStringIdKey,
......
......@@ -12,35 +12,22 @@ ToDo:
(i1 + i2) only if it results in a valid Float.
\begin{code}
{-# 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
import MkCore ( mkWildCase )
import MkCore
import Id
import IdInfo
import Demand
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 TcType ( mkSigmaTy )
import Type
import OccName ( occNameFS )
import PrelNames
......@@ -614,116 +601,3 @@ match_inline _ (Type _ : e : _)
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}
......@@ -15,7 +15,8 @@ import SimplEnv
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 )
......@@ -36,7 +37,6 @@ import Rules ( lookupRule, getRules )
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 )
......
......@@ -31,7 +31,7 @@ import Coercion
import Rules
import Type hiding( substTy )
import Id
import MkId ( mkImpossibleExpr )
import MkCore ( mkImpossibleExpr )
import Var
import VarEnv
import VarSet
......
......@@ -41,6 +41,7 @@ import Name
import HscTypes
import PrelInfo
import MkCore ( eRROR_ID )
import PrelNames
import PrimOp
import SrcLoc
......
......@@ -19,6 +19,7 @@ import Inst
import InstEnv
import FamInst
import FamInstEnv
import MkCore ( nO_METHOD_BINDING_ERROR_ID )
import TcDeriv
import TcEnv
import RnSource ( addTcgDUs )
......
......@@ -30,7 +30,8 @@ import Class
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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment