Vladislav Zavialov pushed to branch wip/int-index/subordinate-export-namespaces at Glasgow Haskell Compiler / GHC

Commits:

17 changed files:

Changes:

  • compiler/GHC/Rename/Env.hs
    ... ... @@ -681,19 +681,20 @@ lookupGlobalOccRn will find it.
    681 681 
     -}
    682 682
    683 683 
     -- | Used in export lists to lookup the children.
    684 
    -lookupSubBndrOcc_helper :: Bool
    684 
    +lookupSubBndrOcc_helper :: Bool          -- ^ must have a parent
    685 
    +                        -> Bool          -- ^ look up in all namespaces
    685 686 
                             -> DeprecationWarnings
    686 687 
                             -> ParentGRE     -- ^ parent
    687 688 
                             -> RdrName       -- ^ thing we are looking up
    688 689 
                             -> RnM ChildLookupResult
    689 
    -lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent_gre rdr_name
    690 
    +lookupSubBndrOcc_helper must_have_parent all_ns warn_if_deprec parent_gre rdr_name
    690 691 
       | isUnboundName (parentGRE_name parent_gre)
    691 692 
         -- Avoid an error cascade
    692 693 
       = return (FoundChild (mkUnboundGRERdr rdr_name))
    693 694
    694 695 
       | otherwise = do
    695 696 
       gre_env <- getGlobalRdrEnv
    696 
    -  let original_gres = lookupGRE gre_env (LookupChildren parent_gre (rdrNameOcc rdr_name))
    697 
    +  let original_gres = lookupGRE gre_env (LookupChildren parent_gre (rdrNameOcc rdr_name) all_ns)
    697 698 
           picked_gres = pick_gres original_gres
    698 699 
       -- The remaining GREs are things that we *could* export here.
    699 700 
       -- Note that this includes things which have `NoParent`;
    ... ... @@ -846,7 +847,7 @@ lookupSubBndrOcc :: DeprecationWarnings
    846 847 
     lookupSubBndrOcc warn_if_deprec the_parent what_subordinate rdr_name =
    847 848 
       lookupExactOrOrig rdr_name (Right . greName) $
    848 849 
         -- This happens for built-in classes, see mod052 for example
    849 
    -    do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name
    850 
    +    do { child <- lookupSubBndrOcc_helper True True warn_if_deprec the_parent rdr_name
    850 851 
            ; return $ case child of
    851 852 
                FoundChild g       -> Right (greName g)
    852 853 
                NameNotFound       -> Left unknown_sub

  • compiler/GHC/Tc/Gen/Export.hs
    ... ... @@ -36,7 +36,6 @@ import GHC.Data.Maybe
    36 36 
     import GHC.Data.FastString (fsLit)
    37 37 
     import GHC.Driver.Env
    38 38 
     import GHC.Driver.DynFlags
    39 
    -import GHC.Parser.PostProcess ( setRdrNameSpace )
    40 39 
     import qualified GHC.LanguageExtensions as LangExt
    41 40
    42 41 
     import GHC.Types.Unique.Map
    ... ... @@ -792,17 +791,19 @@ lookupChildrenExport parent_gre rdr_items = mapAndReportM doOne rdr_items
    792 791 
                   -> RnM (LIEWrappedName GhcRn, GlobalRdrElt)
    793 792 
             doOne n = do
    794 793
    794 
    +          let all_ns = case unLoc n of
    795 
    +                IEName{} -> True    -- Ignore the namespace iff the name is unadorned
    796 
    +                _        -> False
    795 797 
               let bareName = (ieWrappedName . unLoc) n
    796 798 
                     -- Do not report export list declaration deprecations
    797 
    -          name <-  lookupSubBndrOcc_helper False ExportDeprecationWarnings
    799 
    +          name <-  lookupSubBndrOcc_helper False all_ns ExportDeprecationWarnings
    798 800 
                             (ParentGRE spec_parent (greInfo parent_gre)) bareName
    799 801 
               traceRn "lookupChildrenExport" (ppr name)
    800 
    -          -- Default to data constructors for slightly better error
    801 
    -          -- messages
    802 
    +          -- Default to data namespace for slightly better error messages
    802 803 
               let unboundName :: RdrName
    803 
    -              unboundName = if rdrNameSpace bareName == varName
    804 
    -                            then bareName
    805 
    -                            else setRdrNameSpace bareName dataName
    804 
    +              unboundName
    805 
    +                | all_ns = fromMaybe bareName (demoteRdrName bareName)
    806 
    +                | otherwise = bareName
    806 807
    807 808 
               case name of
    808 809 
                 NameNotFound ->

  • compiler/GHC/Types/Name/Reader.hs
    ... ... @@ -1182,8 +1182,12 @@ data LookupGRE info where
    1182 1182
    1183 1183 
       -- | Look up children 'GlobalRdrElt's with a given 'Parent'.
    1184 1184 
       LookupChildren
    1185 
    -    :: ParentGRE        -- ^ the parent
    1186 
    -    -> OccName          -- ^ the child 'OccName' to look up
    1185 
    +    :: { lookupParentGRE :: ParentGRE     -- ^ the parent
    1186 
    +       , lookupChildOccName :: OccName    -- ^ the child 'OccName' to look up
    1187 
    +       , lookupChildrenInAllNameSpaces :: Bool
    1188 
    +          -- ^ whether to look in *all* 'NameSpace's, or just
    1189 
    +          -- in the 'NameSpace' of the 'OccName'
    1190 
    +       }
    1187 1191 
         -> LookupGRE GREInfo
    1188 1192
    1189 1193 
     -- | How should we look up in a 'GlobalRdrEnv'?
    ... ... @@ -1420,10 +1424,15 @@ lookupGRE env = \case
    1420 1424 
           occ = nameOccName nm
    1421 1425 
           lkup | all_ns    = concat $ lookupOccEnv_AllNameSpaces env occ
    1422 1426 
                | otherwise = fromMaybe [] $ lookupOccEnv env occ
    1423 
    -  LookupChildren parent child_occ ->
    1424 
    -    let ns = occNameSpace child_occ
    1425 
    -        all_gres = concat $ lookupOccEnv_AllNameSpaces env child_occ
    1426 
    -    in highestPriorityGREs (childGREPriority parent ns) all_gres
    1427 
    +  LookupChildren { lookupParentGRE = parent
    1428 
    +                 , lookupChildOccName = child_occ
    1429 
    +                 , lookupChildrenInAllNameSpaces = all_ns } ->
    1430 
    +      highestPriorityGREs (childGREPriority parent ns) $
    1431 
    +      concat $ lkup env child_occ
    1432 
    +    where
    1433 
    +      ns = occNameSpace child_occ
    1434 
    +      lkup | all_ns    = lookupOccEnv_AllNameSpaces
    1435 
    +           | otherwise = lookupOccEnv_WithFields
    1427 1436
    1428 1437 
     -- | Collect the 'GlobalRdrElt's with the highest priority according
    1429 1438 
     -- to the given function (lower value <=> higher priority).

  • testsuite/tests/parser/should_fail/T12488c.hs
    1 
    +{-# LANGUAGE PatternSynonyms #-}
    2 
    +module T12488c ( T (pattern A) ) where
    3 
    +
    4 
    +data T = A
    \ No newline at end of file

  • testsuite/tests/parser/should_fail/T12488c.stderr
    1 
    +T12488c.hs:2:21: error: [GHC-58481] parse error on input ‘pattern’
    2 
    +

  • testsuite/tests/parser/should_fail/T12488d.hs
    1 
    +{-# LANGUAGE NamedDefaults #-}
    2 
    +module T12488d ( T (default C) ) where
    3 
    +
    4 
    +class C a where
    5 
    +
    6 
    +data T = A
    \ No newline at end of file

  • testsuite/tests/parser/should_fail/T12488d.stderr
    1 
    +T12488d.hs:2:21: error: [GHC-58481] parse error on input ‘default’
    2 
    +

  • testsuite/tests/parser/should_fail/all.T
    ... ... @@ -242,3 +242,5 @@ test('T25258b', normal, compile_fail, [''])
    242 242 
     test('T25258c', normal, compile_fail, [''])
    243 243 
     test('T25530', normal, compile_fail, [''])
    244 244 
     test('T26418', normal, compile_fail, [''])
    245 
    +test('T12488c', normal, compile_fail, [''])
    246 
    +test('T12488d', normal, compile_fail, [''])

  • testsuite/tests/rename/should_compile/T12488b.hs
    1 
    +{-# LANGUAGE ExplicitNamespaces #-}
    2 
    +module T12488b ( T (data A) ) where
    3 
    +
    4 
    +data T = A

  • testsuite/tests/rename/should_compile/all.T
    ... ... @@ -245,3 +245,4 @@ test('T25899a', normal, compile, [''])
    245 245 
     test('T25899b', normal, compile, [''])
    246 246 
     test('T25899c', [extra_files(['T25899c_helper.hs'])], multimod_compile, ['T25899c', '-v0'])
    247 247 
     test('T25899d', combined_output, ghci_script, ['T25899d.script'])
    248 
    +test('T12488b', normal, compile, [''])

  • testsuite/tests/rename/should_fail/T12488a.hs
    1 
    +{-# LANGUAGE ExplicitNamespaces #-}
    2 
    +module T12488a ( T (type A) ) where
    3 
    +
    4 
    +data T = A

  • testsuite/tests/rename/should_fail/T12488a.stderr
    1 
    +T12488a.hs:2:18: error: [GHC-76037]
    2 
    +    • Not in scope: type constructor or class ‘A’
    3 
    +    • In the export: T(type A)
    4 
    +    Suggested fix: Perhaps use data constructor ‘A’ (line 4)
    5 
    +

  • testsuite/tests/rename/should_fail/T12488a_foo.hs
    1 
    +{-# LANGUAGE ExplicitNamespaces #-}
    2 
    +{-# LANGUAGE TypeFamilies #-}
    3 
    +module T12488a_foo ( T (type A) ) where
    4 
    +
    5 
    +data T = A
    6 
    +
    7 
    +class Foo a where
    8 
    +  type A a
    9 
    +  foo :: a -> Int

  • testsuite/tests/rename/should_fail/T12488a_foo.stderr
    1 
    +T12488a_foo.hs:3:22: error: [GHC-76037]
    2 
    +    • Not in scope: type constructor or class ‘A’
    3 
    +    • In the export: T(type A)
    4 
    +    Suggested fix: Perhaps use data constructor ‘A’ (line 5)
    5 
    +

  • testsuite/tests/rename/should_fail/T12488e.hs
    1 
    +{-# LANGUAGE ExplicitNamespaces #-}
    2 
    +{-# LANGUAGE TypeFamilies #-}
    3 
    +module T12488e ( C (data A) ) where
    4 
    +
    5 
    +class C a where
    6 
    +  type A a

  • testsuite/tests/rename/should_fail/T12488e.stderr
    1 
    +T12488e.hs:3:18: error: [GHC-76037]
    2 
    +    • Not in scope: data constructor ‘A’
    3 
    +    • In the export: C(data A)
    4 
    +    Suggested fix: Perhaps use type constructor or class ‘A’ (line 6)
    5 
    +

  • testsuite/tests/rename/should_fail/all.T
    ... ... @@ -246,3 +246,6 @@ test('T25899e1', normal, compile_fail, [''])
    246 246 
     test('T25899e2', normal, compile_fail, [''])
    247 247 
     test('T25899e3', [extra_files(['T25899e_helper.hs'])], multimod_compile_fail, ['T25899e3', '-v0'])
    248 248 
     test('T25899f',  [extra_files(['T25899f_helper.hs'])], multimod_compile_fail, ['T25899f', '-v0'])
    249 
    +test('T12488a', normal, compile_fail, [''])
    250 
    +test('T12488a_foo', normal, compile_fail, [''])
    251 
    +test('T12488e', normal, compile_fail, [''])

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