diff options
| author | simonmar <unknown> | 2002-01-03 11:45:06 +0000 |
|---|---|---|
| committer | simonmar <unknown> | 2002-01-03 11:45:06 +0000 |
| commit | 6009d77ae17f1b03e7ed208b40e65d1117544050 (patch) | |
| tree | 078f03a45e45b0901543866d506a6e259569fb1b | |
| parent | beaf0404918eae2faf8a1783009a601f81984ac7 (diff) | |
| download | haskell-6009d77ae17f1b03e7ed208b40e65d1117544050.tar.gz | |
[project @ 2002-01-03 11:45:06 by simonmar]
Fix for previous commit: use the SRT on the top-level constructor when
deciding whether it has any CAF references, since not all top-level
bindings have CgInfo pinned on.
| -rw-r--r-- | ghc/compiler/codeGen/CgCon.lhs | 9 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CodeGen.lhs | 5 |
2 files changed, 9 insertions, 5 deletions
diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs index 6c9710505f..db81d25723 100644 --- a/ghc/compiler/codeGen/CgCon.lhs +++ b/ghc/compiler/codeGen/CgCon.lhs @@ -68,8 +68,9 @@ import Outputable cgTopRhsCon :: Id -- Name of thing bound to this RHS -> DataCon -- Id -> [StgArg] -- Args + -> SRT -> FCode (Id, CgIdInfo) -cgTopRhsCon id con args +cgTopRhsCon id con args srt = ASSERT( not (isDllConApp con args) ) -- checks for litlit args too ASSERT( args `lengthIs` dataConRepArity con ) @@ -89,8 +90,12 @@ cgTopRhsCon id con args closure_info dontCareCCS -- because it's static data (map fst amodes_w_offsets) -- Sorted into ptrs first, then nonptrs - (mayHaveCafRefs (idCafInfo id)) + (nonEmptySRT srt) -- has CAF refs ) `thenC` + -- NOTE: can't use idCafInfo instead of nonEmptySRT above, + -- because top-level constructors that were floated by + -- CorePrep don't have CafInfo attached. The SRT is more + -- reliable. -- RETURN returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info) diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs index c9d35229c0..b7f01cbc0b 100644 --- a/ghc/compiler/codeGen/CodeGen.lhs +++ b/ghc/compiler/codeGen/CodeGen.lhs @@ -233,11 +233,10 @@ cgTopRhs :: Id -> StgRhs -> SRT -> FCode (Id, CgIdInfo) -- It's already been globalised if necessary cgTopRhs bndr (StgRhsCon cc con args) srt - = forkStatics (cgTopRhsCon bndr con args) + = forkStatics (cgTopRhsCon bndr con args srt) cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag args body) srt - = -- There should be no free variables - ASSERT(null fvs) + = ASSERT(null fvs) -- There should be no free variables let lf_info = mkClosureLFInfo bndr TopLevel [{-no fvs-}] upd_flag args in |