recursion-ninja pushed to branch wip/fix-26670 at Glasgow Haskell Compiler / GHC

Commits:

15 changed files:

Changes:

  • compiler/GHC/Core/Opt/Simplify/Iteration.hs
    ... ... @@ -657,8 +657,8 @@ tryCastWorkerWrapper env _ _ bndr rhs -- All other bindings
    657 657
    658 658 
     mkCastWrapperInlinePrag :: forall p. IsPass p => InlinePragma (GhcPass p) -> InlinePragma (GhcPass p)
    659 659 
     -- See Note [Cast worker/wrapper]
    660 
    -mkCastWrapperInlinePrag (InlinePragma { inl_src = inTag, inl_inline = fn_inl, inl_act = fn_act, inl_rule = rule_info })
    661 
    -  = InlinePragma { inl_src    = outTag
    660 
    +mkCastWrapperInlinePrag (InlinePragma { inl_ext = inTag, inl_inline = fn_inl, inl_act = fn_act, inl_rule = rule_info })
    661 
    +  = InlinePragma { inl_ext    = outTag
    662 662 
                      , inl_inline = fn_inl       -- See Note [Worker/wrapper for INLINABLE functions]
    663 663 
                      , inl_act    = wrap_act     -- See Note [Wrapper activation]
    664 664 
                      , inl_rule   = rule_info }  --     in GHC.Core.Opt.WorkWrap

  • compiler/GHC/Core/Opt/WorkWrap.hs
    ... ... @@ -834,7 +834,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div
    834 834 
                        _        -> inl_act wrap_prag
    835 835
    836 836 
         srcTxt = SourceText $ fsLit "{-# INLINE"
    837 
    -    work_prag = InlinePragma { inl_src = InlinePragmaGhcTag srcTxt arity
    837 
    +    work_prag = InlinePragma { inl_ext = InlinePragmaGhcTag srcTxt arity
    838 838 
                                  , inl_inline = fn_inline_spec
    839 839 
                                  , inl_act    = work_act
    840 840 
                                  , inl_rule   = FunLike }
    ... ... @@ -901,7 +901,7 @@ mkStrWrapperInlinePrag :: InlinePragma (GhcPass p) -> [CoreRule] -> Arity -> Inl
    901 901 
     mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl
    902 902 
                                          , inl_act    = fn_act
    903 903 
                                          , inl_rule   = rule_info }) rules arity
    904 
    -  = InlinePragma { inl_src    = InlinePragmaGhcTag srcTxt arity
    904 
    +  = InlinePragma { inl_ext    = InlinePragmaGhcTag srcTxt arity
    905 905
    906 906 
                      , inl_inline = fn_inl
    907 907 
                           -- See Note [Worker/wrapper for INLINABLE functions]

  • compiler/GHC/Hs/Binds.hs
    ... ... @@ -819,26 +819,20 @@ ppr_sig (ClassOpSig _ is_deflt vars ty)
    819 819 
       | otherwise                = pprVarSig (map unLoc vars) (ppr ty)
    820 820 
     ppr_sig (FixSig _ fix_sig)   = ppr fix_sig
    821 821
    822 
    -ppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_src = src, inl_inline = spec }))
    822 
    +ppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_inline = spec }))
    823 823 
       = pragSrcBrackets srcTxt pragmaSrc $
    824 824 
         pprSpec (unLoc var) (interpp'SP ty) inl
    825 
    -    where
    826 
    -      srcTxt = case ghcPass @p of
    827 
    -        GhcPs -> src
    828 
    -        GhcRn -> inl_ghcrn_src src
    829 
    -        GhcTc -> inl_ghcrn_src src
    830 
    -      pragmaSrc = case spec of
    831 
    -        NoUserInlinePrag -> "{-# " ++ extractSpecPragName srcTxt
    832 
    -        _                -> "{-# " ++ extractSpecPragName srcTxt  ++ "_INLINE"
    833 
    -
    834 
    -ppr_sig (SpecSigE _ bndrs spec_e inl@(InlinePragma { inl_src = src, inl_inline = spec }))
    825 
    +  where
    826 
    +    srcTxt = inlinePragmaSource inl
    827 
    +    pragmaSrc = case spec of
    828 
    +      NoUserInlinePrag -> "{-# " ++ extractSpecPragName srcTxt
    829 
    +      _                -> "{-# " ++ extractSpecPragName srcTxt  ++ "_INLINE"
    830 
    +
    831 
    +ppr_sig (SpecSigE _ bndrs spec_e inl@(InlinePragma { inl_inline = spec }))
    835 832 
       = pragSrcBrackets srcTxt pragmaSrc $
    836 833 
         pp_inl <+> hang (ppr bndrs) 2 (pprLExpr spec_e)
    837 834 
       where
    838 
    -    srcTxt = case ghcPass @p of
    839 
    -      GhcPs -> src
    840 
    -      GhcRn -> inl_ghcrn_src src
    841 
    -      GhcTc -> inl_ghcrn_src src
    835 
    +    srcTxt = inlinePragmaSource inl
    842 836 
         -- SPECIALISE or SPECIALISE_INLINE
    843 837 
         pragmaSrc = case spec of
    844 838 
           NoUserInlinePrag -> "{-# " ++ extractSpecPragName srcTxt
    ... ... @@ -849,13 +843,8 @@ ppr_sig (SpecSigE _ bndrs spec_e inl@(InlinePragma { inl_src = src, inl_inline =
    849 843
    850 844 
     ppr_sig (InlineSig _ var inl)
    851 845 
       = ppr_pfx <+> pprInline inl <+> pprPrefixOcc (unLoc var) <+> text "#-}"
    852 
    -    where
    853 
    -      srcTxt = case ghcPass @p of
    854 
    -        GhcPs -> inl_src inl
    855 
    -        GhcRn -> inl_ghcrn_src $ inl_src inl
    856 
    -        GhcTc -> inl_ghcrn_src $ inl_src inl
    857 
    -
    858 
    -      ppr_pfx = case srcTxt of
    846 
    +  where
    847 
    +    ppr_pfx = case inlinePragmaSource inl of
    859 848 
             SourceText src -> ftext src
    860 849 
             NoSourceText   -> text "{-#" <+> inlinePragmaName (inl_inline inl)
    861 850

  • compiler/GHC/Hs/Decls.hs
    ... ... @@ -157,13 +157,6 @@ type instance XDocD (GhcPass _) = NoExtField
    157 157 
     type instance XRoleAnnotD (GhcPass _) = NoExtField
    158 158 
     type instance XXHsDecl    (GhcPass _) = DataConCantHappen
    159 159
    160 
    -{-
    161 
    -type instance XInlinePragma GhcPs = SourceText
    162 
    -type instance XInlinePragma GhcRn = (SourceText, Arity)
    163 
    -type instance XInlinePragma GhcTc = (SourceText, Arity)
    164 
    -type instance XXInlinePragma (GhcPass _) = DataConCantHappen
    165 
    --}
    166 
    -
    167 160 
     -- | Partition a list of HsDecls into function/pattern bindings, signatures,
    168 161 
     -- type family declarations, type family instances, and documentation comments.
    169 162 
     --

  • compiler/GHC/HsToCore/Binds.hs
    ... ... @@ -457,19 +457,14 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
    457 457 
         simpl_opts    = initSimpleOpts dflags
    458 458 
         InlinePragma (InlinePragmaGhcTag _ arity) inl_spec _ _ = idInlinePragma gbl_id
    459 459 
         inlinable_unf = mkInlinableUnfolding simpl_opts StableUserSrc rhs
    460 
    -    inline_pair
    461 
    -       | arity > 0
    462 
    -        -- Add an Unfolding for an INLINE (but not for NOINLINE)
    463 
    -        -- And eta-expand the RHS; see Note [Eta-expanding INLINE things]
    464 
    -       , let real_arity = dict_arity + arity
    465 
    -        -- NB: The arity passed to mkInlineUnfoldingWithArity
    466 
    -        --     must take account of the dictionaries
    467 
    -       = ( gbl_id `setIdUnfolding` mkInlineUnfoldingWithArity simpl_opts StableUserSrc real_arity rhs
    468 
    -         , etaExpand real_arity rhs)
    469 
    -
    470 
    -       | otherwise
    471 
    -       = pprTrace "makeCorePair: arity missing" (ppr gbl_id) $
    472 
    -         (gbl_id `setIdUnfolding` mkInlineUnfoldingNoArity simpl_opts StableUserSrc rhs, rhs)
    460 
    +    inline_pair =
    461 
    +      -- Add an Unfolding for an INLINE (but not for NOINLINE)
    462 
    +      -- And eta-expand the RHS; see Note [Eta-expanding INLINE things]
    463 
    +      let real_arity = dict_arity + arity
    464 
    +      -- NB: The arity passed to mkInlineUnfoldingWithArity
    465 
    +      --     must take account of the dictionaries
    466 
    +      in  ( gbl_id `setIdUnfolding` mkInlineUnfoldingWithArity simpl_opts StableUserSrc real_arity rhs
    467 
    +          , etaExpand real_arity rhs)
    473 468
    474 469 
     dictArity :: [Var] -> Arity
    475 470 
     -- Don't count coercion variables in arity
    ... ... @@ -1022,7 +1017,7 @@ dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call
    1022 1017 
                  fn_unf     = realIdUnfolding poly_id
    1023 1018 
                  spec_unf   = specUnfolding simpl_opts spec_bndrs mk_spec_body rule_lhs_args fn_unf
    1024 1019 
                  spec_info  = vanillaIdInfo
    1025 
    -                          `setInlinePragInfo` specFunInlinePrag poly_id (unsetInlinePragmaArity id_inl) (unsetInlinePragmaArity spec_inl)
    1020 
    +                          `setInlinePragInfo` specFunInlinePrag poly_id id_inl spec_inl
    1026 1021 
                               `setUnfoldingInfo`  spec_unf
    1027 1022 
                  spec_id    = mkLocalVar (idDetails poly_id) spec_name ManyTy spec_ty spec_info
    1028 1023 
                               -- Specialised binding is toplevel, hence Many.
    ... ... @@ -1192,17 +1187,19 @@ getCastedVar (Var v) = Just (v, MRefl)
    1192 1187 
     getCastedVar (Cast (Var v) co) = Just (v, MCo co)
    1193 1188 
     getCastedVar _                 = Nothing
    1194 1189
    1195 
    -specFunInlinePrag :: Id -> InlinePragma GhcPs
    1196 
    -                  -> InlinePragma GhcPs -> InlinePragma GhcPs
    1190 
    +specFunInlinePrag :: Id -> InlinePragma GhcTc
    1191 
    +                  -> InlinePragma GhcTc -> InlinePragma GhcTc
    1197 1192 
     -- See Note [Activation pragmas for SPECIALISE]
    1198 1193 
     specFunInlinePrag poly_id id_inl spec_inl
    1199 1194 
       | not (isDefaultInlinePragma spec_inl)    = spec_inl
    1200 1195 
       | isGlobalId poly_id  -- See Note [Specialising imported functions]
    1201 1196 
                             -- in OccurAnal
    1202 
    -  , isStrongLoopBreaker (idOccInfo poly_id) = neverInlinePragma
    1197 
    +  , isStrongLoopBreaker (idOccInfo poly_id) = neverInlinePragma `setInlinePragmaArity` arity
    1203 1198 
       | otherwise                               = id_inl
    1204 1199 
          -- Get the INLINE pragma from SPECIALISE declaration, or,
    1205 1200 
          -- failing that, from the original Id
    1201 
    +  where
    1202 
    +    arity = arityInfo $ idInfo poly_id
    1206 1203
    1207 1204 
     dsWarnOrphanRule :: CoreRule -> DsM ()
    1208 1205 
     dsWarnOrphanRule rule

  • compiler/GHC/Parser/PostProcess.hs
    ... ... @@ -3045,7 +3045,7 @@ mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
    3045 3045 
     -- The (Maybe Activation) is because the user can omit
    3046 3046 
     -- the activation spec (and usually does)
    3047 3047 
     mkInlinePragma src (inl, match_info) mb_act
    3048 
    -  = InlinePragma { inl_src = src -- See Note [Pragma source text] in "GHC.Types.SourceText"
    3048 
    +  = InlinePragma { inl_ext = src -- See Note [Pragma source text] in "GHC.Types.SourceText"
    3049 3049 
                      , inl_inline = inl
    3050 3050 
                      , inl_act    = act
    3051 3051 
                      , inl_rule   = match_info }
    ... ... @@ -3060,7 +3060,7 @@ mkInlinePragma src (inl, match_info) mb_act
    3060 3060
    3061 3061 
     mkOpaquePragma :: SourceText -> InlinePragma GhcPs
    3062 3062 
     mkOpaquePragma src
    3063 
    -  = InlinePragma { inl_src    = src
    3063 
    +  = InlinePragma { inl_ext    = src
    3064 3064 
                      , inl_inline = Opaque
    3065 3065 
                      -- By marking the OPAQUE pragma NeverActive we stop
    3066 3066 
                      -- (constructor) specialisation on OPAQUE things.

  • compiler/GHC/Rename/Bind.hs
    ... ... @@ -1103,7 +1103,7 @@ renameSig ctxt sig@(SpecSig _ v tys inl)
    1103 1103 
                          TopSigCtxt {} -> lookupLocatedOccRn WL_TermVariable v
    1104 1104 
                          _             -> lookupSigOccRn ctxt sig v
    1105 1105 
             ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys
    1106 
    -        ; return (SpecSig noAnn new_v new_ty (inl `setInlinePragmaArity` 0), fvs) }
    1106 
    +        ; return (SpecSig noAnn new_v new_ty (inl `setInlinePragmaArity` 0), fvs) } -- TODO: setting arity to 0 is likely wrong
    1107 1107 
       where
    1108 1108 
         do_one (tys,fvs) ty
    1109 1109 
           = do { (new_ty, fvs_ty) <- rnHsSigType (SpecialiseSigCtx v) TypeLevel ty

  • compiler/GHC/ThToHs.hs
    ... ... @@ -892,7 +892,7 @@ cvtPragmaD (InlineP nm inline rm phases)
    892 892 
            ; let src TH.NoInline  = fsLit "{-# NOINLINE"
    893 893 
                  src TH.Inline    = fsLit "{-# INLINE"
    894 894 
                  src TH.Inlinable = fsLit "{-# INLINABLE"
    895 
    -       ; let ip   = InlinePragma { inl_src    = toSrcTxt inline
    895 
    +       ; let ip   = InlinePragma { inl_ext    = toSrcTxt inline
    896 896 
                                      , inl_inline = cvtInline inline
    897 897 
                                      , inl_rule   = cvtRuleMatch rm
    898 898 
                                      , inl_act    = cvtPhases phases dflt }
    ... ... @@ -902,7 +902,7 @@ cvtPragmaD (InlineP nm inline rm phases)
    902 902
    903 903 
     cvtPragmaD (OpaqueP nm)
    904 904 
       = do { nm' <- vNameN nm
    905 
    -       ; let ip = InlinePragma { inl_src    = srcTxt
    905 
    +       ; let ip = InlinePragma { inl_ext    = srcTxt
    906 906 
                                    , inl_inline = Opaque
    907 907 
                                    , inl_rule   = Hs.FunLike
    908 908 
                                    , inl_act    = NeverActive }
    ... ... @@ -1017,7 +1017,7 @@ cvtInlinePhases inline phases =
    1017 1017 
                              SourceText $ fsLit "{-# SPECIALISE")
    1018 1018 
             where
    1019 1019 
              toSrcTxt a = SourceText $ src a
    1020 
    -  in InlinePragma { inl_src    = srcText
    1020 
    +  in InlinePragma { inl_ext    = srcText
    1021 1021 
                       , inl_inline = inline'
    1022 1022 
                       , inl_rule   = Hs.FunLike
    1023 1023 
                       , inl_act    = cvtPhases phases dflt }

  • compiler/GHC/Types/Basic.hs
    ... ... @@ -1338,12 +1338,12 @@ dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
    1338 1338 
                                              , inl_rule = ConLike }
    1339 1339
    1340 1340 
     setInlinePragmaArity :: InlinePragma GhcPs -> Arity -> InlinePragma GhcTc
    1341 
    -setInlinePragmaArity prag@(InlinePragma { inl_src = srcTxt }) arity =
    1342 
    -    prag { inl_src = InlinePragmaGhcTag srcTxt arity }
    1341 
    +setInlinePragmaArity prag@(InlinePragma { inl_ext = srcTxt }) arity =
    1342 
    +    prag { inl_ext = InlinePragmaGhcTag srcTxt arity }
    1343 1343
    1344 1344
    1345 1345 
     inlinePragmaSource :: forall p. IsPass p => InlinePragma (GhcPass p) -> SourceText
    1346 
    -inlinePragmaSource (InlinePragma { inl_src = src }) = srcTxt
    1346 
    +inlinePragmaSource (InlinePragma { inl_ext = src }) = srcTxt
    1347 1347 
       where
    1348 1348 
         srcTxt = case ghcPass @p of
    1349 1349 
           GhcPs -> src

  • compiler/GHC/Types/Id/Info.hs
    ... ... @@ -557,7 +557,7 @@ setRuleInfo info sp = sp `seq` info { ruleInfo = sp }
    557 557 
     --setInlinePragInfo :: IdInfo -> InlinePragma GhcTc -> IdInfo
    558 558 
     --setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
    559 559 
     setInlinePragInfo :: forall p. IsPass p => IdInfo -> InlinePragma (GhcPass p) -> IdInfo
    560 
    -setInlinePragInfo info pr@(InlinePragma { inl_src = src }) = pr `seq` info { inlinePragInfo = pr { inl_src = tag } }
    560 
    +setInlinePragInfo info pr@(InlinePragma { inl_ext = src }) = pr `seq` info { inlinePragInfo = pr { inl_ext = tag } }
    561 561 
       where
    562 562 
         tag :: InlinePragmaGhcTag
    563 563 
         tag = case ghcPass @p of

  • compiler/GHC/Types/InlinePragma.hs
    ... ... @@ -59,6 +59,12 @@ module GHC.Types.InlinePragma
    59 59 
         -- ** Extensible record type for GhcRn & GhcTc
    60 60 
       , InlinePragmaGhcTag(..)
    61 61
    62 
    +    -- ** InlineSpec
    63 
    +    -- *** Data-type
    64 
    +  , InlineSpec(..)
    65 
    +    -- *** Queries
    66 
    +  , noUserInlineSpec
    67 
    +
    62 68 
         -- ** RuleMatchInfo
    63 69 
         -- *** Data-type
    64 70 
       , RuleMatchInfo(..)
    ... ... @@ -66,12 +72,6 @@ module GHC.Types.InlinePragma
    66 72 
       , isConLike
    67 73 
       , isFunLike
    68 74
    69 
    -    -- ** InlineSpec
    70 
    -    -- *** Data-type
    71 
    -  , InlineSpec(..)
    72 
    -    -- *** Queries
    73 
    -  , noUserInlineSpec
    74 
    -
    75 75 
         -- * Phase Activation
    76 76 
         -- ** Activation
    77 77 
         -- *** Data-type
    ... ... @@ -133,7 +133,7 @@ type instance XXInlinePragma (GhcPass _) = DataConCantHappen
    133 133
    134 134 
     defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
    135 135 
       :: InlinePragma GhcPs
    136 
    -defaultInlinePragma = InlinePragma { inl_src = SourceText $ fsLit "{-# INLINE"
    136 
    +defaultInlinePragma = InlinePragma { inl_ext = SourceText $ fsLit "{-# INLINE"
    137 137 
                                        , inl_act = AlwaysActive
    138 138 
                                        , inl_rule = FunLike
    139 139 
                                        , inl_inline = NoUserInlinePrag }
    ... ... @@ -161,26 +161,25 @@ isDefaultInlinePragma (InlinePragma { inl_act = activation
    161 161 
     setInlinePragmaArity :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ InlinePragmaGhcTag)
    162 162 
       => InlinePragma (GhcPass p) -> Arity -> InlinePragma (GhcPass q)
    163 163 
     setInlinePragmaArity prag arity =
    164 
    -    prag { inl_src = InlinePragmaGhcTag (inlinePragmaSource prag) arity }
    164 
    +    prag { inl_ext = InlinePragmaGhcTag (inlinePragmaSource prag) arity }
    165 165
    166 166 
     unsetInlinePragmaArity :: forall p. IsPass p => InlinePragma (GhcPass p) -> InlinePragma GhcPs
    167 167 
     unsetInlinePragmaArity prag =
    168 
    -    prag { inl_src = inlinePragmaSource prag }
    168 
    +    prag { inl_ext = inlinePragmaSource prag }
    169 169
    170 170 
     inlinePragmaSource :: forall p. IsPass p => InlinePragma (GhcPass p) -> SourceText
    171 
    -inlinePragmaSource (InlinePragma { inl_src = src }) = srcTxt
    171 
    +inlinePragmaSource (InlinePragma { inl_ext = src }) = srcTxt
    172 172 
       where
    173 173 
         srcTxt = case ghcPass @p of
    174 174 
           GhcPs -> src
    175 175 
           GhcRn -> inl_ghcrn_src src
    176 176 
           GhcTc -> inl_ghcrn_src src
    177 177
    178 
    --- TODO: Should we use coerce here?
    179 178 
     promoteInlinePragmaRn :: InlinePragma GhcRn -> InlinePragma GhcTc
    180 
    -promoteInlinePragmaRn prag@(InlinePragma { inl_src = src }) = prag { inl_src = src }
    179 
    +promoteInlinePragmaRn prag@(InlinePragma { inl_ext = src }) = prag { inl_ext = src }
    181 180
    182 181 
     demoteInlinePragmaRn :: InlinePragma GhcTc -> InlinePragma GhcRn
    183 
    -demoteInlinePragmaRn prag@(InlinePragma { inl_src = src }) = prag { inl_src = src }
    182 
    +demoteInlinePragmaRn prag@(InlinePragma { inl_ext = src }) = prag { inl_ext = src }
    184 183
    185 184 
     inlinePragmaSpec :: InlinePragma p -> InlineSpec
    186 185 
     inlinePragmaSpec = inl_inline
    ... ... @@ -192,7 +191,7 @@ inlinePragmaRuleMatchInfo :: InlinePragma (GhcPass p) -> RuleMatchInfo
    192 191 
     inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
    193 192
    194 193 
     setInlinePragmaTag :: InlinePragma (GhcPass p) -> XInlinePragma (GhcPass q) -> InlinePragma (GhcPass q)
    195 
    -setInlinePragmaTag prag tag = prag { inl_src = tag }
    194 
    +setInlinePragmaTag prag tag = prag { inl_ext = tag }
    196 195
    197 196 
     setInlinePragmaActivation :: InlinePragma (GhcPass p) -> Activation -> InlinePragma (GhcPass p)
    198 197 
     setInlinePragmaActivation prag activation = prag { inl_act = activation }

  • compiler/GHC/Utils/Binary.hs
    ... ... @@ -2087,14 +2087,6 @@ instance Binary Activation where
    2087 2087 
                   _ -> do ab <- get bh
    2088 2088 
                           return (ActiveAfter ab)
    2089 2089
    2090 
    -instance Binary RuleMatchInfo where
    2091 
    -    put_ bh FunLike = putByte bh 0
    2092 
    -    put_ bh ConLike = putByte bh 1
    2093 
    -    get bh = do
    2094 
    -            h <- getByte bh
    2095 
    -            if h == 1 then return ConLike
    2096 
    -                      else return FunLike
    2097 
    -
    2098 2090 
     instance Binary InlineSpec where
    2099 2091 
         put_ bh = putByte bh . \case
    2100 2092 
           NoUserInlinePrag -> 0
    ... ... @@ -2110,3 +2102,11 @@ instance Binary InlineSpec where
    2110 2102 
                       2 -> Inlinable
    2111 2103 
                       3 -> NoInline
    2112 2104 
                       _ -> Opaque
    2105 
    +
    2106 
    +instance Binary RuleMatchInfo where
    2107 
    +    put_ bh FunLike = putByte bh 0
    2108 
    +    put_ bh ConLike = putByte bh 1
    2109 
    +    get bh = do
    2110 
    +            h <- getByte bh
    2111 
    +            if h == 1 then return ConLike
    2112 
    +                      else return FunLike

  • compiler/GHC/Utils/Outputable.hs
    ... ... @@ -2049,10 +2049,6 @@ instance Outputable Activation where
    2049 2049 
        ppr (ActiveAfter  n) = brackets (int n)
    2050 2050 
        ppr FinalActive      = text "[final]"
    2051 2051
    2052 
    -instance Outputable RuleMatchInfo where
    2053 
    -   ppr ConLike = text "CONLIKE"
    2054 
    -   ppr FunLike = text "FUNLIKE"
    2055 
    -
    2056 2052 
     instance Outputable InlineSpec where
    2057 2053 
         ppr Inline           = text "INLINE"
    2058 2054 
         ppr NoInline         = text "NOINLINE"
    ... ... @@ -2060,5 +2056,9 @@ instance Outputable InlineSpec where
    2060 2056 
         ppr Opaque           = text "OPAQUE"
    2061 2057 
         ppr NoUserInlinePrag = empty
    2062 2058
    2059 
    +instance Outputable RuleMatchInfo where
    2060 
    +   ppr ConLike = text "CONLIKE"
    2061 
    +   ppr FunLike = text "FUNLIKE"
    2062 
    +
    2063 2063 
     instance Outputable (InlinePragma (GhcPass p)) where
    2064 2064 
       ppr = pprInline

  • compiler/Language/Haskell/Syntax/Binds.hs
    ... ... @@ -802,7 +802,7 @@ no harm.
    802 802
    803 803 
     data InlinePragma pass            -- Note [InlinePragma]
    804 804 
       = InlinePragma
    805 
    -      { inl_src    :: (XInlinePragma pass) -- See Note [Pragma source text]
    805 
    +      { inl_ext    :: (XInlinePragma pass) -- See Note [Pragma source text]
    806 806 
           , inl_inline :: InlineSpec -- See Note [inl_inline and inl_act]
    807 807 
           , inl_act    :: Activation     -- Says during which phases inlining is allowed
    808 808 
                                          -- See Note [inl_inline and inl_act]
    ... ... @@ -1021,7 +1021,7 @@ inlinePragmaRuleMatchInfo :: InlinePragma p -> RuleMatchInfo
    1021 1021 
     inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
    1022 1022
    1023 1023 
     setInlinePragmaTag :: InlinePragma p -> XInlinePragma q -> InlinePragma q
    1024 
    -setInlinePragmaTag prag tag = prag { inl_src = tag }
    1024 
    +setInlinePragmaTag prag tag = prag { inl_ext = tag }
    1025 1025
    1026 1026 
     setInlinePragmaActivation :: InlinePragma p -> Activation -> InlinePragma p
    1027 1027 
     setInlinePragmaActivation prag activation = prag { inl_act = activation }

  • compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs
    ... ... @@ -25,6 +25,12 @@ module Language.Haskell.Syntax.Binds.InlinePragma
    25 25 
       , isNoInlinePragma
    26 26 
       , isOpaquePragma
    27 27
    28 
    +    -- ** InlineSpec
    29 
    +    -- *** Data-type
    30 
    +  , InlineSpec(..)
    31 
    +    -- *** Queries
    32 
    +  , noUserInlineSpec
    33 
    +
    28 34 
         -- ** RuleMatchInfo
    29 35 
         -- *** Data-type
    30 36 
       , RuleMatchInfo(..)
    ... ... @@ -32,12 +38,6 @@ module Language.Haskell.Syntax.Binds.InlinePragma
    32 38 
       , isConLike
    33 39 
       , isFunLike
    34 40
    35 
    -    -- ** InlineSpec
    36 
    -    -- *** Data-type
    37 
    -  , InlineSpec(..)
    38 
    -    -- *** Queries
    39 
    -  , noUserInlineSpec
    40 
    -
    41 41 
         -- * Phase Activation
    42 42 
         -- ** Activation
    43 43 
         -- *** Data-type
    ... ... @@ -68,7 +68,7 @@ import Prelude -- (Eq, Int, Show, ($), seq)
    68 68
    69 69 
     data InlinePragma pass            -- Note [InlinePragma]
    70 70 
       = InlinePragma
    71 
    -      { inl_src    :: (XInlinePragma pass) -- See Note [Pragma source text]
    71 
    +      { inl_ext    :: (XInlinePragma pass) -- See Note [Pragma source text]
    72 72 
           , inl_inline :: InlineSpec -- See Note [inl_inline and inl_act]
    73 73 
           , inl_act    :: Activation     -- Says during which phases inlining is allowed
    74 74 
                                          -- See Note [inl_inline and inl_act]

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