[Git][ghc/ghc][wip/T23146] 2 commits: testsuite: Add tests for #23146
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Thu Mar 23 15:30:11 UTC 2023
Ben Gamari pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC
Commits:
ccca7176 by Ben Gamari at 2023-03-23T10:51:21-04:00
testsuite: Add tests for #23146
Both lifted and unlifted variants.
- - - - -
3dab1c85 by romes at 2023-03-23T11:30:06-04:00
Account for all VoidRep types on precomputedStaticConInfo
Previously, we were considering coercion values whose unlifted type
equality had a zerobit runtime representation (VoidRep) to be
constructor arguments when determining whether we should pre-compute a
staticConInfo for a data constructor.
This made it so that GADT constructors with type-equality constraints
that should have no runtime representation actually ended up impacting
the code generation.
Fixes #23158
- - - - -
10 changed files:
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/StgToCmm/Closure.hs
- compiler/GHC/StgToCmm/DataCon.hs
- + testsuite/tests/codeGen/should_run/T23146.hs
- + testsuite/tests/codeGen/should_run/T23146.stdout
- + testsuite/tests/codeGen/should_run/T23146A.hs
- + testsuite/tests/codeGen/should_run/T23146_lifted.hs
- + testsuite/tests/codeGen/should_run/T23146_lifted.stdout
- + testsuite/tests/codeGen/should_run/T23146_liftedA.hs
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
compiler/GHC/Core/DataCon.hs
=====================================
@@ -1397,7 +1397,7 @@ dataConSourceArity (MkData { dcSourceArity = arity }) = arity
-- | Gives the number of actual fields in the /representation/ of the
-- data constructor. This may be more than appear in the source code;
--- the extra ones are the existentially quantified dictionaries
+-- the extra ones are the existentially quantified dictionaries. ROMES:TODO:
dataConRepArity :: DataCon -> Arity
dataConRepArity (MkData { dcRepArity = arity }) = arity
=====================================
compiler/GHC/StgToCmm/Closure.hs
=====================================
@@ -24,6 +24,8 @@ module GHC.StgToCmm.Closure (
NonVoid(..), fromNonVoid, nonVoidIds, nonVoidStgArgs,
assertNonVoidIds, assertNonVoidStgArgs,
+ isStgNullaryDataCon,
+
-- * LambdaFormInfo
LambdaFormInfo, -- Abstract
StandardFormInfo, -- ...ditto...
@@ -201,6 +203,18 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg
argPrimRep :: StgArg -> PrimRep
argPrimRep arg = typePrimRep1 (stgArgType arg)
+-- | Morally equivalent to @isNullaryRepDataCon con@ at the Stg level, where
+-- we do not consider types with no runtime representation to be constructor
+-- arguments.
+--
+-- 'isNullaryRepDataCon' is not fit for checking whether the constructor is
+-- nullary at the Stg level because the function 'dataConRepArgTys' it
+-- depends on includes unlifted type equalities, whose runtime
+-- representation is 'VoidRep', in the returned list.
+isStgNullaryDataCon :: DataCon -> Bool
+isStgNullaryDataCon =
+ null . filter (not . isZeroBitTy . scaledThing) . dataConRepArgTys
+
------------------------------------------------------
-- Building LambdaFormInfo
------------------------------------------------------
@@ -267,7 +281,7 @@ mkLFImported id =
-- Interface doesn't have a LambdaFormInfo, make a conservative one from
-- the type.
| Just con <- isDataConId_maybe id
- , isNullaryRepDataCon con
+ , isStgNullaryDataCon con
-- See Note [Imported nullary datacon wrappers must have correct LFInfo]
-- in GHC.StgToCmm.Types
-> LFCon con -- An imported nullary constructor
=====================================
compiler/GHC/StgToCmm/DataCon.hs
=====================================
@@ -37,11 +37,12 @@ import GHC.Runtime.Heap.Layout
import GHC.Types.CostCentre
import GHC.Unit
import GHC.Core.DataCon
+import GHC.Core.TyCo.Rep (scaledThing)
import GHC.Data.FastString
import GHC.Types.Id
import GHC.Types.Id.Info( CafInfo( NoCafRefs ) )
import GHC.Types.Name (isInternalName)
-import GHC.Types.RepType (countConRepArgs)
+import GHC.Types.RepType (countConRepArgs, isZeroBitTy)
import GHC.Types.Literal
import GHC.Builtin.Utils
import GHC.Utils.Panic
@@ -327,9 +328,10 @@ because they don't support cross package data references well.
precomputedStaticConInfo_maybe :: StgToCmmConfig -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo
precomputedStaticConInfo_maybe cfg binder con []
-- Nullary constructors
- | isNullaryRepDataCon con
+ | isStgNullaryDataCon con
= Just $ litIdInfo (stgToCmmPlatform cfg) binder (mkConLFInfo con)
(CmmLabel (mkClosureLabel (dataConName con) NoCafRefs))
+
precomputedStaticConInfo_maybe cfg binder con [arg]
-- Int/Char values with existing closures in the RTS
| intClosure || charClosure
=====================================
testsuite/tests/codeGen/should_run/T23146.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE GADTs #-}
+
+import T23146A
+
+fieldsSam :: NP xs -> NP xs -> Bool
+fieldsSam (x' ::* xs) (y' ::* ys) = fieldsSam xs ys
+fieldsSam UNil UNil = True
+
+main :: IO ()
+main = print (fieldsSam UNil UNil)
+
=====================================
testsuite/tests/codeGen/should_run/T23146.stdout
=====================================
@@ -0,0 +1,2 @@
+True
+
=====================================
testsuite/tests/codeGen/should_run/T23146A.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE UnliftedDatatypes #-}
+module T23146A where
+
+import GHC.Exts
+
+type NP :: [UnliftedType] -> UnliftedType
+data NP xs where
+ UNil :: NP '[]
+ (::*) :: x -> NP xs -> NP (x ': xs)
+
=====================================
testsuite/tests/codeGen/should_run/T23146_lifted.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE GADTs #-}
+
+import T23146_liftedA
+
+fieldsSam :: NP xs -> NP xs -> Bool
+fieldsSam (x' ::* xs) (y' ::* ys) = fieldsSam xs ys
+fieldsSam UNil UNil = True
+
+main :: IO ()
+main = print (fieldsSam UNil UNil)
+
=====================================
testsuite/tests/codeGen/should_run/T23146_lifted.stdout
=====================================
@@ -0,0 +1,2 @@
+True
+
=====================================
testsuite/tests/codeGen/should_run/T23146_liftedA.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE DataKinds #-}
+
+module T23146_liftedA where
+
+data NP xs where
+ UNil :: NP '[]
+ (::*) :: x -> NP xs -> NP (x ': xs)
+
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -229,3 +229,5 @@ test('T20640b', normal, compile_and_run, [''])
test('T22296',[only_ways(llvm_ways)
,unless(arch('x86_64'), skip)],compile_and_run,[''])
test('T22798', normal, compile_and_run, ['-fregs-graph'])
+test('T23146', normal, compile_and_run, [''])
+test('T23146_lifted', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d53be9081b7c5e248c003e0baf5e006ec559165...3dab1c853eb42ad336b852078b123199516da8a2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d53be9081b7c5e248c003e0baf5e006ec559165...3dab1c853eb42ad336b852078b123199516da8a2
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/20230323/44b7ac12/attachment-0001.html>
More information about the ghc-commits
mailing list