diff options
| author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2022-10-20 00:09:18 +0200 |
|---|---|---|
| committer | Andreas Klebinger <klebinger.andreas@gmx.at> | 2022-10-20 00:11:08 +0200 |
| commit | 607e1d08cd9b8a2a6bdf627f5945a2bae6949014 (patch) | |
| tree | 62557bea2795a88852db720f2779a366fec3e308 | |
| parent | 2b3ae8840f7fe5072b5d7432969a1c4832ad3a6b (diff) | |
| download | haskell-wip/andreask/virtualCon.tar.gz | |
| -rw-r--r-- | compiler/GHC/StgToCmm/DataCon.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Types/RepType.hs | 5 |
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 |