[project @ 2002-04-26 16:32:03 by simonpj]

Fix the bug that Sven found when bootstrapping:

     stgSyn/CoreToStg.lhs:1112:
         Couldn't match `#' against `*'
         When matching types `GHC.Prim.Int#' and `a'
  	   Expected type: GHC.Prim.Int#
             Inferred type: a
     In the application `error ("cafRefs " ++ (showSDoc (ppr id)))'

I forgot to keep eRROR_ID in the list of wiredInIds in MkId.
Fixed and commented (but not yet tested).

Simon

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