[project @ 2004-11-09 17:04:29 by sof]

[ghc-hetmet.git] / ghc / compiler / rename / RnTypes.lhs

diff --git a/ghc/compiler/rename/RnTypes.lhs b/ghc/compiler/rename/RnTypes.lhs
index 7ec84e0..95f69b2 100644 (file)
--- a/ghc/compiler/rename/RnTypes.lhs
+++ b/ghc/compiler/rename/RnTypes.lhs
@@ -4,7 +4,7 @@
 \section[RnSource]{Main pass of renamer}
 
 \begin{code}
-module RnTypes ( rnHsType, rnLHsType, rnContext,
+module RnTypes ( rnHsType, rnLHsType, rnLHsTypes, rnContext,
                 rnHsSigType, rnHsTypeFVs,
                 rnLPat, rnPat, rnPatsAndThen,          -- Here because it's not part 
                 rnLit, rnOverLit,                      -- of any mutual recursion      
@@ -110,7 +110,7 @@ rnHsType doc (HsTyVar tyvar)
     returnM (HsTyVar tyvar')
 
 rnHsType doc (HsOpTy ty1 (L loc op) ty2)
-  = addSrcSpan loc (
+  = setSrcSpan loc (
       lookupOccRn op                   `thenM` \ op' ->
       lookupTyFixityRn (L loc op')     `thenM` \ fix ->
       rnLHsType doc ty1                        `thenM` \ ty1' ->
@@ -122,6 +122,10 @@ rnHsType doc (HsParTy ty)
   = rnLHsType doc ty           `thenM` \ ty' ->
     returnM (HsParTy ty')
 
+rnHsType doc (HsBangTy b ty)
+  = rnLHsType doc ty           `thenM` \ ty' ->
+    returnM (HsBangTy b ty')
+
 rnHsType doc (HsNumTy i)
   | i == 1    = returnM (HsNumTy i)
   | otherwise = addErr err_msg `thenM_`  returnM (HsNumTy i)
@@ -161,7 +165,7 @@ rnHsType doc (HsAppTy ty1 ty2)
     returnM (HsAppTy ty1' ty2')
 
 rnHsType doc (HsPredTy pred)
-  = rnLPred doc pred   `thenM` \ pred' ->
+  = rnPred doc pred    `thenM` \ pred' ->
     returnM (HsPredTy pred')
 
 rnLHsTypes doc tys = mappM (rnLHsType doc) tys
@@ -169,12 +173,12 @@ rnLHsTypes doc tys = mappM (rnLHsType doc) tys
 
 
 \begin{code}
-rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName] -> LHsContext RdrName
-  -> LHsType RdrName -> RnM (HsType Name)
+rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
+        -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
 
 rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
        -- One reason for this case is that a type like Int#
-       -- starts of as (HsForAllTy Nothing [] Int), in case
+       -- starts off as (HsForAllTy Nothing [] Int), in case
        -- there is some quantification.  Now that we have quantified
        -- and discovered there are no type variables, it's nicer to turn
        -- it into plain Int.  If it were Int# instead of Int, we'd actually
@@ -210,7 +214,7 @@ by the presence of ->
 lookupTyFixityRn (L loc n)
   = doptM Opt_GlasgowExts                      `thenM` \ glaExts ->
     when (not glaExts) 
-       (addSrcSpan loc $ addWarn (infixTyConWarn n))   `thenM_`
+       (setSrcSpan loc $ addWarn (infixTyConWarn n))   `thenM_`
     lookupFixityRn n
 
 -- Building (ty1 `op1` (ty21 `op2` ty22))
@@ -531,7 +535,7 @@ checkTupSize tup_size
 
 forAllWarn doc ty (L loc tyvar)
   = ifOptM Opt_WarnUnusedMatches       $
-    addSrcSpan loc $
+    setSrcSpan loc $
     addWarn (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
                   nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
                   $$
@@ -553,7 +557,8 @@ sectionPrecErr op arg_op section
         nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
 
 infixTyConWarn op
-  = ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op)
+  = vcat [ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op),
+         ftext FSLIT("Use -fglasgow-exts to avoid this warning")]
 
 patSigErr ty
   =  (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)