[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