[Git][ghc/ghc][wip/T23109] Further wibbles

Simon Peyton Jones (@simonpj) gitlab at gitlab.haskell.org
Sat Jun 17 10:52:37 UTC 2023



Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC


Commits:
e171d47b by Simon Peyton Jones at 2023-06-17T11:52:10+01:00
Further wibbles

esp exprIsConLike

- - - - -


6 changed files:

- compiler/GHC/Core/Utils.hs
- compiler/GHC/Types/Demand.hs
- testsuite/tests/numeric/should_compile/T15547.stderr
- testsuite/tests/simplCore/should_compile/T17366.stderr
- testsuite/tests/simplCore/should_compile/T17966.stderr
- testsuite/tests/stranal/sigs/T21888.stderr


Changes:

=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -1933,7 +1933,22 @@ exprIsHNF = exprIsHNFlike isDataConWorkId isEvaldUnfolding
 -- data constructors. Conlike arguments are considered interesting by the
 -- inliner.
 exprIsConLike :: CoreExpr -> Bool       -- True => lambda, conlike, PAP
-exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding
+-- exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding
+-- Trying: just a constructor application
+exprIsConLike (Var v)       = isConLikeId v
+exprIsConLike (Lit l)       = not (isLitRubbish l)
+exprIsConLike (App f a)     = exprIsTrivial a && exprIsConLike f
+exprIsConLike (Lam b e)
+  | isRuntimeVar b          = False
+  | otherwise               = exprIsConLike e
+exprIsConLike (Tick t e)
+  | tickishCounts t         = False
+  | otherwise               = exprIsConLike e
+exprIsConLike (Cast e _)    = exprIsConLike e
+exprIsConLike (Let {})      = False
+exprIsConLike (Case {})     = False
+exprIsConLike (Type {})     = False
+exprIsConLike (Coercion {}) = False
 
 -- | Returns true for values or value-like expressions. These are lambdas,
 -- constructors / CONLIKE functions (as determined by the function argument)


=====================================
compiler/GHC/Types/Demand.hs
=====================================
@@ -2334,20 +2334,25 @@ dmdTransformDataConSig str_marks sd = case viewProd arity body_sd of
 -- on the result into the indicated dictionary component (if saturated).
 -- See Note [Demand transformer for a dictionary selector].
 dmdTransformDictSelSig :: DmdSig -> DmdTransformer
--- NB: This currently doesn't handle newtype dictionaries.
--- It should simply apply call_sd directly to the dictionary, I suppose.
-dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* prod])) call_sd
+dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* dict_dmd])) call_sd
+   -- NB: dict_dmd comes from the demand signature of the class-op
+   --     which is created in GHC.Types.Id.Make.mkDictSelId
    | (n, sd') <- peelCallDmd call_sd
-   , Prod _ sig_ds <- prod
    = multDmdType n $
-     DmdType nopDmdEnv [C_11 :* mkProd Unboxed (map (enhance sd') sig_ds)]
-   | otherwise
-   = nopDmdType -- See Note [Demand transformer for a dictionary selector]
+     DmdType nopDmdEnv [enhance_dict_dmd sd' dict_dmd]
   where
-    enhance _  AbsDmd   = AbsDmd
-    enhance _  BotDmd   = BotDmd
-    enhance sd _dmd_var = C_11 :* sd  -- This is the one!
-                                      -- C_11, because we multiply with n above
+    enhance_dict_dmd sd' dict_dmd
+       | Prod _ sig_ds <- dict_dmd
+       = C_11 :* mkProd Unboxed (map (enhance sd') sig_ds)
+
+       | otherwise    -- Newtype dictionary
+       = C_11 :* sd'  -- Apply sd' to the dictionary
+
+    enhance _   AbsDmd   = AbsDmd
+    enhance _   BotDmd   = BotDmd
+    enhance sd' _dmd_var = C_11 :* sd'  -- This is the one!
+                           -- C_11, because we multiply with n above
+
 dmdTransformDictSelSig sig sd = pprPanic "dmdTransformDictSelSig: no args" (ppr sig $$ ppr sd)
 
 {-


=====================================
testsuite/tests/numeric/should_compile/T15547.stderr
=====================================
@@ -1,29 +1,29 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 36, types: 100, coercions: 56, joins: 0/0}
+  = {terms: 40, types: 122, coercions: 26, joins: 0/0}
 
 nat2Word#
   = \ @n $dKnownNat _ ->
-      naturalToWord# ($dKnownNat `cast` <Co:5> :: ...)
+      naturalToWord# ((natSing $dKnownNat) `cast` <Co:2> :: ...)
 
 foo = \ _ -> 18##
 
 fd
   = \ @n $dKnownNat _ ->
-      naturalToWord# ($dKnownNat `cast` <Co:13> :: ...)
+      naturalToWord# ((natSing $dKnownNat) `cast` <Co:6> :: ...)
 
 d = \ _ -> 3##
 
 fm
   = \ @n $dKnownNat _ ->
-      naturalToWord# ($dKnownNat `cast` <Co:17> :: ...)
+      naturalToWord# ((natSing $dKnownNat) `cast` <Co:8> :: ...)
 
 m = \ _ -> 9##
 
 fp
   = \ @n $dKnownNat _ ->
-      naturalToWord# ($dKnownNat `cast` <Co:21> :: ...)
+      naturalToWord# ((natSing $dKnownNat) `cast` <Co:10> :: ...)
 
 p = \ _ -> 512##
 


=====================================
testsuite/tests/simplCore/should_compile/T17366.stderr
=====================================
@@ -1,2 +1,4 @@
+Rule fired: Class op c (BUILTIN)
+Rule fired: Class op c (BUILTIN)
 Rule fired: SPEC/T17366 f @Identity @_ (T17366)
 Rule fired: SPEC/T17366 f @(Tagged tag) @_ (T17366)


=====================================
testsuite/tests/simplCore/should_compile/T17966.stderr
=====================================
@@ -1,309 +1,298 @@
 
 ==================== Specialise ====================
 Result size of Specialise
-  = {terms: 166, types: 158, coercions: 24, joins: 0/0}
+  = {terms: 162, types: 155, coercions: 10, joins: 0/0}
 
 -- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
-$dShow_sRN :: Show (Maybe Integer)
+$dShow_sTQ :: Show (Maybe Integer)
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=True,
-         WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}]
-$dShow_sRN = GHC.Show.$fShowMaybe @Integer GHC.Show.$fShowInteger
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=False, ConLike=True, WorkFree=False, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
+$dShow_sTQ = GHC.Show.$fShowMaybe @Integer GHC.Show.$fShowInteger
 
-Rec {
--- RHS size: {terms: 2, types: 1, coercions: 4, joins: 0/0}
-$dC_sRM :: C Bool ()
-[LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
-$dC_sRM
-  = ($cm_aHo @() GHC.Show.$fShow())
-    `cast` (Sym (T17966.N:C[0] <Bool>_N <()>_N)
-            :: (forall c. Show c => Bool -> () -> c -> String) ~R# C Bool ())
-
--- RHS size: {terms: 30, types: 24, coercions: 0, joins: 0/0}
-$s$cm_sRQ [InlPrag=[0]]
-  :: forall {c}. Show c => Bool -> () -> c -> [Char]
-[LclId, Arity=4]
-$s$cm_sRQ
-  = \ (@c_aHr)
-      ($dShow_aHs :: Show c_aHr)
-      (a_aBf :: Bool)
-      (b_aBg :: ())
-      (c_aBh :: c_aHr) ->
+-- RHS size: {terms: 28, types: 22, coercions: 0, joins: 0/0}
+$s$cm_sTX [InlPrag=INLINABLE[0]]
+  :: Bool -> () -> Maybe Integer -> [Char]
+[LclId, Arity=3]
+$s$cm_sTX
+  = \ (a_aD5 :: Bool) (b_aD6 :: ()) (c_aD7 :: Maybe Integer) ->
       GHC.Base.augment
         @Char
-        (\ (@b_aQg)
-           (c_aQh [OS=OneShot] :: Char -> b_aQg -> b_aQg)
-           (n_aQi [OS=OneShot] :: b_aQg) ->
+        (\ (@b_aSj)
+           (c_aSk [OS=OneShot] :: Char -> b_aSj -> b_aSj)
+           (n_aSl [OS=OneShot] :: b_aSj) ->
            GHC.Base.foldr
              @Char
-             @b_aQg
-             c_aQh
-             n_aQi
-             (case a_aBf of {
+             @b_aSj
+             c_aSk
+             n_aSl
+             (case a_aD5 of {
                 False -> GHC.Show.$fShowBool5;
                 True -> GHC.Show.$fShowBool4
               }))
         (GHC.Base.augment
            @Char
-           (\ (@b_aQg)
-              (c_aQh [OS=OneShot] :: Char -> b_aQg -> b_aQg)
-              (n_aQi [OS=OneShot] :: b_aQg) ->
+           (\ (@b_aSj)
+              (c_aSk [OS=OneShot] :: Char -> b_aSj -> b_aSj)
+              (n_aSl [OS=OneShot] :: b_aSj) ->
               GHC.Base.foldr
-                @Char @b_aQg c_aQh n_aQi (GHC.Show.$fShow()_$cshow b_aBg))
-           (show @c_aHr $dShow_aHs c_aBh))
+                @Char @b_aSj c_aSk n_aSl (GHC.Show.$fShowUnit_$cshow b_aD6))
+           (GHC.Show.$fShowMaybe_$cshow
+              @Integer GHC.Show.$fShowInteger c_aD7))
 
 -- RHS size: {terms: 33, types: 28, coercions: 0, joins: 0/0}
-$cm_aHo [InlPrag=INLINABLE[0]]
+$cm_aJa [InlPrag=INLINABLE[0]]
   :: forall b c. (Show b, Show c) => Bool -> b -> c -> String
 [LclId,
  Arity=5,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=StableUser, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=IF_ARGS [30 30 30 0 0] 140 0
-         Tmpl= \ (@b_aHl)
-                 ($dShow_aHm [Occ=Once1] :: Show b_aHl)
-                 (@c_aHr)
-                 ($dShow_aHs [Occ=Once1] :: Show c_aHr)
-                 (a_aBf [Occ=Once1!] :: Bool)
-                 (b_aBg [Occ=Once1] :: b_aHl)
-                 (c_aBh [Occ=Once1] :: c_aHr) ->
+         Tmpl= \ (@b_aJ7)
+                 ($dShow_aJ8 [Occ=Once1] :: Show b_aJ7)
+                 (@c_aJd)
+                 ($dShow_aJe [Occ=Once1] :: Show c_aJd)
+                 (a_aD5 [Occ=Once1!] :: Bool)
+                 (b_aD6 [Occ=Once1] :: b_aJ7)
+                 (c_aD7 [Occ=Once1] :: c_aJd) ->
                  ++
                    @Char
-                   (case a_aBf of {
+                   (case a_aD5 of {
                       False -> GHC.Show.$fShowBool5;
                       True -> GHC.Show.$fShowBool4
                     })
                    (++
                       @Char
-                      (show @b_aHl $dShow_aHm b_aBg)
-                      (show @c_aHr $dShow_aHs c_aBh))},
- RULES: "SPEC $cm @()" [0]
-            forall ($dShow_sRP :: Show ()). $cm_aHo @() $dShow_sRP = $s$cm_sRQ]
-$cm_aHo
-  = \ (@b_aHl)
-      ($dShow_aHm :: Show b_aHl)
-      (@c_aHr)
-      ($dShow_aHs :: Show c_aHr)
-      (a_aBf :: Bool)
-      (b_aBg :: b_aHl)
-      (c_aBh :: c_aHr) ->
+                      (show @b_aJ7 $dShow_aJ8 b_aD6)
+                      (show @c_aJd $dShow_aJe c_aD7))},
+ RULES: "SPEC $cm @() @(Maybe Integer)" [0]
+            forall ($dShow_sTS :: Show ())
+                   ($dShow_sTT :: Show (Maybe Integer)).
+              $cm_aJa @() $dShow_sTS @(Maybe Integer) $dShow_sTT
+              = $s$cm_sTX]
+$cm_aJa
+  = \ (@b_aJ7)
+      ($dShow_aJ8 :: Show b_aJ7)
+      (@c_aJd)
+      ($dShow_aJe :: Show c_aJd)
+      (a_aD5 :: Bool)
+      (b_aD6 :: b_aJ7)
+      (c_aD7 :: c_aJd) ->
       GHC.Base.augment
         @Char
-        (\ (@b_aQg)
-           (c_aQh [OS=OneShot] :: Char -> b_aQg -> b_aQg)
-           (n_aQi [OS=OneShot] :: b_aQg) ->
+        (\ (@b_aSj)
+           (c_aSk [OS=OneShot] :: Char -> b_aSj -> b_aSj)
+           (n_aSl [OS=OneShot] :: b_aSj) ->
            GHC.Base.foldr
              @Char
-             @b_aQg
-             c_aQh
-             n_aQi
-             (case a_aBf of {
+             @b_aSj
+             c_aSk
+             n_aSl
+             (case a_aD5 of {
                 False -> GHC.Show.$fShowBool5;
                 True -> GHC.Show.$fShowBool4
               }))
         (GHC.Base.augment
            @Char
-           (\ (@b_aQg)
-              (c_aQh [OS=OneShot] :: Char -> b_aQg -> b_aQg)
-              (n_aQi [OS=OneShot] :: b_aQg) ->
+           (\ (@b_aSj)
+              (c_aSk [OS=OneShot] :: Char -> b_aSj -> b_aSj)
+              (n_aSl [OS=OneShot] :: b_aSj) ->
               GHC.Base.foldr
-                @Char @b_aQg c_aQh n_aQi (show @b_aHl $dShow_aHm b_aBg))
-           (show @c_aHr $dShow_aHs c_aBh))
-end Rec }
+                @Char @b_aSj c_aSk n_aSl (show @b_aJ7 $dShow_aJ8 b_aD6))
+           (show @c_aJd $dShow_aJe c_aD7))
 
 -- RHS size: {terms: 1, types: 0, coercions: 10, joins: 0/0}
-T17966.$fCBoolb [InlPrag=INLINE (sat-args=0)]
-  :: forall b. Show b => C Bool b
+T17966.$fCBoolb [InlPrag=CONLIKE] :: forall b. Show b => C Bool b
 [LclIdX[DFunId(nt)],
  Arity=5,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
-         Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=True)
-         Tmpl= $cm_aHo
-               `cast` (forall (b :: <*>_N).
-                       <Show b>_R %<'Many>_N ->_R Sym (T17966.N:C[0] <Bool>_N <b>_N)
-                       :: (forall {b} c. (Show b, Show c) => Bool -> b -> c -> String)
-                          ~R# (forall {b}. Show b => C Bool b))}]
+ Unf=DFun: \ (@b_anK) (v_B1 :: Show b_anK) ->
+       T17966.C:C TYPE: Bool TYPE: b_anK $cm_aJa @b_anK v_B1]
 T17966.$fCBoolb
-  = $cm_aHo
+  = $cm_aJa
     `cast` (forall (b :: <*>_N).
-            <Show b>_R %<'Many>_N ->_R Sym (T17966.N:C[0] <Bool>_N <b>_N)
+            <Show b>_R %<Many>_N ->_R Sym (T17966.N:C[0] <Bool>_N <b>_N)
             :: (forall {b} c. (Show b, Show c) => Bool -> b -> c -> String)
                ~R# (forall {b}. Show b => C Bool b))
 
--- RHS size: {terms: 18, types: 15, coercions: 3, joins: 0/0}
-$sf_sRO [InlPrag=[0]] :: Bool -> () -> Maybe Integer -> [Char]
+-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
+$dC_sTP :: C Bool ()
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 60}]
+$dC_sTP = T17966.$fCBoolb @() GHC.Show.$fShowUnit
+
+-- RHS size: {terms: 19, types: 16, coercions: 0, joins: 0/0}
+$sf_sTR [InlPrag=INLINABLE[0]]
+  :: Bool -> () -> Maybe Integer -> [Char]
 [LclId, Arity=3]
-$sf_sRO
-  = \ (a_aBl :: Bool) (b_aBm :: ()) (c_aBn :: Maybe Integer) ->
+$sf_sTR
+  = \ (a_aDe :: Bool) (b_aDf :: ()) (c_aDg :: Maybe Integer) ->
       GHC.Base.build
         @Char
-        (\ (@b_aQz)
-           (c_aQA [OS=OneShot] :: Char -> b_aQz -> b_aQz)
-           (n_aQB [OS=OneShot] :: b_aQz) ->
+        (\ (@b_aSC)
+           (c_aSD [OS=OneShot] :: Char -> b_aSC -> b_aSC)
+           (n_aSE [OS=OneShot] :: b_aSC) ->
            GHC.Base.foldr
              @Char
-             @b_aQz
-             c_aQA
-             (GHC.CString.unpackFoldrCString# @b_aQz "!"# c_aQA n_aQB)
-             (($dC_sRM
-               `cast` (T17966.N:C[0] <Bool>_N <()>_N
-                       :: C Bool () ~R# (forall c. Show c => Bool -> () -> c -> String)))
-                @(Maybe Integer) $dShow_sRN a_aBl b_aBm c_aBn))
+             @b_aSC
+             c_aSD
+             (GHC.CString.unpackFoldrCString# @b_aSC "!"# c_aSD n_aSE)
+             ($cm_aJa
+                @()
+                GHC.Show.$fShowUnit
+                @(Maybe Integer)
+                $dShow_sTQ
+                a_aDe
+                b_aDf
+                c_aDg))
 
--- RHS size: {terms: 23, types: 21, coercions: 3, joins: 0/0}
+-- RHS size: {terms: 24, types: 23, coercions: 0, joins: 0/0}
 f [InlPrag=INLINABLE[0]]
   :: forall a b c. (C a b, Show c) => a -> b -> c -> String
 [LclIdX,
  Arity=5,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 0 0 0 0] 120 0
-         Tmpl= \ (@a_aFi)
-                 (@b_aFj)
-                 (@c_aFk)
-                 ($dC_aFl [Occ=Once1] :: C a_aFi b_aFj)
-                 ($dShow_aFm [Occ=Once1] :: Show c_aFk)
-                 (a_aBl [Occ=Once1] :: a_aFi)
-                 (b_aBm [Occ=Once1] :: b_aFj)
-                 (c_aBn [Occ=Once1] :: c_aFk) ->
+ Unf=Unf{Src=StableUser, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [30 0 0 0 0] 130 0
+         Tmpl= \ (@a_aF9)
+                 (@b_aFa)
+                 (@c_aFb)
+                 ($dC_aFc [Occ=Once1] :: C a_aF9 b_aFa)
+                 ($dShow_aFd [Occ=Once1] :: Show c_aFb)
+                 (a_aDe [Occ=Once1] :: a_aF9)
+                 (b_aDf [Occ=Once1] :: b_aFa)
+                 (c_aDg [Occ=Once1] :: c_aFb) ->
                  ++
                    @Char
-                   (($dC_aFl
-                     `cast` (T17966.N:C[0] <a_aFi>_N <b_aFj>_N
-                             :: C a_aFi b_aFj
-                                ~R# (forall c. Show c => a_aFi -> b_aFj -> c -> String)))
-                      @c_aFk $dShow_aFm a_aBl b_aBm c_aBn)
+                   (m @a_aF9 @b_aFa $dC_aFc @c_aFb $dShow_aFd a_aDe b_aDf c_aDg)
                    (GHC.CString.unpackCString# "!"#)},
  RULES: "SPEC f @Bool @() @(Maybe Integer)" [0]
-            forall ($dC_sRM :: C Bool ()) ($dShow_sRN :: Show (Maybe Integer)).
-              f @Bool @() @(Maybe Integer) $dC_sRM $dShow_sRN
-              = $sf_sRO]
-f = \ (@a_aFi)
-      (@b_aFj)
-      (@c_aFk)
-      ($dC_aFl :: C a_aFi b_aFj)
-      ($dShow_aFm :: Show c_aFk)
-      (a_aBl :: a_aFi)
-      (b_aBm :: b_aFj)
-      (c_aBn :: c_aFk) ->
+            forall ($dC_sTP :: C Bool ()) ($dShow_sTQ :: Show (Maybe Integer)).
+              f @Bool @() @(Maybe Integer) $dC_sTP $dShow_sTQ
+              = $sf_sTR]
+f = \ (@a_aF9)
+      (@b_aFa)
+      (@c_aFb)
+      ($dC_aFc :: C a_aF9 b_aFa)
+      ($dShow_aFd :: Show c_aFb)
+      (a_aDe :: a_aF9)
+      (b_aDf :: b_aFa)
+      (c_aDg :: c_aFb) ->
       GHC.Base.build
         @Char
-        (\ (@b_aQz)
-           (c_aQA [OS=OneShot] :: Char -> b_aQz -> b_aQz)
-           (n_aQB [OS=OneShot] :: b_aQz) ->
+        (\ (@b_aSC)
+           (c_aSD [OS=OneShot] :: Char -> b_aSC -> b_aSC)
+           (n_aSE [OS=OneShot] :: b_aSC) ->
            GHC.Base.foldr
              @Char
-             @b_aQz
-             c_aQA
-             (GHC.CString.unpackFoldrCString# @b_aQz "!"# c_aQA n_aQB)
-             (($dC_aFl
-               `cast` (T17966.N:C[0] <a_aFi>_N <b_aFj>_N
-                       :: C a_aFi b_aFj
-                          ~R# (forall c. Show c => a_aFi -> b_aFj -> c -> String)))
-                @c_aFk $dShow_aFm a_aBl b_aBm c_aBn))
+             @b_aSC
+             c_aSD
+             (GHC.CString.unpackFoldrCString# @b_aSC "!"# c_aSD n_aSE)
+             (m @a_aF9 @b_aFa $dC_aFc @c_aFb $dShow_aFd a_aDe b_aDf c_aDg))
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-$trModule_sRG :: GHC.Prim.Addr#
+$trModule_sTJ :: GHC.Prim.Addr#
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
-$trModule_sRG = "main"#
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
+$trModule_sTJ = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-$trModule_sRH :: GHC.Types.TrName
+$trModule_sTK :: GHC.Types.TrName
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-$trModule_sRH = GHC.Types.TrNameS $trModule_sRG
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+$trModule_sTK = GHC.Types.TrNameS $trModule_sTJ
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-$trModule_sRI :: GHC.Prim.Addr#
+$trModule_sTL :: GHC.Prim.Addr#
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-$trModule_sRI = "T17966"#
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
+$trModule_sTL = "T17966"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-$trModule_sRJ :: GHC.Types.TrName
+$trModule_sTM :: GHC.Types.TrName
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-$trModule_sRJ = GHC.Types.TrNameS $trModule_sRI
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+$trModule_sTM = GHC.Types.TrNameS $trModule_sTL
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T17966.$trModule :: GHC.Types.Module
 [LclIdX,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-T17966.$trModule = GHC.Types.Module $trModule_sRH $trModule_sRJ
-
--- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
-$krep_aPr [InlPrag=[~]] :: GHC.Types.KindRep
-[LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-$krep_aPr
-  = GHC.Types.KindRepTyConApp
-      GHC.Types.$tcConstraint (GHC.Types.[] @GHC.Types.KindRep)
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+T17966.$trModule = GHC.Types.Module $trModule_sTK $trModule_sTM
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-$krep_aPq [InlPrag=[~]] :: GHC.Types.KindRep
+$krep_aRp [InlPrag=[~]] :: GHC.Types.KindRep
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-$krep_aPq = GHC.Types.KindRepFun GHC.Types.krep$* $krep_aPr
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+$krep_aRp
+  = GHC.Types.KindRepFun GHC.Types.krep$* GHC.Types.krep$Constraint
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-$krep_aPp [InlPrag=[~]] :: GHC.Types.KindRep
+$krep_aRo [InlPrag=[~]] :: GHC.Types.KindRep
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-$krep_aPp = GHC.Types.KindRepFun GHC.Types.krep$* $krep_aPq
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+$krep_aRo = GHC.Types.KindRepFun GHC.Types.krep$* $krep_aRp
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-$tcC_sRK :: GHC.Prim.Addr#
+$tcC_sTN :: GHC.Prim.Addr#
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
-$tcC_sRK = "C"#
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
+$tcC_sTN = "C"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-$tcC_sRL :: GHC.Types.TrName
+$tcC_sTO :: GHC.Types.TrName
 [LclId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-$tcC_sRL = GHC.Types.TrNameS $tcC_sRK
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
+$tcC_sTO = GHC.Types.TrNameS $tcC_sTN
 
 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
 T17966.$tcC :: GHC.Types.TyCon
 [LclIdX,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T17966.$tcC
   = GHC.Types.TyCon
       12503088876068780286#Word64
       926716241154773768#Word64
       T17966.$trModule
-      $tcC_sRL
+      $tcC_sTO
       0#
-      $krep_aPp
+      $krep_aRo
 
--- RHS size: {terms: 10, types: 7, coercions: 4, joins: 0/0}
+-- RHS size: {terms: 10, types: 7, coercions: 0, joins: 0/0}
 x :: String
 [LclIdX,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
-         WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 120 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=False,
+         Value=False, ConLike=False, WorkFree=False, Expandable=False,
+         Guidance=IF_ARGS [] 120 0}]
 x = f @Bool
       @()
       @(Maybe Integer)
-      (($cm_aHo @() GHC.Show.$fShow())
-       `cast` (Sym (T17966.N:C[0] <Bool>_N <()>_N)
-               :: (forall c. Show c => Bool -> () -> c -> String) ~R# C Bool ()))
+      (T17966.$fCBoolb @() GHC.Show.$fShowUnit)
       (GHC.Show.$fShowMaybe @Integer GHC.Show.$fShowInteger)
       GHC.Types.True
-      GHC.Tuple.()
+      GHC.Tuple.Prim.()
       (GHC.Maybe.Just @Integer (GHC.Num.Integer.IS 42#))
 
 


=====================================
testsuite/tests/stranal/sigs/T21888.stderr
=====================================
@@ -2,8 +2,8 @@
 ==================== Strictness signatures ====================
 Data.MemoTrie.$fHasTrieBool: <1!P(L,L)>
 Data.MemoTrie.$fHasTrieEither: <1C(1,L)><1C(1,L)><1!P(L,L)>
-Data.MemoTrie.$fHasTrieInteger: <1!P(1!P(S,1!P(1!P(S,1L),1!P(S,1L))),1!P(S,1!P(1!P(S,1L),1!P(S,1L))))>b
-Data.MemoTrie.$fHasTrieList: <SC(S,L)><1!P(L,L)>
+Data.MemoTrie.$fHasTrieInteger: <1!P(L,L)>
+Data.MemoTrie.$fHasTrieList: <L>
 Data.MemoTrie.$fHasTrieTuple2: <1C(1,L)><LC(S,L)><L>
 Data.MemoTrie.$fHasTrieUnit: <L>
 
@@ -22,8 +22,8 @@ Data.MemoTrie.$fHasTrieUnit:
 ==================== Strictness signatures ====================
 Data.MemoTrie.$fHasTrieBool: <1!P(L,L)>
 Data.MemoTrie.$fHasTrieEither: <1C(1,L)><1C(1,L)><1!P(L,L)>
-Data.MemoTrie.$fHasTrieInteger: <1!P(1!P(B,1!P(1!P(B,1!P(L,L)),1!P(B,1!P(L,L)))),1!P(B,1!P(1!B,1!B)))>b
-Data.MemoTrie.$fHasTrieList: <SC(S,L)><1!P(L,L)>
+Data.MemoTrie.$fHasTrieInteger: <1!P(L,L)>
+Data.MemoTrie.$fHasTrieList: <L>
 Data.MemoTrie.$fHasTrieTuple2: <1C(1,L)><LC(S,L)><L>
 Data.MemoTrie.$fHasTrieUnit: <L>
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e171d47b9768563fb3166bee48f5c33322e9d0cf

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e171d47b9768563fb3166bee48f5c33322e9d0cf
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230617/bf6e54ee/attachment-0001.html>


More information about the ghc-commits mailing list