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
61a00ea2
Commit
61a00ea2
authored
Jan 26, 2008
by
twanvl
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fixed warnings in stgSyn/StgSyn
parent
39dbcf69
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
23 additions
and
20 deletions
+23
-20
compiler/stgSyn/StgSyn.lhs
compiler/stgSyn/StgSyn.lhs
+23
-20
No files found.
compiler/stgSyn/StgSyn.lhs
View file @
61a00ea2
...
...
@@ -9,13 +9,6 @@ form of @CoreSyntax@, the style being one that happens to be ideally
suited to spineless tagless code generation.
\begin{code}
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module StgSyn (
GenStgArg(..),
GenStgLiveVars,
...
...
@@ -69,7 +62,7 @@ import Outputable
import Util ( count )
import Type ( Type )
import TyCon ( TyCon )
import UniqSet
( isEmptyUniqSet, uniqSetToList, UniqSet )
import UniqSet
import Unique ( Unique )
import Bitmap
import StaticFlags ( opt_SccProfilingOn )
...
...
@@ -109,14 +102,14 @@ data GenStgArg occ
\end{code}
\begin{code}
isStgTypeArg :: StgArg -> Bool
isStgTypeArg (StgTypeArg _) = True
isStgTypeArg
other
= False
isStgTypeArg
_
= False
isDllArg :: PackageId -> StgArg -> Bool
-- Does this argument refer to something in a different DLL?
isDllArg this_pkg (StgTypeArg v) = False
isDllArg this_pkg (StgVarArg v) = isDllName this_pkg (idName v)
isDllArg this_pkg (StgLitArg lit) = False
isDllArg this_pkg (StgVarArg v) = isDllName this_pkg (idName v)
isDllArg _ _ = False
isDllConApp :: PackageId -> DataCon -> [StgArg] -> Bool
-- Does this constructor application refer to
...
...
@@ -129,7 +122,7 @@ stgArgType :: StgArg -> Type
-- Very half baked becase we have lost the type arguments
stgArgType (StgVarArg v) = idType v
stgArgType (StgLitArg lit) = literalType lit
stgArgType (StgTypeArg
lit)
= panic "stgArgType called on stgTypeArg"
stgArgType (StgTypeArg
_)
= panic "stgArgType called on stgTypeArg"
\end{code}
%************************************************************************
...
...
@@ -436,11 +429,13 @@ stgBindHasCafRefs :: GenStgBinding bndr Id -> Bool
stgBindHasCafRefs (StgNonRec _ rhs) = rhsHasCafRefs rhs
stgBindHasCafRefs (StgRec binds) = any rhsHasCafRefs (map snd binds)
rhsHasCafRefs :: GenStgRhs bndr Id -> Bool
rhsHasCafRefs (StgRhsClosure _ _ _ upd srt _ _)
= isUpdatable upd || nonEmptySRT srt
rhsHasCafRefs (StgRhsCon _ _ args)
= any stgArgHasCafRefs args
stgArgHasCafRefs :: GenStgArg Id -> Bool
stgArgHasCafRefs (StgVarArg id) = mayHaveCafRefs (idCafInfo id)
stgArgHasCafRefs _ = False
\end{code}
...
...
@@ -454,6 +449,7 @@ data StgBinderInfo
-- slow entry code for the thing
-- Thunks never get this value
noBinderInfo, stgUnsatOcc, stgSatOcc :: StgBinderInfo
noBinderInfo = NoStgBinderInfo
stgUnsatOcc = NoStgBinderInfo
stgSatOcc = SatCallsOnly
...
...
@@ -464,9 +460,10 @@ satCallsOnly NoStgBinderInfo = False
combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
combineStgBinderInfo SatCallsOnly SatCallsOnly = SatCallsOnly
combineStgBinderInfo
info1 info2
= NoStgBinderInfo
combineStgBinderInfo
_ _
= NoStgBinderInfo
--------------
pp_binder_info :: StgBinderInfo -> SDoc
pp_binder_info NoStgBinderInfo = empty
pp_binder_info SatCallsOnly = ptext SLIT("sat-only")
\end{code}
...
...
@@ -543,6 +540,7 @@ instance Outputable UpdateFlag where
ppr u
= char (case u of { ReEntrant -> 'r'; Updatable -> 'u'; SingleEntry -> 's' })
isUpdatable :: UpdateFlag -> Bool
isUpdatable ReEntrant = False
isUpdatable SingleEntry = False
isUpdatable Updatable = True
...
...
@@ -588,16 +586,15 @@ data SRT = NoSRT
| SRT !Int{-offset-} !Int{-length-} !Bitmap{-bitmap-}
-- generated by computeSRTs
noSRT :: SRT
noSRT = NoSRT
nonEmptySRT :: SRT -> Bool
nonEmptySRT NoSRT = False
nonEmptySRT (SRTEntries vs) = not (isEmptyVarSet vs)
nonEmptySRT _ = True
pprSRT (NoSRT) = ptext SLIT("_no_srt_")
pprSRT :: SRT -> SDoc
pprSRT (NoSRT) = ptext SLIT("_no_srt_")
pprSRT (SRTEntries ids) = text "SRT:" <> ppr ids
pprSRT (SRT off
length bitmap)
= parens (ppr off <> comma <> text "*bitmap*")
pprSRT (SRT off
_ _)
= parens (ppr off <> comma <> text "*bitmap*")
\end{code}
%************************************************************************
...
...
@@ -762,10 +759,13 @@ pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
nest 2 (vcat (map pprStgAlt alts)),
char '}']
pprStgAlt (con, params, use_mask, expr)
pprStgAlt :: (Outputable bndr, Outputable occ, Ord occ)
=> GenStgAlt bndr occ -> SDoc
pprStgAlt (con, params, _use_mask, expr)
= hang (hsep [ppr con, interppSP params, ptext SLIT("->")])
4 (ppr expr <> semi)
pprStgOp :: StgOp -> SDoc
pprStgOp (StgPrimOp op) = ppr op
pprStgOp (StgFCallOp op _) = ppr op
...
...
@@ -777,6 +777,7 @@ instance Outputable AltType where
\end{code}
\begin{code}
#ifdef DEBUG
pprStgLVs :: Outputable occ => GenStgLiveVars occ -> SDoc
pprStgLVs lvs
= getPprStyle $ \ sty ->
...
...
@@ -784,6 +785,7 @@ pprStgLVs lvs
empty
else
hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"]
#endif
\end{code}
\begin{code}
...
...
@@ -809,6 +811,7 @@ pprStgRhs (StgRhsCon cc con args)
= hcat [ ppr cc,
space, ppr con, ptext SLIT("! "), brackets (interppSP args)]
pprMaybeSRT :: SRT -> SDoc
pprMaybeSRT (NoSRT) = empty
pprMaybeSRT srt = ptext SLIT("srt:") <> pprSRT srt
\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