Simon Jakobi pushed to branch wip/sjakobi/T27106 at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • compiler/GHC/Types/Demand.hs
    ... ... @@ -2830,7 +2830,10 @@ instance Outputable DmdEnv where
    2830 2830 
         = ppr div <> if null fv_elts then empty
    2831 2831 
                      else braces (fsep (map pp_elt fv_elts))
    2832 2832 
         where
    2833 
    -      pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd
    2833 
    +      pp_elt (uniq, dmd) =
    2834 
    +        sdocOption sdocSuppressUniques $ \case
    2835 
    +          True  -> ppr dmd
    2836 
    +          False -> ppr uniq <> text "->" <> ppr dmd
    2834 2837 
           fv_elts = nonDetUFMToList fvs
    2835 2838 
             -- It's OK to use nonDetUFMToList here because we only do it for
    2836 2839 
             -- pretty printing

  • testsuite/tests/dmdanal/should_compile/T13143.stderr
    1 1
    2 2 
     ==================== Tidy Core ====================
    3 3 
     Result size of Tidy Core
    4 
    -  = {terms: 71, types: 40, coercions: 0, joins: 0/0}
    4 
    +  = {terms: 59, types: 31, coercions: 0, joins: 0/0}
    5 5
    6 6 
     Rec {
    7 7 
     -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
    8 8 
     T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker]
    9 9 
       :: forall a. (# #) -> a
    10 
    -[GblId, Arity=1, Str=<B>b{sBX->S}, Cpr=b, Unf=OtherCon []]
    10 
    +[GblId, Arity=1, Str=<B>b{S}, Cpr=b, Unf=OtherCon []]
    11 11 
     T13143.$wf
    12 12 
       = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Internal.Types.(##)
    13 13 
     end Rec }
    ... ... @@ -16,7 +16,7 @@ end Rec }
    16 16 
     f [InlPrag=NOINLINE[final]] :: forall a. Int -> a
    17 17 
     [GblId,
    18 18 
      Arity=1,
    19 
    - Str=<B>b{sBX->S},
    19 
    + Str=<B>b{S},
    20 20 
      Cpr=b,
    21 21 
      Unf=Unf{Src=StableSystem, TopLvl=True,
    22 22 
              Value=True, ConLike=True, WorkFree=True, Expandable=True,
    ... ... @@ -26,100 +26,58 @@ f [InlPrag=NOINLINE[final]] :: forall a. Int -> a
    26 26 
     f = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Internal.Types.(##)
    27 27
    28 28 
     -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
    29 
    -T13143.$trModule4 :: GHC.Internal.Prim.Addr#
    30 
    -[GblId,
    31 
    - Unf=Unf{Src=<vanilla>, TopLvl=True,
    32 
    -         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    33 
    -         Guidance=IF_ARGS [] 20 0}]
    34 
    -T13143.$trModule4 = "main"#
    29 
    +$trModule1 :: GHC.Internal.Prim.Addr#
    30 
    +[GblId, Unf=OtherCon []]
    31 
    +$trModule1 = "main"#
    35 32
    36 33 
     -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    37 
    -T13143.$trModule3 :: GHC.Internal.Types.TrName
    38 
    -[GblId,
    39 
    - Unf=Unf{Src=<vanilla>, TopLvl=True,
    40 
    -         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    41 
    -         Guidance=IF_ARGS [] 10 10}]
    42 
    -T13143.$trModule3 = GHC.Internal.Types.TrNameS T13143.$trModule4
    34 
    +$trModule2 :: GHC.Internal.Types.TrName
    35 
    +[GblId, Unf=OtherCon []]
    36 
    +$trModule2 = GHC.Internal.Types.TrNameS $trModule1
    43 37
    44 38 
     -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
    45 
    -T13143.$trModule2 :: GHC.Internal.Prim.Addr#
    46 
    -[GblId,
    47 
    - Unf=Unf{Src=<vanilla>, TopLvl=True,
    48 
    -         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    49 
    -         Guidance=IF_ARGS [] 30 0}]
    50 
    -T13143.$trModule2 = "T13143"#
    39 
    +$trModule3 :: GHC.Internal.Prim.Addr#
    40 
    +[GblId, Unf=OtherCon []]
    41 
    +$trModule3 = "T13143"#
    51 42
    52 43 
     -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    53 
    -T13143.$trModule1 :: GHC.Internal.Types.TrName
    54 
    -[GblId,
    55 
    - Unf=Unf{Src=<vanilla>, TopLvl=True,
    56 
    -         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    57 
    -         Guidance=IF_ARGS [] 10 10}]
    58 
    -T13143.$trModule1 = GHC.Internal.Types.TrNameS T13143.$trModule2
    44 
    +$trModule4 :: GHC.Internal.Types.TrName
    45 
    +[GblId, Unf=OtherCon []]
    46 
    +$trModule4 = GHC.Internal.Types.TrNameS $trModule3
    59 47
    60 48 
     -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
    61 
    -T13143.$trModule :: GHC.Internal.Types.Module
    62 
    -[GblId,
    63 
    - Unf=Unf{Src=<vanilla>, TopLvl=True,
    64 
    -         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    65 
    -         Guidance=IF_ARGS [] 10 10}]
    66 
    -T13143.$trModule
    67 
    -  = GHC.Internal.Types.Module T13143.$trModule3 T13143.$trModule1
    49 
    +T13143.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module
    50 
    +[GblId, Unf=OtherCon []]
    51 
    +T13143.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4
    68 52
    69 
    --- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
    53 
    +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    70 54 
     lvl :: Int
    71 
    -[GblId, Str=b{sBX->S}, Cpr=b]
    72 
    -lvl = T13143.$wf @Int GHC.Internal.Types.(##)
    55 
    +[GblId, Unf=OtherCon []]
    56 
    +lvl = GHC.Internal.Types.I# 1#
    57 
    +
    58 
    +-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
    59 
    +lvl1 :: Int
    60 
    +[GblId, Str=b{S}, Cpr=b]
    61 
    +lvl1 = T13143.$wf @Int GHC.Internal.Types.(##)
    73 62
    74 63 
     Rec {
    75 64 
     -- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0}
    76 
    -T13143.$wg [InlPrag=[2], Occ=LoopBreaker]
    77 
    -  :: Bool -> Bool -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int#
    78 
    -[GblId[StrictWorker([!, !])],
    79 
    - Arity=3,
    80 
    - Str=<1L><1L><L>,
    81 
    - Unf=OtherCon []]
    82 
    -T13143.$wg
    83 
    -  = \ (ds :: Bool) (ds1 :: Bool) (ww :: GHC.Internal.Prim.Int#) ->
    65 
    +g [Occ=LoopBreaker] :: Bool -> Bool -> Int -> Int
    66 
    +[GblId, Arity=3, Str=<1L><1L><L>, Unf=OtherCon []]
    67 
    +g = \ (ds :: Bool) (ds1 :: Bool) (p :: Int) ->
    84 68 
           case ds of {
    85 69 
             False ->
    86 70 
               case ds1 of {
    87 
    -            False ->
    88 
    -              T13143.$wg GHC.Internal.Types.False GHC.Internal.Types.True ww;
    89 
    -            True -> GHC.Internal.Prim.+# ww 1#
    71 
    +            False -> g GHC.Internal.Types.False GHC.Internal.Types.True p;
    72 
    +            True -> + @Int GHC.Internal.Num.$fNumInt p lvl
    90 73 
               };
    91 74 
             True ->
    92 75 
               case ds1 of {
    93 
    -            False ->
    94 
    -              T13143.$wg GHC.Internal.Types.True GHC.Internal.Types.True ww;
    95 
    -            True -> case lvl of {}
    76 
    +            False -> g GHC.Internal.Types.True GHC.Internal.Types.True p;
    77 
    +            True -> lvl1
    96 78 
               }
    97 79 
           }
    98 80 
     end Rec }
    99 81
    100 
    --- RHS size: {terms: 14, types: 6, coercions: 0, joins: 0/0}
    101 
    -g [InlPrag=[2]] :: Bool -> Bool -> Int -> Int
    102 
    -[GblId,
    103 
    - Arity=3,
    104 
    - Str=<1L><1L><1!P(L)>,
    105 
    - Cpr=1,
    106 
    - Unf=Unf{Src=StableSystem, TopLvl=True,
    107 
    -         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    108 
    -         Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
    109 
    -         Tmpl= \ (ds [Occ=Once1] :: Bool)
    110 
    -                 (ds1 [Occ=Once1] :: Bool)
    111 
    -                 (p [Occ=Once1!] :: Int) ->
    112 
    -                 case p of { GHC.Internal.Types.I# ww [Occ=Once1] ->
    113 
    -                 case T13143.$wg ds ds1 ww of ww1 [Occ=Once1] { __DEFAULT ->
    114 
    -                 GHC.Internal.Types.I# ww1
    115 
    -                 }
    116 
    -                 }}]
    117 
    -g = \ (ds :: Bool) (ds1 :: Bool) (p :: Int) ->
    118 
    -      case p of { GHC.Internal.Types.I# ww ->
    119 
    -      case T13143.$wg ds ds1 ww of ww1 { __DEFAULT ->
    120 
    -      GHC.Internal.Types.I# ww1
    121 
    -      }
    122 
    -      }
    123 
    -
    124 82
    125 83

  • testsuite/tests/dmdanal/should_compile/T27106.hs
    1 
    +module T27106 where
    2 
    +
    3 
    +{-# NOINLINE weird #-}
    4 
    +weird :: Int -> a
    5 
    +weird x = weird x

  • testsuite/tests/dmdanal/should_compile/T27106.stderr
    1 
    +weird [InlPrag=NOINLINE[final]] :: forall a. Int -> a
    2 
    +[GblId,
    3 
    + Arity=1,
    4 
    + Str=<B>b{S},

  • testsuite/tests/dmdanal/should_compile/all.T
    ... ... @@ -45,6 +45,13 @@ test('T13077a', normal, compile, [''])
    45 45 
     # T13143: WW for NOINLINE function f
    46 46 
     test('T13143', [ grep_errmsg(r'^T13143\.\$wf') ], compile, ['-ddump-simpl -dsuppress-uniques'])
    47 47
    48 
    +# Uniques in the free variable part of a demand signature should be
    49 
    +# suppressed by -dsuppress-uniques.
    50 
    +test('T27106', normal, multimod_compile_filter,
    51 
    +     ['T27106',
    52 
    +      '-v0 -O -ddump-simpl -dsuppress-uniques',
    53 
    +      r"sed -n '/^weird /,/.* Str=/p'"])
    54 
    +
    48 55 
     # T15627
    49 56 
     #   Absent bindings of unlifted types should be WW'ed away.
    50 57 
     #   The idea is to check that both $wmutVar and $warray

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