summaryrefslogtreecommitdiff
path: root/compiler/GHC/Iface
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Iface')
-rw-r--r--compiler/GHC/Iface/Ext/Ast.hs14
-rw-r--r--compiler/GHC/Iface/Load.hs18
-rw-r--r--compiler/GHC/Iface/Make.hs10
-rw-r--r--compiler/GHC/Iface/Rename.hs21
4 files changed, 35 insertions, 28 deletions
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 3917998c3e..3a511e0d77 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -877,7 +877,7 @@ instance HiePass p => ToHie (Located (PatSynBind (GhcPass p) (GhcPass p))) where
(InfixCon a b) -> combineScopes (mkLScope a) (mkLScope b)
(RecCon r) -> foldr go NoScope r
go (RecordPatSynField a b) c = combineScopes c
- $ combineScopes (mkLScope a) (mkLScope b)
+ $ combineScopes (mkLScope (rdrNameFieldOcc a)) (mkLScope b)
detSpan = case detScope of
LocalScope a -> Just a
_ -> Nothing
@@ -1889,8 +1889,12 @@ instance ToHie (Located (DataFamInstDecl GhcRn)) where
instance ToHie (Located (TyFamInstDecl GhcRn)) where
toHie (L sp (TyFamInstDecl d)) = toHie $ TS (ResolvedScopes [mkScope sp]) d
-instance ToHie (Context a)
- => ToHie (PatSynFieldContext (RecordPatSynField a)) where
+instance HiePass p => ToHie (Context (FieldOcc (GhcPass p))) where
+ toHie (C c (FieldOcc n (L l _))) = case hiePass @p of
+ HieTc -> toHie (C c (L l n))
+ HieRn -> toHie (C c (L l n))
+
+instance HiePass p => ToHie (PatSynFieldContext (RecordPatSynField (GhcPass p))) where
toHie (PSC sp (RecordPatSynField a b)) = concatM $
[ toHie $ C (RecField RecFieldDecl sp) a
, toHie $ C Use b
@@ -2022,7 +2026,7 @@ instance ToHie (IEContext (Located (IE GhcRn))) where
IEThingAll _ n ->
[ toHie $ IEC c n
]
- IEThingWith _ n _ ns flds ->
+ IEThingWith flds n _ ns ->
[ toHie $ IEC c n
, toHie $ map (IEC c) ns
, toHie $ map (IEC c) flds
@@ -2046,7 +2050,7 @@ instance ToHie (IEContext (LIEWrappedName Name)) where
[ toHie $ C (IEThing c) n
]
-instance ToHie (IEContext (Located (FieldLbl Name))) where
+instance ToHie (IEContext (Located FieldLabel)) where
toHie (IEC c (L span lbl)) = concatM $ makeNode lbl span : case lbl of
FieldLabel _ _ n ->
[ toHie $ C (IEThing c) $ L span n
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index e7833d8145..8e5bcf9f4b 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -92,7 +92,6 @@ import GHC.Types.TypeEnv
import GHC.Types.Unique.FM
import GHC.Types.Unique.DSet
import GHC.Types.SrcLoc
-import GHC.Types.FieldLabel
import GHC.Types.TyThing
import GHC.Unit.External
@@ -1134,15 +1133,16 @@ When printing export lists, we print like this:
-}
pprExport :: IfaceExport -> SDoc
-pprExport (Avail n) = ppr n
-pprExport (AvailTC _ [] []) = Outputable.empty
-pprExport (AvailTC n ns0 fs)
- = case ns0 of
- (n':ns) | n==n' -> ppr n <> pp_export ns fs
- _ -> ppr n <> vbar <> pp_export ns0 fs
+pprExport (Avail n) = ppr n
+pprExport (AvailTC _ []) = Outputable.empty
+pprExport avail@(AvailTC n _) =
+ ppr n <> mark <> pp_export (availSubordinateGreNames avail)
where
- pp_export [] [] = Outputable.empty
- pp_export names fs = braces (hsep (map ppr names ++ map (ppr . flLabel) fs))
+ mark | availExportsDecl avail = Outputable.empty
+ | otherwise = vbar
+
+ pp_export [] = Outputable.empty
+ pp_export names = braces (hsep (map ppr names))
pprUsage :: Usage -> SDoc
pprUsage usage@UsagePackageModule{}
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index a37ce7516a..ddeb811564 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -372,14 +372,12 @@ mkIfaceExports exports
where
sort_subs :: AvailInfo -> AvailInfo
sort_subs (Avail n) = Avail n
- sort_subs (AvailTC n [] fs) = AvailTC n [] (sort_flds fs)
- sort_subs (AvailTC n (m:ms) fs)
- | n==m = AvailTC n (m:sortBy stableNameCmp ms) (sort_flds fs)
- | otherwise = AvailTC n (sortBy stableNameCmp (m:ms)) (sort_flds fs)
+ sort_subs (AvailTC n []) = AvailTC n []
+ sort_subs (AvailTC n (m:ms))
+ | NormalGreName n==m = AvailTC n (m:sortBy stableGreNameCmp ms)
+ | otherwise = AvailTC n (sortBy stableGreNameCmp (m:ms))
-- Maintain the AvailTC Invariant
- sort_flds = sortBy (stableNameCmp `on` flSelector)
-
{-
Note [Original module]
~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index 66a8b477f1..aba0c006ca 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -240,20 +240,25 @@ rnModule mod = do
return (renameHoleModule unit_state hmap mod)
rnAvailInfo :: Rename AvailInfo
-rnAvailInfo (Avail n) = Avail <$> rnIfaceGlobal n
-rnAvailInfo (AvailTC n ns fs) = do
+rnAvailInfo (Avail c) = Avail <$> rnGreName c
+rnAvailInfo (AvailTC n ns) = do
-- Why don't we rnIfaceGlobal the availName itself? It may not
-- actually be exported by the module it putatively is from, in
-- which case we won't be able to tell what the name actually
-- is. But for the availNames they MUST be exported, so they
-- will rename fine.
- ns' <- mapM rnIfaceGlobal ns
- fs' <- mapM rnFieldLabel fs
- case ns' ++ map flSelector fs' of
+ ns' <- mapM rnGreName ns
+ case ns' of
[] -> panic "rnAvailInfoEmpty AvailInfo"
- (rep:rest) -> ASSERT2( all ((== nameModule rep) . nameModule) rest, ppr rep $$ hcat (map ppr rest) ) do
- n' <- setNameModule (Just (nameModule rep)) n
- return (AvailTC n' ns' fs')
+ (rep:rest) -> ASSERT2( all ((== childModule rep) . childModule) rest, ppr rep $$ hcat (map ppr rest) ) do
+ n' <- setNameModule (Just (childModule rep)) n
+ return (AvailTC n' ns')
+ where
+ childModule = nameModule . greNameMangledName
+
+rnGreName :: Rename GreName
+rnGreName (NormalGreName n) = NormalGreName <$> rnIfaceGlobal n
+rnGreName (FieldGreName fl) = FieldGreName <$> rnFieldLabel fl
rnFieldLabel :: Rename FieldLabel
rnFieldLabel (FieldLabel l b sel) = do
View Lorry Controller Status