Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
GHC
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Terraform modules
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Gesh
GHC
Commits
9f80aacf
Commit
9f80aacf
authored
27 years ago
by
sof
Browse files
Options
Downloads
Patches
Plain Diff
[project @ 1997-05-18 23:31:25 by sof]
Better unfolding stats
parent
db679452
Loading
Loading
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
ghc/compiler/simplCore/SimplMonad.lhs
+80
-43
80 additions, 43 deletions
ghc/compiler/simplCore/SimplMonad.lhs
with
80 additions
and
43 deletions
ghc/compiler/simplCore/SimplMonad.lhs
+
80
−
43
View file @
9f80aacf
...
...
@@ -12,7 +12,7 @@ module SimplMonad (
mapSmpl, mapAndUnzipSmpl,
-- Counting
SimplCount{-abstract-}, TickType(..), tick, tickN,
SimplCount{-abstract-}, TickType(..), tick, tickN,
tickUnfold,
simplCount, detailedSimplCount,
zeroSimplCount, showSimplCount, combineSimplCounts,
...
...
@@ -25,15 +25,19 @@ IMPORT_1_3(Ix)
IMPORT_DELOOPER(SmplLoop) -- well, cheating sort of
import Id ( mkSysLocal, mkIdWithNewUniq )
import Id (
GenId,
mkSysLocal, mkIdWithNewUniq
, SYN_IE(Id)
)
import CoreUnfold ( SimpleUnfolding )
import SimplEnv
import SrcLoc ( noSrcLoc )
import TyVar ( cloneTyVar )
import TyVar ( cloneTyVar, SYN_IE(TyVar) )
import Type ( SYN_IE(Type) )
import UniqSupply ( getUnique, getUniques, splitUniqSupply,
UniqSupply
)
import Util ( zipWithEqual, panic )
import Util ( zipWithEqual, panic, SYN_IE(Eager), appEager, pprTrace )
import Pretty
import PprStyle
import Outputable ( Outputable(..) )
infixr 9 `thenSmpl`, `thenSmpl_`
\end{code}
...
...
@@ -114,6 +118,11 @@ a mutable array through @SimplM@.
data SimplCount
= SimplCount FAST_INT -- number of ticks
[(TickType, Int)] -- assoc list of all diff kinds of ticks
UnfoldingHistory
type UnfoldingHistory = (Int, -- N
[(Id,Int)], -- Last N unfoldings
[(Id,Int)]) -- The MaxUnfoldHistory unfoldings before that
data TickType
= UnfoldingDone | MagicUnfold | ConReused
...
...
@@ -190,16 +199,22 @@ instance Text TickType where
showSimplCount :: SimplCount -> String
showSimplCount (SimplCount _ stuff)
= shw stuff
showSimplCount (SimplCount _ stuff
(_, unf1, unf2)
)
= shw stuff
++ "\nMost recent unfoldings: " ++ show (ppr PprDebug (reverse unf2 ++ reverse unf1))
where
shw [] = ""
shw ((t,n):tns) | n /= 0 = show t ++ ('\t' : show n) ++ ('\n' : shw tns)
| otherwise = shw tns
-- ToDo: move to Outputable
instance Outputable Int where
ppr sty n = int n
zeroSimplCount :: SimplCount
zeroSimplCount
= SimplCount ILIT(0)
= SimplCount ILIT(0) stuff (0, [], [])
where
stuff =
[ (UnfoldingDone, 0),
(MagicUnfold, 0),
(ConReused, 0),
...
...
@@ -242,48 +257,68 @@ Counting-related monad functions:
\begin{code}
tick :: TickType -> SmplM ()
tick tick_type us (SimplCount n stuff)
tick tick_type us (SimplCount n stuff unf)
= -- pprTrace "Tick: " (text (show tick_type)) $
#ifdef OMIT_SIMPL_COUNTS
=
((), SimplCount (n _ADD_ ILIT(1) stuff)) stuff -- don't change anything
((), SimplCount (n _ADD_ ILIT(1) stuff
unf
)) stuff -- don't change anything
#else
= case inc_tick stuff of
[] -> ((), SimplCount (n _ADD_ ILIT(1)) [])
ls -> ((), SimplCount (n _ADD_ ILIT(1)) ls)
new_stuff `seqL`
((), SimplCount (n _ADD_ ILIT(1)) new_stuff unf)
where
inc_tick [] = panic "couldn't inc_tick!"
inc_tick (x@(ttype, I# cnt#) : xs)
= if ttype == tick_type then
case cnt# +# 1# of { incd -> (ttype, IBOX(incd)) : xs }
else
case inc_tick xs of { [] -> [x]; ls -> x:ls }
new_stuff = inc_tick tick_type ILIT(1) stuff
#endif
maxUnfoldHistory :: Int
maxUnfoldHistory = 20
tickUnfold :: Id -> SmplM ()
tickUnfold id us (SimplCount n stuff (n_unf, unf1, unf2))
= -- pprTrace "Unfolding: " (ppr PprDebug id) $
new_stuff `seqL`
new_unf `seqTriple`
((), SimplCount (n _ADD_ ILIT(1)) new_stuff new_unf)
where
new_stuff = inc_tick UnfoldingDone ILIT(1) stuff
new_unf | n_unf >= maxUnfoldHistory = (1, [unf_item], unf1)
| otherwise = (n_unf+1, unf_item:unf1, unf2)
unf_item = (id, IBOX(n))
-- force list to avoid getting a chain of @inc_tick@ applications
-- building up on the heap. (Only true when not dumping stats).
seqL [] y = y
seqL (_:_) y = y
seqTriple (_,_,_) y = y
tickN :: TickType -> Int -> SmplM ()
tickN tick_type 0 us counts
= ((), counts)
tickN tick_type IBOX(increment) us (SimplCount n stuff)
tickN tick_type IBOX(increment) us (SimplCount n stuff unf)
= -- pprTrace "Tick: " (text (show tick_type)) $
#ifdef OMIT_SIMPL_COUNTS
=
((), SimplCount (n _ADD_ increment) stuff) -- don't change anything
((), SimplCount (n _ADD_ increment) stuff) -- don't change anything
#else
-- force list to avoid getting a chain of @inc_tick@ applications
-- building up on the heap. (Only true when not dumping stats).
= case inc_tick stuff of
[] -> ((), SimplCount (n _ADD_
increment
) [] )
ls -> ((), SimplCount (n _ADD_ increment) ls )
where
inc_tick [] = panic "couldn't inc_tick!"
inc_tick (x@(ttype, I# cnt#) : xs)
= if ttype == tick_type then
case cnt# +#
increment
of
incd -> (ttype,IBOX(incd)) : xs
else
case inc_tick xs of { [] -> [x]; ls -> x:ls }
new_stuff `seqL`
((), SimplCount (n _ADD_ increment) new_stuff unf)
where
new_stuff = inc_tick tick_type
increment
stuff
inc_tick
tick_type n
[] = panic "couldn't inc_tick!"
inc_tick tick_type n (x@(ttype, I# cnt#) : xs)
| ttype == tick_type =
case cnt# +#
n
of
incd -> (ttype,IBOX(incd)) : xs
| otherwise
=
case inc_tick
tick_type n
xs of { [] -> [x]; ls -> x:ls }
#endif
simplCount :: SmplM Int
simplCount us sc@(SimplCount n _) = (IBOX(n), sc)
simplCount us sc@(SimplCount n
_
_) = (IBOX(n), sc)
detailedSimplCount :: SmplM SimplCount
detailedSimplCount us sc = (sc, sc)
...
...
@@ -291,14 +326,16 @@ detailedSimplCount us sc = (sc, sc)
combineSimplCounts :: SimplCount -> SimplCount -> SimplCount
#ifdef OMIT_SIMPL_COUNTS
combineSimplCounts (SimplCount n1 stuff1) (SimplCount n2 stuff2)
combineSimplCounts (SimplCount n1 stuff1
unf1
) (SimplCount n2 stuff2
unf2
)
= SimplCount (n1 _ADD_ n2)
stuff1 -- just pick one
stuff2 -- just pick one
unf2
#else
combineSimplCounts (SimplCount n1 stuff1) (SimplCount n2 stuff2)
= case (zipWithEqual "combineSimplCounts" (\ (t1,c1) (t2,c2) -> (t1,c1+c2)) stuff1 stuff2) of
[] -> SimplCount (n1 _ADD_ n2) []
ls -> SimplCount (n1 _ADD_ n2) ls
combineSimplCounts (SimplCount n1 stuff1 unf1) (SimplCount n2 stuff2 unf2)
= new_stuff `seqL`
SimplCount (n1 _ADD_ n2) new_stuff unf2 -- Just pick the second for unfold history
where
new_stuff = zipWithEqual "combineSimplCounts" (\ (t1,c1) (t2,c2) -> (t1,c1+c2)) stuff1 stuff2
#endif
\end{code}
...
...
@@ -332,9 +369,9 @@ cloneTyVarSmpl tyvar us sc
cloneId :: SimplEnv -> InBinder -> SmplM OutId
cloneId env (id,_) us sc
= (mkIdWithNewUniq id_with_new_ty uniq, sc)
= simplTyInId env id `appEager` \ id_with_new_ty ->
(mkIdWithNewUniq id_with_new_ty uniq, sc)
where
id_with_new_ty = simplTyInId env id
uniq = getUnique us
cloneIds :: SimplEnv -> [InBinder] -> SmplM [OutId]
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment