[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