[Git][ghc/ghc][wip/T17521] Fixes

[Jaro Reinders (@Noughtmare)]

Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC


Commits:
672b8a2f by Jaro Reinders at 2023-07-11T12:25:58+02:00
Fixes

- - - - -


1 changed file:

- compiler/GHC/Core/Utils.hs


Changes:

=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -2022,21 +2022,28 @@ exprIsTopLevelBindable expr ty
     -- consequently we must use 'mightBeUnliftedType' rather than 'isUnliftedType',
     -- as the latter would panic.
   || exprIsTickedString expr
-  || exprIsTrivialConApp expr
+  || isBoxedType ty && exprIsNestedTrivialConApp expr
 
 -- | Check if the expression is zero or more Ticks wrapped around a literal
 -- string.
 exprIsTickedString :: CoreExpr -> Bool
 exprIsTickedString = isJust . exprIsTickedString_maybe
 
--- | Check if the expression is an constructor possibly applied to trivial arguments.
-exprIsTrivialConApp :: CoreExpr -> Bool
-exprIsTrivialConApp x
-  | exprIsTrivial x
-  = True
+-- | Check if the expression is trivial or a constructor application and
+-- continue checking all arguments of that constructor recursively.
+exprIsNestedTrivialConApp :: CoreExpr -> Bool
+exprIsNestedTrivialConApp x
   | (Var v, xs) <- collectArgs x
-  = isDataConWorkId v && all exprIsTrivialConApp xs
-exprIsTrivialConApp _ = False
+  = isDataConWorkId v && all go xs
+  where
+    go x
+      | exprIsTrivial x
+      = True
+      | (Var v, xs) <- collectArgs x
+      = isDataConWorkId v && all go xs
+      | otherwise
+      = False
+exprIsNestedTrivialConApp _ = False
 
 -- | Extract a literal string from an expression that is zero or more Ticks
 -- wrapped around a literal string. Returns Nothing if the expression has a



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/672b8a2f518babd8bce054500a961353470efabf
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/20230711/d1997a55/attachment-0001.html>