SRT(..), noSRT,
pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs,
- getArgPrimRep,
- isLitLitArg,
- stgArity,
+ getArgPrimRep, pprStgAlts,
+ isLitLitArg, isDllConApp, isStgTypeArg,
+ stgArity, stgArgType,
collectFinalStgBinders
#ifdef DEBUG
#include "HsVersions.h"
import CostCentre ( CostCentreStack, CostCentre )
-import Id ( idPrimRep, Id )
-import Const ( Con(..), DataCon, Literal,
- conPrimRep, isLitLitLit )
-import PrimRep ( PrimRep(..) )
+import Id ( Id, idName, idPrimRep, idType )
+import Name ( isDllName )
+import Literal ( Literal, literalType, isLitLitLit, literalPrimRep )
+import DataCon ( DataCon, dataConName )
+import PrimOp ( PrimOp )
import Outputable
import Type ( Type )
+import TyCon ( TyCon )
import UniqSet ( isEmptyUniqSet, uniqSetToList, UniqSet )
\end{code}
\begin{code}
data GenStgArg occ
= StgVarArg occ
- | StgConArg Con -- A literal or nullary data constructor
+ | StgLitArg Literal
+ | StgTypeArg Type -- For when we want to preserve all type info
\end{code}
\begin{code}
-getArgPrimRep (StgVarArg local) = idPrimRep local
-getArgPrimRep (StgConArg con) = conPrimRep con
-
-isLitLitArg (StgConArg (Literal x)) = isLitLitLit x
-isLitLitArg _ = False
+getArgPrimRep (StgVarArg local) = idPrimRep local
+getArgPrimRep (StgLitArg lit) = literalPrimRep lit
+
+isLitLitArg (StgLitArg lit) = isLitLitLit lit
+isLitLitArg _ = False
+
+isStgTypeArg (StgTypeArg _) = True
+isStgTypeArg other = False
+
+isDllArg :: StgArg -> Bool
+ -- Does this argument refer to something in a different DLL?
+isDllArg (StgVarArg v) = isDllName (idName v)
+isDllArg (StgLitArg lit) = isLitLitLit lit
+
+isDllConApp :: DataCon -> [StgArg] -> Bool
+ -- Does this constructor application refer to
+ -- anything in a different DLL?
+ -- If so, we can't allocate it statically
+isDllConApp con args = isDllName (dataConName con) || any isDllArg args
+
+stgArgType :: StgArg -> Type
+ -- Very half baked becase we have lost the type arguments
+stgArgType (StgVarArg v) = idType v
+stgArgType (StgLitArg lit) = literalType lit
\end{code}
%************************************************************************
data GenStgExpr bndr occ
= StgApp
occ -- function
- [GenStgArg occ] -- arguments
-
- -- NB: a literal is: StgApp <lit-atom> [] ...
+ [GenStgArg occ] -- arguments; may be empty
\end{code}
%************************************************************************
%* *
-\subsubsection{@StgCon@ and @StgPrim@---saturated applications}
+\subsubsection{@StgConApp@ and @StgPrimApp@---saturated applications}
%* *
%************************************************************************
There are a specialised forms of application, for
constructors, primitives, and literals.
\begin{code}
- | StgCon -- always saturated
- Con
- [GenStgArg occ]
-
- Type -- Result type; this is needed for primops, where
- -- we need to know the result type so that we can
- -- assign result registers.
-
+ | StgLit Literal
+
+ | StgConApp DataCon
+ [GenStgArg occ] -- Saturated
+
+ | StgPrimApp PrimOp
+ [GenStgArg occ] -- Saturated
+ Type -- Result type; we need to know the result type
+ -- so that we can assign result registers.
\end{code}
-These forms are to do ``inline versions,'' as it were.
-An example might be: @f x = x:[]@.
%************************************************************************
%* *
\begin{code}
| StgLam
Type -- Type of whole lambda (useful when making a binder for it)
- [Id]
+ [bndr]
StgExpr -- Body of lambda
\end{code}
Just like in @CoreSyntax@ (except no type-world stuff).
+* Algebraic cases are done using
+ StgAlgAlts (Just tc) alts deflt
+
+* Polymorphic cases, or case of a function type, are done using
+ StgAlgAlts Nothing [] (StgBindDefault e)
+
+* Primitive cases are done using
+ StgPrimAlts tc alts deflt
+
+We thought of giving polymorphic cases their own constructor,
+but we get a bit more code sharing this way
+
+The type constructor in StgAlgAlts/StgPrimAlts is guaranteed not
+to be abstract; that is, we can see its representation. This is
+important because the code generator uses it to determine return
+conventions etc. But it's not trivial where there's a moduule loop
+involved, because some versions of a type constructor might not have
+all the constructors visible. So mkStgAlgAlts (in CoreToStg) ensures
+that it gets the TyCon from the constructors or literals (which are
+guaranteed to have the Real McCoy) rather than from the scrutinee type.
+
\begin{code}
data GenStgCaseAlts bndr occ
- = StgAlgAlts Type -- so we can find out things about constructor family
+ = StgAlgAlts (Maybe TyCon) -- Just tc => scrutinee type is
+ -- an algebraic data type
+ -- Nothing => scrutinee type is a type
+ -- variable or function type
[(DataCon, -- alts: data constructor,
[bndr], -- constructor's parameters,
[Bool], -- "use mask", same length as
-- used in the ...
GenStgExpr bndr occ)] -- ...right-hand side.
(GenStgCaseDefault bndr occ)
- | StgPrimAlts Type -- so we can find out things about constructor family
+
+ | StgPrimAlts TyCon
[(Literal, -- alts: unboxed literal,
GenStgExpr bndr occ)] -- rhs.
(GenStgCaseDefault bndr occ)
pprStgArg :: (Outputable bdee) => GenStgArg bdee -> SDoc
pprStgArg (StgVarArg var) = ppr var
-pprStgArg (StgConArg con) = ppr con
+pprStgArg (StgLitArg con) = ppr con
+pprStgArg (StgTypeArg ty) = char '@' <+> ppr ty
\end{code}
\begin{code}
pprStgExpr :: (Outputable bndr, Outputable bdee, Ord bdee)
=> GenStgExpr bndr bdee -> SDoc
-- special case
-pprStgExpr (StgApp func []) = ppr func
+pprStgExpr (StgLit lit) = ppr lit
-- general case
pprStgExpr (StgApp func args)
\end{code}
\begin{code}
-pprStgExpr (StgCon con args _)
+pprStgExpr (StgConApp con args)
= hsep [ ppr con, brackets (interppSP args)]
+pprStgExpr (StgPrimApp op args _)
+ = hsep [ ppr op, brackets (interppSP args)]
+
pprStgExpr (StgLam _ bndrs body)
=sep [ char '\\' <+> ppr bndrs <+> ptext SLIT("->"),
pprStgExpr body ]
ptext SLIT("]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
ptext SLIT("]; "),
pprMaybeSRT srt])),
- nest 2 (ppr_alts alts),
+ nest 2 (pprStgAlts alts),
char '}']
where
- ppr_default StgNoDefault = empty
- ppr_default (StgBindDefault expr)
- = hang (hsep [ptext SLIT("DEFAULT"), ptext SLIT("->")]) 4 (ppr expr)
+ pp_ty (StgAlgAlts maybe_tycon _ _) = ppr maybe_tycon
+ pp_ty (StgPrimAlts tycon _ _) = ppr tycon
- pp_ty (StgAlgAlts ty _ _) = ppr ty
- pp_ty (StgPrimAlts ty _ _) = ppr ty
-
- ppr_alts (StgAlgAlts ty alts deflt)
+pprStgAlts (StgAlgAlts _ alts deflt)
= vcat [ vcat (map (ppr_bxd_alt) alts),
- ppr_default deflt ]
+ pprStgDefault deflt ]
where
ppr_bxd_alt (con, params, use_mask, expr)
= hang (hsep [ppr con, interppSP params, ptext SLIT("->")])
4 ((<>) (ppr expr) semi)
- ppr_alts (StgPrimAlts ty alts deflt)
+pprStgAlts (StgPrimAlts _ alts deflt)
= vcat [ vcat (map (ppr_ubxd_alt) alts),
- ppr_default deflt ]
+ pprStgDefault deflt ]
where
ppr_ubxd_alt (lit, expr)
= hang (hsep [ppr lit, ptext SLIT("->")])
4 ((<>) (ppr expr) semi)
+
+pprStgDefault StgNoDefault = empty
+pprStgDefault (StgBindDefault expr) = hang (hsep [ptext SLIT("DEFAULT"), ptext SLIT("->")])
+ 4 (ppr expr)
+
\end{code}
\begin{code}
projects / ghc-hetmet.git / blobdiff