[commit: ghc] wip/names3: Fix RnModIface (7803d1b)
git at git.haskell.org
git at git.haskell.org
Thu Oct 13 22:34:43 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/names3
Link : http://ghc.haskell.org/trac/ghc/changeset/7803d1bfb26a4cbdcdb8d324ea6945733a363765/ghc
>---------------------------------------------------------------
commit 7803d1bfb26a4cbdcdb8d324ea6945733a363765
Author: Ben Gamari <ben at smart-cactus.org>
Date: Thu Oct 13 18:29:11 2016 -0400
Fix RnModIface
>---------------------------------------------------------------
7803d1bfb26a4cbdcdb8d324ea6945733a363765
compiler/backpack/RnModIface.hs | 38 +++++++++++++++++++++++++++++---------
compiler/iface/IfaceEnv.hs | 2 +-
utils/haddock | 2 +-
3 files changed, 31 insertions(+), 11 deletions(-)
diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs
index b90edd9..371a65e 100644
--- a/compiler/backpack/RnModIface.hs
+++ b/compiler/backpack/RnModIface.hs
@@ -339,56 +339,69 @@ rnIfaceDecl' (fp, decl) = (,) fp <$> rnIfaceDecl decl
rnIfaceDecl :: Rename IfaceDecl
rnIfaceDecl d at IfaceId{} = do
+ name <- rnIfaceGlobal (ifName d)
ty <- rnIfaceType (ifType d)
details <- rnIfaceIdDetails (ifIdDetails d)
info <- rnIfaceIdInfo (ifIdInfo d)
- return d { ifType = ty
+ return d { ifName = name
+ , ifType = ty
, ifIdDetails = details
, ifIdInfo = info
}
rnIfaceDecl d at IfaceData{} = do
+ name <- rnIfaceGlobal (ifName d)
binders <- mapM rnIfaceTyConBinder (ifBinders d)
ctxt <- mapM rnIfaceType (ifCtxt d)
cons <- rnIfaceConDecls (ifCons d)
parent <- rnIfaceTyConParent (ifParent d)
- return d { ifBinders = binders
+ return d { ifName = name
+ , ifBinders = binders
, ifCtxt = ctxt
, ifCons = cons
, ifParent = parent
}
rnIfaceDecl d at IfaceSynonym{} = do
+ name <- rnIfaceGlobal (ifName d)
binders <- mapM rnIfaceTyConBinder (ifBinders d)
syn_kind <- rnIfaceType (ifResKind d)
syn_rhs <- rnIfaceType (ifSynRhs d)
- return d { ifBinders = binders
+ return d { ifName = name
+ , ifBinders = binders
, ifResKind = syn_kind
, ifSynRhs = syn_rhs
}
rnIfaceDecl d at IfaceFamily{} = do
+ name <- rnIfaceGlobal (ifName d)
binders <- mapM rnIfaceTyConBinder (ifBinders d)
fam_kind <- rnIfaceType (ifResKind d)
fam_flav <- rnIfaceFamTyConFlav (ifFamFlav d)
- return d { ifBinders = binders
+ return d { ifName = name
+ , ifBinders = binders
, ifResKind = fam_kind
, ifFamFlav = fam_flav
}
rnIfaceDecl d at IfaceClass{} = do
+ name <- rnIfaceGlobal (ifName d)
ctxt <- mapM rnIfaceType (ifCtxt d)
binders <- mapM rnIfaceTyConBinder (ifBinders d)
ats <- mapM rnIfaceAT (ifATs d)
sigs <- mapM rnIfaceClassOp (ifSigs d)
- return d { ifCtxt = ctxt
+ return d { ifName = name
+ , ifCtxt = ctxt
, ifBinders = binders
, ifATs = ats
, ifSigs = sigs
}
rnIfaceDecl d at IfaceAxiom{} = do
+ name <- rnIfaceGlobal (ifName d)
tycon <- rnIfaceTyCon (ifTyCon d)
ax_branches <- mapM rnIfaceAxBranch (ifAxBranches d)
- return d { ifTyCon = tycon
+ return d { ifName = name
+ , ifTyCon = tycon
, ifAxBranches = ax_branches
}
rnIfaceDecl d at IfacePatSyn{} = do
+ name <- rnIfaceGlobal (ifName d)
let rnPat (n, b) = (,) <$> rnIfaceGlobal n <*> pure b
pat_matcher <- rnPat (ifPatMatcher d)
pat_builder <- T.traverse rnPat (ifPatBuilder d)
@@ -398,7 +411,8 @@ rnIfaceDecl d at IfacePatSyn{} = do
pat_req_ctxt <- mapM rnIfaceType (ifPatReqCtxt d)
pat_args <- mapM rnIfaceType (ifPatArgs d)
pat_ty <- rnIfaceType (ifPatTy d)
- return d { ifPatMatcher = pat_matcher
+ return d { ifName = name
+ , ifPatMatcher = pat_matcher
, ifPatBuilder = pat_builder
, ifPatUnivBndrs = pat_univ_bndrs
, ifPatExBndrs = pat_ex_bndrs
@@ -435,15 +449,18 @@ rnIfaceConDecls (IfAbstractTyCon b) = pure (IfAbstractTyCon b)
rnIfaceConDecl :: Rename IfaceConDecl
rnIfaceConDecl d = do
+ con_name <- rnIfaceGlobal (ifConName d)
con_ex_tvs <- mapM rnIfaceForAllBndr (ifConExTvs d)
let rnIfConEqSpec (n,t) = (,) n <$> rnIfaceType t
con_eq_spec <- mapM rnIfConEqSpec (ifConEqSpec d)
con_ctxt <- mapM rnIfaceType (ifConCtxt d)
con_arg_tys <- mapM rnIfaceType (ifConArgTys d)
+ con_fields <- mapM rnIfaceGlobal (ifConFields d)
let rnIfaceBang (IfUnpackCo co) = IfUnpackCo <$> rnIfaceCo co
rnIfaceBang bang = pure bang
con_stricts <- mapM rnIfaceBang (ifConStricts d)
- return d { ifConExTvs = con_ex_tvs
+ return d { ifConName = con_name
+ , ifConExTvs = con_ex_tvs
, ifConEqSpec = con_eq_spec
, ifConCtxt = con_ctxt
, ifConArgTys = con_arg_tys
@@ -451,7 +468,10 @@ rnIfaceConDecl d = do
}
rnIfaceClassOp :: Rename IfaceClassOp
-rnIfaceClassOp (IfaceClassOp n ty dm) = IfaceClassOp n <$> rnIfaceType ty <*> rnMaybeDefMethSpec dm
+rnIfaceClassOp (IfaceClassOp n ty dm) =
+ IfaceClassOp <$> rnIfaceGlobal n
+ <*> rnIfaceType ty
+ <*> rnMaybeDefMethSpec dm
rnMaybeDefMethSpec :: Rename (Maybe (DefMethSpec IfaceType))
rnMaybeDefMethSpec (Just (GenericDM ty)) = Just . GenericDM <$> rnIfaceType ty
diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs
index 482ac76..581aa1f 100644
--- a/compiler/iface/IfaceEnv.hs
+++ b/compiler/iface/IfaceEnv.hs
@@ -154,7 +154,7 @@ lookupOrig mod occ
-- which does some stuff that modifies the name cache
-- This did happen, with tycon_mod in TcIface.tcIfaceAlt (DataAlt..)
mod `seq` occ `seq` return ()
--- ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
+ ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
; updNameCache $ \name_cache ->
case lookupOrigNameCache (nsNames name_cache) mod occ of {
diff --git a/utils/haddock b/utils/haddock
index d73b286..25204dd 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit d73b286cb39ad9d02bee4b1a104e817783ceb195
+Subproject commit 25204dd5bf0e7c67d989bde2ca7125468c428e7c
More information about the ghc-commits
mailing list