[commit: ghc] wip/orf-reboot: Fix handling of IEs (9aeac12)
git at git.haskell.org
git at git.haskell.org
Mon Oct 12 06:36:36 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/orf-reboot
Link : http://ghc.haskell.org/trac/ghc/changeset/9aeac1242bb43146d7bc9e58b4e7b2d51508f3b3/ghc
>---------------------------------------------------------------
commit 9aeac1242bb43146d7bc9e58b4e7b2d51508f3b3
Author: Adam Gundry <adam at well-typed.com>
Date: Wed Jul 29 17:59:51 2015 +0100
Fix handling of IEs
>---------------------------------------------------------------
9aeac1242bb43146d7bc9e58b4e7b2d51508f3b3
compiler/rename/RnNames.hs | 19 ++++++++++++++-----
1 file changed, 14 insertions(+), 5 deletions(-)
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 407f993..c67ae0a 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -1278,18 +1278,27 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
lookup_ie ie@(IEThingAll (L l rdr))
= do name <- lookupGlobalOccRn rdr
- let kids = findChildren kids_env name
- addUsedGREs kids
+ let gres = findChildren kids_env name
+ addUsedGREs gres
warnDodgyExports <- woptM Opt_WarnDodgyExports
- when (null kids) $
+ when (null gres) $
if isTyConName name
then when warnDodgyExports $ addWarn (dodgyExportWarn name)
else -- This occurs when you export T(..), but
-- only import T abstractly, or T is a synonym.
addErr (exportItemErr ie)
+ -- AMG TODO tidy up the following
+ let non_flds = [ gre_name gre | gre <- gres, not (isRecFldGRE gre) ]
+ flds = [ FieldLabel lbl is_overloaded (gre_name gre) | gre <- gres
+ , FldParent _ mb_lbl <- [gre_par gre]
+ , let (lbl, is_overloaded) = case mb_lbl of
+ Nothing -> (occNameFS (nameOccName (gre_name gre)), False)
+ Just x -> (x, True)
+ ]
+
return ( IEThingAll (L l name)
- , foldr (plusAvail . availFromGRE) (AvailTC name [name] []) kids )
+ , AvailTC name (name:non_flds) flds )
lookup_ie ie@(IEThingWith (L l rdr) sub_rdrs sub_flds)
= do name <- lookupGlobalOccRn rdr
@@ -1319,7 +1328,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
]
addUsedGREs gres
return ( IEThingWith (L l name) non_flds flds
- , foldr (plusAvail . availFromGRE) (AvailTC name [name] []) gres )
+ , AvailTC name (name:map unLoc non_flds) (map unLoc flds) )
lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier
More information about the ghc-commits
mailing list