[project @ 1998-01-27 18:39:01 by sof]

Better failure message when entering an unimplemented instance method

ghc/compiler/basicTypes/Unique.lhs

@@ -117,9 +117,8 @@ module Unique (
 	mutableArrayPrimTyConKey,
 	mutableByteArrayPrimTyConKey,
 	nilDataConKey,
-	noDefaultMethodErrorIdKey,
+	noMethodBindingErrorIdKey,
 	nonExhaustiveGuardsErrorIdKey,
-	nonExplicitMethodErrorIdKey,
 	notIdKey,
 	numClassKey,
 	ordClassKey,
@@ -646,63 +645,62 @@ integerPlusTwoIdKey	      = mkPreludeMiscIdUnique 14
 integerZeroIdKey	      = mkPreludeMiscIdUnique 15
 irrefutPatErrorIdKey	      = mkPreludeMiscIdUnique 16
 lexIdKey		      = mkPreludeMiscIdUnique 17
-noDefaultMethodErrorIdKey     = mkPreludeMiscIdUnique 20
+noMethodBindingErrorIdKey     = mkPreludeMiscIdUnique 20
 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 21
-nonExplicitMethodErrorIdKey   = mkPreludeMiscIdUnique 22
-notIdKey		      = mkPreludeMiscIdUnique 23
-packCStringIdKey	      = mkPreludeMiscIdUnique 24
-parErrorIdKey		      = mkPreludeMiscIdUnique 25
-parIdKey		      = mkPreludeMiscIdUnique 26
-patErrorIdKey		      = mkPreludeMiscIdUnique 27
-readParenIdKey		      = mkPreludeMiscIdUnique 28
-realWorldPrimIdKey	      = mkPreludeMiscIdUnique 29
-recConErrorIdKey	      = mkPreludeMiscIdUnique 30
-recUpdErrorIdKey	      = mkPreludeMiscIdUnique 31
-seqIdKey		      = mkPreludeMiscIdUnique 33
-showParenIdKey		      = mkPreludeMiscIdUnique 34
-showSpaceIdKey		      = mkPreludeMiscIdUnique 35
-showStringIdKey		      = mkPreludeMiscIdUnique 36
-traceIdKey		      = mkPreludeMiscIdUnique 37
-unpackCString2IdKey	      = mkPreludeMiscIdUnique 38
-unpackCStringAppendIdKey      = mkPreludeMiscIdUnique 39
-unpackCStringFoldrIdKey	      = mkPreludeMiscIdUnique 40
-unpackCStringIdKey	      = mkPreludeMiscIdUnique 41
-voidIdKey		      = mkPreludeMiscIdUnique 42
-ushowListIdKey		      = mkPreludeMiscIdUnique 43
-ureadListIdKey		      = mkPreludeMiscIdUnique 44
-
-copyableIdKey		= mkPreludeMiscIdUnique 45
-noFollowIdKey		= mkPreludeMiscIdUnique 46
-parAtAbsIdKey		= mkPreludeMiscIdUnique 47
-parAtForNowIdKey	= mkPreludeMiscIdUnique 48
-parAtIdKey		= mkPreludeMiscIdUnique 49
-parAtRelIdKey		= mkPreludeMiscIdUnique 50
-parGlobalIdKey		= mkPreludeMiscIdUnique 51
-parLocalIdKey		= mkPreludeMiscIdUnique 52
+notIdKey		      = mkPreludeMiscIdUnique 22
+packCStringIdKey	      = mkPreludeMiscIdUnique 23
+parErrorIdKey		      = mkPreludeMiscIdUnique 24
+parIdKey		      = mkPreludeMiscIdUnique 25
+patErrorIdKey		      = mkPreludeMiscIdUnique 26
+readParenIdKey		      = mkPreludeMiscIdUnique 27
+realWorldPrimIdKey	      = mkPreludeMiscIdUnique 28
+recConErrorIdKey	      = mkPreludeMiscIdUnique 29
+recUpdErrorIdKey	      = mkPreludeMiscIdUnique 30
+seqIdKey		      = mkPreludeMiscIdUnique 31
+showParenIdKey		      = mkPreludeMiscIdUnique 32
+showSpaceIdKey		      = mkPreludeMiscIdUnique 33
+showStringIdKey		      = mkPreludeMiscIdUnique 34
+traceIdKey		      = mkPreludeMiscIdUnique 35
+unpackCString2IdKey	      = mkPreludeMiscIdUnique 36
+unpackCStringAppendIdKey      = mkPreludeMiscIdUnique 37
+unpackCStringFoldrIdKey	      = mkPreludeMiscIdUnique 38
+unpackCStringIdKey	      = mkPreludeMiscIdUnique 39
+voidIdKey		      = mkPreludeMiscIdUnique 40
+ushowListIdKey		      = mkPreludeMiscIdUnique 41
+ureadListIdKey		      = mkPreludeMiscIdUnique 42
+
+copyableIdKey		= mkPreludeMiscIdUnique 43
+noFollowIdKey		= mkPreludeMiscIdUnique 44
+parAtAbsIdKey		= mkPreludeMiscIdUnique 45
+parAtForNowIdKey	= mkPreludeMiscIdUnique 46
+parAtIdKey		= mkPreludeMiscIdUnique 47
+parAtRelIdKey		= mkPreludeMiscIdUnique 48
+parGlobalIdKey		= mkPreludeMiscIdUnique 49
+parLocalIdKey		= mkPreludeMiscIdUnique 50
 \end{code}
 
 Certain class operations from Prelude classes.  They get
 their own uniques so we can look them up easily when we want
 to conjure them up during type checking.        
 \begin{code}					  
-fromIntClassOpKey	= mkPreludeMiscIdUnique 53
-fromIntegerClassOpKey	= mkPreludeMiscIdUnique 54
-minusClassOpKey		= mkPreludeMiscIdUnique 55
-fromRationalClassOpKey	= mkPreludeMiscIdUnique 56
-enumFromClassOpKey	= mkPreludeMiscIdUnique 57
-enumFromThenClassOpKey	= mkPreludeMiscIdUnique 58
-enumFromToClassOpKey	= mkPreludeMiscIdUnique 59
-enumFromThenToClassOpKey= mkPreludeMiscIdUnique 60
-eqClassOpKey		= mkPreludeMiscIdUnique 61
-geClassOpKey		= mkPreludeMiscIdUnique 62
-zeroClassOpKey		= mkPreludeMiscIdUnique 63
-thenMClassOpKey		= mkPreludeMiscIdUnique 64 -- (>>=)
-unboundKey		= mkPreludeMiscIdUnique 65	-- Just a place holder for unbound
+fromIntClassOpKey	= mkPreludeMiscIdUnique 51
+fromIntegerClassOpKey	= mkPreludeMiscIdUnique 52
+minusClassOpKey		= mkPreludeMiscIdUnique 53
+fromRationalClassOpKey	= mkPreludeMiscIdUnique 54
+enumFromClassOpKey	= mkPreludeMiscIdUnique 55
+enumFromThenClassOpKey	= mkPreludeMiscIdUnique 56
+enumFromToClassOpKey	= mkPreludeMiscIdUnique 57
+enumFromThenToClassOpKey= mkPreludeMiscIdUnique 58
+eqClassOpKey		= mkPreludeMiscIdUnique 59
+geClassOpKey		= mkPreludeMiscIdUnique 60
+zeroClassOpKey		= mkPreludeMiscIdUnique 61
+thenMClassOpKey		= mkPreludeMiscIdUnique 62 -- (>>=)
+unboundKey		= mkPreludeMiscIdUnique 63	-- Just a place holder for unbound
 							-- variables produced by the renamer
-fromEnumClassOpKey	= mkPreludeMiscIdUnique 66
+fromEnumClassOpKey	= mkPreludeMiscIdUnique 64
 
-mainKey			= mkPreludeMiscIdUnique 67
-returnMClassOpKey	= mkPreludeMiscIdUnique 68
-otherwiseIdKey		= mkPreludeMiscIdUnique 69
-toEnumClassOpKey	= mkPreludeMiscIdUnique 70
+mainKey			= mkPreludeMiscIdUnique 65
+returnMClassOpKey	= mkPreludeMiscIdUnique 66
+otherwiseIdKey		= mkPreludeMiscIdUnique 67
+toEnumClassOpKey	= mkPreludeMiscIdUnique 68
 \end{code}

ghc/compiler/prelude/PrelInfo.lhs

@@ -208,8 +208,7 @@ wired_in_ids
     , integerPlusTwoId
     , integerZeroId
     , nON_EXHAUSTIVE_GUARDS_ERROR_ID
-    , nO_DEFAULT_METHOD_ERROR_ID
-    , nO_EXPLICIT_METHOD_ERROR_ID
+    , nO_METHOD_BINDING_ERROR_ID
     , pAR_ERROR_ID
     , pAT_ERROR_ID
     , packStringForCId

ghc/compiler/prelude/PrelVals.lhs

@@ -95,10 +95,8 @@ iRREFUT_PAT_ERROR_ID
   = generic_ERROR_ID irrefutPatErrorIdKey SLIT("irrefutPatError")
 nON_EXHAUSTIVE_GUARDS_ERROR_ID
   = generic_ERROR_ID nonExhaustiveGuardsErrorIdKey SLIT("nonExhaustiveGuardsError")
-nO_DEFAULT_METHOD_ERROR_ID
-  = generic_ERROR_ID noDefaultMethodErrorIdKey SLIT("noDefaultMethodError")
-nO_EXPLICIT_METHOD_ERROR_ID
-  = generic_ERROR_ID nonExplicitMethodErrorIdKey SLIT("noExplicitMethodError")
+nO_METHOD_BINDING_ERROR_ID
+  = generic_ERROR_ID noMethodBindingErrorIdKey SLIT("noMethodBindingError")
 
 aBSENT_ERROR_ID
   = pc_bottoming_Id absentErrorIdKey gHC_ERR SLIT("absentErr")

ghc/compiler/typecheck/TcInstDcls.lhs

@@ -67,7 +67,7 @@ import Name		( nameOccName, getSrcLoc, mkLocalName,
 			  isLocallyDefined, Module,
 			  NamedThing(..)
 			)
-import PrelVals		( nO_EXPLICIT_METHOD_ERROR_ID, nO_DEFAULT_METHOD_ERROR_ID )
+import PrelVals		( nO_METHOD_BINDING_ERROR_ID )
 import PprType		( pprParendGenType,  pprConstraint )
 import SrcLoc		( SrcLoc, noSrcLoc )
 import TyCon		( tyConDataCons, isSynTyCon, isDataTyCon, tyConDerivings )
@@ -504,19 +504,20 @@ tcInstMethodBind clas inst_tys inst_tyvars meth_binds (sel_id, maybe_dm_id)
 
     mk_default_bind local_meth_name loc
       = PatMonoBind (VarPatIn local_meth_name)
-		    (GRHSsAndBindsIn (unguardedRHS default_expr loc) EmptyBinds)
+		    (GRHSsAndBindsIn (unguardedRHS (default_expr loc) loc) EmptyBinds)
 		    loc
 
-    default_expr = case maybe_dm_id of
-			Just dm_id -> HsVar (getName dm_id)	-- There's a default method
-			Nothing    -> error_expr		-- No default method
+    default_expr loc 
+      = case maybe_dm_id of
+	  Just dm_id -> HsVar (getName dm_id)	-- There's a default method
+   	  Nothing    -> error_expr loc		-- No default method
 
-    error_expr = HsApp (HsVar (getName nO_DEFAULT_METHOD_ERROR_ID)) 
-			      (HsLit (HsString (_PK_ error_msg)))
+    error_expr loc
+      = HsApp (HsVar (getName nO_METHOD_BINDING_ERROR_ID)) 
+	             (HsLit (HsString (_PK_ (error_msg loc))))
+
+    error_msg loc = showSDoc (hcat [ppr loc, text "|", ppr sel_id ])
 
-    error_msg = show (hcat [ppr (getSrcLoc sel_id), text "|", 
-			    ppr sel_id
-		])
 \end{code}
 
 

ghc/lib/ghc/GHCerr.lhs

@@ -17,8 +17,7 @@ module GHCerr
 
        (
          irrefutPatError
-       , noDefaultMethodError
-       , noExplicitMethodError
+       , noMethodBindingError
        , nonExhaustiveGuardsError
        , patError
        , recConError
@@ -124,15 +123,16 @@ seqError = error "Oops! Entered seqError (a GHC bug -- please report it!)\n"
 
 \begin{code}
 irrefutPatError
- , noDefaultMethodError
- , noExplicitMethodError
+ , noMethodBindingError
+ --, noExplicitMethodError
  , nonExhaustiveGuardsError
  , patError
  , recConError
  , recUpdError :: String -> a
 
-noDefaultMethodError     s = error ("noDefaultMethodError:"++s)
-noExplicitMethodError    s = error ("No default method for class operation "++s)
+--noDefaultMethodError     s = error ("noDefaultMethodError:"++s)
+--noExplicitMethodError    s = error ("No default method for class operation "++s)
+noMethodBindingError     s = error (untangle s "No instance nor default method for class operation")
 irrefutPatError		 s = error (untangle s "Irrefutable pattern failed for pattern")
 nonExhaustiveGuardsError s = error (untangle s "Non-exhaustive guards in")
 patError 		 s = error (untangle s "Non-exhaustive patterns in")