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

Better failure message when entering an unimplemented instance method

diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs
index e6abf14..c6b6f0a 100644 (file)
--- a/ghc/compiler/basicTypes/Unique.lhs
+++ b/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}

diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs
index 1edca06..21c2ea2 100644 (file)
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ b/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

diff --git a/ghc/compiler/prelude/PrelVals.lhs b/ghc/compiler/prelude/PrelVals.lhs
index c3885b6..513cec4 100644 (file)
--- a/ghc/compiler/prelude/PrelVals.lhs
+++ b/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")

diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index 97a8b15..8406ff6 100644 (file)
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/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}
 
 

diff --git a/ghc/lib/ghc/GHCerr.lhs b/ghc/lib/ghc/GHCerr.lhs
index afa3f15..578fcac 100644 (file)
--- a/ghc/lib/ghc/GHCerr.lhs
+++ b/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")