Brandon Chinn pushed to branch wip/T21730-import at Glasgow Haskell Compiler / GHC

Commits:

8 changed files:

Changes:

  • compiler/GHC/Driver/Backpack.hs
    ... ... @@ -878,14 +878,14 @@ hsModuleToModSummary home_keys pn hsc_src modname
    878 878
         let (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps
    
    879 879
     
    
    880 880
             implicit_prelude = xopt LangExt.ImplicitPrelude dflags
    
    881
    -        implicit_imports = mkPrelImports modname implicit_prelude imps
    
    881
    +        generated_imports = mkPrelImports modname implicit_prelude imps
    
    882 882
     
    
    883 883
             rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) modname
    
    884 884
             convImport (L _ i) = (convImportLevel (ideclLevelSpec i), rn_pkg_qual (ideclPkgQual i), reLoc $ ideclName i)
    
    885 885
     
    
    886 886
         extra_sig_imports <- liftIO $ findExtraSigImports hsc_env hsc_src modname
    
    887 887
     
    
    888
    -    let normal_imports = map convImport (implicit_imports ++ ord_idecls)
    
    888
    +    let normal_imports = map convImport (generated_imports ++ ord_idecls)
    
    889 889
         (implicit_sigs, inst_deps) <- liftIO $ implicitRequirementsShallow hsc_env normal_imports
    
    890 890
     
    
    891 891
         -- So that Finder can find it, even though it doesn't exist...
    

  • compiler/GHC/Hs/ImpExp.hs
    ... ... @@ -80,16 +80,18 @@ type instance XCImportDecl GhcTc = DataConCantHappen
    80 80
     data XImportDeclPass = XImportDeclPass
    
    81 81
         { ideclAnn        :: EpAnn EpAnnImportDecl
    
    82 82
         , ideclSourceText :: SourceText -- Note [Pragma source text] in "GHC.Types.SourceText"
    
    83
    -    , ideclImplicit   :: Bool -- ^ See Note [Implicit imports]
    
    83
    +    , ideclGenerated   :: Bool -- ^ See Note [Generated imports]
    
    84 84
         }
    
    85 85
         deriving (Data)
    
    86 86
     
    
    87
    -{- Note [Implicit imports]
    
    88
    -~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    87
    +{- Note [Generated imports]
    
    88
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    89 89
     GHC generates an `ImportDecl` to represent the invisible `import Prelude`
    
    90 90
     that appears in any file that omits `import Prelude`, setting
    
    91 91
     this field to indicate that the import doesn't appear in the
    
    92
    -original source. True => implicit import (of Prelude)
    
    92
    +original source.
    
    93
    +
    
    94
    +Plugins may also introduce generated imports.
    
    93 95
     -}
    
    94 96
     
    
    95 97
     type instance XXImportDecl  (GhcPass _) = DataConCantHappen
    
    ... ... @@ -165,8 +167,8 @@ instance (OutputableBndrId p
    165 167
           where
    
    166 168
             pp_implicit ext =
    
    167 169
                 let implicit = case ghcPass @p of
    
    168
    -                            GhcPs | XImportDeclPass { ideclImplicit = implicit } <- ext -> implicit
    
    169
    -                            GhcRn | XImportDeclPass { ideclImplicit = implicit } <- ext -> implicit
    
    170
    +                            GhcPs | XImportDeclPass { ideclGenerated = implicit } <- ext -> implicit
    
    171
    +                            GhcRn | XImportDeclPass { ideclGenerated = implicit } <- ext -> implicit
    
    170 172
                                 GhcTc -> dataConCantHappen ext
    
    171 173
                 in if implicit then text "(implicit)"
    
    172 174
                                else empty
    

  • compiler/GHC/Iface/Ext/Ast.hs
    ... ... @@ -348,7 +348,7 @@ enrichHie ts (hsGrp, imports, exports, docs, modName) ev_bs insts tcs tte =
    348 348
         modName <- toHie (IEC Export <$> modName)
    
    349 349
         tasts <- toHie $ fmap (BC RegularBind ModuleScope) ts
    
    350 350
         rasts <- processGrp hsGrp
    
    351
    -    imps <- toHie $ filter (not . ideclImplicit . ideclExt . unLoc) imports
    
    351
    +    imps <- toHie $ filter (not . ideclGenerated . ideclExt . unLoc) imports
    
    352 352
         exps <- toHie $ fmap (map $ IEC Export . fst) exports
    
    353 353
         docs <- toHie docs
    
    354 354
         -- Add Instance bindings
    

  • compiler/GHC/Parser/Header.hs
    ... ... @@ -100,12 +100,12 @@ getImports popts implicit_prelude buf filename source_filename = do
    100 100
                     mod = mb_mod `orElse` L (noAnnSrcSpan main_loc) mAIN_NAME
    
    101 101
                     (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps
    
    102 102
     
    
    103
    -                implicit_imports = mkPrelImports (unLoc mod) implicit_prelude imps
    
    103
    +                generated_imports = mkPrelImports (unLoc mod) implicit_prelude imps
    
    104 104
                     convImport (L _ (i :: ImportDecl GhcPs)) = (convImportLevel (ideclLevelSpec i), ideclPkgQual i, reLoc $ ideclName i)
    
    105 105
                     convImport_src (L _ (i :: ImportDecl GhcPs)) = (reLoc $ ideclName i)
    
    106 106
                   in
    
    107 107
                   return (map convImport_src src_idecls
    
    108
    -                     , map convImport (implicit_imports ++ ord_idecls)
    
    108
    +                     , map convImport (generated_imports ++ ord_idecls)
    
    109 109
                          , reLoc mod)
    
    110 110
     
    
    111 111
     
    
    ... ... @@ -146,7 +146,7 @@ mkPrelImports this_mod implicit_prelude import_decls
    146 146
             = L loc $ ImportDecl { ideclExt       = XImportDeclPass
    
    147 147
                                                         { ideclAnn = noAnn
    
    148 148
                                                         , ideclSourceText = NoSourceText
    
    149
    -                                                    , ideclImplicit  = True   -- Implicit!
    
    149
    +                                                    , ideclGenerated  = True   -- Generated!
    
    150 150
                                                         },
    
    151 151
                                     ideclName      = L loc pRELUDE_NAME,
    
    152 152
                                     ideclPkgQual   = NoRawPkgQual,
    

  • compiler/GHC/Rename/Names.hs
    ... ... @@ -317,7 +317,7 @@ rnImportDecl this_mod
    317 317
                                          , ideclSafe = mod_safe
    
    318 318
                                          , ideclLevelSpec = import_level
    
    319 319
                                          , ideclQualified = qual_style
    
    320
    -                                     , ideclExt = XImportDeclPass { ideclImplicit = implicit }
    
    320
    +                                     , ideclExt = XImportDeclPass { ideclGenerated = implicit }
    
    321 321
                                          , ideclAs = as_mod, ideclImportList = imp_details }), import_reason)
    
    322 322
       = setSrcSpanA loc $ do
    
    323 323
     
    
    ... ... @@ -1922,25 +1922,27 @@ type ImportDeclUsage
    1922 1922
     warnUnusedImportDecls :: TcGblEnv -> HscSource -> RnM ()
    
    1923 1923
     warnUnusedImportDecls gbl_env hsc_src
    
    1924 1924
       = do { uses <- readMutVar (tcg_used_gres gbl_env)
    
    1925
    -       ; let user_imports = filterOut
    
    1926
    -                              (ideclImplicit . ideclExt . unLoc)
    
    1927
    -                              (tcg_rn_imports gbl_env)
    
    1928
    -                -- This whole function deals only with *user* imports
    
    1929
    -                -- both for warning about unnecessary ones, and for
    
    1930
    -                -- deciding the minimal ones
    
    1925
    +       ; let imports = tcg_rn_imports gbl_env
    
    1931 1926
                  rdr_env = tcg_rdr_env gbl_env
    
    1932 1927
     
    
    1933
    -       ; let usage :: [ImportDeclUsage]
    
    1934
    -             usage = findImportUsage user_imports uses
    
    1928
    +        -- We should only warn for unnecessary *user* imports, but deciding
    
    1929
    +        -- minimal imports should take generated imports into account
    
    1930
    +       ; let usageUserImports = findImportUsage (excludeGenerated imports) uses
    
    1931
    +             usageAllImports = findImportUsage imports uses
    
    1935 1932
     
    
    1936 1933
            ; traceRn "warnUnusedImportDecls" $
    
    1937 1934
                            (vcat [ text "Uses:" <+> ppr uses
    
    1938
    -                             , text "Import usage" <+> ppr usage])
    
    1935
    +                             , text "Usage all user imports: " <+> ppr usageUserImports
    
    1936
    +                             , text "Usage all imports: " <+> ppr usageAllImports])
    
    1939 1937
     
    
    1940
    -       ; mapM_ (warnUnusedImport rdr_env) usage
    
    1938
    +       ; mapM_ (warnUnusedImport rdr_env) usageUserImports
    
    1941 1939
     
    
    1942 1940
            ; whenGOptM Opt_D_dump_minimal_imports $
    
    1943
    -         printMinimalImports hsc_src usage }
    
    1941
    +         printMinimalImports hsc_src usageAllImports }
    
    1942
    +
    
    1943
    +-- | Exclude generated imports
    
    1944
    +excludeGenerated :: [LImportDecl GhcRn] -> [LImportDecl GhcRn]
    
    1945
    +excludeGenerated = filterOut (ideclGenerated . ideclExt . unLoc)
    
    1944 1946
     
    
    1945 1947
     findImportUsage :: [LImportDecl GhcRn]
    
    1946 1948
                     -> [GlobalRdrElt]
    
    ... ... @@ -2208,8 +2210,10 @@ x,y to avoid name-shadowing warnings. Example (#9061)
    2208 2210
     
    
    2209 2211
     Note [Printing minimal imports]
    
    2210 2212
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    2211
    -To print the minimal imports we walk over the user-supplied import
    
    2212
    -decls, and simply trim their import lists.  NB that
    
    2213
    +To print the minimal imports we walk over all import decls (both user-supplied
    
    2214
    +and generated), trim their import lists, then filter out generated decls.
    
    2215
    +
    
    2216
    +NB that
    
    2213 2217
     
    
    2214 2218
       * We do *not* change the 'qualified' or 'as' parts!
    
    2215 2219
     
    
    ... ... @@ -2301,7 +2305,7 @@ classifyGREs = partition (not . isRecFldGRE)
    2301 2305
     printMinimalImports :: HscSource -> [ImportDeclUsage] -> RnM ()
    
    2302 2306
     -- See Note [Printing minimal imports]
    
    2303 2307
     printMinimalImports hsc_src imports_w_usage
    
    2304
    -  = do { imports' <- getMinimalImports imports_w_usage
    
    2308
    +  = do { imports' <- excludeGenerated <$> getMinimalImports imports_w_usage
    
    2305 2309
            ; this_mod <- getModule
    
    2306 2310
            ; dflags   <- getDynFlags
    
    2307 2311
            ; liftIO $ withFile (mkFilename dflags this_mod) WriteMode $ \h ->
    

  • compiler/GHC/Types/Name/Reader.hs
    ... ... @@ -2041,10 +2041,13 @@ bestImport iss = NE.head $ NE.sortBy best iss
    2041 2041
         -- Less means better
    
    2042 2042
         -- Unqualified always wins over qualified; then
    
    2043 2043
         -- import-all wins over import-some; then
    
    2044
    +    -- generated wins over user-specified; then
    
    2044 2045
         -- earlier declaration wins over later
    
    2045 2046
         best (ImpSpec { is_item = item1, is_decl = d1 })
    
    2046 2047
              (ImpSpec { is_item = item2, is_decl = d2 })
    
    2047
    -      = (is_qual d1 `compare` is_qual d2) S.<> best_item item1 item2 S.<>
    
    2048
    +      = (is_qual d1 `compare` is_qual d2) S.<>
    
    2049
    +        best_item item1 item2 S.<>
    
    2050
    +        compareGenerated (is_dloc d1) (is_dloc d2) S.<>
    
    2048 2051
             SrcLoc.leftmost_smallest (is_dloc d1) (is_dloc d2)
    
    2049 2052
     
    
    2050 2053
         best_item :: ImpItemSpec -> ImpItemSpec -> Ordering
    
    ... ... @@ -2055,6 +2058,11 @@ bestImport iss = NE.head $ NE.sortBy best iss
    2055 2058
                   (ImpSome { is_explicit = e2 }) = e1 `compare` e2
    
    2056 2059
          -- False < True, so if e1 is explicit and e2 is not, we get GT
    
    2057 2060
     
    
    2061
    +    compareGenerated UnhelpfulSpan{} UnhelpfulSpan{} = EQ
    
    2062
    +    compareGenerated UnhelpfulSpan{} RealSrcSpan{} = LT
    
    2063
    +    compareGenerated RealSrcSpan{} UnhelpfulSpan{} = GT
    
    2064
    +    compareGenerated RealSrcSpan{} RealSrcSpan{} = EQ
    
    2065
    +
    
    2058 2066
     {- Note [Choosing the best import declaration]
    
    2059 2067
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    2060 2068
     When reporting unused import declarations we use the following rules.
    

  • ghc/GHCi/UI.hs
    ... ... @@ -527,7 +527,7 @@ interactiveUI config srcs maybe_exprs = do
    527 527
        let prelude_import =
    
    528 528
              case simpleImportDecl preludeModuleName of
    
    529 529
                -- Set to True because Prelude is implicitly imported.
    
    530
    -           impDecl@ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}}
    
    530
    +           impDecl@ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclGenerated=True}}
    
    531 531
        empty_cache <- liftIO newIfaceCache
    
    532 532
        startGHCi (runGHCi srcs maybe_exprs)
    
    533 533
             GHCiState{ progname           = default_progname,
    

  • testsuite/tests/parser/should_compile/T7476/T7476.stdout
    1
    -import Control.Applicative ( Applicative(pure), (<**>) )
    1
    +import Control.Applicative ( (<**>) )