diff options
| -rw-r--r-- | ghc/compiler/basicTypes/MkId.lhs | 25 | ||||
| -rw-r--r-- | ghc/compiler/stgSyn/CoreToStg.lhs | 4 |
2 files changed, 17 insertions, 12 deletions
diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs index ee92ad1afd..15ed717411 100644 --- a/ghc/compiler/basicTypes/MkId.lhs +++ b/ghc/compiler/basicTypes/MkId.lhs @@ -116,6 +116,12 @@ wiredInIds -- error-reporting functions that they have an 'open' -- result type. -- sof 1/99] + 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, @@ -924,6 +930,16 @@ mkRuntimeErrorId key name = pc_bottoming_Id key pREL_ERR name runtimeErrorTy runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy) \end{code} +\begin{code} +eRROR_ID = pc_bottoming_Id errorIdKey pREL_ERR SLIT("error") 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} + %************************************************************************ %* * @@ -952,17 +968,8 @@ pc_bottoming_Id key mod name ty bottoming_info = noCafNoTyGenIdInfo `setAllStrictnessInfo` Just strict_sig -- these "bottom" out, no matter what their arguments -generic_ERROR_ID u n = pc_bottoming_Id u pREL_ERR n errorTy - (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars openAlphaTy = mkTyVarTy openAlphaTyVar openBetaTy = mkTyVarTy openBetaTyVar - -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} diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs index 1962edf804..1db879401d 100644 --- a/ghc/compiler/stgSyn/CoreToStg.lhs +++ b/ghc/compiler/stgSyn/CoreToStg.lhs @@ -1108,9 +1108,7 @@ cafRefs p (Var id) Just (LetBound (TopLet caf_info) _) -> fastBool (mayHaveCafRefs caf_info) Nothing | isGlobalId id -> fastBool (mayHaveCafRefs (idCafInfo id)) -- Imported | otherwise -> fastBool False -- Nested binder - -- NOTE: The 'fastBool' below is a (temporary?) workaround for a - -- strange bug in GHC. It's strict in its argument, so who cares...? :-} - _other -> fastBool (error ("cafRefs " ++ showSDoc (ppr id))) -- No nested things in env + _other -> error ("cafRefs " ++ showSDoc (ppr id)) -- No nested things in env cafRefs p (Lit l) = fastBool False cafRefs p (App f a) = fastOr (cafRefs p f) (cafRefs p) a |