summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2022-10-20 00:09:18 +0200
committerAndreas Klebinger <klebinger.andreas@gmx.at>2022-10-20 00:11:08 +0200
commit607e1d08cd9b8a2a6bdf627f5945a2bae6949014 (patch)
tree62557bea2795a88852db720f2779a366fec3e308
parent2b3ae8840f7fe5072b5d7432969a1c4832ad3a6b (diff)
downloadhaskell-wip/andreask/virtualCon.tar.gz
-rw-r--r--compiler/GHC/StgToCmm/DataCon.hs6
-rw-r--r--compiler/GHC/Types/RepType.hs5
2 files changed, 3 insertions, 8 deletions
diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs
index da5776989c..47777675bf 100644
--- a/compiler/GHC/StgToCmm/DataCon.hs
+++ b/compiler/GHC/StgToCmm/DataCon.hs
@@ -79,17 +79,13 @@ cgTopRhsCon cfg id con mn args
-- See Note [About the NameSorts] in "GHC.Types.Name" for Internal/External
(static_info, static_code)
+ -- For virtual data constructors simply produce a indirection.
| virtualDataConType con == VirtualBoxed
, [NonVoid (StgVarArg x)] <- args
= let cg_id_info = litIdInfo platform id lf_info (CmmLabel closure_label)
lf_info = LFUnknown False
in (cg_id_info, emitIndCon x dontCareCCS closure_label)
- -- panic "topRhsCon" $ let fake_rhs = StgApp x []
- -- in
- -- pprTrace "cgTopRhsCon" (ppr id $$ ppr con $$ ppr args) $
- -- cgTopRhsClosure platform NonRecursive id dontCareCCS Updatable [] fake_rhs
-
-- Otherwise generate a closure for the constructor.
| otherwise
= (id_Info, gen_code)
diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs
index 3b8af01ab7..0669248d8d 100644
--- a/compiler/GHC/Types/RepType.hs
+++ b/compiler/GHC/Types/RepType.hs
@@ -766,10 +766,8 @@ isVirtualTyCon tc
-- That field is boxed
, isBoxedType field
-- And it's a boxed ADT!
- -- , pprTrace "isV.5" empty True
- -- , pprTrace "isV.6" empty True
- -- That field is either unlifted or strict
, isBoxedType (dataConOrigResTy dc)
+ -- That field is either unlifted or strict
= if (isUnliftedType field)
then
-- (\r -> pprTrace "safeUnlifted " (ppr tc <+> ppr r) r)
@@ -783,6 +781,7 @@ isVirtualTyCon tc
where
isSafeLifted strictness = case strictness of MarkedStrict -> VirtualBoxed; _ -> NonVirtual
+ -- And it's not a prim type.
isSafeUnlifted field
| Just field_tc <- tyConAppTyCon_maybe field
-- , pprTrace "ftc" (ppr field_tc) True