[commit: ghc] wip/spj-wildcard-refactor: Wibbles to merge with master (7ca1b27)
git at git.haskell.org
git at git.haskell.org
Mon Nov 23 16:15:06 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/spj-wildcard-refactor
Link : http://ghc.haskell.org/trac/ghc/changeset/7ca1b27baec059157a4ba874019581a5bdda893e/ghc
>---------------------------------------------------------------
commit 7ca1b27baec059157a4ba874019581a5bdda893e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon Nov 23 16:11:05 2015 +0000
Wibbles to merge with master
>---------------------------------------------------------------
7ca1b27baec059157a4ba874019581a5bdda893e
compiler/deSugar/DsMeta.hs | 4 ++--
compiler/parser/RdrHsSyn.hs | 2 +-
compiler/rename/RnTypes.hs | 8 ++++----
compiler/typecheck/TcHsType.hs | 2 +-
compiler/typecheck/TcRnDriver.hs | 2 +-
5 files changed, 9 insertions(+), 9 deletions(-)
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 80b5785..8d701af 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -769,7 +769,7 @@ rep_wc_ty_sig mk_sig loc sig_ty nm
= do { nm1 <- lookupLOcc nm
; let rep_in_scope_tv tv = do { name <- lookupBinder (hsLTyVarName tv)
; repTyVarBndrWithKind tv name }
- all_tvs = map (noLoc . UserTyVar) implicit_tvs ++ explicit_tvs
+ all_tvs = map (noLoc . UserTyVar . noLoc) implicit_tvs ++ explicit_tvs
; th_tvs <- repList tyVarBndrTyConName rep_in_scope_tv all_tvs
; th_ctxt <- repLContext ctxt
; th_ty <- repLTy ty
@@ -921,7 +921,7 @@ repHsSigWcType (HsIB { hsib_kvs = implicit_kvs
, hsib_body = sig1 })
| (explicit_tvs, ctxt, ty) <- splitLHsSigmaTy (hswc_body sig1)
= addTyVarBinds (HsQTvs { hsq_kvs = implicit_kvs
- , hsq_tvs = map (noLoc . UserTyVar) implicit_tvs
+ , hsq_tvs = map (noLoc . UserTyVar . noLoc) implicit_tvs
++ explicit_tvs })
$ \ th_tvs ->
do { th_ctxt <- repLContext ctxt
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 8db41ec..4b744fe 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -942,7 +942,7 @@ checkPatBind msg lhs (L _ (_,grhss))
([],[])) }
checkValSigLhs :: LHsExpr RdrName -> P (Located RdrName)
-checkValSigLhs (L _ (HsVar lrdr@(L l v)))
+checkValSigLhs (L _ (HsVar lrdr@(L _ v)))
| isUnqual v
, not (isDataOcc (rdrNameOcc v))
= return lrdr
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 401bd70..90aa942 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -591,7 +591,7 @@ rnWildCard _ (AnonWildCard _)
= do { loc <- getSrcSpanM
; uniq <- newUnique
; let name = mkInternalName uniq (mkTyVarOcc "_") loc
- ; return (AnonWildCard name) }
+ ; return (AnonWildCard (L loc name)) }
rnWildCard ctxt wc@(NamedWildCard (L loc rdr_name))
-- NB: The parser only generates NamedWildCard if -XNamedWildCards
@@ -599,7 +599,7 @@ rnWildCard ctxt wc@(NamedWildCard (L loc rdr_name))
= do { mb_name <- lookupOccRn_maybe rdr_name
; traceRn (text "rnWildCard named" <+> (ppr rdr_name $$ ppr mb_name))
; case mb_name of
- Just n -> return (NamedWildCard n)
+ Just n -> return (NamedWildCard (L loc n))
Nothing -> do { addErr msg -- I'm not sure how this can happen
; return (NamedWildCard (L loc (mkUnboundNameRdr rdr_name))) } }
where
@@ -704,11 +704,11 @@ newTyVarNameRn mb_assoc rdr_env loc rdr
collectNamedWildCards :: LHsType RdrName -> [Located RdrName]
collectNamedWildCards hs_ty
= nubBy eqLocated $
- [L l n | L l (NamedWildCard n) <- collectWildCards hs_ty ]
+ [n | L _ (NamedWildCard n) <- collectWildCards hs_ty ]
collectAnonWildCards :: LHsType Name -> [Name]
collectAnonWildCards hs_ty
- = [n | L _ (AnonWildCard n) <- collectWildCards hs_ty ]
+ = [n | L _ (AnonWildCard (L _ n)) <- collectWildCards hs_ty ]
collectWildCards :: LHsType name -> [Located (HsWildCardInfo name)]
-- | Extract all wild cards from a type.
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 4ebe834..105a1b8 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -1098,7 +1098,7 @@ tcHsTyVarBndr :: HsTyVarBndr Name -> TcM TcTyVar
-- with a mutable kind in it.
--
-- Returned TcTyVar has the same name; no cloning
-tcHsTyVarBndr (UserTyVar name)
+tcHsTyVarBndr (UserTyVar (L _ name))
= do { kind <- newMetaKindVar
; return (mkTcTyVar name kind (SkolemTv False)) }
tcHsTyVarBndr (KindedTyVar (L _ name) kind)
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index c6236e4..b7af287 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -1762,7 +1762,7 @@ getGhciStepIO = do
ghciM = nlHsAppTy (nlHsTyVar ghciTy) (nlHsTyVar a_tv)
ioM = nlHsAppTy (nlHsTyVar ioTyConName) (nlHsTyVar a_tv)
- step_ty = noLoc $ HsForAllTy { hst_bndrs = [noLoc $ UserTyVar a_tv]
+ step_ty = noLoc $ HsForAllTy { hst_bndrs = [noLoc $ UserTyVar (noLoc a_tv)]
, hst_body = nlHsFunTy ghciM ioM }
stepTy :: LHsSigWcType Name
More information about the ghc-commits
mailing list