[Git][ghc/ghc][wip/T17521] 2 commits: Add exception to letrect invariant
Jaro Reinders (@Noughtmare)
gitlab at gitlab.haskell.org
Mon Jul 17 13:52:16 UTC 2023
Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC
Commits:
44bd7b2f by Jaro Reinders at 2023-07-17T15:51:38+02:00
Add exception to letrect invariant
- - - - -
df499b72 by Jaro Reinders at 2023-07-17T15:52:02+02:00
Add stg rewrites test
- - - - -
4 changed files:
- compiler/GHC/Core.hs
- + testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewrite.hs
- + testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewritea.hs
- testsuite/tests/unlifted-datatypes/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core.hs
=====================================
@@ -377,13 +377,13 @@ for the meaning of "lifted" vs. "unlifted".
For the non-top-level, non-recursive case see
Note [Core let-can-float invariant].
-At top level, however, there are two exceptions to this rule:
+At top level, however, there are three exceptions to this rule:
(TL1) A top-level binding is allowed to bind primitive string literal,
(which is unlifted). See Note [Core top-level string literals].
(TL2) In Core, we generate a top-level binding for every non-newtype data
-constructor worker or wrapper
+ constructor worker or wrapper
e.g. data T = MkT Int
we generate
MkT :: Int -> T
@@ -399,6 +399,12 @@ constructor worker or wrapper
S1 = S1
We allow this top-level unlifted binding to exist.
+(TL3) A boxed top-level binding is allowed to bind the application of a data
+ constructor worker to trivial arguments. These bindings are guaranteed
+ to not require any evaluation and can thus be compiled to static data.
+ Unboxed top-level bindings are still not allowed because references
+ to them might have to be pointers.
+
Note [Core let-can-float invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The let-can-float invariant:
=====================================
testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewrite.hs
=====================================
@@ -0,0 +1,17 @@
+{-# OPTIONS_GHC -O #-}
+{-# LANGUAGE UnliftedDatatypes #-}
+
+module TopLevelStgRewrite where
+
+import TopLevelStgRewritea
+import GHC.Exts
+import Data.Kind (Type)
+
+type Box :: UnliftedType -> Type
+data Box a = Box a
+
+type B :: Type -> UnliftedType
+data B a = B !a
+
+b :: Box (B Bool)
+b = Box (B a)
=====================================
testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewritea.hs
=====================================
@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -O0 #-}
+
+module TopLevelStgRewritea where
+
+a :: Bool
+a = True
=====================================
testsuite/tests/unlifted-datatypes/should_compile/all.T
=====================================
@@ -3,3 +3,4 @@ test('UnlDataPolySigs', normal, compile, [''])
test('UnlDataFams', normal, compile, [''])
test('UnlDataUsersGuide', normal, compile, [''])
test('TopLevel', normal, multimod_compile, ['TopLevel', '-O'])
+test('TopLevelStgRewrite', normal, multimod_compile, ['TopLevelStgRewrite', '-v0'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0891b558ad08124d8e1a53f14fd68805cb02e711...df499b7224175010b63e83a3eb4b0f4db41375f6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0891b558ad08124d8e1a53f14fd68805cb02e711...df499b7224175010b63e83a3eb4b0f4db41375f6
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/20230717/89895b0c/attachment-0001.html>
More information about the ghc-commits
mailing list