Better error message for Template Haskell pattern brackets

[ghc-hetmet.git] / ghc / compiler / typecheck / Inst.lhs

diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 8e8e44a..b270a59 100644 (file)
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -27,8 +27,7 @@ module Inst (
 
        isDict, isClassDict, isMethod, 
        isLinearInst, linearInstType, isIPDict, isInheritableInst,
-       isTyVarDict, isStdClassTyVarDict, isMethodFor, 
-       instBindingRequired,
+       isTyVarDict, isMethodFor, 
 
        zonkInst, zonkInsts,
        instToId, instName,
@@ -43,8 +42,7 @@ import {-# SOURCE #-} TcUnify ( unifyTauTy )  -- Used in checkKind (sigh)
 
 import HsSyn   ( HsLit(..), HsOverLit(..), HsExpr(..), LHsExpr, mkHsApp,
                  nlHsLit, nlHsVar )
-import TcHsSyn ( TcId, TcIdSet, 
-                 mkHsTyApp, mkHsDictApp, zonkId, 
+import TcHsSyn ( mkHsTyApp, mkHsDictApp, zonkId, 
                  mkCoercion, ExprCoFn
                )
 import TcRnMonad
@@ -58,13 +56,13 @@ import TcMType      ( zonkTcType, zonkTcTypes, zonkTcPredType, zonkTcThetaType,
                )
 import TcType  ( Type, TcType, TcThetaType, TcTyVarSet, TcTyVar, TcPredType,
                  PredType(..), SkolemInfo(..), typeKind, mkSigmaTy,
-                 tcSplitForAllTys, tcSplitForAllTys, mkFunTy,
-                 tcSplitPhiTy, tcIsTyVarTy, tcSplitDFunHead,
+                 tcSplitForAllTys, mkFunTy,
+                 tcSplitPhiTy, tcSplitDFunHead,
                  isIntTy,isFloatTy, isIntegerTy, isDoubleTy,
-                 tcIsTyVarTy, mkPredTy, mkTyVarTy, mkTyVarTys,
+                 mkPredTy, mkTyVarTy, mkTyVarTys,
                  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred,
                  isClassPred, isTyVarClassPred, isLinearPred, 
-                 getClassPredTys, getClassPredTys_maybe, mkPredName,
+                 getClassPredTys, mkPredName,
                  isInheritablePred, isIPPred, 
                  tidyType, tidyTypes, tidyFreeTyVars, tcSplitSigmaTy, 
                  pprPred, pprParendType, pprTheta 
@@ -78,9 +76,8 @@ import HscTypes       ( ExternalPackageState(..) )
 import CoreFVs ( idFreeTyVars )
 import DataCon ( DataCon, dataConTyVars, dataConStupidTheta, dataConName, dataConWrapId )
 import Id      ( Id, idName, idType, mkUserLocal, mkLocalId )
-import PrelInfo        ( isStandardClass, isNoDictClass )
 import Name    ( Name, mkMethodOcc, getOccName, getSrcLoc, nameModule,
-                 isInternalName, setNameUnique, mkSystemVarNameEncoded )
+                 isInternalName, setNameUnique, mkSystemVarName )
 import NameSet ( addOneToNameSet )
 import Literal ( inIntRange )
 import Var     ( TyVar, tyVarKind, setIdType )
@@ -194,23 +191,8 @@ isLinearInst other      = False
 
 linearInstType :: Inst -> TcType       -- %x::t  -->  t
 linearInstType (Dict _ (IParam _ ty) _) = ty
-
-
-isStdClassTyVarDict (Dict _ pred _) = case getClassPredTys_maybe pred of
-                                       Just (clas, [ty]) -> isStandardClass clas && tcIsTyVarTy ty
-                                       other             -> False
 \end{code}
 
-Two predicates which deal with the case where class constraints don't
-necessarily result in bindings.  The first tells whether an @Inst@
-must be witnessed by an actual binding; the second tells whether an
-@Inst@ can be generalised over.
-
-\begin{code}
-instBindingRequired :: Inst -> Bool
-instBindingRequired (Dict _ (ClassP clas _) _) = not (isNoDictClass clas)
-instBindingRequired other                     = True
-\end{code}
 
 
 %************************************************************************
@@ -404,9 +386,7 @@ newLitInst orig lit expected_ty     -- Make a LitInst
   = do         { loc <- getInstLoc orig
        ; new_uniq <- newUnique
        ; let
-               lit_nm   = mkSystemVarNameEncoded new_uniq FSLIT("lit")
-               -- The "encoded" bit means that we don't need to
-               -- z-encode the string every time we call this!
+               lit_nm   = mkSystemVarName new_uniq FSLIT("lit")
                lit_inst = LitInst lit_nm lit expected_ty loc
        ; extendLIE lit_inst
        ; return (HsVar (instToId lit_inst)) }
@@ -776,11 +756,11 @@ lookupPred pred@(ClassP clas tys)
 lookupPred ip_pred = return Nothing
 
 record_dfun_usage dfun_id 
-  = do { dflags <- getDOpts
+  = do { gbl <- getGblEnv
        ; let  dfun_name = idName dfun_id
               dfun_mod  = nameModule dfun_name
        ; if isInternalName dfun_name ||    -- Internal name => defined in this module
-            not (isHomeModule dflags dfun_mod)
+            not (isHomeModule (tcg_home_mods gbl) dfun_mod)
          then return () -- internal, or in another package
           else do { tcg_env <- getGblEnv
                   ; updMutVar (tcg_inst_uses tcg_env)