Cheng Shao pushed to branch wip/ghci-no-simpl at Glasgow Haskell Compiler / GHC

Commits:

14 changed files:

Changes:

  • compiler/GHC/Core/Opt/Pipeline.hs
    ... ... @@ -6,7 +6,7 @@
    6 6
    7 7 
     {-# LANGUAGE CPP #-}
    8 8
    9 
    -module GHC.Core.Opt.Pipeline ( core2core, simplifyExpr ) where
    9 
    +module GHC.Core.Opt.Pipeline ( core2core ) where
    10 10
    11 11 
     import GHC.Prelude
    12 12
    ... ... @@ -27,7 +27,7 @@ import GHC.Core.Ppr ( pprCoreBindings )
    27 27 
     import GHC.Core.Utils   ( dumpIdInfoOfProgram )
    28 28 
     import GHC.Core.Lint    ( lintAnnots )
    29 29 
     import GHC.Core.Lint.Interactive ( interactiveInScope )
    30 
    -import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm )
    30 
    +import GHC.Core.Opt.Simplify ( simplifyPgm )
    31 31 
     import GHC.Core.Opt.Simplify.Monad
    32 32 
     import GHC.Core.Opt.Monad
    33 33 
     import GHC.Core.Opt.Pipeline.Types

  • compiler/GHC/Core/Opt/Simplify.hs
    1 1 
     {-# LANGUAGE CPP #-}
    2 2
    3 3 
     module GHC.Core.Opt.Simplify
    4 
    -  ( SimplifyExprOpts(..), SimplifyOpts(..)
    5 
    -  , simplifyExpr, simplifyPgm
    4 
    +  ( SimplifyOpts(..)
    5 
    +  , simplifyPgm
    6 6 
       ) where
    7 7
    8 8 
     import GHC.Prelude
    ... ... @@ -11,20 +11,18 @@ import GHC.Driver.Flags
    11 11
    12 12 
     import GHC.Core
    13 13 
     import GHC.Core.Rules
    14 
    -import GHC.Core.Ppr     ( pprCoreBindings, pprCoreExpr )
    15 
    -import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
    16 
    -import GHC.Core.Stats   ( coreBindsSize, coreBindsStats, exprSize )
    14 
    +import GHC.Core.Ppr     ( pprCoreBindings )
    15 
    +import GHC.Core.Opt.OccurAnal ( occurAnalysePgm )
    16 
    +import GHC.Core.Stats   ( coreBindsSize, coreBindsStats )
    17 17 
     import GHC.Core.Utils   ( mkTicks, stripTicksTop )
    18 18 
     import GHC.Core.Lint    ( LintPassResultConfig, dumpPassResult, lintPassResult )
    19 
    -import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules )
    19 
    +import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplImpRules )
    20 20 
     import GHC.Core.Opt.Simplify.Utils  ( activeRule )
    21 21 
     import GHC.Core.Opt.Simplify.Inline ( activeUnfolding )
    22 22 
     import GHC.Core.Opt.Simplify.Env
    23 23 
     import GHC.Core.Opt.Simplify.Monad
    24 24 
     import GHC.Core.Opt.Stats ( simplCountN )
    25 
    -import GHC.Core.FamInstEnv
    26 25
    27 
    -import GHC.Utils.Error  ( withTiming )
    28 26 
     import GHC.Utils.Logger as Logger
    29 27 
     import GHC.Utils.Outputable
    30 28 
     import GHC.Utils.Constants (debugIsOn)
    ... ... @@ -44,72 +42,6 @@ import GHC.Types.Unique.FM
    44 42 
     import Control.Monad
    45 43 
     import Data.Foldable ( for_ )
    46 44
    47 
    -{-
    48 
    -************************************************************************
    49 
    -*                                                                      *
    50 
    -        Gentle simplification
    51 
    -*                                                                      *
    52 
    -************************************************************************
    53 
    --}
    54 
    -
    55 
    --- | Configuration record for `simplifyExpr`.
    56 
    --- The values of this datatype are /only/ driven by the demands of that function.
    57 
    -data SimplifyExprOpts = SimplifyExprOpts
    58 
    -  { se_fam_inst :: ![FamInst]
    59 
    -  , se_mode :: !SimplMode
    60 
    -  , se_top_env_cfg :: !TopEnvConfig
    61 
    -  }
    62 
    -
    63 
    -simplifyExpr :: Logger
    64 
    -             -> ExternalUnitCache
    65 
    -             -> SimplifyExprOpts
    66 
    -             -> CoreExpr
    67 
    -             -> IO CoreExpr
    68 
    --- ^ Simplify an expression using 'simplExprGently'.
    69 
    ---
    70 
    --- See 'simplExprGently' for details.
    71 
    -simplifyExpr logger euc opts expr
    72 
    -  = withTiming logger (text "Simplify [expr]") (const ()) $
    73 
    -    do  { eps <- eucEPS euc ;
    74 
    -        ; let fam_envs = ( eps_fam_inst_env eps
    75 
    -                         , extendFamInstEnvList emptyFamInstEnv $ se_fam_inst opts
    76 
    -                         )
    77 
    -              simpl_env = mkSimplEnv (se_mode opts) fam_envs
    78 
    -              top_env_cfg = se_top_env_cfg opts
    79 
    -              read_eps_rules = eps_rule_base <$> eucEPS euc
    80 
    -              read_ruleenv = updExternalPackageRules emptyRuleEnv <$> read_eps_rules
    81 
    -
    82 
    -        ; let sz = exprSize expr
    83 
    -
    84 
    -        ; (expr', counts) <- initSmpl logger read_ruleenv top_env_cfg sz $
    85 
    -                             simplExprGently simpl_env expr
    86 
    -
    87 
    -        ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats
    88 
    -                  "Simplifier statistics" FormatText (pprSimplCount counts)
    89 
    -
    90 
    -        ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl "Simplified expression"
    91 
    -                        FormatCore
    92 
    -                        (pprCoreExpr expr')
    93 
    -
    94 
    -        ; return expr'
    95 
    -        }
    96 
    -
    97 
    -simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr
    98 
    --- ^ Simplifies an expression by doing occurrence analysis, then simplification,
    99 
    --- and repeating (twice currently), because one pass alone leaves tons of crud.
    100 
    ---
    101 
    --- Used only:
    102 
    ---
    103 
    ---   1. for user expressions typed in at the interactive prompt (see 'GHC.Driver.Main.hscStmt'),
    104 
    ---   2. for Template Haskell splices (see 'GHC.Tc.Gen.Splice.runMeta').
    105 
    ---
    106 
    --- The name 'Gently' suggests that the SimplMode is InitialPhase,
    107 
    --- and in fact that is so.... but the 'Gently' in 'simplExprGently' doesn't
    108 
    --- enforce that; it just simplifies the expression twice.
    109 
    -simplExprGently env expr = do
    110 
    -    expr1 <- simplExpr env (occurAnalyseExpr expr)
    111 
    -    simplExpr env (occurAnalyseExpr expr1)
    112 
    -
    113 45 
     {-
    114 46 
     ************************************************************************
    115 47 
     *                                                                      *

  • compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
    1 1 
     module GHC.Driver.Config.Core.Opt.Simplify
    2 
    -  ( initSimplifyExprOpts
    3 
    -  , initSimplifyOpts
    2 
    +  ( initSimplifyOpts
    4 3 
       , initSimplMode
    5 4 
       , initGentleSimplMode
    6 5 
       ) where
    ... ... @@ -9,7 +8,7 @@ import GHC.Prelude
    9 8
    10 9 
     import GHC.Core.Rules ( RuleBase )
    11 10 
     import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) )
    12 
    -import GHC.Core.Opt.Simplify ( SimplifyExprOpts(..), SimplifyOpts(..) )
    11 
    +import GHC.Core.Opt.Simplify ( SimplifyOpts(..) )
    13 12 
     import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..), SimplPhase(..) )
    14 13 
     import GHC.Core.Opt.Simplify.Monad ( TopEnvConfig(..) )
    15 14
    ... ... @@ -19,26 +18,9 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts )
    19 18 
     import GHC.Driver.Config.Core.Opt.Arity ( initArityOpts )
    20 19 
     import GHC.Driver.DynFlags ( DynFlags(..), GeneralFlag(..), gopt )
    21 20
    22 
    -import GHC.Runtime.Context ( InteractiveContext(..) )
    23 
    -
    24 21 
     import GHC.Types.Basic ( CompilerPhase(..) )
    25 22 
     import GHC.Types.Var ( Var )
    26 23
    27 
    -initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts
    28 
    -initSimplifyExprOpts dflags ic = SimplifyExprOpts
    29 
    -  { se_fam_inst = snd $ ic_instances ic
    30 
    -  , se_mode = (initSimplMode dflags InitialPhase "GHCi")
    31 
    -    { sm_inline = False
    32 
    -      -- Do not do any inlining, in case we expose some
    33 
    -      -- unboxed tuple stuff that confuses the bytecode
    34 
    -      -- interpreter
    35 
    -    }
    36 
    -  , se_top_env_cfg = TopEnvConfig
    37 
    -    { te_history_size = historySize dflags
    38 
    -    , te_tick_factor = simplTickFactor dflags
    39 
    -    }
    40 
    -  }
    41 
    -
    42 24 
     initSimplifyOpts :: DynFlags -> [Var] -> Int -> SimplMode -> RuleBase -> SimplifyOpts
    43 25 
     initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let
    44 26 
       -- This is a particularly ugly construction, but we will get rid of it in !8341.

  • compiler/GHC/Driver/Main.hs
    ... ... @@ -121,8 +121,8 @@ import GHC.Driver.Errors
    121 121 
     import GHC.Driver.Messager
    122 122 
     import GHC.Driver.Errors.Types
    123 123 
     import GHC.Driver.CodeOutput
    124 
    +import GHC.Driver.Config
    124 125 
     import GHC.Driver.Config.Cmm.Parser (initCmmParserConfig)
    125 
    -import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts )
    126 126 
     import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO )
    127 127 
     import GHC.Driver.Config.Core.Lint.Interactive ( lintInteractiveExpr )
    128 128 
     import GHC.Driver.Config.CoreToStg
    ... ... @@ -181,6 +181,7 @@ import GHC.Core.Utils ( exprType )
    181 181 
     import GHC.Core.ConLike
    182 182 
     import GHC.Core.Opt.Pipeline
    183 183 
     import GHC.Core.Opt.Pipeline.Types      ( CoreToDo (..))
    184 
    +import GHC.Core.SimpleOpt
    184 185 
     import GHC.Core.TyCon
    185 186 
     import GHC.Core.InstEnv
    186 187 
     import GHC.Core.FamInstEnv
    ... ... @@ -2712,15 +2713,17 @@ hscCompileCoreExpr hsc_env loc expr =
    2712 2713 
     hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
    2713 2714 
     hscCompileCoreExpr' hsc_env srcspan ds_expr = do
    2714 2715 
       {- Simplify it -}
    2715 
    -  -- Question: should we call SimpleOpt.simpleOptExpr here instead?
    2716 
    -  -- It is, well, simpler, and does less inlining etc.
    2717 2716 
       let dflags = hsc_dflags hsc_env
    2718 2717 
       let logger = hsc_logger hsc_env
    2719 
    -  let ic = hsc_IC hsc_env
    2720 
    -  let unit_env = hsc_unit_env hsc_env
    2721 
    -  let simplify_expr_opts = initSimplifyExprOpts dflags ic
    2722 2718
    2723 
    -  simpl_expr <- simplifyExpr logger (ue_eps unit_env) simplify_expr_opts ds_expr
    2719 
    +  let simpl_expr =
    2720 
    +        simpleOptExpr
    2721 
    +          ( initSimpleOpts $
    2722 
    +              if gopt Opt_UnoptimizedCoreForInterpreter dflags
    2723 
    +                then updOptLevel 0 dflags
    2724 
    +                else dflags
    2725 
    +          )
    2726 
    +          ds_expr
    2724 2727
    2725 2728 
       -- Create a unique temporary binding
    2726 2729 
       --

  • compiler/GHC/Runtime/Heap/Inspect.hs
    ... ... @@ -74,12 +74,12 @@ import GHC.Utils.Outputable as Ppr
    74 74 
     import GHC.Utils.Panic
    75 75 
     import GHC.Char
    76 76 
     import GHC.Exts.Heap
    77 
    -import GHC.Runtime.Heap.Layout ( roundUpTo )
    77 
    +import GHC.Runtime.Heap.Layout (ByteOff)
    78 78 
     import GHC.IO (throwIO)
    79 79
    80 80 
     import Control.Monad
    81 81 
     import Data.Maybe
    82 
    -import Data.List ((\\))
    82 
    +import Data.List ((\\), mapAccumL)
    83 83 
     import Data.List.NonEmpty (NonEmpty (..))
    84 84 
     import qualified Data.List.NonEmpty as NE
    85 85 
     import GHC.Exts
    ... ... @@ -89,6 +89,10 @@ import Foreign hiding (shiftL, shiftR)
    89 89 
     import System.IO.Unsafe
    90 90 
     import GHC.InfoProv
    91 91
    92 
    +import GHC.StgToCmm.Closure ( NonVoid(NonVoid))
    93 
    +import GHC.StgToCmm.Layout (mkVirtHeapOffsets, ClosureHeader(..))
    94 
    +import Data.Array (Array, (!), array)
    95 
    +
    92 96 
     ---------------------------------------------
    93 97 
     -- * A representation of semi evaluated Terms
    94 98 
     ---------------------------------------------
    ... ... @@ -922,63 +926,80 @@ extractSubTerms :: (Type -> ForeignHValue -> TcM Term)
    922 926 
                     -> [Word]          -- ^ data arguments
    923 927 
                     -> [Type]
    924 928 
                     -> TcM [Term]
    925 
    -extractSubTerms recurse ptr_args data_args = liftM thdOf3 . go 0 0
    929 
    +extractSubTerms recurse ptr_args data_args tys = do
    930 
    +  dflags <- getDynFlags
    931 
    +  let profile = targetProfile dflags
    932 
    +      (n_primreps, r) = mapAccumL collectReps 0 tys
    933 
    +      (rep_tys, make_term) = unzip r
    934 
    +      (_tot_words, ptr_words, nv_rep_offsets) =
    935 
    +          mkVirtHeapOffsets profile NoHeader (map NonVoid $ concat rep_tys)
    936 
    +      rep_offsets = map (\(NonVoid x, off) -> (x, off)) nv_rep_offsets
    937 
    +      -- index maps the Int index of each PrimRep to its ByteOff
    938 
    +      index :: Array Int ByteOff
    939 
    +      index = array (0, n_primreps-1) rep_offsets
    940 
    +  mapM (\m -> m index ptr_words) make_term
    926 941 
       where
    927 
    -    go ptr_i arr_i [] = return (ptr_i, arr_i, [])
    928 
    -    go ptr_i arr_i (ty:tys)
    942 
    +
    943 
    +    {- Collect all PrimReps from the Type, indexing each with an Int.
    944 
    +       Also returns a function to construct the Term once the heap offset of
    945 
    +       each indexed PrimRep is known.
    946 
    +    -}
    947 
    +    collectReps :: Int                  -- first index to use
    948 
    +                -> Type
    949 
    +                -> ( Int                -- next available index
    950 
    +                   , ( [(PrimRep, Int)] -- indexed PrimReps
    951 
    +                     , Array Int ByteOff -> Int -> TcM Term
    952 
    +                     ))
    953 
    +    collectReps n ty
    929 954 
           | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty
    930 955 
           , isUnboxedTupleTyCon tc
    931 
    -                -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
    932 
    -      = do (ptr_i, arr_i, terms0) <-
    933 
    -               go ptr_i arr_i (dropRuntimeRepArgs elem_tys)
    934 
    -           (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
    935 
    -           return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)
    936 
    -      | otherwise
    937 
    -      = case typePrimRep ty of
    938 
    -          [rep_ty] -> do
    939 
    -            (ptr_i, arr_i, term0)  <- go_rep ptr_i arr_i ty rep_ty
    940 
    -            (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
    941 
    -            return (ptr_i, arr_i, term0 : terms1)
    942 
    -          rep_tys -> do
    943 
    -           (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys
    944 
    -           (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
    945 
    -           return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)
    946 
    -
    947 
    -    go_unary_types ptr_i arr_i [] = return (ptr_i, arr_i, [])
    948 
    -    go_unary_types ptr_i arr_i (rep_ty:rep_tys) = do
    949 
    -      tv <- newVar liftedTypeKind
    950 
    -      (ptr_i, arr_i, term0)  <- go_rep ptr_i arr_i tv rep_ty
    951 
    -      (ptr_i, arr_i, terms1) <- go_unary_types ptr_i arr_i rep_tys
    952 
    -      return (ptr_i, arr_i, term0 : terms1)
    953 
    -
    954 
    -    go_rep ptr_i arr_i ty rep
    956 
    +      -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
    957 
    +      = let (n', sub) = mapAccumL collectReps n (dropRuntimeRepArgs elem_tys)
    958 
    +            (reps, mk_terms) = unzip sub
    959 
    +        in (n', (concat reps,
    960 
    +                   \idx ptr_words -> unboxedTupleTerm ty <$>
    961 
    +                        mapM (\mk -> mk idx ptr_words) mk_terms))
    962 
    +      | otherwise =
    963 
    +          case typePrimRep ty of
    964 
    +              [rep] -> (n + 1
    965 
    +                       ,([(rep, n)]
    966 
    +                        ,\idx ptr_words -> mkTerm ptr_words ty rep (idx ! n)))
    967 
    +              reps  -> let n_reps = length reps
    968 
    +                           indexed_reps = zip reps [n..]
    969 
    +                           mk idx ptr_words =
    970 
    +                               unboxedTupleTerm ty <$>
    971 
    +                                 mapM (\(rep, i) -> mkTerm ptr_words ty rep (idx ! i))
    972 
    +                                      indexed_reps
    973 
    +                       in (n + n_reps, (indexed_reps, mk))
    974 
    +
    975 
    +
    976 
    +
    977 
    +    mkTerm :: Int -> Type -> PrimRep -> ByteOff -> TcM Term
    978 
    +    mkTerm ptr_words ty rep byte_offset
    955 979 
           | isGcPtrRep rep = do
    956 
    -          t <- recurse ty $ ptr_args !! ptr_i
    957 
    -          return (ptr_i + 1, arr_i, t)
    980 
    +          platform <- getPlatform
    981 
    +          let word_size = platformWordSizeInBytes platform
    982 
    +              (word_offset, r) = byte_offset `quotRem` word_size
    983 
    +          massert (word_offset < length ptr_args)
    984 
    +          massert (r == 0)
    985 
    +          r <- recurse ty (ptr_args !! (byte_offset `quot` word_size))
    986 
    +          pure r
    958 987 
           | otherwise = do
    959 
    -          -- This is a bit involved since we allow packing multiple fields
    960 
    -          -- within a single word. See also
    961 
    -          -- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding
    962 988 
               platform <- getPlatform
    963 989 
               let word_size = platformWordSizeInBytes platform
    964 
    -              endian = platformByteOrder platform
    965 
    -              size_b = primRepSizeB platform rep
    966 
    -              -- Align the start offset (eg, 2-byte value should be 2-byte
    967 
    -              -- aligned). But not more than to a word. The offset calculation
    968 
    -              -- should be the same with the offset calculation in
    969 
    -              -- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding.
    970 
    -              !aligned_idx = roundUpTo arr_i (min word_size size_b)
    971 
    -              !new_arr_i = aligned_idx + size_b
    972 
    -              ws | size_b < word_size =
    973 
    -                     [index size_b aligned_idx word_size endian]
    974 
    -                 | otherwise =
    975 
    -                     let (q, r) = size_b `quotRem` word_size
    976 
    -                     in assert (r == 0 )
    977 
    -                        [ data_args !! i
    978 
    -                        | o <- [0.. q - 1]
    979 
    -                        , let i = (aligned_idx `quot` word_size) + o
    980 
    -                        ]
    981 
    -          return (ptr_i, new_arr_i, Prim ty ws)
    990 
    +              endian    = platformByteOrder platform
    991 
    +              size_b    = primRepSizeB platform rep
    992 
    +              ws        | size_b < word_size
    993 
    +                        = [index size_b (byte_offset - word_size * ptr_words) word_size endian]
    994 
    +                        | otherwise
    995 
    +                        =
    996 
    +                            let (q, r) = size_b `quotRem` word_size
    997 
    +                            in assert (r == 0 )
    998 
    +                                [ data_args !! i
    999 
    +                                | o <- [0.. q - 1]
    1000 
    +                                , let i = (byte_offset `quot` word_size) - ptr_words + o
    1001 
    +                                ]
    1002 
    +          return (Prim ty ws)
    982 1003
    983 1004 
         unboxedTupleTerm ty terms
    984 1005 
           = Term ty (Right (tupleDataCon Unboxed (length terms)))

  • compiler/GHC/StgToCmm/Layout.hs
    ... ... @@ -56,7 +56,8 @@ import GHC.Platform.Profile
    56 56 
     import GHC.Unit
    57 57
    58 58 
     import GHC.Utils.Misc
    59 
    -import Data.List (mapAccumL, partition)
    59 
    +import Data.List (mapAccumL, partition, sortBy)
    60 
    +import Data.Ord (comparing)
    60 61 
     import GHC.Utils.Outputable
    61 62 
     import GHC.Utils.Panic
    62 63 
     import GHC.Utils.Constants (debugIsOn)
    ... ... @@ -459,10 +460,19 @@ mkVirtHeapOffsetsWithPadding profile header things =
    459 460 
           ThunkHeader -> thunkHdrSize profile
    460 461 
         hdr_bytes = wordsToBytes platform hdr_words
    461 462
    462 
    -    (ptrs, non_ptrs) = partition (isGcPtrRep . fst . fromNonVoid) things
    463 
    +    (ptrs, unsorted_non_ptrs) = partition (isGcPtrRep . fst . fromNonVoid) things
    464 
    +
    465 
    +    -- Sort the non-pointer fields by their size, starting with the largest
    466 
    +    -- size, so that we can pack them more efficiently.
    467 
    +
    468 
    +    cmp_sizes (NonVoid (rep1, _)) (NonVoid (rep2, _)) =
    469 
    +        comparing (primRepSizeB platform) rep2 rep1
    470 
    +
    471 
    +    non_ptrs = sortBy cmp_sizes unsorted_non_ptrs
    463 472
    464 473 
         (bytes_of_ptrs, ptrs_w_offsets) =
    465 474 
            mapAccumL computeOffset 0 ptrs
    475 
    +
    466 476 
         (tot_bytes, non_ptrs_w_offsets) =
    467 477 
            mapAccumL computeOffset bytes_of_ptrs non_ptrs
    468 478

  • libraries/ghc-heap/GHC/Exts/Heap.hs
    ... ... @@ -67,10 +67,26 @@ import GHC.Exts.Heap.ClosureTypes
    67 67 
     import GHC.Exts.Heap.Constants
    68 68 
     import GHC.Exts.Heap.ProfInfo.Types
    69 69 
     #if defined(PROFILING)
    70 
    +import GHC.Exts.Heap.InfoTable () -- See Note [No way-dependent imports]
    70 71 
     import GHC.Exts.Heap.InfoTableProf
    71 72 
     #else
    72 73 
     import GHC.Exts.Heap.InfoTable
    74 
    +import GHC.Exts.Heap.InfoTableProf () -- See Note [No way-dependent imports]
    75 
    +
    76 
    +{-
    77 
    +Note [No way-dependent imports]
    78 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    79 
    +`ghc -M` currently assumes that the imports for a module are the same
    80 
    +in every way.  This is arguably a bug, but breaking this assumption by
    81 
    +importing different things in different ways can cause trouble.  For
    82 
    +example, this module in the profiling way imports and uses
    83 
    +GHC.Exts.Heap.InfoTableProf.  When it was not also imported in the
    84 
    +vanilla way, there were intermittent build failures due to this module
    85 
    +being compiled in the profiling way before GHC.Exts.Heap.InfoTableProf
    86 
    +in the profiling way. (#15197)
    87 
    +-}
    73 88 
     #endif
    89 
    +
    74 90 
     import GHC.Exts.Heap.Utils
    75 91 
     import qualified GHC.Exts.Heap.FFIClosures as FFIClosures
    76 92 
     import qualified GHC.Exts.Heap.ProfInfo.PeekProfInfo as PPI

  • testsuite/tests/codeGen/should_run/T13825-unit.hs
    ... ... @@ -25,8 +25,8 @@ tests :: Ghc ()
    25 25 
     tests = do
    26 26 
           (_, _, off) <- runTest [("a", FloatRep), ("b", DoubleRep)]
    27 27 
           assert_32_64 (map fmt off)
    28 
    -          ["F(a,4)", "F(b,8)"]
    29 
    -          ["F(a,8)", "P(4,12)", "F(b,16)"]
    28 
    +          ["F(b,4)", "F(a,12)"]
    29 
    +          ["F(b,8)", "F(a,16)", "P(4,20)"]
    30 30
    31 31 
           (_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep)]
    32 32 
           assert_32_64 (map fmt off)
    ... ... @@ -40,8 +40,8 @@ tests = do
    40 40
    41 41 
           (_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep), ("c", Int64Rep)]
    42 42 
           assert_32_64 (map fmt off)
    43 
    -          ["F(a,4)", "F(b,8)", "F(c,12)"]
    44 
    -          ["F(a,8)", "F(b,12)", "F(c,16)"]
    43 
    +          ["F(c,4)", "F(a,12)", "F(b,16)"]
    44 
    +          ["F(c,8)", "F(a,16)", "F(b,20)"]
    45 45
    46 46 
           (_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", FloatRep)]
    47 47 
           assert_32_64 (map fmt off)
    ... ... @@ -50,8 +50,8 @@ tests = do
    50 50
    51 51 
           (_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", Int64Rep)]
    52 52 
           assert_32_64 (map fmt off)
    53 
    -          ["F(a,4)", "F(b,12)", "F(c,16)"]
    54 
    -          ["F(a,8)", "F(b,16)", "P(4,20)", "F(c,24)"]
    53 
    +          ["F(a,4)", "F(c,12)", "F(b,20)"]
    54 
    +          ["F(a,8)", "F(c,16)", "F(b,24)", "P(4,28)"]
    55 55
    56 56
    57 57 
     assert_32_64 :: (Eq a, Show a) => a -> a -> a -> Ghc ()

  • testsuite/tests/interface-stability/ghc-prim-exports.stdout
    ... ... @@ -3481,6 +3481,7 @@ module GHC.PrimopWrappers where
    3481 3481 
       remWord8# :: GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8#
    3482 3482 
       resizeMutableByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> (# GHC.Internal.Prim.State# s, GHC.Internal.Prim.MutableByteArray# s #)
    3483 3483 
       retry# :: forall a_levpoly. GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, a_levpoly #)
    3484 
    +  seq :: forall a b_reppoly. a -> b_reppoly -> b_reppoly
    3484 3485 
       setAddrRange# :: GHC.Internal.Prim.Addr# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    3485 3486 
       setByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> GHC.Internal.Prim.State# s
    3486 3487 
       setOtherThreadAllocationCounter# :: GHC.Internal.Prim.Int64# -> GHC.Internal.Prim.ThreadId# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld

  • testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
    ... ... @@ -3484,6 +3484,7 @@ module GHC.PrimopWrappers where
    3484 3484 
       remWord8# :: GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8#
    3485 3485 
       resizeMutableByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> (# GHC.Internal.Prim.State# s, GHC.Internal.Prim.MutableByteArray# s #)
    3486 3486 
       retry# :: forall a_levpoly. GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, a_levpoly #)
    3487 
    +  seq :: forall a b_reppoly. a -> b_reppoly -> b_reppoly
    3487 3488 
       setAddrRange# :: GHC.Internal.Prim.Addr# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    3488 3489 
       setByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> GHC.Internal.Prim.State# s
    3489 3490 
       setOtherThreadAllocationCounter# :: GHC.Internal.Prim.Int64# -> GHC.Internal.Prim.ThreadId# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld

  • testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout
    ... ... @@ -29,4 +29,4 @@ size: 10
    29 29
    30 30 
     ### u_maybeW32
    31 31 
     U_MaybeW32 NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295)
    32 
    -size: 9
    32 
    +size: 6

  • testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout-ws-32
    ... ... @@ -29,4 +29,4 @@ size: 11
    29 29
    30 30 
     ### u_maybeW32
    31 31 
     U_MaybeW32 NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295)
    32 
    -size: 17
    32 
    +size: 11

  • utils/genprimopcode/Main.hs
    ... ... @@ -510,7 +510,7 @@ gen_wrappers (Info _ entries)
    510 510 
             want_wrapper :: Entry -> Bool
    511 511 
             want_wrapper entry =
    512 512 
               and
    513 
    -            [ is_primop entry
    513 
    +            [ (is_primop entry || is_seq_pseudoop entry)
    514 514 
                 , not $ name entry `elem` magical_primops
    515 515 
                 , not $ is_vector entry
    516 516 
                     -- We currently don't generate wrappers for vector primops.
    ... ... @@ -520,6 +520,12 @@ gen_wrappers (Info _ entries)
    520 520 
                     -- suppose this choice can be revisited?
    521 521 
                 ]
    522 522
    523 
    +        -- We also want a wrapper for the `seq` pseudoop, since GHCi
    524 
    +        -- expects to find a value binding in PrimopWrappers.
    525 
    +        is_seq_pseudoop :: Entry -> Bool
    526 
    +        is_seq_pseudoop (PseudoOpSpec { name = n }) = n == "seq"
    527 
    +        is_seq_pseudoop _ = False
    528 
    +
    523 529 
             magical_primops :: [String]
    524 530 
             magical_primops =
    525 531 
               [ "tagToEnum#"

  • utils/genprimopcode/hie.yaml
    1 
    +cradle:
    2 
    +  cabal:

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