%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[StgSyn]{Shared term graph (STG) syntax for spineless-tagless code generation}
#include "HsVersions.h"
module StgSyn (
- StgAtom(..),
- StgLiveVars(..),
+ GenStgArg(..),
+ GenStgLiveVars(..),
- StgBinding(..), StgExpr(..), StgRhs(..),
- StgCaseAlternatives(..), StgCaseDefault(..),
-#ifdef DPH
- StgParCommunicate(..),
-#endif {- Data Parallel Haskell -}
+ GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
+ GenStgCaseAlts(..), GenStgCaseDefault(..),
UpdateFlag(..),
combineStgBinderInfo,
-- a set of synonyms for the most common (only :-) parameterisation
- PlainStgAtom(..), PlainStgLiveVars(..), PlainStgProgram(..),
- PlainStgBinding(..), PlainStgExpr(..), PlainStgRhs(..),
- PlainStgCaseAlternatives(..), PlainStgCaseDefault(..),
+ StgArg(..), StgLiveVars(..),
+ StgBinding(..), StgExpr(..), StgRhs(..),
+ StgCaseAlts(..), StgCaseDefault(..),
pprPlainStgBinding,
---UNUSED: fvsFromAtoms,
- getAtomKind,
- isLitLitStgAtom,
+ getArgPrimRep,
+ isLitLitArg,
stgArity,
- collectExportedStgBinders,
+ collectExportedStgBinders
-- and to make the interface self-sufficient...
- Outputable(..), NamedThing(..), Pretty(..),
- Unique, ExportFlag, SrcLoc, PprStyle, PrettyRep,
-
- BasicLit, Class, ClassOp,
-
- Binds, Expr, GRHS, GRHSsAndBinds, InPat,
-
- Id, IdInfo, Maybe, Name, FullName, ShortName,
- PrimKind, PrimOp, CostCentre, TyCon, TyVar,
- UniqSet(..), UniqFM, Bag,
- TyVarTemplate, UniType, TauType(..),
- ThetaType(..), SigmaType(..),
- TyVarEnv(..), IdEnv(..)
-
- IF_ATTACK_PRAGMAS(COMMA isLitLitLit)
- IF_ATTACK_PRAGMAS(COMMA cmpTyCon COMMA cmpTyVar COMMA cmpClass)
- IF_ATTACK_PRAGMAS(COMMA cmpUniType)
) where
-import AbsPrel ( getPrimOpResultInfo, PrimOpResultInfo(..),
- PrimOp, PrimKind
+import Ubiq{-uitous-}
+
+{-
+import PrelInfo ( getPrimOpResultInfo, PrimOpResultInfo(..),
+ PrimOp, PrimRep
IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
)
-import AbsSyn ( Binds, Expr, GRHS, GRHSsAndBinds, InPat )
-import AbsUniType
-import BasicLit ( typeOfBasicLit, kindOfBasicLit, isLitLitLit,
- BasicLit(..) -- (..) for pragmas
+import HsSyn ( HsBinds, HsExpr, GRHS, GRHSsAndBinds, InPat )
+import Type
+import Literal ( literalPrimRep, isLitLitLit,
+ Literal(..) -- (..) for pragmas
)
-import Id ( getIdUniType, getIdKind, toplevelishId,
+import Id ( idType, getIdPrimRep, toplevelishId,
isTopLevId, Id, IdInfo
)
import Maybes ( Maybe(..), catMaybes )
import Outputable
import Pretty
-import PrimKind ( PrimKind )
import CostCentre ( showCostCentre, CostCentre )
import UniqSet
-import Unique
import Util
+-}
\end{code}
%************************************************************************
%* *
-\subsection[StgBinding]{@StgBinding@}
+\subsection{@GenStgBinding@}
%* *
%************************************************************************
As usual, expressions are interesting; other things are boring. Here
-are the boring things [except note the @StgRhs@], parameterised with
-respect to binder and bindee information (just as in @CoreSyntax@):
-\begin{code}
-data StgBinding binder bindee
- = StgNonRec binder (StgRhs binder bindee)
- | StgRec [(binder, StgRhs binder bindee)]
-\end{code}
+are the boring things [except note the @GenStgRhs@], parameterised
+with respect to binder and occurrence information (just as in
+@CoreSyn@):
-An @StgProgram@ is just a list of @StgBindings@; the
-properties/restrictions-on this list are the same as for a
-@CoreProgram@ (a list of @CoreBindings@).
\begin{code}
---type StgProgram binder bindee = [StgBinding binder bindee]
+data GenStgBinding bndr occ
+ = StgNonRec bndr (GenStgRhs bndr occ)
+ | StgRec [(bndr, GenStgRhs bndr occ)]
\end{code}
%************************************************************************
%* *
-\subsection[StgAtom]{@StgAtom@}
+\subsection{@GenStgArg@}
%* *
%************************************************************************
\begin{code}
-data StgAtom bindee
- = StgVarAtom bindee
- | StgLitAtom BasicLit
+data GenStgArg occ
+ = StgVarArg occ
+ | StgLitArg Literal
\end{code}
\begin{code}
-getAtomKind (StgVarAtom local) = getIdKind local
-getAtomKind (StgLitAtom lit) = kindOfBasicLit lit
+getArgPrimRep (StgVarArg local) = getIdPrimRep local
+getArgPrimRep (StgLitArg lit) = literalPrimRep lit
-{- UNUSED happily
-fvsFromAtoms :: [PlainStgAtom] -> (UniqSet Id) -- ToDo: this looks like a HACK to me (WDP)
-fvsFromAtoms as = mkUniqSet [ id | (StgVarAtom id) <- as, not (toplevelishId id) ]
--}
-
-isLitLitStgAtom (StgLitAtom x) = isLitLitLit x
-isLitLitStgAtom _ = False
+isLitLitArg (StgLitArg x) = isLitLitLit x
+isLitLitArg _ = False
\end{code}
%************************************************************************
%* *
-\subsection[StgExpr]{STG expressions}
+\subsection{STG expressions}
%* *
%************************************************************************
-The @StgExpr@ data type is parameterised on binder and bindee info, as
-before.
+The @GenStgExpr@ data type is parameterised on binder and occurrence
+info, as before.
%************************************************************************
%* *
-\subsubsection[StgExpr-application]{@StgExpr@ application}
+\subsubsection{@GenStgExpr@ application}
%* *
%************************************************************************
There is no constructor for a lone variable; it would appear as
@StgApp var [] _@.
\begin{code}
-type StgLiveVars bindee = UniqSet bindee
+type GenStgLiveVars occ = UniqSet occ
-data StgExpr binder bindee
- = StgApp
- (StgAtom bindee) -- function
- [StgAtom bindee] -- arguments
- (StgLiveVars bindee) -- Live vars in continuation; ie not
+data GenStgExpr bndr occ
+ = StgApp
+ (GenStgArg occ) -- function
+ [GenStgArg occ] -- arguments
+ (GenStgLiveVars occ) -- Live vars in continuation; ie not
-- including the function and args
-- NB: a literal is: StgApp <lit-atom> [] ...
%************************************************************************
%* *
-\subsubsection[StgExpr-apps]{@StgConApp@ and @StgPrimApp@---saturated applications}
+\subsubsection{@StgCon@ and @StgPrim@---saturated applications}
%* *
%************************************************************************
There are two specialised forms of application, for
constructors and primitives.
\begin{code}
- | StgConApp -- always saturated
+ | StgCon -- always saturated
Id -- data constructor
- [StgAtom bindee]
- (StgLiveVars bindee) -- Live vars in continuation; ie not
+ [GenStgArg occ]
+ (GenStgLiveVars occ) -- Live vars in continuation; ie not
-- including the constr and args
- | StgPrimApp -- always saturated
+ | StgPrim -- always saturated
PrimOp
- [StgAtom bindee]
- (StgLiveVars bindee) -- Live vars in continuation; ie not
+ [GenStgArg occ]
+ (GenStgLiveVars occ) -- Live vars in continuation; ie not
-- including the op and args
\end{code}
These forms are to do ``inline versions,'' as it were.
%************************************************************************
%* *
-\subsubsection[StgExpr-case]{@StgExpr@: case-expressions}
+\subsubsection{@GenStgExpr@: case-expressions}
%* *
%************************************************************************
This has the same boxed/unboxed business as Core case expressions.
\begin{code}
| StgCase
- (StgExpr binder bindee)
+ (GenStgExpr bndr occ)
-- the thing to examine
- (StgLiveVars bindee) -- Live vars of whole case
+ (GenStgLiveVars occ) -- Live vars of whole case
-- expression; i.e., those which mustn't be
-- overwritten
- (StgLiveVars bindee) -- Live vars of RHSs;
+ (GenStgLiveVars occ) -- Live vars of RHSs;
-- i.e., those which must be saved before eval.
--
-- note that an alt's constructor's
-- variable to hold the tag of a primop with
-- algebraic result
- (StgCaseAlternatives binder bindee)
+ (GenStgCaseAlts bndr occ)
\end{code}
%************************************************************************
%* *
-\subsubsection[StgExpr-lets]{@StgExpr@: @let(rec)@-expressions}
+\subsubsection{@GenStgExpr@: @let(rec)@-expressions}
%* *
%************************************************************************
\item
We may eventually want:
\begin{verbatim}
-let-literal x = BasicLit
+let-literal x = Literal
in e
\end{verbatim}
And so the code for let(rec)-things:
\begin{code}
| StgLet
- (StgBinding binder bindee) -- right hand sides (see below)
- (StgExpr binder bindee) -- body
+ (GenStgBinding bndr occ) -- right hand sides (see below)
+ (GenStgExpr bndr occ) -- body
| StgLetNoEscape -- remember: ``advanced stuff''
- (StgLiveVars bindee) -- Live in the whole let-expression
+ (GenStgLiveVars occ) -- Live in the whole let-expression
-- Mustn't overwrite these stack slots
-- *Doesn't* include binders of the let(rec).
- (StgLiveVars bindee) -- Live in the right hand sides (only)
+ (GenStgLiveVars occ) -- Live in the right hand sides (only)
-- These are the ones which must be saved on
-- the stack if they aren't there already
-- *Does* include binders of the let(rec) if recursive.
- (StgBinding binder bindee) -- right hand sides (see below)
- (StgExpr binder bindee) -- body
+ (GenStgBinding bndr occ) -- right hand sides (see below)
+ (GenStgExpr bndr occ) -- body
\end{code}
%************************************************************************
%* *
-\subsubsection[StgExpr-scc]{@StgExpr@: @scc@ expressions}
+\subsubsection{@GenStgExpr@: @scc@ expressions}
%* *
%************************************************************************
\begin{code}
| StgSCC
- UniType -- the type of the body
+ Type -- the type of the body
CostCentre -- label of SCC expression
- (StgExpr binder bindee) -- scc expression
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[DataParallel]{Data parallel extensions to STG syntax}
-%* *
-%************************************************************************
-
-\begin{code}
-#ifdef DPH
- | StgParConApp -- saturated parallel constructor
- Id
- Int -- What parallel context
- [StgAtom bindee]
- (StgLiveVars bindee)
-
- | StgParComm
- Int
- (StgExpr binder bindee) -- The thing we are communicating
- (StgParCommunicate binder bindee)
-#endif {- Data Parallel Haskell -}
- -- end of StgExpr
+ (GenStgExpr bndr occ) -- scc expression
+ -- end of GenStgExpr
\end{code}
%************************************************************************
%* *
-\subsection[StgRhs]{STG right-hand sides}
+\subsection{STG right-hand sides}
%* *
%************************************************************************
Here's the rest of the interesting stuff for @StgLet@s; the first
flavour is for closures:
\begin{code}
-data StgRhs binder bindee
+data GenStgRhs bndr occ
= StgRhsClosure
CostCentre -- cost centre to be attached (default is CCC)
StgBinderInfo -- Info about how this binder is used (see below)
- [bindee] -- non-global free vars; a list, rather than
+ [occ] -- non-global free vars; a list, rather than
-- a set, because order is important
UpdateFlag -- ReEntrant | Updatable | SingleEntry
- [binder] -- arguments; if empty, then not a function;
+ [bndr] -- arguments; if empty, then not a function;
-- as above, order is important
- (StgExpr binder bindee) -- body
+ (GenStgExpr bndr occ) -- body
\end{code}
An example may be in order. Consider:
\begin{verbatim}
-- data in heap profiles, and we don't set CCC
-- from static closure.
Id -- constructor
- [StgAtom bindee] -- args
+ [GenStgArg occ] -- args
\end{code}
Here's the @StgBinderInfo@ type, and its combining op:
\begin{code}
-data StgBinderInfo
+data StgBinderInfo
= NoStgBinderInfo
-
| StgBinderInfo
Bool -- At least one occurrence as an argument
Bool -- At least one fake application occurrence, that is
-- an StgApp f args where args is an empty list
-- This is due to the fact that we do not have a
- -- StgVar constructor.
+ -- StgVar constructor.
-- Used by the lambda lifter.
-- True => "at least one unsat app" is True too
stgNoUpdHeapOcc = StgBinderInfo False False False True False
stgNormalOcc = StgBinderInfo False False False False False
-- [Andre] can't think of a good name for the last one.
-stgFakeFunAppOcc = StgBinderInfo False True False False True
+stgFakeFunAppOcc = StgBinderInfo False True False False True
combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
Just like in @CoreSyntax@ (except no type-world stuff).
\begin{code}
-data StgCaseAlternatives binder bindee
- = StgAlgAlts UniType -- so we can find out things about constructor family
+data GenStgCaseAlts bndr occ
+ = StgAlgAlts Type -- so we can find out things about constructor family
[(Id, -- alts: data constructor,
- [binder], -- constructor's parameters,
+ [bndr], -- constructor's parameters,
[Bool], -- "use mask", same length as
-- parameters; a True in a
-- param's position if it is
-- used in the ...
- StgExpr binder bindee)] -- ...right-hand side.
- (StgCaseDefault binder bindee)
- | StgPrimAlts UniType -- so we can find out things about constructor family
- [(BasicLit, -- alts: unboxed literal,
- StgExpr binder bindee)] -- rhs.
- (StgCaseDefault binder bindee)
-#ifdef DPH
- | StgParAlgAlts
- UniType
- Int -- What context we are in
- [binder]
- [(Id,StgExpr binder bindee)]
- (StgCaseDefault binder bindee)
- | StgParPrimAlts UniType
- Int -- What context we are in
- [(BasicLit, -- alts: unboxed literal,
- StgExpr binder bindee)] -- rhs.
- (StgCaseDefault binder bindee)
-#endif {- Data Parallel Haskell -}
-
-data StgCaseDefault binder bindee
+ GenStgExpr bndr occ)] -- ...right-hand side.
+ (GenStgCaseDefault bndr occ)
+ | StgPrimAlts Type -- so we can find out things about constructor family
+ [(Literal, -- alts: unboxed literal,
+ GenStgExpr bndr occ)] -- rhs.
+ (GenStgCaseDefault bndr occ)
+
+data GenStgCaseDefault bndr occ
= StgNoDefault -- small con family: all
-- constructor accounted for
- | StgBindDefault binder -- form: var -> expr
+ | StgBindDefault bndr -- form: var -> expr
Bool -- True <=> var is used in rhs
-- i.e., False <=> "_ -> expr"
- (StgExpr binder bindee)
+ (GenStgExpr bndr occ)
\end{code}
%************************************************************************
%* *
-\subsection[Stg-parComummunicate]{Communication operations}
-%* *
-%************************************************************************
-
-\begin{code}
-#ifdef DPH
-data StgParCommunicate binder bindee
- = StgParSend
- [StgAtom bindee] -- Sending PODs
-
- | StgParFetch
- [StgAtom bindee] -- Fetching PODs
-
- | StgToPodized -- Convert a POD to the podized form
-
- | StgFromPodized -- Convert a POD from the podized form
-#endif {- Data Parallel Haskell -}
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[PlainStg]{The Plain STG parameterisation}
+\subsection[Stg]{The Plain STG parameterisation}
%* *
%************************************************************************
This happens to be the only one we use at the moment.
\begin{code}
-type PlainStgProgram = [StgBinding Id Id]
-type PlainStgBinding = StgBinding Id Id
-type PlainStgAtom = StgAtom Id
-type PlainStgLiveVars= UniqSet Id
-type PlainStgExpr = StgExpr Id Id
-type PlainStgRhs = StgRhs Id Id
-type PlainStgCaseAlternatives = StgCaseAlternatives Id Id
-type PlainStgCaseDefault = StgCaseDefault Id Id
+type StgBinding = GenStgBinding Id Id
+type StgArg = GenStgArg Id
+type StgLiveVars = GenStgLiveVars Id
+type StgExpr = GenStgExpr Id Id
+type StgRhs = GenStgRhs Id Id
+type StgCaseAlts = GenStgCaseAlts Id Id
+type StgCaseDefault = GenStgCaseDefault Id Id
\end{code}
%************************************************************************
\subsubsection[UpdateFlag-datatype]{@UpdateFlag@}
%* *
%************************************************************************
-
+
This is also used in @LambdaFormInfo@ in the @ClosureInfo@ module.
-
+
\begin{code}
data UpdateFlag = ReEntrant | Updatable | SingleEntry
-
+
instance Outputable UpdateFlag where
ppr sty u
= ppChar (case u of { ReEntrant -> 'r'; Updatable -> 'u'; SingleEntry -> 's' })
\begin{code}
collectExportedStgBinders
- :: [PlainStgBinding] -- input: PlainStgProgram
+ :: [StgBinding] -- input program
-> [Id] -- exported top-level Ids
collectExportedStgBinders binds
- = exported_from_here [] binds
+ = ex [] binds
where
- exported_from_here es [] = es
+ ex es [] = es
- exported_from_here es ((StgNonRec b _) : binds)
+ ex es ((StgNonRec b _) : binds)
= if not (isExported b) then
- exported_from_here es binds
+ ex es binds
else
- exported_from_here (b:es) binds
+ ex (b:es) binds
- exported_from_here es ((StgRec []) : binds)
- = exported_from_here es binds
+ ex es ((StgRec []) : binds) = ex es binds
- exported_from_here es ((StgRec ((b, rhs) : pairs)) : binds)
- = exported_from_here
- es
- (StgNonRec b rhs : (StgRec pairs : binds))
+ ex es ((StgRec ((b, rhs) : pairs)) : binds)
+ = ex es (StgNonRec b rhs : (StgRec pairs : binds))
-- OK, a total hack; laziness rules
\end{code}
\begin{code}
pprStgBinding :: (Outputable bndr, Outputable bdee, Ord bdee) =>
- PprStyle -> StgBinding bndr bdee -> Pretty
+ PprStyle -> GenStgBinding bndr bdee -> Pretty
-pprStgBinding sty (StgNonRec binder rhs)
- = ppHang (ppCat [ppr sty binder, ppEquals])
+pprStgBinding sty (StgNonRec bndr rhs)
+ = ppHang (ppCat [ppr sty bndr, ppEquals])
4 (ppBeside (ppr sty rhs) ppSemi)
pprStgBinding sty (StgRec pairs)
= ppAboves ((ifPprDebug sty (ppStr "{- StgRec -}")) :
(map (ppr_bind sty) pairs))
where
- ppr_bind sty (binder, expr)
- = ppHang (ppCat [ppr sty binder, ppEquals])
+ ppr_bind sty (bndr, expr)
+ = ppHang (ppCat [ppr sty bndr, ppEquals])
4 (ppBeside (ppr sty expr) ppSemi)
-pprPlainStgBinding :: PprStyle -> PlainStgBinding -> Pretty
+pprPlainStgBinding :: PprStyle -> StgBinding -> Pretty
pprPlainStgBinding sty b = pprStgBinding sty b
\end{code}
\begin{code}
-instance (Outputable bdee) => Outputable (StgAtom bdee) where
- ppr = pprStgAtom
+instance (Outputable bdee) => Outputable (GenStgArg bdee) where
+ ppr = pprStgArg
instance (Outputable bndr, Outputable bdee, Ord bdee)
- => Outputable (StgBinding bndr bdee) where
+ => Outputable (GenStgBinding bndr bdee) where
ppr = pprStgBinding
instance (Outputable bndr, Outputable bdee, Ord bdee)
- => Outputable (StgExpr bndr bdee) where
+ => Outputable (GenStgExpr bndr bdee) where
ppr = pprStgExpr
-{- OLD:
instance (Outputable bndr, Outputable bdee, Ord bdee)
- => Outputable (StgCaseDefault bndr bdee) where
- ppr sty deflt = panic "ppr:StgCaseDefault"
--}
-
-instance (Outputable bndr, Outputable bdee, Ord bdee)
- => Outputable (StgRhs bndr bdee) where
+ => Outputable (GenStgRhs bndr bdee) where
ppr sty rhs = pprStgRhs sty rhs
\end{code}
\begin{code}
-pprStgAtom :: (Outputable bdee) => PprStyle -> StgAtom bdee -> Pretty
+pprStgArg :: (Outputable bdee) => PprStyle -> GenStgArg bdee -> Pretty
-pprStgAtom sty (StgVarAtom var) = ppr sty var
-pprStgAtom sty (StgLitAtom lit) = ppr sty lit
+pprStgArg sty (StgVarArg var) = ppr sty var
+pprStgArg sty (StgLitArg lit) = ppr sty lit
\end{code}
\begin{code}
pprStgExpr :: (Outputable bndr, Outputable bdee, Ord bdee) =>
- PprStyle -> StgExpr bndr bdee -> Pretty
+ PprStyle -> GenStgExpr bndr bdee -> Pretty
-- special case
pprStgExpr sty (StgApp func [] lvs)
= ppBeside (ppr sty func) (pprStgLVs sty lvs)
\end{code}
\begin{code}
-pprStgExpr sty (StgConApp con args lvs)
+pprStgExpr sty (StgCon con args lvs)
= ppBesides [ ppBeside (ppr sty con) (pprStgLVs sty lvs),
ppStr "! [", interppSP sty args, ppStr "]" ]
-pprStgExpr sty (StgPrimApp op args lvs)
+pprStgExpr sty (StgPrim op args lvs)
= ppBesides [ ppr sty op, ppChar '#', pprStgLVs sty lvs,
ppStr " [", interppSP sty args, ppStr "]" ]
\end{code}
-- special case: let v = <very specific thing>
-- in
-- let ...
--- in
+-- in
-- ...
--
-- Very special! Suspicious! (SLPJ)
-pprStgExpr sty (StgLet (StgNonRec binder (StgRhsClosure cc bi free_vars upd_flag args rhs))
+pprStgExpr sty (StgLet (StgNonRec bndr (StgRhsClosure cc bi free_vars upd_flag args rhs))
expr@(StgLet _ _))
= ppAbove
- (ppHang (ppBesides [ppStr "let { ", ppr sty binder, ppStr " = ",
- ppStr (showCostCentre sty True{-as string-} cc),
+ (ppHang (ppBesides [ppStr "let { ", ppr sty bndr, ppStr " = ",
+ ppStr (showCostCentre sty True{-as string-} cc),
pp_binder_info sty bi,
- ppStr " [", ifPprDebug sty (interppSP sty free_vars), ppStr "] \\",
- ppr sty upd_flag, ppStr " [",
- interppSP sty args, ppStr "]"])
+ ppStr " [", ifPprDebug sty (interppSP sty free_vars), ppStr "] \\",
+ ppr sty upd_flag, ppStr " [",
+ interppSP sty args, ppStr "]"])
8 (ppSep [ppCat [ppr sty rhs, ppStr "} in"]]))
(ppr sty expr)
= ppHang (ppCat [ppr sty lit, ppStr "->"])
4 (ppBeside (ppr sty expr) ppSemi)
-#ifdef DPH
- ppr_alts sty (StgParAlgAlts ty dim params alts deflt)
- = ppAboves [ ppBeside (ppCat (map (ppr sty) params))
- (ppCat [ppStr "|" , ppr sty dim , ppStr "|"]),
- ppAboves (map (ppr_bxd_alt sty) alts),
- ppr_default sty deflt ]
- where
- ppr_bxd_alt sty (con, expr)
- = ppHang (ppCat [ppStr "\\/", ppr_con sty con, ppStr "->"])
- 4 (ppr sty expr)
- where
- ppr_con sty con
- = if isOpLexeme con
- then ppBesides [ppLparen, ppr sty con, ppRparen]
- else ppr sty con
-
- ppr_alts sty (StgParPrimAlts ty dim alts deflt)
- = ppAboves [ ifPprShowAll sty (ppr sty ty),
- ppCat [ppStr "|" , ppr sty dim , ppStr "|"],
- ppAboves (map (ppr_ubxd_alt sty) alts),
- ppr_default sty deflt ]
- where
- ppr_ubxd_alt sty (lit, expr)
- = ppHang (ppCat [ppStr "\\/", ppr sty lit, ppStr "->"]) 4 (ppr sty expr)
-#endif {- Data Parallel Haskell -}
-
ppr_default sty StgNoDefault = ppNil
- ppr_default sty (StgBindDefault binder used expr)
+ ppr_default sty (StgBindDefault bndr used expr)
= ppHang (ppCat [pp_binder, ppStr "->"]) 4 (ppr sty expr)
where
- pp_binder = if used then ppr sty binder else ppChar '_'
-\end{code}
-
-\begin{code}
-#ifdef DPH
-pprStgExpr sty (StgParConApp con dim args lvs)
- = ppBesides [ppr sty con, pprStgLVs sty lvs, ppStr "!<<" ,ppr sty dim ,
- ppStr ">> [", interppSP sty args, ppStr "]" ]
-
-pprStgExpr sty (StgParComm dim expr comm)
- = ppSep [ppSep [ppStr "COMM ",
- ppNest 2 (pprStgExpr sty expr),ppStr "{"],
- ppNest 2 (ppr_comm sty comm),
- ppStr "}"]
- where
- ppr_comm sty (StgParSend args)
- = ppSep [ppStr "SEND [",interppSP sty args, ppStr "]" ]
- ppr_comm sty (StgParFetch args)
- = ppSep [ppStr "FETCH [",interppSP sty args, ppStr "]" ]
- ppr_comm sty (StgToPodized)
- = ppStr "ToPodized"
- ppr_comm sty (StgFromPodized)
- = ppStr "FromPodized"
-#endif {- Data Parallel Haskell -}
+ pp_binder = if used then ppr sty bndr else ppChar '_'
\end{code}
\begin{code}
--- pprStgLVs :: PprStyle -> StgLiveVars bindee -> Pretty
+-- pprStgLVs :: PprStyle -> GenStgLiveVars occ -> Pretty
pprStgLVs PprForUser lvs = ppNil
\begin{code}
pprStgRhs :: (Outputable bndr, Outputable bdee, Ord bdee) =>
- PprStyle -> StgRhs bndr bdee -> Pretty
+ PprStyle -> GenStgRhs bndr bdee -> Pretty
-- special case
pprStgRhs sty (StgRhsClosure cc bi [free_var] upd_flag [{-no args-}] (StgApp func [] lvs))
from the STG bindings.
\begin{code}
-stgArity :: PlainStgRhs -> Int
+stgArity :: StgRhs -> Int
stgArity (StgRhsCon _ _ _) = 0 -- it's a constructor, fully applied
stgArity (StgRhsClosure _ _ _ _ args _ ) = length args
projects / ghc-hetmet.git / blobdiff