Ben Gamari pushed to branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC

Commits:

11 changed files:

Changes:

  • compiler/GHC/Driver/Downsweep.hs
    ... ... @@ -519,7 +519,7 @@ loopFixedModule key loc done = do
    519 519 
             -- part of the compiler.
    520 520 
             lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
    521 521 
               Just iface -> return (M.Succeeded iface)
    522 
    -          Nothing -> readIface (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
    522 
    +          Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
    523 523 
           case read_result of
    524 524 
             M.Succeeded iface -> do
    525 525 
               -- Computer information about this node

  • compiler/GHC/Driver/Main.hs
    ... ... @@ -1299,7 +1299,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
    1299 1299 
               -- when compiling gHC_PRIM without generating code (e.g. with
    1300 1300 
               -- Haddock), we still want the virtual interface in the cache
    1301 1301 
               if ms_mod summary == gHC_PRIM
    1302 
    -            then return $ HscUpdate (getGhcPrimIface hsc_env)
    1302 
    +            then return $ HscUpdate (getGhcPrimIface (hsc_hooks hsc_env))
    1303 1303 
                 else return $ HscUpdate iface
    1304 1304
    1305 1305
    ... ... @@ -1314,7 +1314,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
    1314 1314 
             -- when compiling gHC_PRIM without generating code (e.g. with
    1315 1315 
             -- Haddock), we still want the virtual interface in the cache
    1316 1316 
             if ms_mod summary == gHC_PRIM
    1317 
    -          then return $ HscUpdate (getGhcPrimIface hsc_env)
    1317 
    +          then return $ HscUpdate (getGhcPrimIface (hsc_hooks hsc_env))
    1318 1318 
               else return $ HscUpdate iface
    1319 1319
    1320 1320 
     {-

  • compiler/GHC/Driver/Make.hs
    ... ... @@ -1616,7 +1616,7 @@ executeCompileNode k n !old_hmi hug mrehydrate_mods mni = do
    1616 1616 
         executeCompileNodeFixed hsc_env MakeEnv{diag_wrapper, env_messager} mod loc =
    1617 1617 
           wrapAction diag_wrapper hsc_env $ do
    1618 1618 
             forM_ env_messager $ \hscMessage -> hscMessage hsc_env (k, n) UpToDate (ModuleNode [] (ModuleNodeFixed mod loc))
    1619 
    -        read_result <- readIface (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule mod) (ml_hi_file loc)
    1619 
    +        read_result <- readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule mod) (ml_hi_file loc)
    1620 1620 
             case read_result of
    1621 1621 
               M.Failed interface_err ->
    1622 1622 
                 let mn = mnkModuleName mod

  • compiler/GHC/Driver/Pipeline.hs
    ... ... @@ -44,6 +44,7 @@ module GHC.Driver.Pipeline (
    44 44
    45 45
    46 46 
     import GHC.Prelude
    47 
    +import GHC.Builtin.Names
    47 48
    48 49 
     import GHC.Platform
    49 50
    ... ... @@ -91,6 +92,7 @@ import GHC.Data.StringBuffer ( hPutStringBuffer )
    91 92 
     import GHC.Data.Maybe          ( expectJust )
    92 93
    93 94 
     import GHC.Iface.Make          ( mkFullIface )
    95 
    +import GHC.Iface.Load          ( getGhcPrimIface )
    94 96 
     import GHC.Runtime.Loader      ( initializePlugins )
    95 97
    96 98
    ... ... @@ -819,7 +821,13 @@ hscGenBackendPipeline pipe_env hsc_env mod_sum result = do
    819 821 
             let !linkable = Linkable part_time (ms_mod mod_sum) (NE.singleton (DotO final_object ModuleObject))
    820 822 
             -- Add the object linkable to the potential bytecode linkable which was generated in HscBackend.
    821 823 
             return (mlinkable { homeMod_object = Just linkable })
    822 
    -  return (miface, final_linkable)
    824 
    +
    825 
    +  -- when building ghc-internal with --make (e.g. with cabal-install), we want
    826 
    +  -- the virtual interface for gHC_PRIM in the cache, not the empty one.
    827 
    +  let miface_final
    828 
    +        | ms_mod mod_sum == gHC_PRIM = getGhcPrimIface (hsc_hooks hsc_env)
    829 
    +        | otherwise                  = miface
    830 
    +  return (miface_final, final_linkable)
    823 831
    824 832 
     asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile)
    825 833 
     asPipeline use_cpp pipe_env hsc_env location input_fn =

  • compiler/GHC/Iface/Load.hs
    ... ... @@ -895,6 +895,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
    895 895 
           mhome_unit  = hsc_home_unit_maybe hsc_env
    896 896 
           dflags     = hsc_dflags hsc_env
    897 897 
           logger     = hsc_logger hsc_env
    898 
    +      hooks      = hsc_hooks hsc_env
    898 899
    899 900
    900 901 
       trace_if logger (sep [hsep [text "Reading",
    ... ... @@ -905,59 +906,51 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
    905 906 
                                ppr mod <> semi],
    906 907 
                          nest 4 (text "reason:" <+> doc_str)])
    907 908
    908 
    -  -- Check for GHC.Prim, and return its static interface
    909 
    -  -- See Note [GHC.Prim] in primops.txt.pp.
    910 
    -  -- TODO: make this check a function
    911 
    -  if mod `installedModuleEq` gHC_PRIM
    912 
    -      then do
    913 
    -          let iface = getGhcPrimIface hsc_env
    914 
    -          return (Succeeded (iface, panic "GHC.Prim ModLocation (findAndReadIface)"))
    915 
    -      else do
    916 
    -          -- Look for the file
    917 
    -          mb_found <- liftIO (findExactModule hsc_env mod hi_boot_file)
    918 
    -          case mb_found of
    919 
    -              InstalledFound loc -> do
    920 
    -                  -- See Note [Home module load error]
    921 
    -                  if HUG.memberHugUnitId (moduleUnit mod) (hsc_HUG hsc_env)
    922 
    -                      && not (isOneShot (ghcMode dflags))
    923 
    -                    then return (Failed (HomeModError mod loc))
    924 
    -                    else do
    925 
    -                        r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
    926 
    -                        case r of
    927 
    -                          Failed err
    928 
    -                            -> return (Failed $ BadIfaceFile err)
    929 
    -                          Succeeded (iface,_fp)
    930 
    -                            -> do
    931 
    -                                r2 <- load_dynamic_too_maybe logger name_cache unit_state
    932 
    -                                                         (setDynamicNow dflags) wanted_mod
    933 
    -                                                         iface loc
    934 
    -                                case r2 of
    935 
    -                                  Failed sdoc -> return (Failed sdoc)
    936 
    -                                  Succeeded {} -> return $ Succeeded (iface, loc)
    937 
    -              err -> do
    938 
    -                  trace_if logger (text "...not found")
    939 
    -                  return $ Failed $ cannotFindInterface
    940 
    -                                      unit_state
    941 
    -                                      mhome_unit
    942 
    -                                      profile
    943 
    -                                      (moduleName mod)
    944 
    -                                      err
    909 
    +  -- Look for the file
    910 
    +  mb_found <- liftIO (findExactModule hsc_env mod hi_boot_file)
    911 
    +  case mb_found of
    912 
    +      InstalledFound loc -> do
    913 
    +          -- See Note [Home module load error]
    914 
    +          if HUG.memberHugUnitId (moduleUnit mod) (hsc_HUG hsc_env)
    915 
    +              && not (isOneShot (ghcMode dflags))
    916 
    +            then return (Failed (HomeModError mod loc))
    917 
    +            else do
    918 
    +                r <- read_file hooks logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
    919 
    +                case r of
    920 
    +                  Failed err
    921 
    +                    -> return (Failed $ BadIfaceFile err)
    922 
    +                  Succeeded (iface,_fp)
    923 
    +                    -> do
    924 
    +                        r2 <- load_dynamic_too_maybe hooks logger name_cache unit_state
    925 
    +                                                 (setDynamicNow dflags) wanted_mod
    926 
    +                                                 iface loc
    927 
    +                        case r2 of
    928 
    +                          Failed sdoc -> return (Failed sdoc)
    929 
    +                          Succeeded {} -> return $ Succeeded (iface, loc)
    930 
    +      err -> do
    931 
    +          trace_if logger (text "...not found")
    932 
    +          return $ Failed $ cannotFindInterface
    933 
    +                              unit_state
    934 
    +                              mhome_unit
    935 
    +                              profile
    936 
    +                              (moduleName mod)
    937 
    +                              err
    945 938
    946 939 
     -- | Check if we need to try the dynamic interface for -dynamic-too
    947 
    -load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags
    940 
    +load_dynamic_too_maybe :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
    948 941 
                            -> Module -> ModIface -> ModLocation
    949 942 
                            -> IO (MaybeErr MissingInterfaceError ())
    950 
    -load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc
    943 
    +load_dynamic_too_maybe hooks logger name_cache unit_state dflags wanted_mod iface loc
    951 944 
       -- Indefinite interfaces are ALWAYS non-dynamic.
    952 945 
       | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ())
    953 
    -  | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc
    946 
    +  | gopt Opt_BuildDynamicToo dflags = load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc
    954 947 
       | otherwise = return (Succeeded ())
    955 948
    956 
    -load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags
    949 
    +load_dynamic_too :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
    957 950 
                      -> Module -> ModIface -> ModLocation
    958 951 
                      -> IO (MaybeErr MissingInterfaceError ())
    959 
    -load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
    960 
    -  read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
    952 
    +load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc = do
    953 
    +  read_file hooks logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
    961 954 
         Succeeded (dynIface, _)
    962 955 
          | mi_mod_hash iface == mi_mod_hash dynIface
    963 956 
          -> return (Succeeded ())
    ... ... @@ -971,10 +964,10 @@ load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
    971 964
    972 965
    973 966
    974 
    -read_file :: Logger -> NameCache -> UnitState -> DynFlags
    967 
    +read_file :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
    975 968 
               -> Module -> FilePath
    976 969 
               -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath))
    977 
    -read_file logger name_cache unit_state dflags wanted_mod file_path = do
    970 
    +read_file hooks logger name_cache unit_state dflags wanted_mod file_path = do
    978 971
    979 972 
       -- Figure out what is recorded in mi_module.  If this is
    980 973 
       -- a fully definite interface, it'll match exactly, but
    ... ... @@ -985,7 +978,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do
    985 978 
                 (_, Just indef_mod) ->
    986 979 
                   instModuleToModule unit_state
    987 980 
                     (uninstantiateInstantiatedModule indef_mod)
    988 
    -  read_result <- readIface logger dflags name_cache wanted_mod' file_path
    981 
    +  read_result <- readIface hooks logger dflags name_cache wanted_mod' file_path
    989 982 
       case read_result of
    990 983 
         Failed err      -> return (Failed err)
    991 984 
         Succeeded iface -> return (Succeeded (iface, file_path))
    ... ... @@ -1012,13 +1005,14 @@ flagsToIfCompression dflags
    1012 1005 
     -- Failed err    <=> file not found, or unreadable, or illegible
    1013 1006 
     -- Succeeded iface <=> successfully found and parsed
    1014 1007 
     readIface
    1015 
    -  :: Logger
    1008 
    +  :: Hooks
    1009 
    +  -> Logger
    1016 1010 
       -> DynFlags
    1017 1011 
       -> NameCache
    1018 1012 
       -> Module
    1019 1013 
       -> FilePath
    1020 1014 
       -> IO (MaybeErr ReadInterfaceError ModIface)
    1021 
    -readIface logger dflags name_cache wanted_mod file_path = do
    1015 
    +readIface hooks logger dflags name_cache wanted_mod file_path = do
    1022 1016 
       trace_if logger (text "readIFace" <+> text file_path)
    1023 1017 
       let profile = targetProfile dflags
    1024 1018 
       res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path
    ... ... @@ -1028,9 +1022,14 @@ readIface logger dflags name_cache wanted_mod file_path = do
    1028 1022 
             -- critical for correctness of recompilation checking
    1029 1023 
             -- (it lets us tell when -this-unit-id has changed.)
    1030 1024 
             | wanted_mod == actual_mod
    1031 
    -                        -> return (Succeeded iface)
    1025 
    +                        -> return (Succeeded final_iface)
    1032 1026 
             | otherwise     -> return (Failed err)
    1033 1027 
             where
    1028 
    +          final_iface
    1029 
    +            -- Check for GHC.Prim, and return its static interface
    1030 
    +            -- See Note [GHC.Prim] in primops.txt.pp.
    1031 
    +            | wanted_mod == gHC_PRIM = getGhcPrimIface hooks
    1032 
    +            | otherwise              = iface
    1034 1033 
               actual_mod = mi_module iface
    1035 1034 
               err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod
    1036 1035
    ... ... @@ -1245,8 +1244,8 @@ instance Outputable WhereFrom where
    1245 1244 
     -- This is a helper function that takes into account the hook allowing ghc-prim
    1246 1245 
     -- interface to be extended via the ghc-api. Afaik it was introduced for GHCJS
    1247 1246 
     -- so that it can add its own primitive types.
    1248 
    -getGhcPrimIface :: HscEnv -> ModIface
    1249 
    -getGhcPrimIface hsc_env =
    1250 
    -  case ghcPrimIfaceHook (hsc_hooks hsc_env) of
    1247 
    +getGhcPrimIface :: Hooks -> ModIface
    1248 
    +getGhcPrimIface hooks =
    1249 
    +  case ghcPrimIfaceHook hooks of
    1251 1250 
         Nothing -> ghcPrimIface
    1252 1251 
         Just h  -> h

  • compiler/GHC/Iface/Recomp.hs
    ... ... @@ -304,7 +304,7 @@ check_old_iface hsc_env mod_summary maybe_iface
    304 304
    305 305 
             loadIface read_dflags iface_path = do
    306 306 
                  let ncu        = hsc_NC hsc_env
    307 
    -             read_result <- readIface logger read_dflags ncu (ms_mod mod_summary) iface_path
    307 
    +             read_result <- readIface (hsc_hooks hsc_env) logger read_dflags ncu (ms_mod mod_summary) iface_path
    308 308 
                  case read_result of
    309 309 
                      Failed err -> do
    310 310 
                          let msg = readInterfaceErrorDiagnostic err

  • testsuite/tests/driver/make-prim/GHC/Internal/Prim.hs
    1 
    +{-# LANGUAGE NoImplicitPrelude #-}
    2 
    +
    3 
    +module GHC.Internal.Prim where
    4 
    +
    5 
    +

  • testsuite/tests/driver/make-prim/Makefile
    1 
    +TOP=../..
    2 
    +include $(TOP)/mk/boilerplate.mk
    3 
    +include $(TOP)/mk/test.mk
    4 
    +
    5 
    +make-prim:
    6 
    +	# build once to test the substitution of the virtual interface in --make
    7 
    +	# mode with codegen
    8 
    +	"$(TEST_HC)" $(TEST_HC_OPTS) --make Test.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0
    9 
    +	# build a different module (Test2) in --make mode to test the reloading
    10 
    +	# of the GHC.Internal.Prim interface
    11 
    +	"$(TEST_HC)" $(TEST_HC_OPTS) --make Test2.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0

  • testsuite/tests/driver/make-prim/Test.hs
    1 
    +{-# LANGUAGE MagicHash #-}
    2 
    +{-# LANGUAGE NoImplicitPrelude #-}
    3 
    +
    4 
    +module Test where
    5 
    +
    6 
    +import GHC.Internal.Prim
    7 
    +
    8 
    +foo :: Int# -> Int#
    9 
    +foo = notI#

  • testsuite/tests/driver/make-prim/Test2.hs
    1 
    +{-# LANGUAGE MagicHash #-}
    2 
    +{-# LANGUAGE NoImplicitPrelude #-}
    3 
    +
    4 
    +module Test2 where
    5 
    +
    6 
    +import GHC.Internal.Prim
    7 
    +
    8 
    +foo :: Int# -> Int#
    9 
    +foo = notI#

  • testsuite/tests/driver/make-prim/all.T
    1 
    +test('make-prim', [extra_files(['Test.hs','Test2.hs', 'GHC', 'GHC/Internal', 'GHC/Internal/Prim.hs'])], makefile_test, ['make-prim'])

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