summaryrefslogtreecommitdiff
path: root/ghc/compiler/codeGen
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/compiler/codeGen')
-rw-r--r--ghc/compiler/codeGen/CgBindery.lhs58
-rw-r--r--ghc/compiler/codeGen/CgCase.lhs13
-rw-r--r--ghc/compiler/codeGen/CgCon.lhs77
-rw-r--r--ghc/compiler/codeGen/CgConTbls.lhs38
-rw-r--r--ghc/compiler/codeGen/CgExpr.lhs42
-rw-r--r--ghc/compiler/codeGen/CgRetConv.lhs4
-rw-r--r--ghc/compiler/codeGen/CgTailCall.lhs4
-rw-r--r--ghc/compiler/codeGen/ClosureInfo.lhs130
-rw-r--r--ghc/compiler/codeGen/CodeGen.lhs11
-rw-r--r--ghc/compiler/codeGen/SMRep.lhs127
10 files changed, 201 insertions, 303 deletions
diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs
index 8cda07b537..92acdfbdd8 100644
--- a/ghc/compiler/codeGen/CgBindery.lhs
+++ b/ghc/compiler/codeGen/CgBindery.lhs
@@ -33,24 +33,24 @@ import CgMonad
import CgUsages ( getHpRelOffset, getSpRelOffset, getRealSp )
import CgStackery ( freeStackSlots, addFreeSlots )
-import CLabel ( mkStaticClosureLabel, mkClosureLabel,
+import CLabel ( mkClosureLabel,
mkBitmapLabel, pprCLabel )
import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
import BitSet ( mkBS, emptyBS )
import PrimRep ( isFollowableRep, getPrimRepSize )
import DataCon ( DataCon, dataConName )
-import Id ( Id, idPrimRep, idType )
+import Id ( Id, idPrimRep, idType, isDataConWrapId )
import Type ( typePrimRep )
import VarEnv
import VarSet ( varSetElems )
-import Const ( Con(..), Literal )
+import Literal ( Literal )
import Maybes ( catMaybes, maybeToBool )
import Name ( isLocallyDefined, isWiredInName, NamedThing(..) )
#ifdef DEBUG
import PprAbsC ( pprAmode )
#endif
import PrimRep ( PrimRep(..) )
-import StgSyn ( StgArg, StgLiveVars, GenStgArg(..) )
+import StgSyn ( StgArg, StgLiveVars, GenStgArg(..), isStgTypeArg )
import Unique ( Unique, Uniquable(..) )
import UniqSet ( elementOfUniqSet )
import Util ( zipWithEqual, sortLt )
@@ -252,8 +252,13 @@ I {\em think} all looking-up is done through @getCAddrMode(s)@.
getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
getCAddrModeAndInfo id
- | not (isLocallyDefined name) || isWiredInName name
- {- Why the "isWiredInName"?
+ | not (isLocallyDefined name) || isDataConWrapId id
+ -- Why the isDataConWrapId? Because CoreToStg changes a call to
+ -- a nullary constructor worker fn to a call to its wrapper,
+ -- which may not be defined until later
+
+ {- -- OLD: the unpack stuff isn't injected now Jan 2000
+ Why the "isWiredInName"?
Imagine you are compiling PrelBase.hs (a module that
supplies some of the wired-in values). What can
happen is that the compiler will inject calls to
@@ -342,6 +347,9 @@ getVolatileRegs vars
getArgAmodes :: [StgArg] -> FCode [CAddrMode]
getArgAmodes [] = returnFC []
getArgAmodes (atom:atoms)
+ | isStgTypeArg atom
+ = getArgAmodes atoms
+ | otherwise
= getArgAmode atom `thenFC` \ amode ->
getArgAmodes atoms `thenFC` \ amodes ->
returnFC ( amode : amodes )
@@ -349,43 +357,7 @@ getArgAmodes (atom:atoms)
getArgAmode :: StgArg -> FCode CAddrMode
getArgAmode (StgVarArg var) = getCAddrMode var -- The common case
-
-getArgAmode (StgConArg (DataCon con))
- {- Why does this case differ from StgVarArg?
- Because the program might look like this:
- data Foo a = Empty | Baz a
- f a x = let c = Empty! a
- in h c
- Now, when we go Core->Stg, we drop the type applications,
- so we can inline c, giving
- f x = h Empty
- Now we are referring to Empty as an argument (rather than in an STGCon),
- so we'll look it up with getCAddrMode. We want to return an amode for
- the static closure that we make for nullary constructors. But if we blindly
- go ahead with getCAddrMode we end up looking in the environment, and it ain't there!
-
- This special case used to be in getCAddrModeAndInfo, but it doesn't work there.
- Consider:
- f a x = Baz a x
- If the constructor Baz isn't inlined we simply want to treat it like any other
- identifier, with a top level definition. We don't want to spot that it's a constructor.
-
- In short
- StgApp con args
- and
- StgCon con args
- are treated differently; the former is a call to a bog standard function while the
- latter uses the specially-labelled, pre-defined info tables etc for the constructor.
-
- The way to think of this case in getArgAmode is that
- SApp f Empty
- is really
- App f (StgCon Empty [])
- -}
- = returnFC (CLbl (mkStaticClosureLabel (dataConName con)) PtrRep)
-
-
-getArgAmode (StgConArg (Literal lit)) = returnFC (CLit lit)
+getArgAmode (StgLitArg lit) = returnFC (CLit lit)
\end{code}
%************************************************************************
diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index e358b9bf55..9ede65019e 100644
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgCase.lhs,v 1.37 2000/01/13 14:33:57 hwloidl Exp $
+% $Id: CgCase.lhs,v 1.38 2000/03/23 17:45:19 simonpj Exp $
%
%********************************************************
%* *
@@ -49,12 +49,11 @@ import CLabel ( CLabel, mkVecTblLabel, mkReturnPtLabel,
import ClosureInfo ( mkLFArgument )
import CmdLineOpts ( opt_SccProfilingOn, opt_GranMacros )
import CostCentre ( CostCentre )
-import CoreSyn ( isDeadBinder )
-import Id ( Id, idPrimRep )
+import Id ( Id, idPrimRep, isDeadBinder )
import DataCon ( DataCon, dataConTag, fIRST_TAG, ConTag,
- isUnboxedTupleCon, dataConType )
+ isUnboxedTupleCon )
import VarSet ( varSetElems )
-import Const ( Con(..), Literal )
+import Literal ( Literal )
import PrimOp ( primOpOutOfLine, PrimOp(..) )
import PrimRep ( getPrimRepSize, retPrimRepSize, PrimRep(..)
)
@@ -150,7 +149,7 @@ mkBuiltinUnique, because that occasionally clashes with some
temporaries generated for _ccall_GC, amongst others (see CgExpr.lhs).
\begin{code}
-cgCase (StgCon (PrimOp op) args res_ty)
+cgCase (StgPrimApp op args res_ty)
live_in_whole_case live_in_alts bndr srt (StgAlgAlts ty alts deflt)
| isEnumerationTyCon tycon
= getArgAmodes args `thenFC` \ arg_amodes ->
@@ -197,7 +196,7 @@ cgCase (StgCon (PrimOp op) args res_ty)
Special case #2: inline PrimOps.
\begin{code}
-cgCase (StgCon (PrimOp op) args res_ty)
+cgCase (StgPrimApp op args res_ty)
live_in_whole_case live_in_alts bndr srt alts
| not (primOpOutOfLine op)
=
diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index 5fa258b359..f771fdb048 100644
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -37,7 +37,7 @@ import Constants ( mAX_INTLIKE, mIN_INTLIKE, mIN_UPD_SIZE )
import CgHeapery ( allocDynClosure, inPlaceAllocDynClosure )
import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall,
mkUnboxedTupleReturnCode )
-import CLabel ( mkClosureLabel, mkStaticClosureLabel )
+import CLabel ( mkClosureLabel )
import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
layOutDynCon, layOutDynClosure,
layOutStaticClosure, closureSize
@@ -45,12 +45,12 @@ import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
currentCCS )
import DataCon ( DataCon, dataConName, dataConTag, dataConTyCon,
- isUnboxedTupleCon )
-import MkId ( mkDataConId )
+ isUnboxedTupleCon, isNullaryDataCon, isDynDataCon, dataConId, dataConWrapId
+ )
import Id ( Id, idName, idType, idPrimRep )
import Name ( nameModule, isLocallyDefinedName )
import Module ( isDynamicModule )
-import Const ( Con(..), Literal(..), isLitLitLit )
+import Literal ( Literal(..) )
import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
import PrimRep ( PrimRep(..), isFollowableRep )
import Unique ( Uniquable(..) )
@@ -68,10 +68,9 @@ import Panic ( assertPanic, trace )
cgTopRhsCon :: Id -- Name of thing bound to this RHS
-> DataCon -- Id
-> [StgArg] -- Args
- -> Bool -- All zero-size args (see buildDynCon)
-> FCode (Id, CgIdInfo)
-cgTopRhsCon id con args all_zero_size_args
- = ASSERT(not (any_litlit_args || dynamic_con_or_args))
+cgTopRhsCon id con args
+ = ASSERT(not dynamic_con_or_args) -- checks for litlit args too
(
-- LAY IT OUT
getArgAmodes args `thenFC` \ amodes ->
@@ -101,26 +100,7 @@ cgTopRhsCon id con args all_zero_size_args
top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data
-- stuff needed by the assert pred only.
- any_litlit_args = any isLitLitArg args
- dynamic_con_or_args = dynamic_con || any (isDynamic) args
-
- dynamic_con = isDynName (dataConName con)
-
- isDynName nm =
- not (isLocallyDefinedName nm) &&
- isDynamicModule (nameModule nm)
-
- {-
- Do any of the arguments refer to something in a DLL?
- -}
- isDynamic (StgVarArg v) = isDynName (idName v)
- isDynamic (StgConArg c) =
- case c of
- DataCon dc -> isDynName (dataConName dc)
- Literal l -> isLitLitLit l -- all bets are off if it is.
- _ -> False
-
-
+ dynamic_con_or_args = isDynDataCon con || any isDynArg args
\end{code}
%************************************************************************
@@ -137,13 +117,17 @@ buildDynCon :: Id -- Name of the thing to which this constr will
-- current CCS if currentOrSubsumedCCS
-> DataCon -- The data constructor
-> [CAddrMode] -- Its args
- -> Bool -- True <=> all args (if any) are
- -- of "zero size" (i.e., VoidRep);
- -- The reason we don't just look at the
- -- args is that we may be in a "knot", and
- -- premature looking at the args will cause
- -- the compiler to black-hole!
-> FCode CgIdInfo -- Return details about how to find it
+
+-- We used to pass a boolean indicating whether all the
+-- args were of size zero, so we could use a static
+-- construtor; but I concluded that it just isn't worth it.
+-- Now I/O uses unboxed tuples there just aren't any constructors
+-- with all size-zero args.
+--
+-- The reason for having a separate argument, rather than looking at
+-- the addr modes of the args is that we may be in a "knot", and
+-- premature looking at the args will cause the compiler to black-hole!
\end{code}
First we deal with the case of zero-arity constructors. Now, they
@@ -155,9 +139,9 @@ which have exclusively size-zero (VoidRep) args, we generate no code
at all.
\begin{code}
-buildDynCon binder cc con args all_zero_size_args@True
+buildDynCon binder cc con []
= returnFC (stableAmodeIdInfo binder
- (CLbl (mkStaticClosureLabel (dataConName con)) PtrRep)
+ (CLbl (mkClosureLabel (idName (dataConWrapId con))) PtrRep)
(mkConLFInfo con))
\end{code}
@@ -177,7 +161,7 @@ which is guaranteed in range.
Because of this, we use can safely return an addressing mode.
\begin{code}
-buildDynCon binder cc con [arg_amode] all_zero_size_args@False
+buildDynCon binder cc con [arg_amode]
| maybeCharLikeCon con
= absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
@@ -188,8 +172,8 @@ buildDynCon binder cc con [arg_amode] all_zero_size_args@False
where
(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 other_amode = False
+ in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
+ in_range_int_lit other_amode = False
tycon = dataConTyCon con
\end{code}
@@ -197,7 +181,7 @@ buildDynCon binder cc con [arg_amode] all_zero_size_args@False
Now the general case.
\begin{code}
-buildDynCon binder ccs con args all_zero_size_args@False
+buildDynCon binder ccs con args
= allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
returnFC (heapIdInfo binder hp_off lf_info)
where
@@ -283,9 +267,9 @@ bindUnboxedTupleComponents args
Note: it's the responsibility of the @cgReturnDataCon@ caller to be
sure the @amodes@ passed don't conflict with each other.
\begin{code}
-cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> Code
+cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
-cgReturnDataCon con amodes all_zero_size_args
+cgReturnDataCon con amodes
= getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
case sequel of
@@ -315,7 +299,7 @@ cgReturnDataCon con amodes all_zero_size_args
-- If the sequel is an update frame, we might be able to
-- do update in place...
UpdateCode
- | not all_zero_size_args -- no nullary constructors, please
+ | not (isNullaryDataCon con) -- no nullary constructors, please
&& not (maybeCharLikeCon con) -- no chars please (these are all static)
&& not (any isFollowableRep (map getAmodeRep amodes))
-- no ptrs please (generational gc...)
@@ -394,17 +378,14 @@ cgReturnDataCon con amodes all_zero_size_args
-- This Id is also used to get a unique for a
-- temporary variable, if the closure is a CHARLIKE.
- -- funilly enough, this makes the unique always come
+ -- funnily enough, this makes the unique always come
-- out as '54' :-)
- buildDynCon (mkDataConId con) currentCCS
- con amodes all_zero_size_args
- `thenFC` \ idinfo ->
- idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
+ buildDynCon (dataConId con) currentCCS con amodes `thenFC` \ idinfo ->
+ idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
-- RETURN
profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
-- could use doTailCall here.
performReturn (move_to_reg amode node) return
-
\end{code}
diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs
index 7ae92a890d..a20e0ee097 100644
--- a/ghc/compiler/codeGen/CgConTbls.lhs
+++ b/ghc/compiler/codeGen/CgConTbls.lhs
@@ -14,14 +14,13 @@ import CgMonad
import StgSyn ( SRT(..) )
import AbsCUtils ( mkAbstractCs, mkAbsCStmts )
import CgTailCall ( performReturn, mkStaticAlgReturnCode )
-import CLabel ( mkConEntryLabel, mkStaticClosureLabel )
+import CLabel ( mkConEntryLabel )
import ClosureInfo ( layOutStaticClosure, layOutDynCon,
mkConLFInfo, ClosureInfo
)
import CostCentre ( dontCareCCS )
import FiniteMap ( fmToList, FiniteMap )
-import DataCon ( DataCon, dataConName, dataConAllRawArgTys )
-import Const ( Con(..) )
+import DataCon ( DataCon, dataConName, dataConRepArgTys, isNullaryDataCon )
import Name ( getOccString )
import PrimRep ( getPrimRepSize, PrimRep(..) )
import TyCon ( tyConDataCons, isEnumerationTyCon, TyCon )
@@ -58,12 +57,9 @@ Static occurrences of the constructor
macro: @STATIC_INFO_TABLE@.
\end{description}
-For zero-arity constructors, \tr{con}, we also generate a static closure:
-\begin{description}
-\item[@_closure@:]
-A single static copy of the (zero-arity) constructor itself.
-\end{description}
+For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
+it's place is taken by the top level defn of the constructor.
For charlike and intlike closures there is a fixed array of static
closures predeclared.
@@ -115,8 +111,7 @@ genConInfo comp_info tycon data_con
= mkAbstractCs [
CSplitMarker,
closure_code,
- static_code,
- closure_maybe]
+ static_code]
-- Order of things is to reduce forward references
where
(closure_info, body_code) = mkConCodeAndInfo data_con
@@ -144,26 +139,15 @@ genConInfo comp_info tycon data_con
cost_centre = mkCCostCentreStack dontCareCCS -- not worried about static data costs
- -- For zero-arity data constructors, or, more accurately,
- -- those which only have VoidRep args (or none):
- -- We make the closure too (not just info tbl), so that we can share
- -- one copy throughout.
- closure_maybe = if not zero_arity_con then
- AbsCNop
- else
- CStaticClosure closure_label -- Label for closure
- static_ci -- Info table
- cost_centre
- [{-No args! A slight lie for constrs
- with VoidRep args-}]
-
zero_size arg_ty = getPrimRepSize (typePrimRep arg_ty) == 0
- zero_arity_con = all zero_size arg_tys
+ zero_arity_con = isNullaryDataCon data_con
+ -- We used to check that all the arg-sizes were zero, but we don't
+ -- really have any constructors with only zero-size args, and it's
+ -- just one more thing to go wrong.
- arg_tys = dataConAllRawArgTys data_con
+ arg_tys = dataConRepArgTys data_con
entry_label = mkConEntryLabel con_name
- closure_label = mkStaticClosureLabel con_name
con_name = dataConName data_con
\end{code}
@@ -173,7 +157,7 @@ mkConCodeAndInfo :: DataCon -- Data constructor
mkConCodeAndInfo con
= let
- arg_tys = dataConAllRawArgTys con
+ arg_tys = dataConRepArgTys con
(closure_info, arg_things)
= layOutDynCon con typePrimRep arg_tys
diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index 0fca2d3e57..78e8a300d4 100644
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ b/ghc/compiler/codeGen/CgExpr.lhs
@@ -1,7 +1,7 @@
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgExpr.lhs,v 1.30 1999/10/25 13:21:16 sof Exp $
+% $Id: CgExpr.lhs,v 1.31 2000/03/23 17:45:19 simonpj Exp $
%
%********************************************************
%* *
@@ -40,9 +40,8 @@ import CostCentre ( sccAbleCostCentre, isSccCountCostCentre )
import Id ( idPrimRep, idType, Id )
import VarSet
import DataCon ( DataCon, dataConTyCon )
-import Const ( Con(..) )
import IdInfo ( ArityInfo(..) )
-import PrimOp ( primOpOutOfLine,
+import PrimOp ( primOpOutOfLine, ccallMayGC,
getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..)
)
import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep )
@@ -85,11 +84,9 @@ cgExpr (StgApp fun args) = cgTailCall fun args
%********************************************************
\begin{code}
-cgExpr (StgCon (DataCon con) args res_ty)
+cgExpr (StgConApp con args)
= getArgAmodes args `thenFC` \ amodes ->
- cgReturnDataCon con amodes (all zero_size args)
- where
- zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
+ cgReturnDataCon con amodes
\end{code}
Literals are similar to constructors; they return by putting
@@ -97,9 +94,8 @@ themselves in an appropriate register and returning to the address on
top of the stack.
\begin{code}
-cgExpr (StgCon (Literal lit) args res_ty)
- = ASSERT( null args )
- performPrimReturn (text "literal" <+> ppr lit) (CLit lit)
+cgExpr (StgLit lit)
+ = performPrimReturn (text "literal" <+> ppr lit) (CLit lit)
\end{code}
@@ -113,19 +109,21 @@ Here is where we insert real live machine instructions.
NOTE about _ccall_GC_:
-A _ccall_GC_ is treated as an out-of-line primop for the case
-expression code, because we want a proper stack frame on the stack
-when we perform it. When we get here, however, we need to actually
-perform the call, so we treat it as an inline primop.
+A _ccall_GC_ is treated as an out-of-line primop (returns True
+for primOpOutOfLine) so that when we see the call in case context
+ case (ccall ...) of { ... }
+we get a proper stack frame on the stack when we perform it. When we
+get in a tail-call position, however, we need to actually perform the
+call, so we treat it as an inline primop.
\begin{code}
-cgExpr (StgCon (PrimOp op@(CCallOp _ _ may_gc@True _)) args res_ty)
+cgExpr (StgPrimApp op@(CCallOp ccall) args res_ty)
= primRetUnboxedTuple op args res_ty
-- tagToEnum# is special: we need to pull the constructor out of the table,
-- and perform an appropriate return.
-cgExpr (StgCon (PrimOp TagToEnumOp) [arg] res_ty)
+cgExpr (StgPrimApp TagToEnumOp [arg] res_ty)
= ASSERT(isEnumerationTyCon tycon)
getArgAmode arg `thenFC` \amode ->
-- save the tag in a temporary in case amode overlaps
@@ -150,7 +148,7 @@ cgExpr (StgCon (PrimOp TagToEnumOp) [arg] res_ty)
(Just (tycon,_)) = splitTyConApp_maybe res_ty
-cgExpr x@(StgCon (PrimOp op) args res_ty)
+cgExpr x@(StgPrimApp op args res_ty)
| primOpOutOfLine op = tailCallPrimOp op args
| otherwise
= ASSERT(op /= SeqOp) -- can't handle SeqOp
@@ -283,12 +281,9 @@ cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
-- the Id is passed along so a binding can be set up
cgRhs name (StgRhsCon maybe_cc con args)
- = getArgAmodes args `thenFC` \ amodes ->
- buildDynCon name maybe_cc con amodes (all zero_size args)
- `thenFC` \ idinfo ->
+ = getArgAmodes args `thenFC` \ amodes ->
+ buildDynCon name maybe_cc con amodes `thenFC` \ idinfo ->
returnFC (name, idinfo)
- where
- zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
cgRhs name (StgRhsClosure cc bi srt@(NoSRT) fvs upd_flag args body)
= mkRhsClosure name cc bi srt fvs upd_flag args body
@@ -445,7 +440,7 @@ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
(StgRhsCon cc con args)
= cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} NoSRT full_live_in_rhss rhs_eob_info maybe_cc_slot rec
[] --No args; the binder is data structure, not a function
- (StgCon (DataCon con) args (idType binder))
+ (StgConApp con args)
\end{code}
Little helper for primitives that return unboxed tuples.
@@ -478,5 +473,4 @@ primRetUnboxedTuple op args res_ty
temp_amodes = zipWith CTemp temp_uniqs prim_reps
in
returnUnboxedTuple temp_amodes (absC (COpStmt temp_amodes op arg_temps []))
-
\end{code}
diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs
index d4784b6aae..a68a35287b 100644
--- a/ghc/compiler/codeGen/CgRetConv.lhs
+++ b/ghc/compiler/codeGen/CgRetConv.lhs
@@ -1,7 +1,7 @@
%
% (c) The GRASP Project, Glasgow University, 1992-1998
%
-% $Id: CgRetConv.lhs,v 1.19 1999/05/13 17:30:58 simonm Exp $
+% $Id: CgRetConv.lhs,v 1.20 2000/03/23 17:45:19 simonpj Exp $
%
\section[CgRetConv]{Return conventions for the code generator}
@@ -27,7 +27,7 @@ import CmdLineOpts ( opt_UseVanillaRegs, opt_UseFloatRegs,
opt_UseDoubleRegs, opt_UseLongRegs
)
import Maybes ( catMaybes )
-import DataCon ( dataConRawArgTys, DataCon )
+import DataCon ( DataCon )
import PrimOp ( PrimOp{-instance Outputable-} )
import PrimRep ( isFloatingRep, PrimRep(..), is64BitRep )
import TyCon ( TyCon, tyConDataCons, tyConFamilySize )
diff --git a/ghc/compiler/codeGen/CgTailCall.lhs b/ghc/compiler/codeGen/CgTailCall.lhs
index 46e3b0219f..82c64a4c48 100644
--- a/ghc/compiler/codeGen/CgTailCall.lhs
+++ b/ghc/compiler/codeGen/CgTailCall.lhs
@@ -1,7 +1,7 @@
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgTailCall.lhs,v 1.23 1999/11/02 15:05:43 simonmar Exp $
+% $Id: CgTailCall.lhs,v 1.24 2000/03/23 17:45:19 simonpj Exp $
%
%********************************************************
%* *
@@ -48,7 +48,7 @@ import ClosureInfo ( nodeMustPointToIt,
import CmdLineOpts ( opt_DoSemiTagging )
import Id ( Id, idType, idName )
import DataCon ( DataCon, dataConTyCon, dataConTag, fIRST_TAG )
-import Const ( mkMachInt )
+import Literal ( mkMachInt )
import Maybes ( assocMaybe, maybeToBool )
import PrimRep ( PrimRep(..) )
import StgSyn ( StgArg, GenStgArg(..) )
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index 157a6b70e2..62836a1d7b 100644
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ b/ghc/compiler/codeGen/ClosureInfo.lhs
@@ -1,7 +1,7 @@
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: ClosureInfo.lhs,v 1.39 1999/11/02 15:05:44 simonmar Exp $
+% $Id: ClosureInfo.lhs,v 1.40 2000/03/23 17:45:19 simonpj Exp $
%
\section[ClosureInfo]{Data structures which describe closures}
@@ -67,7 +67,7 @@ import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
import CgRetConv ( assignRegs )
import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
mkInfoTableLabel,
- mkConInfoTableLabel, mkStaticClosureLabel,
+ mkConInfoTableLabel,
mkCAFBlackHoleInfoTableLabel,
mkSECAFBlackHoleInfoTableLabel,
mkStaticInfoTableLabel, mkStaticConEntryLabel,
@@ -79,7 +79,7 @@ import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
import CmdLineOpts ( opt_SccProfilingOn, opt_OmitBlackHoling,
opt_Parallel, opt_DoTickyProfiling,
opt_SMP )
-import Id ( Id, idType, getIdArity )
+import Id ( Id, idType, idArityInfo )
import DataCon ( DataCon, dataConTag, fIRST_TAG,
isNullaryDataCon, isTupleCon, dataConName
)
@@ -258,7 +258,7 @@ mkLFLetNoEscape = LFLetNoEscape
mkLFImported :: Id -> LambdaFormInfo
mkLFImported id
- = case getIdArity id of
+ = case idArityInfo id of
ArityExactly 0 -> LFThunk (idType id)
TopLevel True{-no fvs-}
True{-updatable-} NonStandardThunk
@@ -300,10 +300,8 @@ closurePtrsSize (MkClosureInfo _ _ sm_rep)
-- not exported:
sizes_from_SMRep :: SMRep -> (Int,Int)
-sizes_from_SMRep (GenericRep ptrs nonptrs _) = (ptrs, nonptrs)
-sizes_from_SMRep (StaticRep ptrs nonptrs _) = (ptrs, nonptrs)
-sizes_from_SMRep ConstantRep = (0, 0)
-sizes_from_SMRep BlackHoleRep = (0, 0)
+sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
+sizes_from_SMRep BlackHoleRep = (0, 0)
\end{code}
Computing slop size. WARNING: this looks dodgy --- it has deep
@@ -341,16 +339,15 @@ slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
computeSlopSize :: Int -> SMRep -> Bool -> Int
-computeSlopSize tot_wds (StaticRep _ _ _) True -- Updatable
+computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable
= max 0 (mIN_UPD_SIZE - tot_wds)
-computeSlopSize tot_wds (StaticRep _ _ _) False
- = 0 -- non updatable, non-heap object
-computeSlopSize tot_wds (GenericRep _ _ _) True -- Updatable
- = max 0 (mIN_UPD_SIZE - tot_wds)
-computeSlopSize tot_wds (GenericRep _ _ _) False
- = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds)
-computeSlopSize tot_wds ConstantRep _
- = 0
+
+computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable
+ = 0 -- Static
+
+computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
+ = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic
+
computeSlopSize tot_wds BlackHoleRep _ -- Updatable
= max 0 (mIN_UPD_SIZE - tot_wds)
\end{code}
@@ -376,7 +373,7 @@ layOutDynClosure name kind_fn things lf_info
where
(tot_wds, -- #ptr_wds + #nonptr_wds
ptr_wds, -- #ptr_wds
- things_w_offsets) = mkVirtHeapOffsets sm_rep kind_fn things
+ things_w_offsets) = mkVirtHeapOffsets kind_fn things
sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
\end{code}
@@ -407,25 +404,26 @@ layOutStaticNoFVClosure.
\begin{code}
layOutStaticClosure name kind_fn things lf_info
= (MkClosureInfo name lf_info
- (StaticRep ptr_wds (tot_wds - ptr_wds) closure_type),
+ (GenericRep is_static ptr_wds (tot_wds - ptr_wds) closure_type),
things_w_offsets)
where
(tot_wds, -- #ptr_wds + #nonptr_wds
ptr_wds, -- #ptr_wds
- things_w_offsets) = mkVirtHeapOffsets (StaticRep bot bot bot) kind_fn things
+ things_w_offsets) = mkVirtHeapOffsets kind_fn things
-- constructors with no pointer fields will definitely be NOCAF things.
-- this is a compromise until we can generate both kinds of constructor
-- (a normal static kind and the NOCAF_STATIC kind).
- closure_type = case lf_info of
- LFCon _ _ | ptr_wds == 0 -> CONSTR_NOCAF
- _ -> getStaticClosureType lf_info
+ closure_type = getClosureType is_static tot_wds ptr_wds lf_info
+ is_static = True
bot = panic "layoutStaticClosure"
layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
layOutStaticNoFVClosure name lf_info
- = MkClosureInfo name lf_info (StaticRep 0 0 (getStaticClosureType lf_info))
+ = MkClosureInfo name lf_info (GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info))
+ where
+ is_static = True
\end{code}
%************************************************************************
@@ -442,55 +440,45 @@ chooseDynSMRep
chooseDynSMRep lf_info tot_wds ptr_wds
= let
- nonptr_wds = tot_wds - ptr_wds
- closure_type = getClosureType tot_wds ptr_wds nonptr_wds lf_info
+ is_static = False
+ nonptr_wds = tot_wds - ptr_wds
+ closure_type = getClosureType is_static tot_wds ptr_wds lf_info
in
- case lf_info of
- LFTuple _ True -> ConstantRep
- LFCon _ True -> ConstantRep
- _ -> GenericRep ptr_wds nonptr_wds closure_type
-
-getStaticClosureType :: LambdaFormInfo -> ClosureType
-getStaticClosureType lf_info =
- case lf_info of
- LFCon con True -> CONSTR_NOCAF
- LFCon con False -> CONSTR
- LFReEntrant _ _ _ _ _ _ -> FUN
- LFTuple _ _ -> CONSTR
- LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
- LFThunk _ _ _ True _ _ _ -> THUNK
- LFThunk _ _ _ False _ _ _ -> FUN
- _ -> panic "getClosureType"
+ GenericRep is_static ptr_wds nonptr_wds closure_type
-- we *do* get non-updatable top-level thunks sometimes. eg. f = g
-- gets compiled to a jump to g (if g has non-zero arity), instead of
-- messing around with update frames and PAPs. We set the closure type
-- to FUN_STATIC in this case.
-getClosureType :: Int -> Int -> Int -> LambdaFormInfo -> ClosureType
-getClosureType tot_wds ptrs nptrs lf_info =
- case lf_info of
- LFCon con True -> CONSTR_NOCAF
+getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
+getClosureType is_static tot_wds ptr_wds lf_info
+ = case lf_info of
+ LFCon con zero_arity
+ | is_static && ptr_wds == 0 -> CONSTR_NOCAF
+ | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
+ | otherwise -> CONSTR
- LFCon con False
- | tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
- | otherwise -> CONSTR
+ LFTuple _ zero_arity
+ | is_static && ptr_wds == 0 -> CONSTR_NOCAF
+ | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
+ | otherwise -> CONSTR
LFReEntrant _ _ _ _ _ _
- | tot_wds > 0 && tot_wds <= mAX_SPEC_FUN_SIZE -> FUN_p_n ptrs nptrs
- | otherwise -> FUN
-
- LFTuple _ _
- | tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
- | otherwise -> CONSTR
+ | specialised_rep mAX_SPEC_FUN_SIZE -> FUN_p_n
+ | otherwise -> FUN
LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
LFThunk _ _ _ _ _ _ _
- | tot_wds > 0 && tot_wds <= mAX_SPEC_THUNK_SIZE -> THUNK_p_n ptrs nptrs
- | otherwise -> THUNK
+ | specialised_rep mAX_SPEC_THUNK_SIZE -> THUNK_p_n
+ | otherwise -> THUNK
- _ -> panic "getClosureType"
+ _ -> panic "getClosureType"
+ where
+ specialised_rep max_size = not is_static
+ && tot_wds > 0
+ && tot_wds <= max_size
\end{code}
%************************************************************************
@@ -504,8 +492,8 @@ smaller offsets than the unboxed things, and furthermore, the offsets in
the result list
\begin{code}
-mkVirtHeapOffsets :: SMRep -- Representation to be used by storage manager
- -> (a -> PrimRep) -- To be able to grab kinds;
+mkVirtHeapOffsets ::
+ (a -> PrimRep) -- To be able to grab kinds;
-- w/ a kind, we can find boxedness
-> [a] -- Things to make offsets for
-> (Int, -- *Total* number of words allocated
@@ -516,7 +504,7 @@ mkVirtHeapOffsets :: SMRep -- Representation to be used by storage manager
-- First in list gets lowest offset, which is initial offset + 1.
-mkVirtHeapOffsets sm_rep kind_fun things
+mkVirtHeapOffsets kind_fun things
= let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
(wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
(tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
@@ -712,7 +700,10 @@ blackHoleOnEntry :: ClosureInfo -> Bool
-- Single-entry ones have no fvs to plug, and we trust they don't form part
-- of a loop.
-blackHoleOnEntry (MkClosureInfo _ _ (StaticRep _ _ _)) = False
+blackHoleOnEntry (MkClosureInfo _ _ rep)
+ | isStaticRep rep
+ = False
+ -- Never black-hole a static closure
blackHoleOnEntry (MkClosureInfo _ lf_info _)
= case lf_info of
@@ -969,25 +960,18 @@ infoTableLabelFromCI (MkClosureInfo id lf_info rep)
mkConInfoPtr :: DataCon -> SMRep -> CLabel
mkConInfoPtr con rep
- = case rep of
- StaticRep _ _ _ -> mkStaticInfoTableLabel name
- _ -> mkConInfoTableLabel name
+ | isStaticRep rep = mkStaticInfoTableLabel name
+ | otherwise = mkConInfoTableLabel name
where
name = dataConName con
mkConEntryPtr :: DataCon -> SMRep -> CLabel
mkConEntryPtr con rep
- = case rep of
- StaticRep _ _ _ -> mkStaticConEntryLabel (dataConName con)
- _ -> mkConEntryLabel (dataConName con)
+ | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
+ | otherwise = mkConEntryLabel (dataConName con)
where
name = dataConName con
-closureLabelFromCI (MkClosureInfo name _ rep)
- | isConstantRep rep
- = mkStaticClosureLabel name
- -- This case catches those pesky static closures for nullary constructors
-
closureLabelFromCI (MkClosureInfo id _ other_rep) = mkClosureLabel id
entryLabelFromCI :: ClosureInfo -> CLabel
diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index a2dcbc9bff..1f1d0f8e34 100644
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -73,8 +73,11 @@ codeGen mod_name imported_modules cost_centre_info fe_binders
cost_centre_info
abstractC = mkAbstractCs [ init_stuff,
- datatype_stuff,
- code_stuff ]
+ code_stuff,
+ datatype_stuff]
+ -- Put datatype_stuff after code_stuff, because the
+ -- datatype closure table (for enumeration types)
+ -- to (say) PrelBase_True_closure, which is defined in code_stuff
flat_abstractC = flattenAbsC fl_uniqs abstractC
in
@@ -221,9 +224,7 @@ cgTopRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
-- the Id is passed along for setting up a binding...
cgTopRhs bndr (StgRhsCon cc con args)
- = forkStatics (cgTopRhsCon bndr con args (all zero_size args))
- where
- zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
+ = forkStatics (cgTopRhsCon bndr con args)
cgTopRhs bndr (StgRhsClosure cc bi srt fvs upd_flag args body)
= ASSERT(null fvs) -- There should be no free variables
diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs
index aabcf40449..c338cf8b3f 100644
--- a/ghc/compiler/codeGen/SMRep.lhs
+++ b/ghc/compiler/codeGen/SMRep.lhs
@@ -9,7 +9,7 @@ Other modules should access this info through ClosureInfo.
\begin{code}
module SMRep (
SMRep(..), ClosureType(..),
- isConstantRep, isStaticRep,
+ isStaticRep,
fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
fixedItblSize, pprSMRep
@@ -68,31 +68,28 @@ import GlaExts ( Int(..), Int#, (<#), (==#), (<#), (>#) )
\begin{code}
data SMRep
-- static closure have an extra static link field at the end.
- = StaticRep
- Int -- # ptr words (useful for interpreter, debugger, etc)
- Int -- # non-ptr words
- ClosureType -- closure type
-
- | GenericRep -- GC routines consult sizes in info tbl
+ = GenericRep -- GC routines consult sizes in info tbl
+ Bool -- True <=> This is a static closure. Affects how
+ -- we garbage-collect it
Int -- # ptr words
Int -- # non-ptr words
ClosureType -- closure type
- | ConstantRep -- CONSTR with zero-arity
-
| BlackHoleRep
-data ClosureType
+data ClosureType -- Corresponds 1-1 with the varieties of closures
+ -- implemented by the RTS. Compare with ghc/includes/ClosureTypes.h
= CONSTR
- | CONSTR_p_n Int Int
+ | CONSTR_p_n -- The p_n variants have more efficient GC, but we
+ -- only provide them for dynamically-allocated closures
+ -- (We could do them for static ones, but we don't)
| CONSTR_NOCAF
| FUN
- | FUN_p_n Int Int
+ | FUN_p_n
| THUNK
- | THUNK_p_n Int Int
+ | THUNK_p_n
| THUNK_SELECTOR
deriving (Eq,Ord)
-
\end{code}
Size of a closure header.
@@ -140,77 +137,63 @@ tickyItblSize | opt_DoTickyProfiling = tICKY_ITBL_SIZE
\end{code}
\begin{code}
-isConstantRep, isStaticRep :: SMRep -> Bool
-isConstantRep ConstantRep = True
-isConstantRep other = False
-
-isStaticRep (StaticRep _ _ _) = True
-isStaticRep _ = False
+isStaticRep :: SMRep -> Bool
+isStaticRep (GenericRep is_static _ _ _) = is_static
+isStaticRep BlackHoleRep = False
\end{code}
\begin{code}
-{- ToDo: needed? -}
-instance Text SMRep where
- showsPrec d rep
- = showString (case rep of
- StaticRep _ _ _ -> "STATIC"
- GenericRep _ _ _ -> ""
- ConstantRep -> "")
-
instance Outputable SMRep where
ppr rep = pprSMRep rep
pprSMRep :: SMRep -> SDoc
-pprSMRep (GenericRep _ _ t) = pprClosureType t
-pprSMRep (StaticRep _ _ t) = pprClosureType t <> ptext SLIT("_STATIC")
-pprSMRep ConstantRep = ptext SLIT("CONSTR_NOCAF_STATIC")
-pprSMRep BlackHoleRep = ptext SLIT("BLACKHOLE")
-
-pprClosureType CONSTR = ptext SLIT("CONSTR")
-pprClosureType (CONSTR_p_n p n) = ptext SLIT("CONSTR_") <> int p <> char '_' <> int n
-pprClosureType CONSTR_NOCAF = ptext SLIT("CONSTR_NOCAF")
-pprClosureType FUN = ptext SLIT("FUN")
-pprClosureType (FUN_p_n p n) = ptext SLIT("FUN_") <> int p <> char '_' <> int n
-pprClosureType THUNK = ptext SLIT("THUNK")
-pprClosureType (THUNK_p_n p n) = ptext SLIT("THUNK_") <> int p <> char '_' <> int n
-pprClosureType THUNK_SELECTOR = ptext SLIT("THUNK_SELECTOR")
+pprSMRep (GenericRep True ptrs nptrs clo_ty) = pprClosureType clo_ty ptrs nptrs <> ptext SLIT("_STATIC")
+pprSMRep (GenericRep False ptrs nptrs clo_ty) = pprClosureType clo_ty ptrs nptrs
+
+pprClosureType CONSTR p n = ptext SLIT("CONSTR")
+pprClosureType CONSTR_p_n p n = ptext SLIT("CONSTR_") <> int p <> char '_' <> int n
+pprClosureType CONSTR_NOCAF p n = ptext SLIT("CONSTR_NOCAF")
+pprClosureType FUN p n = ptext SLIT("FUN")
+pprClosureType FUN_p_n p n = ptext SLIT("FUN_") <> int p <> char '_' <> int n
+pprClosureType THUNK p n = ptext SLIT("THUNK")
+pprClosureType THUNK_p_n p n = ptext SLIT("THUNK_") <> int p <> char '_' <> int n
+pprClosureType THUNK_SELECTOR p n = ptext SLIT("THUNK_SELECTOR")
#ifndef OMIT_NATIVE_CODEGEN
getSMRepClosureTypeInt :: SMRep -> Int
-getSMRepClosureTypeInt (GenericRep _ _ t) =
- case t of
- CONSTR -> cONSTR
- CONSTR_p_n 1 0 -> cONSTR_1_0
- CONSTR_p_n 0 1 -> cONSTR_0_1
- CONSTR_p_n 2 0 -> cONSTR_2_0
- CONSTR_p_n 1 1 -> cONSTR_1_1
- CONSTR_p_n 0 2 -> cONSTR_0_2
- CONSTR_NOCAF -> panic "getClosureTypeInt: CONSTR_NOCAF"
- FUN -> fUN
- FUN_p_n 1 0 -> fUN_1_0
- FUN_p_n 0 1 -> fUN_0_1
- FUN_p_n 2 0 -> fUN_2_0
- FUN_p_n 1 1 -> fUN_1_1
- FUN_p_n 0 2 -> fUN_0_2
- THUNK -> tHUNK
- THUNK_p_n 1 0 -> tHUNK_1_0
- THUNK_p_n 0 1 -> tHUNK_0_1
- THUNK_p_n 2 0 -> tHUNK_2_0
- THUNK_p_n 1 1 -> tHUNK_1_1
- THUNK_p_n 0 2 -> tHUNK_0_2
- THUNK_SELECTOR -> tHUNK_SELECTOR
-getSMRepClosureTypeInt (StaticRep _ _ t) =
- case t of
- CONSTR -> cONSTR_STATIC
- CONSTR_NOCAF -> cONSTR_NOCAF_STATIC
- FUN -> fUN_STATIC
- THUNK -> tHUNK_STATIC
- THUNK_SELECTOR -> panic "getClosureTypeInt: THUNK_SELECTOR_STATIC"
-
-getSMRepClosureTypeInt ConstantRep = cONSTR_NOCAF_STATIC
+getSMRepClosureTypeInt (GenericRep False _ _ CONSTR) = cONSTR
+getSMRepClosureTypeInt (GenericRep False 1 0 CONSTR_p_n) = cONSTR_1_0
+getSMRepClosureTypeInt (GenericRep False 0 1 CONSTR_p_n) = cONSTR_0_1
+getSMRepClosureTypeInt (GenericRep False 2 0 CONSTR_p_n) = cONSTR_2_0
+getSMRepClosureTypeInt (GenericRep False 1 1 CONSTR_p_n) = cONSTR_1_1
+getSMRepClosureTypeInt (GenericRep False 0 2 CONSTR_p_n) = cONSTR_0_2
+
+getSMRepClosureTypeInt (GenericRep False _ _ FUN) = fUN
+getSMRepClosureTypeInt (GenericRep False 1 0 FUN_p_n) = fUN_1_0
+getSMRepClosureTypeInt (GenericRep False 0 1 FUN_p_n) = fUN_0_1
+getSMRepClosureTypeInt (GenericRep False 2 0 FUN_p_n) = fUN_2_0
+getSMRepClosureTypeInt (GenericRep False 1 1 FUN_p_n) = fUN_1_1
+getSMRepClosureTypeInt (GenericRep False 0 2 FUN_p_n) = fUN_0_2
+
+getSMRepClosureTypeInt (GenericRep False _ _ THUNK) = tHUNK
+getSMRepClosureTypeInt (GenericRep False 1 0 THUNK_p_n) = tHUNK_1_0
+getSMRepClosureTypeInt (GenericRep False 0 1 THUNK_p_n) = tHUNK_0_1
+getSMRepClosureTypeInt (GenericRep False 2 0 THUNK_p_n) = tHUNK_2_0
+getSMRepClosureTypeInt (GenericRep False 1 1 THUNK_p_n) = tHUNK_1_1
+getSMRepClosureTypeInt (GenericRep False 0 2 THUNK_p_n) = tHUNK_0_2
+
+getSMRepClosureTypeInt (GenericRep False _ _ THUNK_SELECTOR) = tHUNK_SELECTOR
+
+getSMRepClosureTypeInt (GenericRep True _ _ CONSTR) = cONSTR_STATIC
+getSMRepClosureTypeInt (GenericRep True _ _ CONSTR_NOCAF) = cONSTR_NOCAF_STATIC
+getSMRepClosureTypeInt (GenericRep True _ _ FUN) = fUN_STATIC
+getSMRepClosureTypeInt (GenericRep True _ _ THUNK) = tHUNK_STATIC
getSMRepClosureTypeInt BlackHoleRep = bLACKHOLE
+getSMRepClosureTypeInt rep = pprPanic "getSMRepClosureTypeInt:" (pprSMRep rep)
+
+
-- Just the ones we need:
#include "../includes/ClosureTypes.h"
View Lorry Controller Status