diff options
Diffstat (limited to 'compiler/GHC/Rename/Utils.hs')
-rw-r--r-- | compiler/GHC/Rename/Utils.hs | 30 |
1 files changed, 18 insertions, 12 deletions
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs index a00d97dd0d..a333edf93d 100644 --- a/compiler/GHC/Rename/Utils.hs +++ b/compiler/GHC/Rename/Utils.hs @@ -18,7 +18,7 @@ module GHC.Rename.Utils ( warnForallIdentifier, checkUnusedRecordWildcard, badQualBndrErr, typeAppErr, badFieldConErr, - wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genAppType, + wrapGenSpan, wrapGenSpanI, genHsVar, genLHsVar, genHsApp, genHsApps, genAppType, genHsIntegralLit, genHsTyLit, genSimpleConPat, genVarPat, genWildPat, genSimpleFunBind, genFunBind, @@ -85,9 +85,9 @@ newLocalBndrRn (L loc rdr_name) -- See Note [Binders in Template Haskell] in "GHC.ThToHs" | otherwise = do { unless (isUnqual rdr_name) - (addErrAt (locA loc) (badQualBndrErr rdr_name)) + (addErrAt (locN loc) (badQualBndrErr rdr_name)) ; uniq <- newUnique - ; return (mkInternalName uniq (rdrNameOcc rdr_name) (locA loc)) } + ; return (mkInternalName uniq (rdrNameOcc rdr_name) (locN loc)) } newLocalBndrsRn :: [LocatedN RdrName] -> RnM [Name] newLocalBndrsRn = mapM newLocalBndrRn @@ -111,14 +111,14 @@ bindLocalNamesFV names enclosed_scope checkDupRdrNames :: [LocatedN RdrName] -> RnM () -- Check for duplicated names in a binding group checkDupRdrNames rdr_names_w_loc - = mapM_ (dupNamesErr getLocA) dups + = mapM_ (dupNamesErr getLocN) dups where (_, dups) = removeDupsOn unLoc rdr_names_w_loc checkDupRdrNamesN :: [LocatedN RdrName] -> RnM () -- Check for duplicated names in a binding group checkDupRdrNamesN rdr_names_w_loc - = mapM_ (dupNamesErr getLocA) dups + = mapM_ (dupNamesErr getLocN) dups where (_, dups) = removeDupsOn unLoc rdr_names_w_loc @@ -141,7 +141,7 @@ checkShadowedRdrNames loc_rdr_names where filtered_rdrs = filterOut (isExact . unLoc) loc_rdr_names -- See Note [Binders in Template Haskell] in "GHC.ThToHs" - get_loc_occ (L loc rdr) = (locA loc,rdrNameOcc rdr) + get_loc_occ (L loc rdr) = (locN loc,rdrNameOcc rdr) checkDupAndShadowedNames :: (GlobalRdrEnv, LocalRdrEnv) -> [Name] -> RnM () checkDupAndShadowedNames envs names @@ -437,7 +437,7 @@ check_unused flag bound_names used_names warnForallIdentifier :: LocatedN RdrName -> RnM () warnForallIdentifier (L l rdr_name@(Unqual occ)) | isKw (fsLit "forall") || isKw (fsLit "∀") - = addDiagnosticAt (locA l) (TcRnForallIdentifier rdr_name) + = addDiagnosticAt (locN l) (TcRnForallIdentifier rdr_name) where isKw = (occNameFS occ ==) warnForallIdentifier _ = return () @@ -663,11 +663,16 @@ checkCTupSize tup_size * * ********************************************************************* -} -wrapGenSpan :: a -> LocatedAn an a +wrapGenSpan :: (Monoid an) => a -> LocatedAnS an a -- Wrap something in a "generatedSrcSpan" -- See Note [Rebindable syntax and HsExpansion] wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x +wrapGenSpanI :: a -> LocatedAn an a +-- Wrap something in a "generatedSrcSpan" +-- See Note [Rebindable syntax and HsExpansion] +wrapGenSpanI x = L (noAnnSrcSpanI generatedSrcSpan) x + genHsApps :: Name -> [LHsExpr GhcRn] -> HsExpr GhcRn genHsApps fun args = foldl genHsApp (genHsVar fun) args @@ -683,7 +688,7 @@ genHsVar nm = HsVar noExtField $ wrapGenSpan nm genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn genAppType expr ty = HsAppType noExtField (wrapGenSpan expr) noHsTok (mkEmptyWildCardBndrs (wrapGenSpan ty)) -genHsIntegralLit :: IntegralLit -> LocatedAn an (HsExpr GhcRn) +genHsIntegralLit :: IntegralLit -> LocatedA (HsExpr GhcRn) genHsIntegralLit lit = wrapGenSpan $ HsLit noAnn (HsInt noExtField lit) genHsTyLit :: FastString -> HsType GhcRn @@ -705,16 +710,17 @@ genWildPat = wrapGenSpan $ WildPat noExtField genSimpleFunBind :: Name -> [LPat GhcRn] -> LHsExpr GhcRn -> LHsBind GhcRn genSimpleFunBind fun pats expr - = L gen $ genFunBind (L gen fun) - [mkMatch (mkPrefixFunRhs (L gen fun)) pats expr + = L gen $ genFunBind (L genN fun) + [mkMatch (mkPrefixFunRhs (L genN fun)) pats expr emptyLocalBinds] where gen = noAnnSrcSpan generatedSrcSpan + genN = noAnnSrcSpanN generatedSrcSpan genFunBind :: LocatedN Name -> [LMatch GhcRn (LHsExpr GhcRn)] -> HsBind GhcRn genFunBind fn ms = FunBind { fun_id = fn - , fun_matches = mkMatchGroup Generated (wrapGenSpan ms) + , fun_matches = mkMatchGroup Generated (wrapGenSpanI ms) , fun_ext = emptyNameSet } |