[project @ 2003-12-10 14:15:16 by simonmar]

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

diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs
index 46a7892..824e95c 100644 (file)
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyDecls.lhs
@@ -12,7 +12,7 @@ files for imported data types.
 
 \begin{code}
 module TcTyDecls(
-        calcTyConArgVrcs, tyVarVrc,
+        calcTyConArgVrcs,
        calcRecFlags, calcCycleErrs,
        newTyConRhs
     ) where
@@ -20,12 +20,12 @@ module TcTyDecls(
 #include "HsVersions.h"
 
 import TypeRep          ( Type(..), TyNote(..), PredType(..) )  -- friend
-import HsSyn           ( TyClDecl(..), HsPred(..) )
+import HsSyn           ( TyClDecl(..), HsPred(..), LTyClDecl )
 import RnHsSyn         ( extractHsTyNames )
 import Type            ( predTypeRep )
 import BuildTyCl       ( newTyConRhs )
 import HscTypes                ( TyThing(..) )
-import TyCon            ( TyCon, ArgVrcs, tyConArity, tyConDataCons_maybe, tyConDataCons, tyConTyVars,
+import TyCon            ( TyCon, ArgVrcs, tyConArity, tyConDataCons, tyConTyVars,
                           getSynTyConDefn, isSynTyCon, isAlgTyCon, isHiBootTyCon,
                          tyConName, isNewTyCon, isProductTyCon, tyConArgVrcs )
 import Class           ( classTyCon )
@@ -36,8 +36,8 @@ import Name           ( Name, isTyVarName )
 import NameEnv
 import NameSet
 import Digraph                 ( SCC(..), stronglyConnComp, stronglyConnCompR )
-import Maybe           ( isNothing )
 import BasicTypes      ( RecFlag(..) )
+import SrcLoc          ( Located(..) )
 import Outputable
 \end{code}
 
@@ -107,18 +107,25 @@ synTyConsOfType ty
 ---------------------------------------- END NOTE ]
 
 \begin{code}
-calcCycleErrs :: [TyClDecl Name] -> ([[Name]], -- Recursive type synonym groups
+calcCycleErrs :: [LTyClDecl Name] -> ([[Name]],        -- Recursive type synonym groups
                                     [[Name]])  -- Ditto classes
 calcCycleErrs decls
   = (findCyclics syn_edges, findCyclics cls_edges)
   where
        --------------- Type synonyms ----------------------
-    syn_edges       = [ (name, mk_syn_edges rhs) | TySynonym { tcdName = name, tcdSynRhs = rhs } <- decls ]
-    mk_syn_edges rhs = [ tc | tc <- nameSetToList (extractHsTyNames rhs), not (isTyVarName tc) ]
+    syn_edges       = [ (name, mk_syn_edges rhs) | 
+                         L _ (TySynonym { tcdLName  = L _ name, 
+                                          tcdSynRhs = rhs }) <- decls ]
+
+    mk_syn_edges rhs = [ tc | tc <- nameSetToList (extractHsTyNames rhs), 
+                             not (isTyVarName tc) ]
 
        --------------- Classes ----------------------
-    cls_edges = [ (name, mk_cls_edges ctxt) | ClassDecl { tcdName = name, tcdCtxt = ctxt } <- decls ]
-    mk_cls_edges ctxt = [ cls | HsClassP cls _ <- ctxt ]
+    cls_edges = [ (name, mk_cls_edges ctxt) | 
+                 L _ (ClassDecl { tcdLName = L _ name, 
+                                  tcdCtxt  = L _ ctxt }) <- decls ]
+
+    mk_cls_edges ctxt = [ cls | L _ (HsClassP cls _) <- ctxt ]
 \end{code}
 
 
@@ -427,18 +434,6 @@ vrcInTy fao v (NewTcApp tc tys)         = let pms1 = map (vrcInTy fao v) tys
 vrcInTy fao v (PredTy st) = vrcInTy fao v (predTypeRep st)
 \end{code}
 
-
-External entry point: assumes tyconargvrcs already computed.
-
-\begin{code}
-tyVarVrc :: TyVar               -- tyvar to check Vrc of
-         -> Type                -- type to check for occ in
-         -> (Bool,Bool)         -- (occurs positively, occurs negatively)
-
-tyVarVrc = vrcInTy tyConArgVrcs
-\end{code}
-
-
 Variance algebra
 ~~~~~~~~~~~~~~~~