Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
be3b84f3
Commit
be3b84f3
authored
Sep 23, 2013
by
Krzysztof Gogolewski
Browse files
Typos
parent
e19ae5df
Changes
6
Hide whitespace changes
Inline
Side-by-side
compiler/coreSyn/CoreSyn.lhs
View file @
be3b84f3
...
...
@@ -388,13 +388,13 @@ is fine, and has type Bool. This is one reason we need a type on
the case expression: if the alternatives are empty we can't get the type
from the alternatives! I'll write this
case (error Int "Hello") of Bool {}
with the return type just before the alter
a
ntives.
with the return type just before the altern
a
tives.
Here's another example:
data T
f :: T -> Bool
f = \(x:t). case x of Bool {}
Since T has no data constructors, the case alter
a
ntives are of course
Since T has no data constructors, the case altern
a
tives are of course
empty. However note that 'x' is not bound to a visbily-bottom value;
it's the *type* that tells us it's going to diverge. Its a bit of a
degnerate situation but we do NOT want to replace
...
...
compiler/coreSyn/CoreUtils.lhs
View file @
be3b84f3
...
...
@@ -695,7 +695,7 @@ Should we inline 'v' at its use site inside the loop? At the moment
we do. I experimented with saying that case are *not* work-free, but
that increased allocation slightly. It's a fairly small effect, and at
the moment we go for the slightly more aggressive version which treats
(case x of ....) as work-free if the alter
a
ntives are.
(case x of ....) as work-free if the altern
a
tives are.
Note [exprIsCheap] See also Note [Interaction of exprIsCheap and lone variables]
...
...
@@ -984,7 +984,7 @@ app_ok primop_ok fun args
-----------------------------
altsAreExhaustive :: [Alt b] -> Bool
-- True <=> the case alter
a
ntives are definiely exhaustive
-- True <=> the case altern
a
tives are definiely exhaustive
-- False <=> they may or may not be
altsAreExhaustive []
= False -- Should not happen
...
...
compiler/rename/RnBinds.lhs
View file @
be3b84f3
...
...
@@ -828,7 +828,7 @@ rnMatch' ctxt rnBody match@(Match pats maybe_rhs_sig grhss)
; return (Match pats' Nothing grhss', grhss_fvs) }}
emptyCaseErr :: HsMatchContext Name -> SDoc
emptyCaseErr ctxt = hang (ptext (sLit "Empty list of alter
a
ntives in") <+> pp_ctxt)
emptyCaseErr ctxt = hang (ptext (sLit "Empty list of altern
a
tives in") <+> pp_ctxt)
2 (ptext (sLit "Use EmptyCase to allow this"))
where
pp_ctxt = case ctxt of
...
...
compiler/rename/RnNames.lhs
View file @
be3b84f3
...
...
@@ -206,8 +206,8 @@ rnImportDecl this_mod
(warnRedundantSourceImport imp_mod_name)
when (mod_safe && not (safeImportsOn dflags)) $
addErrAt loc (ptext (sLit "safe import can't be used as Safe Haskell isn't on!")
$+$ ptext (sLit $ "please enable Safe Haskell through either"
++ "Safe, Trustw
r
othy or Unsafe"))
$+$ ptext (sLit $ "please enable Safe Haskell through either
"
++ "Safe, Trustwo
r
thy or Unsafe"))
let imp_mod = mi_module iface
warns = mi_warns iface
...
...
compiler/simplCore/SimplUtils.lhs
View file @
be3b84f3
...
...
@@ -1553,7 +1553,7 @@ prepareAlts scrut case_bndr' alts
_ -> []
\end{code}
Note [Combine identical alter
a
ntives]
Note [Combine identical altern
a
tives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If several alternatives are identical, merge them into
a single DEFAULT alternative. I've occasionally seen this
...
...
@@ -1598,7 +1598,7 @@ defeats combineIdenticalAlts (see Trac #7360).
\begin{code}
combineIdenticalAlts :: OutId -> [InAlt] -> SimplM [InAlt]
-- See Note [Combine identical alter
a
ntives]
-- See Note [Combine identical altern
a
tives]
combineIdenticalAlts case_bndr ((_con1,bndrs1,rhs1) : con_alts)
| all isDeadBinder bndrs1 -- Remember the default
, length filtered_alts < length con_alts -- alternative comes first
...
...
compiler/stranal/DmdAnal.lhs
View file @
be3b84f3
...
...
@@ -831,7 +831,7 @@ Notice that j' is not a let-no-escape any more.
However this means in turn that the *enclosing* function
may be CPR'd (via the returned Justs). But in the case of
sums, there may be Nothing alter
a
ntives; and that messes
sums, there may be Nothing altern
a
tives; and that messes
up the sum-type CPR.
Conclusion: only do this for products. It's still not
...
...
Write
Preview
Supports
Markdown
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