@CgClosure@, which deals with closures.
\begin{code}
-#include "HsVersions.h"
-
module CgCon (
cgTopRhsCon, buildDynCon,
bindConArgs,
cgReturnDataCon
) where
-import Ubiq{-uitous-}
+#include "HsVersions.h"
import CgMonad
import AbsCSyn
import CgBindery ( getArgAmodes, bindNewToNode,
bindArgsToRegs, newTempAmodeAndIdInfo,
idInfoToAmode, stableAmodeIdInfo,
- heapIdInfo
+ heapIdInfo, CgIdInfo
)
import CgClosure ( cgTopRhsClosure )
-import CgCompInfo ( mAX_INTLIKE, mIN_INTLIKE )
+import Constants ( mAX_INTLIKE, mIN_INTLIKE )
import CgHeapery ( allocDynClosure )
import CgRetConv ( dataReturnConvAlg, DataReturnConvention(..) )
import CgTailCall ( performReturn, mkStaticAlgReturnCode )
-import CLabel ( mkClosureLabel, mkInfoTableLabel,
- mkPhantomInfoTableLabel,
- mkConEntryLabel, mkStdEntryLabel
+import CLabel ( mkClosureLabel, mkStaticClosureLabel,
+ mkConInfoTableLabel, mkPhantomInfoTableLabel
)
import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
layOutDynCon, layOutDynClosure,
layOutStaticClosure
)
import CostCentre ( currentOrSubsumedCosts, useCurrentCostCentre,
- dontCareCostCentre
+ dontCareCostCentre, CostCentre
)
import Id ( idPrimRep, dataConTag, dataConTyCon,
- isDataCon, DataCon(..),
- emptyIdSet
+ isDataCon, DataCon,
+ emptyIdSet, Id
)
import Literal ( Literal(..) )
import Maybes ( maybeToBool )
-import PrelInfo ( maybeCharLikeTyCon, maybeIntLikeTyCon )
+import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
import PrimRep ( isFloatingRep, PrimRep(..) )
import TyCon ( TyCon{-instance Uniquable-} )
import Util ( isIn, zipWithEqual, panic, assertPanic )
= cgTopRhsClosure name top_cc NoStgBinderInfo [] body lf_info
where
body = StgCon con args emptyIdSet{-emptyLiveVarSet-}
- lf_info = mkClosureLFInfo True {- Top level -} [] ReEntrant [] body
+ lf_info = mkClosureLFInfo True {- Top level -} [] ReEntrant []
\end{code}
OK, so now we have the general case.
-- RETURN
returnFC (name, stableAmodeIdInfo name (CLbl closure_label PtrRep) lf_info)
where
- con_tycon = dataConTyCon con
- lf_info = mkConLFInfo con
-
- closure_label = mkClosureLabel name
- info_label = mkInfoTableLabel con
- con_entry_label = mkConEntryLabel con
- entry_label = mkStdEntryLabel name
+ con_tycon = dataConTyCon con
+ lf_info = mkConLFInfo con
+ closure_label = mkClosureLabel name
\end{code}
The general case is:
buildDynCon binder cc con args all_zero_size_args@True
= ASSERT(isDataCon con)
returnFC (stableAmodeIdInfo binder
- (CLbl (mkClosureLabel con) PtrRep)
+ (CLbl (mkStaticClosureLabel con) PtrRep)
(mkConLFInfo con))
\end{code}
\begin{code}
buildDynCon binder cc con [arg_amode] all_zero_size_args@False
- | maybeToBool (maybeCharLikeTyCon tycon)
+ | maybeCharLikeCon con
= ASSERT(isDataCon con)
absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
returnFC temp_id_info
- | maybeToBool (maybeIntLikeTyCon tycon) && in_range_int_lit arg_amode
+ | maybeIntLikeCon con && in_range_int_lit arg_amode
= ASSERT(isDataCon con)
returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
where
- tycon = dataConTyCon con
(temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
- in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
+ in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE &&
+ val >= mIN_INTLIKE
in_range_int_lit other_amode = False
\end{code}
-- MAKE NODE POINT TO IT
let reg_assts = move_to_reg amode node
- info_lbl = mkInfoTableLabel con
+ info_lbl = mkConInfoTableLabel con
in
-- RETURN