diff options
| author | Torsten Schmits <git@tryp.io> | 2022-07-22 22:49:11 +0200 |
|---|---|---|
| committer | Torsten Schmits <git@tryp.io> | 2022-07-22 22:49:11 +0200 |
| commit | 6a817e125099f5d50fc371f430b05f0ac18a5c89 (patch) | |
| tree | be17aaccf3cd21fd2bcc488a387230896432547f | |
| parent | 4ded00fc1fbd1a308d130741d01c8f63404ed321 (diff) | |
| download | haskell-6a817e125099f5d50fc371f430b05f0ac18a5c89.tar.gz | |
filter out named wildcards in scope when renaming them in rnWcBody
| -rw-r--r-- | compiler/GHC/Rename/HsType.hs | 12 |
1 files changed, 9 insertions, 3 deletions
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index 7d62a858bb..70be2f6206 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -234,11 +234,19 @@ rnHsPatSigTypeBindingVars ctxt sigType thing_inside = case sigType of (res, fvs') <- thing_inside sig_ty return (res, fvs `plusFV` fvs') +unboundWildcards :: FreeKiTyVars -> RnM [Name] +unboundWildcards tyvars = do + new <- filterInScopeM tyvars + mapM newLocalBndrRn (nubL (wcs new)) + where + wcs = + filter (startsWithUnderscore . rdrNameOcc . unLoc) + rnWcBody :: HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs -> RnM ([Name], LHsType GhcRn, FreeVars) rnWcBody ctxt tyvars hs_ty = do { wildcards_enabled <- xoptM LangExt.NamedWildCards - ; nwcs <- if wildcards_enabled then mapM newLocalBndrRn (nubL (wcs tyvars)) else pure [] + ; nwcs <- if wildcards_enabled then unboundWildcards tyvars else pure [] ; let env = RTKE { rtke_level = TypeLevel , rtke_what = RnTypeBody , rtke_nwcs = mkNameSet nwcs @@ -247,8 +255,6 @@ rnWcBody ctxt tyvars hs_ty rn_lty env hs_ty ; return (nwcs, hs_ty', fvs) } where - wcs = - filter (startsWithUnderscore . rdrNameOcc . unLoc) rn_lty env (L loc hs_ty) = setSrcSpanA loc $ do { (hs_ty', fvs) <- rn_ty env hs_ty |