X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnHsSyn.lhs;h=7d785362668723966b650ffbfcbd30feb6c91fd0;hp=8774b40625cbe02d8a376208463dde2168a4adf9;hb=432b9c9322181a3644083e3c19b7e240d90659e7;hpb=654a1ba16e47d3ddabeb74b809ee6097c0770d35

diff --git a/compiler/rename/RnHsSyn.lhs b/compiler/rename/RnHsSyn.lhs
index 8774b40..7d78536 100644
--- a/compiler/rename/RnHsSyn.lhs
+++ b/compiler/rename/RnHsSyn.lhs
@@ -4,33 +4,33 @@
 \section[RnHsSyn]{Specialisations of the @HsSyn@ syntax for the renamer}
 
 \begin{code}
-module RnHsSyn( 
-	-- Names
-	charTyCon_name, listTyCon_name, parrTyCon_name, tupleTyCon_name,
-	extractHsTyVars, extractHsTyNames, extractHsTyNames_s, 
-	extractFunDepNames, extractHsCtxtTyNames, extractHsPredTyNames,
-
-	-- Free variables
-	hsSigsFVs, hsSigFVs, conDeclFVs, bangTyFVs,
-	
-	maybeGenericMatch
+module RnHsSyn(
+        -- Names
+        charTyCon_name, listTyCon_name, parrTyCon_name, tupleTyCon_name,
+        extractHsTyVars, extractHsTyNames, extractHsTyNames_s,
+        extractFunDepNames, extractHsCtxtTyNames, extractHsPredTyNames,
+
+        -- Free variables
+        hsSigsFVs, hsSigFVs, conDeclFVs, bangTyFVs,
+
+        maybeGenericMatch
   ) where
 
 #include "HsVersions.h"
 
 import HsSyn
-import Class		( FunDep )
-import TysWiredIn	( tupleTyCon, listTyCon, parrTyCon, charTyCon )
-import Name		( Name, getName, isTyVarName )
+import Class            ( FunDep )
+import TysWiredIn       ( tupleTyCon, listTyCon, parrTyCon, charTyCon )
+import Name             ( Name, getName, isTyVarName )
 import NameSet
-import BasicTypes	( Boxity )
-import SrcLoc		( Located(..), unLoc )
+import BasicTypes       ( Boxity )
+import SrcLoc           ( Located(..), unLoc )
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Free variables}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 These free-variable finders returns tycons and classes too.
@@ -59,21 +59,22 @@ extractHsTyNames ty
     get (HsAppTy ty1 ty2)      = getl ty1 `unionNameSets` getl ty2
     get (HsListTy ty)          = unitNameSet listTyCon_name `unionNameSets` getl ty
     get (HsPArrTy ty)          = unitNameSet parrTyCon_name `unionNameSets` getl ty
-    get (HsTupleTy con tys)    = extractHsTyNames_s tys
+    get (HsTupleTy _ tys)      = extractHsTyNames_s tys
     get (HsFunTy ty1 ty2)      = getl ty1 `unionNameSets` getl ty2
-    get (HsPredTy p)	       = extractHsPredTyNames p
+    get (HsPredTy p)           = extractHsPredTyNames p
     get (HsOpTy ty1 op ty2)    = getl ty1 `unionNameSets` getl ty2 `unionNameSets` unitNameSet (unLoc op)
     get (HsParTy ty)           = getl ty
     get (HsBangTy _ ty)        = getl ty
-    get (HsNumTy n)            = emptyNameSet
-    get (HsTyVar tv)	       = unitNameSet tv
-    get (HsSpliceTy _)         = emptyNameSet	-- Type splices mention no type variables
-    get (HsKindSig ty k)       = getl ty
-    get (HsForAllTy _ tvs 
-		    ctxt ty)   = (extractHsCtxtTyNames ctxt
-					 `unionNameSets` getl ty)
-					    `minusNameSet`
-				  mkNameSet (hsLTyVarNames tvs)
+    get (HsRecTy flds)         = extractHsTyNames_s (map cd_fld_type flds)
+    get (HsNumTy _)            = emptyNameSet
+    get (HsTyVar tv)           = unitNameSet tv
+    get (HsSpliceTy _)         = emptyNameSet   -- Type splices mention no type variables
+    get (HsKindSig ty _)       = getl ty
+    get (HsForAllTy _ tvs
+                    ctxt ty)   = (extractHsCtxtTyNames ctxt
+                                         `unionNameSets` getl ty)
+                                            `minusNameSet`
+                                  mkNameSet (hsLTyVarNames tvs)
     get (HsDocTy ty _)         = getl ty
 
 extractHsTyNames_s  :: [LHsType Name] -> NameSet
@@ -85,63 +86,67 @@ extractHsCtxtTyNames (L _ ctxt)
 
 -- You don't import or export implicit parameters,
 -- so don't mention the IP names
+extractHsPredTyNames :: HsPred Name -> NameSet
 extractHsPredTyNames (HsClassP cls tys)
   = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
 extractHsPredTyNames (HsEqualP ty1 ty2)
   = extractHsTyNames ty1 `unionNameSets` extractHsTyNames ty2
-extractHsPredTyNames (HsIParam n ty)
+extractHsPredTyNames (HsIParam _ ty)
   = extractHsTyNames ty
 \end{code}
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Free variables of declarations}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 Return the Names that must be in scope if we are to use this declaration.
 In all cases this is set up for interface-file declarations:
-	- for class decls we ignore the bindings
-	- for instance decls likewise, plus the pragmas
-	- for rule decls, we ignore HsRules
+        - for class decls we ignore the bindings
+        - for instance decls likewise, plus the pragmas
+        - for rule decls, we ignore HsRules
         - for data decls, we ignore derivings
 
-	*** See "THE NAMING STORY" in HsDecls ****
+        *** See "THE NAMING STORY" in HsDecls ****
 
 \begin{code}
 ----------------
 hsSigsFVs :: [LSig Name] -> FreeVars
 hsSigsFVs sigs = plusFVs (map (hsSigFVs.unLoc) sigs)
 
-hsSigFVs (TypeSig v ty)     = extractHsTyNames ty
-hsSigFVs (SpecInstSig ty)   = extractHsTyNames ty
-hsSigFVs (SpecSig v ty inl) = extractHsTyNames ty
-hsSigFVs other		    = emptyFVs
+hsSigFVs :: Sig Name -> FreeVars
+hsSigFVs (TypeSig _ ty)   = extractHsTyNames ty
+hsSigFVs (SpecInstSig ty) = extractHsTyNames ty
+hsSigFVs (SpecSig _ ty _) = extractHsTyNames ty
+hsSigFVs _                = emptyFVs
 
 ----------------
-conDeclFVs (L _ (ConDecl { con_qvars = tyvars, con_cxt = context, 
-			   con_details = details, con_res = res_ty}))
+conDeclFVs :: LConDecl Name -> FreeVars
+conDeclFVs (L _ (ConDecl { con_qvars = tyvars, con_cxt = context,
+                           con_details = details, con_res = res_ty}))
   = delFVs (map hsLTyVarName tyvars) $
     extractHsCtxtTyNames context  `plusFV`
-    conDetailsFVs details	  `plusFV`
+    conDetailsFVs details         `plusFV`
     conResTyFVs res_ty
 
+conResTyFVs :: ResType Name -> FreeVars
 conResTyFVs ResTyH98       = emptyFVs
 conResTyFVs (ResTyGADT ty) = extractHsTyNames ty
 
-conDetailsFVs (PrefixCon btys)     = plusFVs (map bangTyFVs btys)
-conDetailsFVs (InfixCon bty1 bty2) = bangTyFVs bty1 `plusFV` bangTyFVs bty2
-conDetailsFVs (RecCon flds)	   = plusFVs [bangTyFVs bty | (HsRecField _ bty  _) <- flds]
+conDetailsFVs :: HsConDeclDetails Name -> FreeVars
+conDetailsFVs details = plusFVs (map bangTyFVs (hsConDeclArgTys details))
 
+bangTyFVs :: LHsType Name -> FreeVars
 bangTyFVs bty = extractHsTyNames (getBangType bty)
 \end{code}
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{A few functions on generic defintions
-%*									*
+%*                                                                      *
 %************************************************************************
 
 These functions on generics are defined over Matches Name, which is
@@ -155,5 +160,5 @@ maybeGenericMatch :: LMatch Name -> Maybe (HsType Name, LMatch Name)
 maybeGenericMatch (L loc (Match (L _ (TypePat (L _ ty)) : pats) sig_ty grhss))
   = Just (ty, L loc (Match pats sig_ty grhss))
 
-maybeGenericMatch other_match = Nothing
+maybeGenericMatch _ = Nothing
 \end{code}