David Eichmann pushed to branch wip/davide/hadrian-aclocal_path at Glasgow Haskell Compiler / GHC

Commits:

9 changed files:

Changes:

  • boot
    ... ... @@ -52,9 +52,8 @@ def autoreconf():
    52 52 
         # Run autoreconf on everything that needs it.
    53 53 
         processes = {}
    54 54 
         if os.name == 'nt':
    55 
    -        # Get the normalized ACLOCAL_PATH for Windows
    56 
    -        # This is necessary since on Windows this will be a Windows
    57 
    -        # path, which autoreconf doesn't know doesn't know how to handle.
    55 
    +        # Convert ACLOCAL_PATH env variable to unix style paths on Windows
    56 
    +        # See Note [Autoreconf unix paths from ACLOCAL_PATH]
    58 57 
             ac_local = os.getenv('ACLOCAL_PATH', '')
    59 58 
             ac_local_arg = re.sub(r';', r':', ac_local)
    60 59 
             ac_local_arg = re.sub(r'\\', r'/', ac_local_arg)

  • changelog.d/T27182.md
    1 
    +section: compiler
    2 
    +issues: #27182
    3 
    +mrs: !16003
    4 
    +synopsis:
    5 
    +  Fix `getStgArgFromTrivialArg` panic in CoreToStg
    6 
    +description:
    7 
    +  Avoid a `getStgArgFromTrivialArg` panic in CoreToStg due to a call to `mkTick`
    8 
    +  in Core Prep which invalidated ANF.

  • compiler/GHC/Builtin/primops.txt.pp
    ... ... @@ -2149,7 +2149,7 @@ primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
    2149 2149
    2150 2150 
     primop  GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp
    2151 2151 
        MutableByteArray# s -> State# s -> (# State# s, Int# #)
    2152 
    -   {Return the number of elements in the array, correctly accounting for
    2152 
    +   {Return the number of bytes in the array, correctly accounting for
    2153 2153 
        the effect of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'.
    2154 2154
    2155 2155 
        @since 0.5.0.0}

  • compiler/GHC/Core/Utils.hs
    ... ... @@ -11,6 +11,7 @@ module GHC.Core.Utils (
    11 11 
             -- * Constructing expressions
    12 12 
             mkCast, mkCastMCo, mkPiMCo,
    13 13 
             mkTick, mkTicks, mkTickNoHNF, tickHNFArgs,
    14 
    +        mkTickCpe,
    14 15 
             bindNonRec, needsCaseBinding, needsCaseBindingL,
    15 16 
             mkAltExpr, mkDefaultCase, mkSingleAltCase,
    16 17
    ... ... @@ -319,7 +320,18 @@ mkCast expr co
    319 320 
     --   * Split profiling ticks into counting/scoping parts so that the two parts
    320 321 
     --     can be placed independently into the AST.
    321 322 
     mkTick :: CoreTickish -> CoreExpr -> CoreExpr
    322 
    -mkTick t orig_expr = mkTick' orig_expr
    323 
    +mkTick = mk_tick False
    324 
    +
    325 
    +-- | A version of 'mkTick' that preserves ANF, for use in Core Prep.
    326 
    +--
    327 
    +-- See Note [mkTick breaks ANF] in GHC.CoreToStg.Prep.
    328 
    +mkTickCpe :: CoreTickish -> CoreExpr -> CoreExpr
    329 
    +mkTickCpe = mk_tick True
    330 
    +
    331 
    +-- | Internal function used to define both 'mkTick' and 'mkTickCpe'
    332 
    +-- without duplication.
    333 
    +mk_tick :: Bool -> CoreTickish -> CoreExpr -> CoreExpr
    334 
    +mk_tick preserve_anf t orig_expr = mkTick' orig_expr
    323 335 
      where
    324 336 
       -- Some ticks (cost-centres) can be split in two, with the
    325 337 
       -- non-counting part having laxer placement properties.
    ... ... @@ -343,7 +355,7 @@ mkTick t orig_expr = mkTick' orig_expr
    343 355 
           -- Push SCCs into lambdas.
    344 356 
           -- See (PSCC2) in Note [Pushing SCCs inwards].
    345 357 
           | can_split
    346 
    -      -> Tick (mkNoScope t) $ Lam x $ mkTick (mkNoCount t) e
    358 
    +      -> Tick (mkNoScope t) $ Lam x $ mk_tick preserve_anf (mkNoCount t) e
    347 359
    348 360 
         App f arg
    349 361 
           -- All ticks float inwards through non-runtime arguments, as per
    ... ... @@ -353,7 +365,9 @@ mkTick t orig_expr = mkTick' orig_expr
    353 365
    354 366 
           -- Push SCCs into saturated constructor applications.
    355 367 
           -- See (PSCC3) in Note [Pushing SCCs inwards].
    356 
    -      | isSaturatedConApp expr
    368 
    +      | not preserve_anf -- this optimisation breaks ANF;
    369 
    +                         -- see Note [mkTick breaks ANF] in GHC.CoreToStg.Prep
    370 
    +      , isSaturatedConApp expr
    357 371 
           , tickishPlace t == PlaceCostCentre || can_split
    358 372 
           -> if tickishPlace t == PlaceCostCentre
    359 373 
              then tickHNFArgs t expr

  • compiler/GHC/CoreToStg/Prep.hs
    ... ... @@ -801,7 +801,9 @@ cpeBodyF env (Tick tickish expr)
    801 801 
            ; return (FloatTick tickish `consFloat` floats, body) }
    802 802 
       | otherwise
    803 803 
       = do { body <- cpeBody env expr
    804 
    -       ; return (emptyFloats, mkTick tickish' body) }
    804 
    +       ; return (emptyFloats, mkTickCpe tickish' body) }
    805 
    +    -- Use mkTickCpe and not mkTick, as the latter may break ANF (#27182).
    806 
    +    -- See (TickANF2) in Note [mkTick breaks ANF].
    805 807 
       where
    806 808 
         tickish' | Breakpoint ext bid fvs <- tickish
    807 809 
                  -- See also 'substTickish'
    ... ... @@ -905,6 +907,28 @@ cpeBodyF env (Case scrut bndr ty alts)
    905 907 
                 ; rhs' <- cpeBody env2 rhs
    906 908 
                 ; return (Alt con bs' rhs') }
    907 909
    910 
    +{- Note [mkTick breaks ANF]
    911 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~
    912 
    +mkTick does not preserve the ANF property as required by Core Prep (see
    913 
    +Note [CorePrep invariants]), as seen in #27182. Given:
    914 
    +
    915 
    +  mkTick scc<foo> (\ (eta :: Char -> Bool) -> BindP (p :: Int) eta)
    916 
    +
    917 
    +mkTick will push the SCC into the constructor application, resulting in:
    918 
    +
    919 
    +  \ (eta :: Char -> Bool) -> BindP (p :: Int) (scc<oneM> eta)
    920 
    +
    921 
    +To avoid this problem (at least until 'mkTick' is more thoroughly reworked to
    922 
    +avoid this infelicity, see #27141), we define a variant of 'mkTick', called
    923 
    +'mkTickCpe', which does not push ticks into constructor applications (this is
    924 
    +the only optimisation done by 'mkTick' that can break ANF).
    925 
    +
    926 
    +We prefer using a small variant of 'mkTick' rather than using the 'Tick'
    927 
    +constructor, as the latter can slightly degrade profiling reports by failing to
    928 
    +combine ticks (can result in spurious cost centres with 0 entries appearing in
    929 
    +profiling reports).
    930 
    +-}
    931 
    +
    908 932 
     -- ---------------------------------------------------------------------------
    909 933 
     --              CpeBody: produces a result satisfying CpeBody
    910 934 
     -- ---------------------------------------------------------------------------
    ... ... @@ -1207,7 +1231,7 @@ cpeApp top_env expr
    1207 1231 
         rebuild_app' env (a : as) fun' floats ss rt_ticks req_depth = case a of
    1208 1232 
           -- See Note [Ticks and mandatory eta expansion]
    1209 1233 
           _ | not (null rt_ticks), req_depth <= 0
    1210 
    -        -> let tick_fun = foldr mkTick fun' rt_ticks
    1234 
    +        -> let tick_fun = foldr mkTickCpe fun' rt_ticks
    1211 1235 
                in rebuild_app' env (a : as) tick_fun floats ss rt_ticks req_depth
    1212 1236
    1213 1237 
           AIApp (Type arg_ty)
    ... ... @@ -2307,7 +2331,7 @@ wrapBinds floats body
    2307 2331 
         mk_bind (UnsafeEqualityCase scrut b con bs) body
    2308 2332 
           = mkSingleAltCase scrut b con bs body
    2309 2333 
         mk_bind (FloatTick tickish) body
    2310 
    -      = mkTick tickish body
    2334 
    +      = mkTickCpe tickish body
    2311 2335
    2312 2336 
     -- | Put floats at top-level
    2313 2337 
     deFloatTop :: Floats -> [CoreBind]
    ... ... @@ -2735,7 +2759,7 @@ newVar env ty
    2735 2759 
     wrapTicks :: Floats -> CoreExpr -> (Floats, CoreExpr)
    2736 2760 
     wrapTicks floats expr
    2737 2761 
       | (floats1, ticks1) <- fold_fun go floats
    2738 
    -  = (floats1, foldrOL mkTick expr ticks1)
    2762 
    +  = (floats1, foldrOL mkTickCpe expr ticks1)
    2739 2763 
       where fold_fun f floats =
    2740 2764 
                let (binds, ticks) = foldlOL f (nilOL,nilOL) (fs_binds floats)
    2741 2765 
                in (floats { fs_binds = binds }, ticks)
    ... ... @@ -2755,8 +2779,8 @@ wrapTicks floats expr
    2755 2779
    2756 2780 
             wrap t (Float bind bound info) = Float (wrapBind t bind) bound info
    2757 2781 
             wrap _ f                 = pprPanic "Unexpected FloatingBind" (ppr f)
    2758 
    -        wrapBind t (NonRec binder rhs) = NonRec binder (mkTick t rhs)
    2759 
    -        wrapBind t (Rec pairs)         = Rec (mapSnd (mkTick t) pairs)
    2782 
    +        wrapBind t (NonRec binder rhs) = NonRec binder (mkTickCpe t rhs)
    2783 
    +        wrapBind t (Rec pairs)         = Rec (mapSnd (mkTickCpe t) pairs)
    2760 2784
    2761 2785 
     ------------------------------------------------------------------------------
    2762 2786 
     -- Numeric literals

  • hadrian/src/Hadrian/Oracles/Path.hs
    1 1 
     {-# LANGUAGE TypeFamilies #-}
    2 2 
     module Hadrian.Oracles.Path (
    3 
    -    lookupInPath, fixAbsolutePathOnWindows, pathOracle
    3 
    +    lookupInPath, fixAbsolutePathOnWindows, fixUnixPathsOnWindows,
    4 
    +    pathOracle
    4 5 
         ) where
    5 6
    6 7 
     import Control.Monad
    ... ... @@ -33,6 +34,14 @@ fixAbsolutePathOnWindows path =
    33 34 
         else
    34 35 
             return path
    35 36
    37 
    +-- | Fix a unix path list on Windows:
    38 
    +-- * "C:\\foo\\bar;C:\\msys2\\bin" => "/c/foo/bar:/c/msys2/bin"
    39 
    +fixUnixPathsOnWindows :: FilePath -> Action FilePath
    40 
    +fixUnixPathsOnWindows paths =
    41 
    +    if isWindows
    42 
    +    then askOracle $ UnixPathList paths
    43 
    +    else return paths
    44 
    +
    36 45 
     newtype LookupInPath = LookupInPath String
    37 46 
         deriving (Binary, Eq, Hashable, NFData, Show)
    38 47 
     type instance RuleResult LookupInPath = String
    ... ... @@ -41,6 +50,10 @@ newtype WindowsPath = WindowsPath FilePath
    41 50 
         deriving (Binary, Eq, Hashable, NFData, Show)
    42 51 
     type instance RuleResult WindowsPath = String
    43 52
    53 
    +newtype UnixPathList = UnixPathList FilePath
    54 
    +    deriving (Binary, Eq, Hashable, NFData, Show)
    55 
    +type instance RuleResult UnixPathList = String
    56 
    +
    44 57 
     -- | Oracles for looking up paths. These are slow and require caching.
    45 58 
     pathOracle :: Rules ()
    46 59 
     pathOracle = do
    ... ... @@ -50,6 +63,12 @@ pathOracle = do
    50 63 
             putVerbose $ "| Windows path mapping: " ++ path ++ " => " ++ windowsPath
    51 64 
             return windowsPath
    52 65
    66 
    +    void $ addOracleCache $ \(UnixPathList paths) -> do
    67 
    +        Stdout out <- quietly $ cmd ["cygpath", "-p", "-u", paths]
    68 
    +        let unixPaths = unifyPath $ dropWhileEnd isSpace out
    69 
    +        putVerbose $ "| Unix path mapping: " ++ paths ++ " => " ++ unixPaths
    70 
    +        return unixPaths
    71 
    +
    53 72 
         void $ addOracleCache $ \(LookupInPath name) -> do
    54 73 
             path <- liftIO getSearchPath
    55 74 
             exes <- liftIO (findExecutablesInDirectories path name)

  • hadrian/src/Rules/BinaryDist.hs
    ... ... @@ -3,18 +3,19 @@ module Rules.BinaryDist where
    3 3
    4 4 
     import CommandLine
    5 5 
     import Context
    6 
    +import Data.Either
    7 
    +import qualified Data.Set as Set
    6 8 
     import Expression
    9 
    +import Hadrian.Oracles.Path (fixUnixPathsOnWindows)
    10 
    +import Oracles.Flavour
    7 11 
     import Oracles.Setting
    8 12 
     import Packages
    13 
    +import Rules.Generate (generateSettings)
    9 14 
     import Settings
    15 
    +import qualified System.Directory.Extra as IO
    10 16 
     import Settings.Program (programContext)
    11 17 
     import Target
    12 18 
     import Utilities
    13 
    -import qualified System.Directory.Extra as IO
    14 
    -import Data.Either
    15 
    -import qualified Data.Set as Set
    16 
    -import Oracles.Flavour
    17 
    -import Rules.Generate (generateSettings)
    18 19
    19 20 
     {-
    20 21 
     Note [Binary distributions]
    ... ... @@ -343,7 +344,25 @@ bindistRules = do
    343 344 
             ghcRoot <- topDirectory
    344 345 
             copyFile (ghcRoot -/- "aclocal.m4") (ghcRoot -/- "distrib" -/- "aclocal.m4")
    345 346 
             copyDirectory (ghcRoot -/- "m4") (ghcRoot -/- "distrib")
    346 
    -        buildWithCmdOptions [] $
    347 
    +
    348 
    +        -- Note [Autoreconf unix paths from ACLOCAL_PATH]
    349 
    +        -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    350 
    +        -- On Windows, autoreconf fails when the ACLOCAL_PATH env variable contains Windows-
    351 
    +        -- style paths. This happens because MSYS2 automatically converts env variables to
    352 
    +        -- Windows-style paths. To fix this, we convert ACLOCAL_PATH back to Unix style.
    353 
    +        -- This is done both in the boot Python script and here when building a bindist.
    354 
    +        win_host <- isWinHost
    355 
    +        env <- if not win_host
    356 
    +          then pure []
    357 
    +          else do
    358 
    +            aclocalPathMay <- getEnv "ACLOCAL_PATH"
    359 
    +            case aclocalPathMay of
    360 
    +              Nothing -> pure []
    361 
    +              Just aclocalPath -> do
    362 
    +                unixAclocalPath <- fixUnixPathsOnWindows aclocalPath
    363 
    +                pure [AddEnv "ACLOCAL_PATH" unixAclocalPath]
    364 
    +
    365 
    +        buildWithCmdOptions env $
    347 366 
                 target (vanillaContext Stage1 ghc) (Autoreconf $ ghcRoot -/- "distrib") [] []
    348 367 
             -- We clean after ourselves, moving the configure script we generated in
    349 368 
             -- our bindist dir

  • testsuite/tests/profiling/should_compile/T27182.hs
    1 
    +module T27182 ( oneM ) where
    2 
    +
    3 
    +data Parser = BindP Int ( Char -> Bool )
    4 
    +
    5 
    +oneM :: Int -> ( Char -> Bool ) -> Parser
    6 
    +oneM p = BindP p

  • testsuite/tests/profiling/should_compile/all.T
    ... ... @@ -22,3 +22,4 @@ test('T19894', [test_opts, extra_files(['T19894'])], multimod_compile, ['Main',
    22 22 
     test('T20938', [test_opts], compile, ['-O -prof'])
    23 23 
     test('T26056', [test_opts], compile, ['-O -prof'])
    24 24 
     test('T27121', [test_opts, extra_files(['T27121_aux.hs'])], multimod_compile, ['T27121', '-v0 -O -prof -fprof-auto'])
    25 
    +test('T27182', [test_opts], compile, ['-O -prof -fprof-late'])

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