Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

17 changed files:

Changes:

  • compiler/GHC/Tc/Gen/Export.hs
    ... ... @@ -23,6 +23,7 @@ import GHC.Rename.Module
    23 23 
     import GHC.Rename.Names
    24 24 
     import GHC.Rename.Env
    25 25 
     import GHC.Rename.Unbound ( reportUnboundName )
    26 
    +import GHC.Rename.Splice
    26 27 
     import GHC.Unit.Module
    27 28 
     import GHC.Unit.Module.Imported
    28 29 
     import GHC.Unit.Module.Warnings
    ... ... @@ -312,7 +313,7 @@ exports_from_avail Nothing rdr_env _imports _this_mod
    312 313 
         ; addDiagnostic
    313 314 
             (TcRnMissingExportList $ moduleName _this_mod)
    314 315 
         ; let avails =
    315 
    -            map fix_faminst . gresToAvailInfo
    316 
    +            map fix_faminst . gresToAvailInfo . mapMaybe pickLevelZeroGRE
    316 317 
                   . filter isLocalGRE . globalRdrEnvElts $ rdr_env
    317 318 
         ; return (Nothing, emptyDefaultEnv, avails, []) }
    318 319 
       where
    ... ... @@ -384,6 +385,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
    384 385 
           = do { let { exportValid    = (mod `elem` imported_modules)
    385 386 
                                       || (moduleName this_mod == mod)
    386 387 
                      ; gre_prs        = pickGREsModExp mod (globalRdrEnvElts rdr_env)
    388 
    +                                    -- NB: this filters out non level 0 exports
    387 389 
                      ; new_gres       = [ gre'
    388 390 
                                         | (gre, _) <- gre_prs
    389 391 
                                         , gre' <- expand_tyty_gre gre ]
    ... ... @@ -451,6 +453,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
    451 453 
                    let avail = availFromGRE gre
    452 454 
                        name = greName gre
    453 455
    456 
    +               checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
    454 457 
                    occs' <- check_occs occs ie [gre]
    455 458 
                    (export_warn_spans', dont_warn_export', warn_txt_rn)
    456 459 
                      <- process_warning export_warn_spans
    ... ... @@ -499,6 +502,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
    499 502 
                         occs' <- check_occs occs ie [gre]
    500 503 
                         return (Just avail, occs', exp_dflts)
    501 504
    505 
    +               checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
    502 506 
                    (export_warn_spans', dont_warn_export', warn_txt_rn)
    503 507 
                      <- process_warning export_warn_spans
    504 508 
                                         dont_warn_export
    ... ... @@ -526,6 +530,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
    526 530 
                        all_gres = par : all_kids
    527 531 
                        all_names = map greName all_gres
    528 532
    533 
    +               checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
    529 534 
                    occs' <- check_occs occs ie all_gres
    530 535 
                    (export_warn_spans', dont_warn_export', warn_txt_rn)
    531 536 
                      <- process_warning export_warn_spans
    ... ... @@ -563,6 +568,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
    563 568 
                        all_gres = par : all_kids
    564 569 
                        all_names = map greName all_gres
    565 570
    571 
    +               checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
    566 572 
                    occs' <- check_occs occs ie all_gres
    567 573 
                    (export_warn_spans', dont_warn_export', warn_txt_rn)
    568 574 
                      <- process_warning export_warn_spans
    ... ... @@ -589,17 +595,19 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
    589 595
    590 596 
         lookup_ie_kids_all :: IE GhcPs -> LIEWrappedName GhcPs -> GlobalRdrElt
    591 597 
                       -> RnM [GlobalRdrElt]
    592 
    -    lookup_ie_kids_all ie (L _ rdr) gre =
    598 
    +    lookup_ie_kids_all ie (L _loc rdr) gre =
    593 599 
           do { let name = greName gre
    594 600 
                    gres = findChildren kids_env name
    595 
    -         ; addUsedKids (ieWrappedName rdr) gres
    596 
    -         ; when (null gres) $
    601 
    +         -- We only choose level 0 exports when filling in part of an export list implicitly.
    602 
    +         ; let kids_0 = mapMaybe pickLevelZeroGRE gres
    603 
    +         ; addUsedKids (ieWrappedName rdr) kids_0
    604 
    +         ; when (null kids_0) $
    597 605 
                 if isTyConName name
    598 606 
                 then addTcRnDiagnostic (TcRnDodgyExports gre)
    599 607 
                 else -- This occurs when you export T(..), but
    600 608 
                      -- only import T abstractly, or T is a synonym.
    601 609 
                      addErr (TcRnExportHiddenComponents ie)
    602 
    -         ; return gres }
    610 
    +         ; return kids_0 }
    603 611
    604 612 
         -------------
    605 613
    ... ... @@ -696,6 +704,10 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
    696 704 
         addUsedKids parent_rdr kid_gres
    697 705 
           = addUsedGREs ExportDeprecationWarnings (pickGREs parent_rdr kid_gres)
    698 706
    707 
    +
    708 
    +ieLWrappedUserRdrName :: LIEWrappedName GhcPs -> Name -> LIdOccP GhcRn
    709 
    +ieLWrappedUserRdrName l n = fmap (\rdr -> WithUserRdr rdr n) $ ieLWrappedName l
    710 
    +
    699 711 
     -- | In what namespaces should we go looking for an import/export item
    700 712 
     -- that is out of scope, for suggestions in error messages?
    701 713 
     ieWrappedNameWhatLooking :: IEWrappedName GhcPs -> WhatLooking
    ... ... @@ -800,6 +812,7 @@ lookupChildrenExport parent_gre rdr_items = mapAndReportM doOne rdr_items
    800 812 
                      ; return (L l (IEName noExtField (L (l2l l) ub)), gre)}
    801 813 
                 FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) ->
    802 814 
                   do { checkPatSynParent spec_parent par child_nm
    815 
    +                 ; checkThLocalNameNoLift (ieLWrappedUserRdrName n child_nm)
    803 816 
                      ; return (replaceLWrappedName n child_nm, child)
    804 817 
                      }
    805 818 
                 IncorrectParent p c gs -> failWithDcErr (parentGRE_name p) (greName c) gs

  • compiler/GHC/Types/Name/Reader.hs
    ... ... @@ -69,7 +69,7 @@ module GHC.Types.Name.Reader (
    69 69 
             lookupGRE_Name,
    70 70 
             lookupGRE_FieldLabel,
    71 71 
             getGRE_NameQualifier_maybes,
    72 
    -        transformGREs, pickGREs, pickGREsModExp,
    72 
    +        transformGREs, pickGREs, pickGREsModExp, pickLevelZeroGRE,
    73 73
    74 74 
             -- * GlobalRdrElts
    75 75 
             availFromGRE,
    ... ... @@ -144,7 +144,7 @@ import GHC.Utils.Panic
    144 144 
     import GHC.Utils.Binary
    145 145
    146 146 
     import Control.DeepSeq
    147 
    -import Control.Monad ( guard )
    147 
    +import Control.Monad ( guard , (>=>) )
    148 148 
     import Data.Data
    149 149 
     import Data.List ( sort )
    150 150 
     import qualified Data.List.NonEmpty as NE
    ... ... @@ -641,7 +641,7 @@ greParent = gre_par
    641 641 
     greInfo :: GlobalRdrElt -> GREInfo
    642 642 
     greInfo = gre_info
    643 643
    644 
    -greLevels :: GlobalRdrElt -> Set.Set ImportLevel
    644 
    +greLevels :: GlobalRdrEltX info -> Set.Set ImportLevel
    645 645 
     greLevels g =
    646 646 
       if gre_lcl g then Set.singleton NormalLevel
    647 647 
                    else Set.fromList (bagToList (fmap (is_level . is_decl) (gre_imp g)))
    ... ... @@ -1604,7 +1604,14 @@ pickGREsModExp :: ModuleName -> [GlobalRdrEltX info] -> [(GlobalRdrEltX info,Glo
    1604 1604 
     --
    1605 1605 
     -- Used only for the 'module M' item in export list;
    1606 1606 
     --   see 'GHC.Tc.Gen.Export.exports_from_avail'
    1607 
    -pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres
    1607 
    +-- This function also only chooses GREs which are at level zero.
    1608 
    +pickGREsModExp mod gres = mapMaybe (pickLevelZeroGRE >=> pickBothGRE mod) gres
    1609 
    +
    1610 
    +pickLevelZeroGRE :: GlobalRdrEltX info -> Maybe (GlobalRdrEltX info)
    1611 
    +pickLevelZeroGRE gre =
    1612 
    +  if NormalLevel `Set.member` greLevels gre
    1613 
    +    then Just gre
    1614 
    +    else Nothing
    1608 1615
    1609 1616 
     -- | isBuiltInSyntax filter out names for built-in syntax They
    1610 1617 
     -- just clutter up the environment (esp tuples), and the

  • testsuite/tests/splice-imports/DodgyLevelExport.hs
    1 
    +{-# LANGUAGE ExplicitLevelImports #-}
    2 
    +module DodgyLevelExport ( T(..) ) where
    3 
    +
    4 
    +import quote DodgyLevelExportA
    5 
    +import DodgyLevelExportA (T)

  • testsuite/tests/splice-imports/DodgyLevelExport.stderr
    1 
    +DodgyLevelExport.hs:2:27: warning: [GHC-75356] [-Wdodgy-exports (in -Wextra)]
    2 
    +    The export item ‘T(..)’ suggests that
    3 
    +    ‘T’ has (in-scope) constructors or record fields, but it has none
    4 
    +

  • testsuite/tests/splice-imports/DodgyLevelExportA.hs
    1 
    +module DodgyLevelExportA where
    2 
    +
    3 
    +data T = T { a :: Int }

  • testsuite/tests/splice-imports/LevelImportExports.hs
    1 
    +{-# LANGUAGE ExplicitLevelImports #-}
    2 
    +module LevelImportExports ( module LevelImportExportsA, T(..) ) where
    3 
    +
    4 
    +import quote LevelImportExportsA
    5 
    +import splice LevelImportExportsA
    6 
    +import LevelImportExportsA(a, T)

  • testsuite/tests/splice-imports/LevelImportExports.stdout
    1 
    +[1 of 2] Compiling LevelImportExportsA ( LevelImportExportsA.hs, LevelImportExportsA.o )
    2 
    +[2 of 2] Compiling LevelImportExports ( LevelImportExports.hs, LevelImportExports.o )
    3 
    +exports:
    4 
    +  LevelImportExportsA.a
    5 
    +  LevelImportExportsA.T
    6 
    +defaults:

  • testsuite/tests/splice-imports/LevelImportExportsA.hs
    1 
    +module LevelImportExportsA where
    2 
    +
    3 
    +a = 100
    4 
    +b = 100
    5 
    +
    6 
    +data T = T { c :: Int }

  • testsuite/tests/splice-imports/Makefile
    ... ... @@ -24,5 +24,9 @@ SI10_oneshot:
    24 24 
     	"$(TEST_HC)" $(TEST_HC_OPTS) -c InstanceA.hs
    25 25 
     	"$(TEST_HC)" $(TEST_HC_OPTS) -c SI10.hs
    26 26
    27 
    +LevelImportExports:
    28 
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -haddock LevelImportExports.hs
    29 
    +	"$(TEST_HC)" --show-iface LevelImportExports.hi | grep -A3 "^exports:"
    30 
    +
    27 31 
     clean:
    28 32 
     	rm -f *.o *.hi

  • testsuite/tests/splice-imports/ModuleExport.hs
    1 
    +module ModuleExport where
    2 
    +
    3 
    +-- Should fail
    4 
    +import ModuleExportA (a)

  • testsuite/tests/splice-imports/ModuleExport.stderr
    1 
    +ModuleExport.hs:4:23: error: [GHC-61689]
    2 
    +    Module ‘ModuleExportA’ does not export ‘a’.
    3 
    +

  • testsuite/tests/splice-imports/ModuleExportA.hs
    1 
    +{-# LANGUAGE ExplicitLevelImports #-}
    2 
    +-- Module export only exports level 0 things (b)
    3 
    +module ModuleExportA (module ModuleExportB) where
    4 
    +
    5 
    +-- Everything at level 1
    6 
    +import quote ModuleExportB
    7 
    +-- Only b at level 0
    8 
    +import ModuleExportB (b)

  • testsuite/tests/splice-imports/ModuleExportB.hs
    1 
    +module ModuleExportB where
    2 
    +
    3 
    +a = ()
    4 
    +b = ()
    5 
    +
    6 
    +

  • testsuite/tests/splice-imports/T26090.hs
    1 
    +{-# LANGUAGE ExplicitLevelImports, TemplateHaskell #-}
    2 
    +module T26090 ( a --varaible
    3 
    +              , T(..) -- WithAll
    4 
    +              , S(s) -- With
    5 
    +              , R    -- Abs
    6 
    +              ) where
    7 
    +
    8 
    +import quote T26090A
    9 
    +import T26090A (T(T), S)
    10 
    +

  • testsuite/tests/splice-imports/T26090.stderr
    1 
    +T26090.hs:2:17: error: [GHC-28914]
    2 
    +    • Level error: ‘a’ is bound at level 1 but used at level 0
    3 
    +    • Available from the imports:
    4 
    +      • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
    5 
    +
    6 
    +T26090.hs:4:17: error: [GHC-28914]
    7 
    +    • Level error: ‘s’ is bound at level 1 but used at level 0
    8 
    +    • Available from the imports:
    9 
    +      • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
    10 
    +    • In the export: S(s)
    11 
    +
    12 
    +T26090.hs:5:17: error: [GHC-28914]
    13 
    +    • Level error: ‘R’ is bound at level 1 but used at level 0
    14 
    +    • Available from the imports:
    15 
    +      • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
    16 
    +

  • testsuite/tests/splice-imports/T26090A.hs
    1 
    +{-# LANGUAGE ExplicitLevelImports, TemplateHaskell #-}
    2 
    +module T26090A where
    3 
    +
    4 
    +import Language.Haskell.TH
    5 
    +
    6 
    +a :: Q Exp
    7 
    +a = [| True |]
    8 
    +
    9 
    +data T = T { t :: () }
    10 
    +
    11 
    +data S = S { s :: () }
    12 
    +
    13 
    +data R = R { r :: () }
    14 
    +

  • testsuite/tests/splice-imports/all.T
    ... ... @@ -48,3 +48,7 @@ test('SI35',
    48 48 
     test('SI36', [extra_files(["SI36_A.hs", "SI36_B1.hs", "SI36_B2.hs", "SI36_B3.hs", "SI36_C1.hs", "SI36_C2.hs", "SI36_C3.hs"])], multimod_compile_fail, ['SI36', '-v0'])
    49 49 
     test('T26087', [], multimod_compile_fail, ['T26087A', ''])
    50 50 
     test('T26088', [], multimod_compile_fail, ['T26088A', '-v0'])
    51 
    +test('T26090', [], multimod_compile_fail, ['T26090', '-v0'])
    52 
    +test('ModuleExport', [], multimod_compile_fail, ['ModuleExport', '-v0'])
    53 
    +test('LevelImportExports', [], makefile_test, [])
    54 
    +test('DodgyLevelExport', [], multimod_compile, ['DodgyLevelExport', '-v0 -Wdodgy-exports'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help