Refactor SrcLoc and SrcSpan

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

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index f2b090b..a825d23 100644 (file)
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -169,8 +169,6 @@ import ListSetOps
 import Outputable
 import FastString
 
-import qualified Data.Foldable as Foldable
-import Data.Functor( (<$>) )
 import Data.List( mapAccumL )
 import Data.IORef
 \end{code}
@@ -311,14 +309,12 @@ data MetaInfo
                   -- A TauTv is always filled in with a tau-type, which
                   -- never contains any ForAlls 
 
-   | SigTv Name           -- A variant of TauTv, except that it should not be
+   | SigTv        -- A variant of TauTv, except that it should not be
                   -- unified with a type, only with a type variable
                   -- SigTvs are only distinguished to improve error messages
                   --      see Note [Signature skolems]        
                   --      The MetaDetails, if filled in, will 
                   --      always be another SigTv or a SkolemTv
-                  -- The Name is the name of the function from whose
-                  -- type signature we got this skolem
 
    | TcsTv        -- A MetaTv allocated by the constraint solver
                   -- Its particular property is that it is always "touchable"
@@ -397,12 +393,12 @@ kind_var_occ = mkOccName tvName "k"
 \begin{code}
 pprTcTyVarDetails :: TcTyVarDetails -> SDoc
 -- For debugging
-pprTcTyVarDetails (SkolemTv _)         = ptext (sLit "sk")
-pprTcTyVarDetails (RuntimeUnk {})      = ptext (sLit "rt")
-pprTcTyVarDetails (FlatSkol {})        = ptext (sLit "fsk")
-pprTcTyVarDetails (MetaTv TauTv _)     = ptext (sLit "tau")
-pprTcTyVarDetails (MetaTv TcsTv _)     = ptext (sLit "tcs")
-pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig")
+pprTcTyVarDetails (SkolemTv {})     = ptext (sLit "sk")
+pprTcTyVarDetails (RuntimeUnk {})  = ptext (sLit "rt")
+pprTcTyVarDetails (FlatSkol {})    = ptext (sLit "fsk")
+pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau")
+pprTcTyVarDetails (MetaTv TcsTv _) = ptext (sLit "tcs")
+pprTcTyVarDetails (MetaTv SigTv _) = ptext (sLit "sig")
 
 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
 pprUserTypeCtxt (FunSigCtxt n)  = ptext (sLit "the type signature for") <+> quotes (ppr n)
@@ -547,7 +543,6 @@ tidyCo env@(_, subst) co
     go (ForAllCo tv co)      = ForAllCo tvp $! (tidyCo envp co)
                                where
                                  (envp, tvp) = tidyTyVarBndr env tv
-    go (PredCo pco)          = PredCo $! (go <$> pco)
     go (CoVarCo cv)          = case lookupVarEnv subst cv of
                                  Nothing  -> CoVarCo cv
                                  Just cv' -> CoVarCo cv'
@@ -586,9 +581,9 @@ isTyConableTyVar tv
        -- not a SigTv
   = ASSERT( isTcTyVar tv) 
     case tcTyVarDetails tv of
-        MetaTv (SigTv _) _ -> False
-       _                  -> True
-
+       MetaTv SigTv _ -> False
+       _              -> True
+       
 isSkolemTyVar tv 
   = ASSERT2( isTcTyVar tv, ppr tv )
     case tcTyVarDetails tv of
@@ -617,8 +612,8 @@ isSigTyVar :: Var -> Bool
 isSigTyVar tv 
   = ASSERT( isTcTyVar tv )
     case tcTyVarDetails tv of
-       MetaTv (SigTv _) _ -> True
-       _                  -> False
+       MetaTv SigTv _ -> True
+       _              -> False
 
 metaTvRef :: TyVar -> IORef MetaDetails
 metaTvRef tv 
@@ -1081,8 +1076,6 @@ orphNamesOfCo (Refl ty)             = orphNamesOfType ty
 orphNamesOfCo (TyConAppCo tc cos)   = unitNameSet (getName tc) `unionNameSets` orphNamesOfCos cos
 orphNamesOfCo (AppCo co1 co2)       = orphNamesOfCo co1 `unionNameSets` orphNamesOfCo co2
 orphNamesOfCo (ForAllCo _ co)       = orphNamesOfCo co
-orphNamesOfCo (PredCo p)            = Foldable.foldr (unionNameSets . orphNamesOfCo)
-                                                      emptyNameSet p
 orphNamesOfCo (CoVarCo _)           = emptyNameSet
 orphNamesOfCo (AxiomInstCo con cos) = orphNamesOfCoCon con `unionNameSets` orphNamesOfCos cos
 orphNamesOfCo (UnsafeCo ty1 ty2)    = orphNamesOfType ty1 `unionNameSets` orphNamesOfType ty2