Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

7 changed files:

Changes:

  • libraries/containers
    1 
    -Subproject commit 801b06e5d4392b028e519d5ca116a2881d559721
    1 
    +Subproject commit 953428ad079d5708df696442f9bdeaccd1acfc6c

  • testsuite/tests/package/T4806a.stderr
    ... ... @@ -3,5 +3,5 @@ T4806a.hs:1:1: error: [GHC-87110]
    3 3 
         Could not load module ‘Data.Map’.
    4 4 
         It is a member of the package ‘containers-0.6.7’
    5 5 
         which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies:
    6 
    -      deepseq-1.4.8.1 template-haskell-2.20.0.0
    6 
    +      deepseq-1.4.8.1
    7 7 
         Use -v to see a list of the files searched for.

  • testsuite/tests/package/all.T
    ... ... @@ -20,7 +20,7 @@ test('package09e', normal, compile_fail, ['-package "containers (Data.Map as M,
    20 20 
     test('package10',  normal, compile,      ['-hide-all-packages -package "ghc (GHC.Types.Unique.FM as Prelude)" -frebindable-known-names'])
    21 21
    22 22 
     test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers'])
    23 
    -test('T4806a', normalise_version('deepseq', 'containers', 'template-haskell'), compile_fail, ['-ignore-package deepseq'])
    23 
    +test('T4806a', normalise_version('deepseq', 'containers'), compile_fail, ['-ignore-package deepseq'])
    24 24 
     test('T22884', normalise_version('text'), compile_fail, ['-hide-package text'])
    25 25 
     test('T22884_interactive', normalise_version('text'), ghci_script, ['T22884_interactive.script'])
    26 26 
     test('T4806_interactive', [extra_files(['T4806.hs']), normalise_version('containers')], ghci_script, ['T4806_interactive.script'])

  • testsuite/tests/simplCore/should_compile/T22611.hs
    1 
    --- The method `alterF` inside containers is marked as INLINEABLE
    1 
    +-- The method `alterF` in T22611a is marked as INLINEABLE
    2 2 
     -- and hence should be specialized to the `CheckRes` Functor.
    3 3
    4 4 
     -- This only started to work with 9.6, this test checks that we don't
    ... ... @@ -8,11 +8,11 @@
    8 8
    9 9 
     module T22611 where
    10 10
    11 
    -import Data.Map.Strict as Map
    12 
    -import qualified Data.Map.Strict as Map
    11 
    +import Data.Map.Strict (Map)
    12 
    +import T22611a (alterF)
    13 13
    14 14 
     foo :: Either Int Char -> Map (Either Int Char) v -> Maybe (v, (Map (Either Int Char) v))
    15 
    -foo x subst = case Map.alterF alt x subst of
    15 
    +foo x subst = case alterF alt x subst of
    16 16 
       NotFound -> foo (fmap (toEnum . (+1) . fromEnum) x) subst
    17 17 
       Found p q -> Just (p, q)
    18 18 
       where

  • testsuite/tests/simplCore/should_compile/T22611.stderr
    1 
    +[1 of 2] Compiling T22611a          ( T22611a.hs, T22611a.o )
    1 2
    2 3 
     ==================== Tidy Core ====================
    3 4 
     Result size of Tidy Core
    4 
    -  = {terms: 562, types: 505, coercions: 0, joins: 0/10}
    5 
    +  = {terms: 62, types: 94, coercions: 0, joins: 0/1}
    6 
    +
    7 
    +alterF
    8 
    +  = \ @f @k @a $dFunctor $dOrd f1 k1 m ->
    9 
    +      case k1 of k2 { __DEFAULT ->
    10 
    +      case lookupTrace $dOrd k2 m of { TraceResult bx bx1 bx2 ->
    11 
    +      let { lvl = $wdeleteAlong bx1 bx2 m } in
    12 
    +      fmap
    13 
    +        $dFunctor
    14 
    +        (\ fres ->
    15 
    +           case fres of {
    16 
    +             Nothing ->
    17 
    +               case bx of {
    18 
    +                 (# _| #) bx4 -> m;
    19 
    +                 (# |_ #) bx4 -> lvl
    20 
    +               };
    21 
    +             Just new ->
    22 
    +               case new of new1 { __DEFAULT ->
    23 
    +               case bx of {
    24 
    +                 (# _| #) bx4 -> $winsertAlong bx1 bx2 k2 new1 m;
    25 
    +                 (# |_ #) bx4 -> $wreplaceAlong bx1 bx2 new1 m
    26 
    +               }
    27 
    +               }
    28 
    +           })
    29 
    +        (f1
    30 
    +           (case bx of {
    31 
    +              (# _| #) bx4 -> Nothing;
    32 
    +              (# |_ #) bx4 -> Just bx4
    33 
    +            }))
    34 
    +      }
    35 
    +      }
    36 
    +
    37 
    +
    38 
    +------ Local rules for imported ids --------
    39 
    +"alterF/Identity"
    40 
    +    forall @k @a $dFunctor $dOrd k1 f.
    41 
    +      alterF $dFunctor $dOrd f k1
    42 
    +      = (\ t -> alter $dOrd (f `cast` <Co:7>) k1 t) `cast` <Co:10>
    43 
    +"alterF/Const"
    44 
    +    forall @k @a @b $dFunctor $dOrd k1 f.
    45 
    +      alterF $dFunctor $dOrd f k1
    46 
    +      = (\ m -> f (lookup $dOrd k1 m)) `cast` <Co:18>
    5 47
    6 
    -$WFound
    7 
    -  = \ @a @m conrep conrep1 ->
    8 
    -      case conrep of conrep2 { __DEFAULT -> Found conrep2 conrep1 }
    48 
    +
    49 
    +[2 of 2] Compiling T22611           ( T22611.hs, T22611.o )
    50 
    +
    51 
    +==================== Tidy Core ====================
    52 
    +Result size of Tidy Core
    53 
    +  = {terms: 502, types: 578, coercions: 0, joins: 1/8}
    9 54
    10 55 
     $fFunctorCheckRes_$c<$
    11 56 
       = \ @a @a1 @b z ds ->
    ... ... @@ -29,11 +74,31 @@ $fFunctorCheckRes
    29 74 
       = \ @a -> C:Functor $fFunctorCheckRes_$cfmap $fFunctorCheckRes_$c<$
    30 75
    31 76 
     Rec {
    32 
    -$w$sgo15
    77 
    +$w$sgo12
    33 78 
       = \ @a1 ww ww1 ds ds1 ->
    34 79 
           case ds of ds2 { __DEFAULT ->
    35 80 
           case ds1 of {
    36 81 
             Bin ipv2 ipv3 ipv4 ipv5 ipv6 ->
    82 
    +          join {
    83 
    +            $j
    84 
    +              = case ww1 of wild2 {
    85 
    +                  __DEFAULT ->
    86 
    +                    let {
    87 
    +                      hi1 = or# (uncheckedShiftRL# ww 1#) 9223372036854775808## } in
    88 
    +                    let { zeros = ctz# wild2 } in
    89 
    +                    let { zeros1 = word2Int# zeros } in
    90 
    +                    (# (# |_ #) ipv4, uncheckedShiftRL# hi1 zeros1,
    91 
    +                       or#
    92 
    +                         (uncheckedShiftRL#
    93 
    +                            (or# (uncheckedShiftRL# wild2 1#) (uncheckedShiftL# ww 63#))
    94 
    +                            zeros1)
    95 
    +                         (uncheckedShiftL# hi1 (-# 64# zeros1)) #);
    96 
    +                  0## ->
    97 
    +                    (# (# |_ #) ipv4, 0##,
    98 
    +                       uncheckedShiftRL#
    99 
    +                         (or# (uncheckedShiftRL# ww 1#) 9223372036854775808##)
    100 
    +                         (word2Int# (ctz# ww)) #)
    101 
    +                } } in
    37 102 
               case ds2 of wild1 {
    38 103 
                 Left a2 ->
    39 104 
                   case ipv3 of {
    ... ... @@ -44,33 +109,15 @@ $w$sgo15
    44 109 
                         __DEFAULT ->
    45 110 
                           case ==# x# y# of {
    46 111 
                             __DEFAULT ->
    47 
    -                          $w$sgo15
    112 
    +                          $w$sgo12
    48 113 
                                 (or# (uncheckedShiftRL# ww 1#) 9223372036854775808##)
    49 114 
                                 (or# (uncheckedShiftRL# ww1 1#) (uncheckedShiftL# ww 63#))
    50 115 
                                 wild1
    51 116 
                                 ipv6;
    52 
    -                        1# ->
    53 
    -                          case ww1 of ds3 {
    54 
    -                            __DEFAULT ->
    55 
    -                              let {
    56 
    -                                hi1 = or# (uncheckedShiftRL# ww 1#) 9223372036854775808## } in
    57 
    -                              let { zeros = ctz# ds3 } in
    58 
    -                              let { zeros1 = word2Int# zeros } in
    59 
    -                              (# Just ipv4, uncheckedShiftRL# hi1 zeros1,
    60 
    -                                 or#
    61 
    -                                   (uncheckedShiftRL#
    62 
    -                                      (or# (uncheckedShiftRL# ds3 1#) (uncheckedShiftL# ww 63#))
    63 
    -                                      zeros1)
    64 
    -                                   (uncheckedShiftL# hi1 (-# 64# zeros1)) #);
    65 
    -                            0## ->
    66 
    -                              (# Just ipv4, 0##,
    67 
    -                                 uncheckedShiftRL#
    68 
    -                                   (or# (uncheckedShiftRL# ww 1#) 9223372036854775808##)
    69 
    -                                   (word2Int# (ctz# ww)) #)
    70 
    -                          }
    117 
    +                        1# -> jump $j
    71 118 
                           };
    72 119 
                         1# ->
    73 
    -                      $w$sgo15
    120 
    +                      $w$sgo12
    74 121 
                             (uncheckedShiftRL# ww 1#)
    75 122 
                             (or# (uncheckedShiftRL# ww1 1#) (uncheckedShiftL# ww 63#))
    76 123 
                             wild1
    ... ... @@ -79,7 +126,7 @@ $w$sgo15
    79 126 
                       }
    80 127 
                       };
    81 128 
                     Right ipv ->
    82 
    -                  $w$sgo15
    129 
    +                  $w$sgo12
    83 130 
                         (uncheckedShiftRL# ww 1#)
    84 131 
                         (or# (uncheckedShiftRL# ww1 1#) (uncheckedShiftL# ww 63#))
    85 132 
                         wild1
    ... ... @@ -88,7 +135,7 @@ $w$sgo15
    88 135 
                 Right a2 ->
    89 136 
                   case ipv3 of {
    90 137 
                     Left ipv ->
    91 
    -                  $w$sgo15
    138 
    +                  $w$sgo12
    92 139 
                         (or# (uncheckedShiftRL# ww 1#) 9223372036854775808##)
    93 140 
                         (or# (uncheckedShiftRL# ww1 1#) (uncheckedShiftL# ww 63#))
    94 141 
                         wild1
    ... ... @@ -100,55 +147,39 @@ $w$sgo15
    100 147 
                         __DEFAULT ->
    101 148 
                           case leChar# x y of {
    102 149 
                             __DEFAULT ->
    103 
    -                          $w$sgo15
    150 
    +                          $w$sgo12
    104 151 
                                 (or# (uncheckedShiftRL# ww 1#) 9223372036854775808##)
    105 152 
                                 (or# (uncheckedShiftRL# ww1 1#) (uncheckedShiftL# ww 63#))
    106 153 
                                 wild1
    107 154 
                                 ipv6;
    108 155 
                             1# ->
    109 
    -                          $w$sgo15
    156 
    +                          $w$sgo12
    110 157 
                                 (uncheckedShiftRL# ww 1#)
    111 158 
                                 (or# (uncheckedShiftRL# ww1 1#) (uncheckedShiftL# ww 63#))
    112 159 
                                 wild1
    113 160 
                                 ipv5
    114 161 
                           };
    115 
    -                    1# ->
    116 
    -                      case ww1 of ds3 {
    117 
    -                        __DEFAULT ->
    118 
    -                          let {
    119 
    -                            hi1 = or# (uncheckedShiftRL# ww 1#) 9223372036854775808## } in
    120 
    -                          let { zeros = ctz# ds3 } in
    121 
    -                          let { zeros1 = word2Int# zeros } in
    122 
    -                          (# Just ipv4, uncheckedShiftRL# hi1 zeros1,
    123 
    -                             or#
    124 
    -                               (uncheckedShiftRL#
    125 
    -                                  (or# (uncheckedShiftRL# ds3 1#) (uncheckedShiftL# ww 63#)) zeros1)
    126 
    -                               (uncheckedShiftL# hi1 (-# 64# zeros1)) #);
    127 
    -                        0## ->
    128 
    -                          (# Just ipv4, 0##,
    129 
    -                             uncheckedShiftRL#
    130 
    -                               (or# (uncheckedShiftRL# ww 1#) 9223372036854775808##)
    131 
    -                               (word2Int# (ctz# ww)) #)
    132 
    -                      }
    162 
    +                    1# -> jump $j
    133 163 
                       }
    134 164 
                       }
    135 165 
                       }
    136 166 
                   }
    137 167 
               };
    138 168 
             Tip ->
    139 
    -          case ww1 of ds3 {
    169 
    +          case ww1 of wild1 {
    140 170 
                 __DEFAULT ->
    141 171 
                   let {
    142 172 
                     hi1 = or# (uncheckedShiftRL# ww 1#) 9223372036854775808## } in
    143 
    -              let { zeros = ctz# ds3 } in
    173 
    +              let { zeros = ctz# wild1 } in
    144 174 
                   let { zeros1 = word2Int# zeros } in
    145 
    -              (# Nothing, uncheckedShiftRL# hi1 zeros1,
    175 
    +              (# (# _| #) (##), uncheckedShiftRL# hi1 zeros1,
    146 176 
                      or#
    147 177 
                        (uncheckedShiftRL#
    148 
    -                      (or# (uncheckedShiftRL# ds3 1#) (uncheckedShiftL# ww 63#)) zeros1)
    178 
    +                      (or# (uncheckedShiftRL# wild1 1#) (uncheckedShiftL# ww 63#))
    179 
    +                      zeros1)
    149 180 
                        (uncheckedShiftL# hi1 (-# 64# zeros1)) #);
    150 181 
                 0## ->
    151 
    -              (# Nothing, 0##,
    182 
    +              (# (# _| #) (##), 0##,
    152 183 
                      uncheckedShiftRL#
    153 184 
                        (or# (uncheckedShiftRL# ww 1#) 9223372036854775808##)
    154 185 
                        (word2Int# (ctz# ww)) #)
    ... ... @@ -160,9 +191,14 @@ end Rec }
    160 191 
     $salterF
    161 192 
       = \ @v @a f1 k1 m ->
    162 193 
           case k1 of k2 { __DEFAULT ->
    163 
    -      case $w$sgo15 9223372036854775808## 0## k2 m of
    194 
    +      case $w$sgo12 9223372036854775808## 0## k2 m of
    164 195 
           { (# ww, ww1, ww2 #) ->
    165 
    -      case f1 ww of {
    196 
    +      case f1
    197 
    +             (case ww of {
    198 
    +                (# _| #) bx4 -> Nothing;
    199 
    +                (# |_ #) bx4 -> Just bx4
    200 
    +              })
    201 
    +      of {
    166 202 
             NotFound -> NotFound;
    167 203 
             Found a1 a2 ->
    168 204 
               Found
    ... ... @@ -170,17 +206,14 @@ $salterF
    170 206 
                 (case a2 of {
    171 207 
                    Nothing ->
    172 208 
                      case ww of {
    173 
    -                   Nothing -> m;
    174 
    -                   Just old ->
    175 
    -                     case m of m1 { __DEFAULT ->
    176 
    -                     case $wbogus (##) of { __DEFAULT -> $wgo ww1 ww2 m1 }
    177 
    -                     }
    209 
    +                   (# _| #) bx4 -> m;
    210 
    +                   (# |_ #) bx4 -> $wdeleteAlong ww1 ww2 m
    178 211 
                      };
    179 212 
                    Just new ->
    180 213 
                      case new of new1 { __DEFAULT ->
    181 214 
                      case ww of {
    182 
    -                   Nothing -> $winsertAlong ww1 ww2 k2 new1 m;
    183 
    -                   Just ds -> $wreplaceAlong ww1 ww2 new1 m
    215 
    +                   (# _| #) bx4 -> $winsertAlong ww1 ww2 k2 new1 m;
    216 
    +                   (# |_ #) bx4 -> $wreplaceAlong ww1 ww2 new1 m
    184 217 
                      }
    185 218 
                      }
    186 219 
                  })
    ... ... @@ -192,7 +225,7 @@ lvl
    192 225 
       = \ @v ds ->
    193 226 
           case ds of {
    194 227 
             Nothing -> NotFound;
    195 
    -        Just t -> case t of conrep { __DEFAULT -> Found conrep Nothing }
    228 
    +        Just t -> Found t Nothing
    196 229 
           }
    197 230
    198 231 
     Rec {
    ... ... @@ -208,11 +241,12 @@ $wfoo
    208 241 
                   $wfoo
    209 242 
                     (Right
    210 243 
                        (case y of { C# c# ->
    211 
    -                    let { i# = +# (ord# c#) 1# } in
    212 
    -                    case leWord# (int2Word# i#) 1114111## of {
    213 
    -                      __DEFAULT -> $wlvl i#;
    214 
    -                      1# -> C# (chr# i#)
    215 
    -                    }
    244 
    +                    C#
    245 
    +                      (let { i# = +# (ord# c#) 1# } in
    246 
    +                       case leWord# (int2Word# i#) 1114111## of {
    247 
    +                         __DEFAULT -> chr_error i#;
    248 
    +                         1# -> chr# i#
    249 
    +                       })
    216 250 
                         }))
    217 251 
                     subst1
    218 252 
               };
    ... ... @@ -226,42 +260,42 @@ foo
    226 260 
       = \ @v x subst ->
    227 261 
           case $wfoo x subst of { (# ww, ww1 #) -> Just (ww, ww1) }
    228 262
    229 
    -$trModule4 = "main"#
    263 
    +$trModule1 = "main"#
    230 264
    231 
    -$trModule3 = TrNameS $trModule4
    265 
    +$trModule2 = TrNameS $trModule1
    232 266
    233 
    -$trModule2 = "T22611"#
    267 
    +$trModule3 = "T22611"#
    234 268
    235 
    -$trModule1 = TrNameS $trModule2
    269 
    +$trModule4 = TrNameS $trModule3
    236 270
    237 
    -$trModule = Module $trModule3 $trModule1
    271 
    +$trModule = Module $trModule2 $trModule4
    238 272
    239 273 
     $krep = KindRepVar 1#
    240 274
    241 275 
     $krep1 = KindRepVar 0#
    242 276
    243 
    -$tcCheckRes2 = "CheckRes"#
    277 
    +$tcCheckRes1 = "CheckRes"#
    244 278
    245 
    -$tcCheckRes1 = TrNameS $tcCheckRes2
    279 
    +$tcCheckRes2 = TrNameS $tcCheckRes1
    246 280
    247 281 
     $tcCheckRes
    248 282 
       = TyCon
    249 283 
           2720702776801478797#Word64
    250 284 
           9603347784695333983#Word64
    251 285 
           $trModule
    252 
    -      $tcCheckRes1
    286 
    +      $tcCheckRes2
    253 287 
           0#
    254 
    -      krep$*->*->*
    288 
    +      krepStarArrStarArr
    255 289
    256 290 
     $krep2 = : $krep []
    257 291
    258 292 
     $krep3 = : $krep1 $krep2
    259 293
    260 
    -$tc'NotFound1 = KindRepTyConApp $tcCheckRes $krep3
    294 
    +$krep4 = KindRepTyConApp $tcCheckRes $krep3
    261 295
    262 
    -$tc'NotFound3 = "'NotFound"#
    296 
    +$tc'NotFound1 = "'NotFound"#
    263 297
    264 
    -$tc'NotFound2 = TrNameS $tc'NotFound3
    298 
    +$tc'NotFound2 = TrNameS $tc'NotFound1
    265 299
    266 300 
     $tc'NotFound
    267 301 
       = TyCon
    ... ... @@ -270,15 +304,15 @@ $tc'NotFound
    270 304 
           $trModule
    271 305 
           $tc'NotFound2
    272 306 
           2#
    273 
    -      $tc'NotFound1
    307 
    +      $krep4
    274 308
    275 
    -$krep4 = KindRepFun $krep $tc'NotFound1
    309 
    +$krep5 = KindRepFun $krep $krep4
    276 310
    277 
    -$tc'Found1 = KindRepFun $krep1 $krep4
    311 
    +$krep6 = KindRepFun $krep1 $krep5
    278 312
    279 
    -$tc'Found3 = "'Found"#
    313 
    +$tc'Found1 = "'Found"#
    280 314
    281 
    -$tc'Found2 = TrNameS $tc'Found3
    315 
    +$tc'Found2 = TrNameS $tc'Found1
    282 316
    283 317 
     $tc'Found
    284 318 
       = TyCon
    ... ... @@ -287,7 +321,7 @@ $tc'Found
    287 321 
           $trModule
    288 322 
           $tc'Found2
    289 323 
           2#
    290 
    -      $tc'Found1
    324 
    +      $krep6
    291 325
    292 326
    293 327 
     ------ Local rules for imported ids --------

  • testsuite/tests/simplCore/should_compile/T22611a.hs
    1 
    +-- The code below is based on containers-0.8
    2 
    +module T22611a
    3 
    +  ( alterF
    4 
    +  ) where
    5 
    +
    6 
    +import Data.Coerce (coerce)
    7 
    +import Data.Functor.Const (Const(..))
    8 
    +import Data.Functor.Identity (Identity(..))
    9 
    +import GHC.Exts (inline)
    10 
    +import Data.Map.Strict (Map)
    11 
    +import qualified Data.Map.Strict as Map
    12 
    +
    13 
    +alterF :: (Functor f, Ord k)
    14 
    +       => (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
    15 
    +alterF f k m = inline Map.alterF f k m
    16 
    +
    17 
    +-- alterF is INLINABLE and we expect it to be specialized at the call site.
    18 
    +{-# INLINABLE [2] alterF #-}
    19 
    +
    20 
    +{-# RULES
    21 
    +"alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)) . alterF f k = \m -> Const . getConst . f $ Map.lookup k m
    22 
    +"alterF/Identity" forall k f . alterF f k = atKeyIdentity k f
    23 
    + #-}
    24 
    +
    25 
    +atKeyIdentity :: Ord k => k -> (Maybe a -> Identity (Maybe a)) -> Map k a -> Identity (Map k a)
    26 
    +atKeyIdentity k f t = Identity (Map.alter (coerce f) k t)
    27 
    +{-# INLINABLE atKeyIdentity #-}

  • testsuite/tests/simplCore/should_compile/all.T
    ... ... @@ -493,7 +493,7 @@ test('T22623', normal, multimod_compile, ['T22623', '-O -v0'])
    493 493 
     test('T22662', normal, compile, [''])
    494 494 
     test('T22725', normal, compile, ['-O'])
    495 495 
     test('T22502', normal, compile, ['-O'])
    496 
    -test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all -fpolymorphic-specialisation'])
    496 
    +test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], multimod_compile, ['T22611', '-O -ddump-simpl -dsuppress-uniques -dsuppress-all -fpolymorphic-specialisation'])
    497 497 
     test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively'])
    498 498 
     test('T22802', normal, compile, ['-O'])
    499 499 
     test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/32c4f4ab2bcb2ef8249f83bf13760a0657ba3bce at 1791592088