X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FInstEnv.lhs;h=774808d4fea8b6018ad795d69cfeea4375a1d5e5;hb=a385f0af5ea320a18d580f6a36c59c55b3516efd;hp=3042a48044f58fb81ffe0b15c2d2fd4209394d0a;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs index 3042a48..774808d 100644 --- a/compiler/types/InstEnv.lhs +++ b/compiler/types/InstEnv.lhs @@ -7,13 +7,6 @@ The bits common to TcInstDcls and TcDeriv. \begin{code} -{-# OPTIONS_GHC -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings --- for details - module InstEnv ( DFunId, OverlapFlag(..), Instance(..), pprInstance, pprInstanceHdr, pprInstances, @@ -34,13 +27,12 @@ import VarSet import Name import TcType import TyCon -import TcGadt import Unify import Outputable import BasicTypes import UniqFM import Id -import SrcLoc +import FastString import Data.Maybe ( isJust, isNothing ) \end{code} @@ -139,15 +131,15 @@ instance Outputable Instance where pprInstance :: Instance -> SDoc -- Prints the Instance as an instance declaration -pprInstance ispec@(Instance { is_flag = flag }) +pprInstance ispec = hang (pprInstanceHdr ispec) - 2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcSpan ispec))) + 2 (ptext (sLit "--") <+> pprNameLoc (getName ispec)) -- * pprInstanceHdr is used in VStudio to populate the ClassView tree pprInstanceHdr :: Instance -> SDoc -- Prints the Instance as an instance declaration pprInstanceHdr ispec@(Instance { is_flag = flag }) - = ptext SLIT("instance") <+> ppr flag + = ptext (sLit "instance") <+> ppr flag <+> sep [pprThetaArrow theta, pprClassPred clas tys] where (_, theta, clas, tys) = instanceHead ispec @@ -191,7 +183,7 @@ instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool -- possibly be instantiated to actual, nor vice versa; -- False is non-committal instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as -instanceCantMatch ts as = False -- Safe +instanceCantMatch _ _ = False -- Safe \end{code} @@ -378,7 +370,7 @@ extendInstEnv inst_env ins_item@(Instance { is_cls = cls_nm, is_tcs = mb_tcs }) add (ClsIE cur_insts cur_tyvar) _ = ClsIE (ins_item : cur_insts) (ins_tyvar || cur_tyvar) ins_tyvar = not (any isJust mb_tcs) -\end{code} +\end{code} %************************************************************************ @@ -491,9 +483,10 @@ lookupInstEnv (pkg_ie, home_ie) cls tys -- They shouldn't because we allocate separate uniques for them case tcUnifyTys bind_fn tpl_tys tys of Just _ -> find ms (item:us) rest - Nothing -> find ms us rest + Nothing -> find ms us rest --------------- +bind_fn :: TyVar -> BindFlag bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem | otherwise = BindMe -- The key_tys can contain skolem constants, and we can guarantee that those @@ -539,6 +532,6 @@ insert_overlapping new_item (item:items) where overlap_ok = case is_flag instB of NoOverlap -> False - other -> True + _ -> True \end{code}