Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
4,323
Issues
4,323
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
363
Merge Requests
363
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
9d4d03d5
Commit
9d4d03d5
authored
May 18, 1997
by
sof
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[project @ 1997-05-18 23:04:57 by sof]
2.0x bootable;new PP
parent
7f1218d8
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
104 additions
and
101 deletions
+104
-101
ghc/compiler/stgSyn/StgSyn.lhs
ghc/compiler/stgSyn/StgSyn.lhs
+80
-79
ghc/compiler/stranal/SaAbsInt.lhs
ghc/compiler/stranal/SaAbsInt.lhs
+8
-7
ghc/compiler/stranal/SaLib.lhs
ghc/compiler/stranal/SaLib.lhs
+9
-9
ghc/compiler/stranal/StrictAnal.lhs
ghc/compiler/stranal/StrictAnal.lhs
+7
-6
No files found.
ghc/compiler/stgSyn/StgSyn.lhs
View file @
9d4d03d5
...
...
@@ -39,18 +39,19 @@ module StgSyn (
IMP_Ubiq(){-uitous-}
import CostCentre ( showCostCentre )
import Id ( idPrimRep, SYN_IE(DataCon), GenId{-instance NamedThing-} )
import CostCentre ( showCostCentre, CostCentre )
import Id ( idPrimRep, SYN_IE(DataCon),
GenId{-instance NamedThing-}, SYN_IE(Id) )
import Literal ( literalPrimRep, isLitLitLit, Literal{-instance Outputable-} )
import Name ( pprNonSym )
import Outputable ( ifPprDebug, interppSP, interpp'SP,
Outputable(..){-instance * Bool-}
)
import PprStyle ( PprStyle(..) )
import PprStyle ( PprStyle(..)
, userStyle
)
import PprType ( GenType{-instance Outputable-} )
import Pretty -- all of it
import PrimOp ( PrimOp{-instance Outputable-} )
import Unique ( pprUnique )
import Type ( SYN_IE(Type) )
import Unique ( pprUnique, Unique )
import UniqSet ( isEmptyUniqSet, uniqSetToList, SYN_IE(UniqSet) )
import Util ( panic )
\end{code}
...
...
@@ -463,7 +464,7 @@ data UpdateFlag = ReEntrant | Updatable | SingleEntry
instance Outputable UpdateFlag where
ppr sty u
=
ppC
har (case u of { ReEntrant -> 'r'; Updatable -> 'u'; SingleEntry -> 's' })
=
c
har (case u of { ReEntrant -> 'r'; Updatable -> 'u'; SingleEntry -> 's' })
\end{code}
%************************************************************************
...
...
@@ -498,25 +499,25 @@ hoping he likes terminators instead... Ditto for case alternatives.
\begin{code}
pprStgBinding :: (Outputable bndr, Outputable bdee, Ord bdee) =>
PprStyle -> GenStgBinding bndr bdee ->
Pretty
PprStyle -> GenStgBinding bndr bdee ->
Doc
pprStgBinding sty (StgNonRec bndr rhs)
=
ppHang (ppCat [ppr sty bndr, ppE
quals])
4 (
ppBeside (ppr sty rhs) ppS
emi)
=
hang (hsep [ppr sty bndr, e
quals])
4 (
(<>) (ppr sty rhs) s
emi)
pprStgBinding sty (StgCoerceBinding bndr occ)
=
ppHang (ppCat [ppr sty bndr, ppEquals, ppPStr
SLIT("{-Coerce-}")])
4 (
ppBeside (ppr sty occ) ppS
emi)
=
hang (hsep [ppr sty bndr, equals, ptext
SLIT("{-Coerce-}")])
4 (
(<>) (ppr sty occ) s
emi)
pprStgBinding sty (StgRec pairs)
=
ppAboves ((ifPprDebug sty (ppPStr
SLIT("{- StgRec (begin) -}"))) :
(map (ppr_bind sty) pairs) ++ [(ifPprDebug sty (p
pPStr
SLIT("{- StgRec (end) -}")))])
=
vcat ((ifPprDebug sty (ptext
SLIT("{- StgRec (begin) -}"))) :
(map (ppr_bind sty) pairs) ++ [(ifPprDebug sty (p
text
SLIT("{- StgRec (end) -}")))])
where
ppr_bind sty (bndr, expr)
=
ppHang (ppCat [ppr sty bndr, ppE
quals])
4 (
ppBeside (ppr sty expr) ppS
emi)
=
hang (hsep [ppr sty bndr, e
quals])
4 (
(<>) (ppr sty expr) s
emi)
pprPlainStgBinding :: PprStyle -> StgBinding ->
Pretty
pprPlainStgBinding :: PprStyle -> StgBinding ->
Doc
pprPlainStgBinding sty b = pprStgBinding sty b
\end{code}
...
...
@@ -538,7 +539,7 @@ instance (Outputable bndr, Outputable bdee, Ord bdee)
\end{code}
\begin{code}
pprStgArg :: (Outputable bdee) => PprStyle -> GenStgArg bdee ->
Pretty
pprStgArg :: (Outputable bdee) => PprStyle -> GenStgArg bdee ->
Doc
pprStgArg sty (StgVarArg var) = ppr sty var
pprStgArg sty (StgConArg con) = ppr sty con
...
...
@@ -547,25 +548,25 @@ pprStgArg sty (StgLitArg lit) = ppr sty lit
\begin{code}
pprStgExpr :: (Outputable bndr, Outputable bdee, Ord bdee) =>
PprStyle -> GenStgExpr bndr bdee ->
Pretty
PprStyle -> GenStgExpr bndr bdee ->
Doc
-- special case
pprStgExpr sty (StgApp func [] lvs)
=
ppBeside
(ppr sty func) (pprStgLVs sty lvs)
=
(<>)
(ppr sty func) (pprStgLVs sty lvs)
-- general case
pprStgExpr sty (StgApp func args lvs)
=
ppHang (ppBeside
(ppr sty func) (pprStgLVs sty lvs))
4 (
ppS
ep (map (ppr sty) args))
=
hang ((<>)
(ppr sty func) (pprStgLVs sty lvs))
4 (
s
ep (map (ppr sty) args))
\end{code}
\begin{code}
pprStgExpr sty (StgCon con args lvs)
=
ppBesides [ ppBeside
(ppr sty con) (pprStgLVs sty lvs),
p
pPStr SLIT("! ["), interppSP sty args, ppC
har ']' ]
=
hcat [ (<>)
(ppr sty con) (pprStgLVs sty lvs),
p
text SLIT("! ["), interppSP sty args, c
har ']' ]
pprStgExpr sty (StgPrim op args lvs)
=
ppBesides [ ppr sty op, ppC
har '#', pprStgLVs sty lvs,
p
pPStr SLIT(" ["), interppSP sty args, ppC
har ']' ]
=
hcat [ ppr sty op, c
har '#', pprStgLVs sty lvs,
p
text SLIT(" ["), interppSP sty args, c
har ']' ]
\end{code}
\begin{code}
...
...
@@ -579,131 +580,131 @@ pprStgExpr sty (StgPrim op args lvs)
pprStgExpr sty (StgLet (StgNonRec bndr (StgRhsClosure cc bi free_vars upd_flag args rhs))
expr@(StgLet _ _))
=
ppAbove
(
ppHang (ppBesides [ppPStr SLIT("let { "), ppr sty bndr, ppPStr
SLIT(" = "),
ppStr
(showCostCentre sty True{-as string-} cc),
=
($$)
(
hang (hcat [ptext SLIT("let { "), ppr sty bndr, ptext
SLIT(" = "),
text
(showCostCentre sty True{-as string-} cc),
pp_binder_info sty bi,
p
pPStr SLIT(" ["), ifPprDebug sty (interppSP sty free_vars), ppPStr
SLIT("] \\"),
ppr sty upd_flag, p
pPStr
SLIT(" ["),
interppSP sty args,
ppC
har ']'])
8 (
ppSep [ppCat [ppr sty rhs, ppPStr
SLIT("} in")]]))
p
text SLIT(" ["), ifPprDebug sty (interppSP sty free_vars), ptext
SLIT("] \\"),
ppr sty upd_flag, p
text
SLIT(" ["),
interppSP sty args,
c
har ']'])
8 (
sep [hsep [ppr sty rhs, ptext
SLIT("} in")]]))
(ppr sty expr)
-- special case: let ... in let ...
pprStgExpr sty (StgLet bind expr@(StgLet _ _))
=
ppAbove
(
ppSep [ppHang (ppPStr SLIT("let {")) 2 (ppCat [pprStgBinding sty bind, ppPStr
SLIT("} in")])])
=
($$)
(
sep [hang (ptext SLIT("let {")) 2 (hsep [pprStgBinding sty bind, ptext
SLIT("} in")])])
(ppr sty expr)
-- general case
pprStgExpr sty (StgLet bind expr)
=
ppSep [ppHang (ppPStr
SLIT("let {")) 2 (pprStgBinding sty bind),
ppHang (ppPStr
SLIT("} in ")) 2 (ppr sty expr)]
=
sep [hang (ptext
SLIT("let {")) 2 (pprStgBinding sty bind),
hang (ptext
SLIT("} in ")) 2 (ppr sty expr)]
pprStgExpr sty (StgLetNoEscape lvs_whole lvs_rhss bind expr)
=
ppSep [ppHang (ppPStr
SLIT("let-no-escape {"))
=
sep [hang (ptext
SLIT("let-no-escape {"))
2 (pprStgBinding sty bind),
ppHang (ppBeside (ppPStr
SLIT("} in "))
hang ((<>) (ptext
SLIT("} in "))
(ifPprDebug sty (
ppN
est 4 (
ppBesides [ppPStr
SLIT("-- lvs: ["), interppSP sty (uniqSetToList lvs_whole),
p
pPStr
SLIT("]; rhs lvs: ["), interppSP sty (uniqSetToList lvs_rhss),
ppC
har ']']))))
n
est 4 (
hcat [ptext
SLIT("-- lvs: ["), interppSP sty (uniqSetToList lvs_whole),
p
text
SLIT("]; rhs lvs: ["), interppSP sty (uniqSetToList lvs_rhss),
c
har ']']))))
2 (ppr sty expr)]
\end{code}
\begin{code}
pprStgExpr sty (StgSCC ty cc expr)
=
ppSep [ ppCat [ppPStr SLIT("_scc_"), ppStr
(showCostCentre sty True{-as string-} cc)],
=
sep [ hsep [ptext SLIT("_scc_"), text
(showCostCentre sty True{-as string-} cc)],
pprStgExpr sty expr ]
\end{code}
\begin{code}
pprStgExpr sty (StgCase expr lvs_whole lvs_rhss uniq alts)
=
ppSep [ppSep [ppPStr
SLIT("case"),
ppNest 4 (ppCat
[pprStgExpr sty expr,
ifPprDebug sty (
ppBeside (ppPStr
SLIT("::")) (pp_ty alts))]),
p
pPStr
SLIT("of {")],
=
sep [sep [ptext
SLIT("case"),
nest 4 (hsep
[pprStgExpr sty expr,
ifPprDebug sty (
(<>) (ptext
SLIT("::")) (pp_ty alts))]),
p
text
SLIT("of {")],
ifPprDebug sty (
ppN
est 4 (
ppBesides [ppPStr
SLIT("-- lvs: ["), interppSP sty (uniqSetToList lvs_whole),
p
pPStr
SLIT("]; rhs lvs: ["), interppSP sty (uniqSetToList lvs_rhss),
p
pPStr
SLIT("]; uniq: "), pprUnique uniq])),
ppN
est 2 (ppr_alts sty alts),
ppC
har '}']
n
est 4 (
hcat [ptext
SLIT("-- lvs: ["), interppSP sty (uniqSetToList lvs_whole),
p
text
SLIT("]; rhs lvs: ["), interppSP sty (uniqSetToList lvs_rhss),
p
text
SLIT("]; uniq: "), pprUnique uniq])),
n
est 2 (ppr_alts sty alts),
c
har '}']
where
ppr_default sty StgNoDefault =
ppNil
ppr_default sty StgNoDefault =
empty
ppr_default sty (StgBindDefault bndr used expr)
=
ppHang (ppCat [pp_binder, ppPStr
SLIT("->")]) 4 (ppr sty expr)
=
hang (hsep [pp_binder, ptext
SLIT("->")]) 4 (ppr sty expr)
where
pp_binder = if used then ppr sty bndr else
ppC
har '_'
pp_binder = if used then ppr sty bndr else
c
har '_'
pp_ty (StgAlgAlts ty _ _) = ppr sty ty
pp_ty (StgPrimAlts ty _ _) = ppr sty ty
ppr_alts sty (StgAlgAlts ty alts deflt)
=
ppAboves [ ppAboves
(map (ppr_bxd_alt sty) alts),
=
vcat [ vcat
(map (ppr_bxd_alt sty) alts),
ppr_default sty deflt ]
where
ppr_bxd_alt sty (con, params, use_mask, expr)
=
ppHang (ppCat [pprNonSym sty con, interppSP sty params, ppPStr
SLIT("->")])
4 (
ppBeside (ppr sty expr) ppS
emi)
=
hang (hsep [ppr sty con, interppSP sty params, ptext
SLIT("->")])
4 (
(<>) (ppr sty expr) s
emi)
ppr_alts sty (StgPrimAlts ty alts deflt)
=
ppAboves [ ppAboves
(map (ppr_ubxd_alt sty) alts),
=
vcat [ vcat
(map (ppr_ubxd_alt sty) alts),
ppr_default sty deflt ]
where
ppr_ubxd_alt sty (lit, expr)
=
ppHang (ppCat [ppr sty lit, ppPStr
SLIT("->")])
4 (
ppBeside (ppr sty expr) ppS
emi)
=
hang (hsep [ppr sty lit, ptext
SLIT("->")])
4 (
(<>) (ppr sty expr) s
emi)
\end{code}
\begin{code}
-- pprStgLVs :: PprStyle -> GenStgLiveVars occ ->
Pretty
-- pprStgLVs :: PprStyle -> GenStgLiveVars occ ->
Doc
pprStgLVs
PprForUser lvs = ppNil
pprStgLVs
sty lvs | userStyle sty = empty
pprStgLVs sty lvs
= if isEmptyUniqSet lvs then
ppNil
empty
else
ppBesides [ppStr "{-lvs:", interpp'SP sty (uniqSetToList lvs), ppStr
"-}"]
hcat [text "{-lvs:", interpp'SP sty (uniqSetToList lvs), text
"-}"]
\end{code}
\begin{code}
pprStgRhs :: (Outputable bndr, Outputable bdee, Ord bdee) =>
PprStyle -> GenStgRhs bndr bdee ->
Pretty
PprStyle -> GenStgRhs bndr bdee ->
Doc
-- special case
pprStgRhs sty (StgRhsClosure cc bi [free_var] upd_flag [{-no args-}] (StgApp func [] lvs))
=
ppBesides [ ppStr
(showCostCentre sty True{-as String-} cc),
=
hcat [ text
(showCostCentre sty True{-as String-} cc),
pp_binder_info sty bi,
p
pPStr
SLIT(" ["), ifPprDebug sty (ppr sty free_var),
p
pPStr SLIT("] \\"), ppr sty upd_flag, ppPStr
SLIT(" [] "), ppr sty func ]
p
text
SLIT(" ["), ifPprDebug sty (ppr sty free_var),
p
text SLIT("] \\"), ppr sty upd_flag, ptext
SLIT(" [] "), ppr sty func ]
-- general case
pprStgRhs sty (StgRhsClosure cc bi free_vars upd_flag args body)
=
ppHang (ppBesides [ ppStr
(showCostCentre sty True{-as String-} cc),
=
hang (hcat [ text
(showCostCentre sty True{-as String-} cc),
pp_binder_info sty bi,
p
pPStr
SLIT(" ["), ifPprDebug sty (interppSP sty free_vars),
p
pPStr SLIT("] \\"), ppr sty upd_flag, ppPStr SLIT(" ["), interppSP sty args, ppC
har ']'])
p
text
SLIT(" ["), ifPprDebug sty (interppSP sty free_vars),
p
text SLIT("] \\"), ppr sty upd_flag, ptext SLIT(" ["), interppSP sty args, c
har ']'])
4 (ppr sty body)
pprStgRhs sty (StgRhsCon cc con args)
=
ppBesides [ ppStr
(showCostCentre sty True{-as String-} cc),
ppSP, ppr sty con, ppPStr SLIT("! ["), interppSP sty args, ppC
har ']' ]
=
hcat [ text
(showCostCentre sty True{-as String-} cc),
space, ppr sty con, ptext SLIT("! ["), interppSP sty args, c
har ']' ]
--------------
pp_binder_info
PprForUser _ = ppNil
pp_binder_info
sty _ | userStyle sty = empty
pp_binder_info sty NoStgBinderInfo =
ppNil
pp_binder_info sty NoStgBinderInfo =
empty
-- cases so boring that we print nothing
pp_binder_info sty (StgBinderInfo True b c d e) =
ppNil
pp_binder_info sty (StgBinderInfo True b c d e) =
empty
-- general case
pp_binder_info sty (StgBinderInfo a b c d e)
= p
pBesides [ppChar '(', ppInterleave ppComma (map pp_bool [a,b,c,d,e]), ppChar ')']
= p
arens (hsep (punctuate comma (map pp_bool [a,b,c,d,e])))
where
pp_bool x = ppr (panic "pp_bool") x
\end{code}
...
...
ghc/compiler/stranal/SaAbsInt.lhs
View file @
9d4d03d5
...
...
@@ -21,7 +21,7 @@ import CoreSyn
import CoreUnfold ( Unfolding(..), UfExpr, RdrName, SimpleUnfolding(..), FormSummary )
import CoreUtils ( unTagBinders )
import Id ( idType, getIdStrictness, getIdUnfolding,
dataConTyCon, dataConArgTys
dataConTyCon, dataConArgTys
, SYN_IE(Id)
)
import IdInfo ( StrictnessInfo(..),
wwPrim, wwStrict, wwEnum, wwUnpack
...
...
@@ -31,13 +31,14 @@ import MagicUFs ( MagicUnfoldingFun )
import Maybes ( maybeToBool )
import Outputable ( Outputable(..){-instance * []-} )
import PprStyle ( PprStyle(..) )
import Pretty (
ppPStr
)
import Pretty (
Doc, ptext
)
import PrimOp ( PrimOp(..) )
import SaLib
import TyCon ( maybeTyConSingleCon, isEnumerationTyCon,
TyCon{-instance Eq-}
)
import Type ( maybeAppDataTyConExpandingDicts, isPrimType )
import Type ( maybeAppDataTyConExpandingDicts,
isPrimType, SYN_IE(Type) )
import TysWiredIn ( intTyCon, integerTyCon, doubleTyCon,
floatTyCon, wordTyCon, addrTyCon
)
...
...
@@ -432,11 +433,11 @@ absId anal var env
-- Try the strictness info
absValFromStrictness anal strictness_info
in
-- pprTrace "absId:" (
ppBesides [ppr PprDebug var, ppPStr SLIT("=:"), pp_anal anal, ppStr
SLIT(":="),ppr PprDebug result]) $
-- pprTrace "absId:" (
hcat [ppr PprDebug var, ptext SLIT("=:"), pp_anal anal, text
SLIT(":="),ppr PprDebug result]) $
result
where
pp_anal StrAnal = p
pPStr
SLIT("STR")
pp_anal AbsAnal = p
pPStr
SLIT("ABS")
pp_anal StrAnal = p
text
SLIT("STR")
pp_anal AbsAnal = p
text
SLIT("ABS")
absEvalAtom anal (VarArg v) env = absId anal v env
absEvalAtom anal (LitArg _) env = AbsTop
...
...
@@ -558,7 +559,7 @@ absEval anal (Case expr (AlgAlts alts deflt)) env
{-
(case anal of
StrAnal -> id
_ -> pprTrace "absCase:ABS:" (
ppAbove (ppCat
[ppr PprDebug expr, ppr PprDebug result, ppr PprDebug expr_val, ppr PprDebug abs_deflt, ppr PprDebug abs_alts]) (ppr PprDebug (keysFM env `zip` eltsFM env)))
_ -> pprTrace "absCase:ABS:" (
($$) (hsep
[ppr PprDebug expr, ppr PprDebug result, ppr PprDebug expr_val, ppr PprDebug abs_deflt, ppr PprDebug abs_alts]) (ppr PprDebug (keysFM env `zip` eltsFM env)))
)
-}
result
...
...
ghc/compiler/stranal/SaLib.lhs
View file @
9d4d03d5
...
...
@@ -23,13 +23,13 @@ IMP_Ubiq(){-uitous-}
import CoreSyn ( SYN_IE(CoreExpr) )
import Id ( nullIdEnv, addOneToIdEnv, growIdEnvList,
lookupIdEnv, SYN_IE(IdEnv),
GenId{-instance Outputable-}
GenId{-instance Outputable-}
, SYN_IE(Id)
)
import IdInfo ( StrictnessInfo(..) )
import Demand ( Demand{-instance Outputable-} )
import Outputable ( Outputable(..){-instance * []-} )
import PprType ( GenType{-instance Outputable-} )
import Pretty ( p
pPStr, ppCat, ppC
har )
import Pretty ( p
text, hsep, c
har )
\end{code}
%************************************************************************
...
...
@@ -74,15 +74,15 @@ data AbsVal
-- argument if the Demand so indicates.
instance Outputable AbsVal where
ppr sty AbsTop = p
pPStr
SLIT("AbsTop")
ppr sty AbsBot = p
pPStr
SLIT("AbsBot")
ppr sty (AbsProd prod) =
ppCat [ppPStr
SLIT("AbsProd"), ppr sty prod]
ppr sty AbsTop = p
text
SLIT("AbsTop")
ppr sty AbsBot = p
text
SLIT("AbsBot")
ppr sty (AbsProd prod) =
hsep [ptext
SLIT("AbsProd"), ppr sty prod]
ppr sty (AbsFun arg body env)
=
ppCat [ppPStr
SLIT("AbsFun{"), ppr sty arg,
p
pPStr SLIT("???"), -- ppStr
"}{env:", ppr sty (keysFM env `zip` eltsFM env),
ppC
har '}' ]
=
hsep [ptext
SLIT("AbsFun{"), ppr sty arg,
p
text SLIT("???"), -- text
"}{env:", ppr sty (keysFM env `zip` eltsFM env),
c
har '}' ]
ppr sty (AbsApproxFun demand val)
=
ppCat [ppPStr
SLIT("AbsApprox "), ppr sty demand, ppr sty val ]
=
hsep [ptext
SLIT("AbsApprox "), ppr sty demand, ppr sty val ]
\end{code}
%-----------
...
...
ghc/compiler/stranal/StrictAnal.lhs
View file @
9d4d03d5
...
...
@@ -19,7 +19,7 @@ import CmdLineOpts ( opt_AllStrict, opt_NumbersStrict,
import CoreSyn
import Id ( idType, addIdStrictness, isWrapperId,
getIdDemandInfo, addIdDemandInfo,
GenId{-instance Outputable-}
GenId{-instance Outputable-}
, SYN_IE(Id)
)
import IdInfo ( mkStrictnessInfo, mkBottomStrictnessInfo,
mkDemandInfo, willBeDemanded, DemandInfo
...
...
@@ -27,12 +27,13 @@ import IdInfo ( mkStrictnessInfo, mkBottomStrictnessInfo,
import PprCore ( pprCoreBinding, pprBigCoreBinder )
import PprStyle ( PprStyle(..) )
import PprType ( GenType{-instance Outputable-}, GenTyVar{-ditto-} )
import Pretty (
ppBesides, ppPStr, ppInt, ppChar, ppAboves
)
import Pretty (
Doc, hcat, ptext, int, char, vcat
)
import SaAbsInt
import SaLib
import TyVar ( GenTyVar{-instance Eq-} )
import WorkWrap -- "back-end" of strictness analyser
import Unique ( Unique{-instance Eq -} )
import UniqSupply ( UniqSupply )
import Util ( zipWith4Equal, pprTrace, panic )
\end{code}
...
...
@@ -102,7 +103,7 @@ saWwTopBinds us binds
in
-- possibly show what we decided about strictness...
(if opt_D_dump_stranal
then pprTrace "Strictness:\n" (
ppAboves
(
then pprTrace "Strictness:\n" (
vcat
(
map (pprCoreBinding PprDebug) binds_w_strictness))
else id
)
...
...
@@ -123,9 +124,9 @@ saWwTopBinds us binds
where
pp_stats (SaStats tlam dlam tc dc tlet dlet)
= pprTrace "Binders marked demanded: "
(
ppBesides [ppPStr SLIT("Lambda vars: "), ppInt IBOX(dlam), ppChar '/', ppI
nt IBOX(tlam),
p
pPStr SLIT("; Case vars: "), ppInt IBOX(dc), ppChar '/', ppI
nt IBOX(tc),
p
pPStr SLIT("; Let vars: "), ppInt IBOX(dlet), ppChar '/', ppI
nt IBOX(tlet)
(
hcat [ptext SLIT("Lambda vars: "), int IBOX(dlam), char '/', i
nt IBOX(tlam),
p
text SLIT("; Case vars: "), int IBOX(dc), char '/', i
nt IBOX(tc),
p
text SLIT("; Let vars: "), int IBOX(dlet), char '/', i
nt IBOX(tlet)
])
#endif
\end{code}
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment