[commit: ghc] master: Rename mkNoTick to mkNoCount (2885ab0)
git at git.haskell.org
git at git.haskell.org
Thu Nov 21 13:25:09 UTC 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/2885ab09169db21a0f0525194e281db5b4c721ba/ghc
>---------------------------------------------------------------
commit 2885ab09169db21a0f0525194e281db5b4c721ba
Author: Simon Marlow <marlowsd at gmail.com>
Date: Thu Nov 21 09:45:57 2013 +0000
Rename mkNoTick to mkNoCount
>---------------------------------------------------------------
2885ab09169db21a0f0525194e281db5b4c721ba
compiler/coreSyn/CoreSyn.lhs | 19 ++++++++++---------
compiler/coreSyn/CoreUtils.lhs | 4 ++--
compiler/simplCore/FloatOut.lhs | 2 +-
compiler/simplCore/Simplify.lhs | 4 ++--
4 files changed, 15 insertions(+), 14 deletions(-)
diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index d77d5dc..75cc5ed 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -44,7 +44,7 @@ module CoreSyn (
isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
isRuntimeArg, isRuntimeVar,
- tickishCounts, tickishScoped, tickishIsCode, mkNoTick, mkNoScope,
+ tickishCounts, tickishScoped, tickishIsCode, mkNoCount, mkNoScope,
tickishCanSplit,
-- * Unfolding data types
@@ -475,9 +475,10 @@ data Tickish id =
deriving (Eq, Ord, Data, Typeable)
--- | A "tick" note is one that counts evaluations in some way. We
--- cannot discard a tick, and the compiler should preserve the number
--- of ticks as far as possible.
+-- | A "counting tick" (where tickishCounts is True) is one that
+-- counts evaluations in some way. We cannot discard a counting tick,
+-- and the compiler should preserve the number of counting ticks as
+-- far as possible.
--
-- However, we still allow the simplifier to increase or decrease
-- sharing, so in practice the actual number of ticks may vary, except
@@ -496,10 +497,10 @@ tickishScoped Breakpoint{} = True
-- stacks, but also this helps prevent the simplifier from moving
-- breakpoints around and changing their result type (see #1531).
-mkNoTick :: Tickish id -> Tickish id
-mkNoTick n at ProfNote{} = n {profNoteCount = False}
-mkNoTick Breakpoint{} = panic "mkNoTick: Breakpoint" -- cannot split a BP
-mkNoTick t = t
+mkNoCount :: Tickish id -> Tickish id
+mkNoCount n at ProfNote{} = n {profNoteCount = False}
+mkNoCount Breakpoint{} = panic "mkNoCount: Breakpoint" -- cannot split a BP
+mkNoCount HpcTick{} = panic "mkNoCount: HpcTick"
mkNoScope :: Tickish id -> Tickish id
mkNoScope n at ProfNote{} = n {profNoteScope = False}
@@ -512,7 +513,7 @@ tickishIsCode :: Tickish id -> Bool
tickishIsCode _tickish = True -- all of them for now
-- | Return True if this Tick can be split into (tick,scope) parts with
--- 'mkNoScope' and 'mkNoTick' respectively.
+-- 'mkNoScope' and 'mkNoCount' respectively.
tickishCanSplit :: Tickish Id -> Bool
tickishCanSplit Breakpoint{} = False
tickishCanSplit _ = True
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 264a9da..8f7b777 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -245,7 +245,7 @@ mkTick t expr@(App f arg)
= if not (tickishCounts t)
then tickHNFArgs t expr
else if tickishScoped t && tickishCanSplit t
- then Tick (mkNoScope t) (tickHNFArgs (mkNoTick t) expr)
+ then Tick (mkNoScope t) (tickHNFArgs (mkNoCount t) expr)
else Tick t expr
mkTick t (Lam x e)
@@ -258,7 +258,7 @@ mkTick t (Lam x e)
-- counting tick can probably be floated, and the lambda may then be
-- in a position to be beta-reduced.
| tickishScoped t && tickishCanSplit t
- = Tick (mkNoScope t) (Lam x (mkTick (mkNoTick t) e))
+ = Tick (mkNoScope t) (Lam x (mkTick (mkNoCount t) e))
-- just a counting tick: leave it on the outside
| otherwise = Tick t (Lam x e)
diff --git a/compiler/simplCore/FloatOut.lhs b/compiler/simplCore/FloatOut.lhs
index e0c39bf..fbe8a3e 100644
--- a/compiler/simplCore/FloatOut.lhs
+++ b/compiler/simplCore/FloatOut.lhs
@@ -290,7 +290,7 @@ floatExpr (Tick tickish expr)
let
-- Annotate bindings floated outwards past an scc expression
-- with the cc. We mark that cc as "duplicated", though.
- annotated_defns = wrapTick (mkNoTick tickish) floating_defns
+ annotated_defns = wrapTick (mkNoCount tickish) floating_defns
in
(fs, annotated_defns, Tick tickish expr') }
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index cb9d6e5..8a5a77b 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -1071,7 +1071,7 @@ simplTick env tickish expr cont
Case scrut bndr ty alts
-> Just (Case (mkTick t scrut) bndr ty alts')
- where t_scope = mkNoTick t -- drop the tick on the dup'd ones
+ where t_scope = mkNoCount t -- drop the tick on the dup'd ones
alts' = [ (c,bs, mkTick t_scope e) | (c,bs,e) <- alts]
_other -> Nothing
where
@@ -1098,7 +1098,7 @@ simplTick env tickish expr cont
-- ; (env', expr') <- simplExprF (zapFloats env) expr inc
-- ; let tickish' = simplTickish env tickish
-- ; let wrap_float (b,rhs) = (zapIdStrictness (setIdArity b 0),
--- mkTick (mkNoTick tickish') rhs)
+-- mkTick (mkNoCount tickish') rhs)
-- -- when wrapping a float with mkTick, we better zap the Id's
-- -- strictness info and arity, because it might be wrong now.
-- ; let env'' = addFloats env (mapFloats env' wrap_float)
More information about the ghc-commits
mailing list