Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
e8f5efb5
Commit
e8f5efb5
authored
Feb 08, 2017
by
Gabor Greif
💬
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Tweaks and typos in manual, note refs, comments
parent
b9bebd8c
Changes
27
Hide whitespace changes
Inline
Side-by-side
Showing
27 changed files
with
34 additions
and
34 deletions
+34
-34
compiler/basicTypes/Demand.hs
compiler/basicTypes/Demand.hs
+1
-1
compiler/cmm/CmmSink.hs
compiler/cmm/CmmSink.hs
+1
-1
compiler/codeGen/StgCmmCon.hs
compiler/codeGen/StgCmmCon.hs
+1
-1
compiler/coreSyn/CoreUtils.hs
compiler/coreSyn/CoreUtils.hs
+1
-1
compiler/ghci/ByteCodeGen.hs
compiler/ghci/ByteCodeGen.hs
+1
-1
compiler/prelude/TysPrim.hs
compiler/prelude/TysPrim.hs
+1
-1
compiler/simplCore/OccurAnal.hs
compiler/simplCore/OccurAnal.hs
+1
-1
compiler/simplCore/SetLevels.hs
compiler/simplCore/SetLevels.hs
+8
-8
compiler/simplCore/Simplify.hs
compiler/simplCore/Simplify.hs
+1
-1
compiler/stranal/DmdAnal.hs
compiler/stranal/DmdAnal.hs
+1
-1
compiler/typecheck/TcEvidence.hs
compiler/typecheck/TcEvidence.hs
+1
-1
compiler/typecheck/TcMatches.hs
compiler/typecheck/TcMatches.hs
+1
-1
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcRnTypes.hs
+1
-1
compiler/typecheck/TcSimplify.hs
compiler/typecheck/TcSimplify.hs
+1
-1
compiler/types/Unify.hs
compiler/types/Unify.hs
+1
-1
compiler/vectorise/Vectorise.hs
compiler/vectorise/Vectorise.hs
+1
-1
docs/users_guide/glasgow_exts.rst
docs/users_guide/glasgow_exts.rst
+1
-1
ghc/GHCi/UI.hs
ghc/GHCi/UI.hs
+1
-1
libraries/base/GHC/ExecutionStack/Internal.hsc
libraries/base/GHC/ExecutionStack/Internal.hsc
+1
-1
testsuite/tests/parser/should_fail/readFail027.hs
testsuite/tests/parser/should_fail/readFail027.hs
+1
-1
testsuite/tests/programs/andy_cherry/andy_cherry.stdout
testsuite/tests/programs/andy_cherry/andy_cherry.stdout
+1
-1
testsuite/tests/programs/andy_cherry/mygames.pgn
testsuite/tests/programs/andy_cherry/mygames.pgn
+1
-1
testsuite/tests/programs/galois_raytrace/Data.hs
testsuite/tests/programs/galois_raytrace/Data.hs
+1
-1
testsuite/tests/rename/should_fail/T4042.hs
testsuite/tests/rename/should_fail/T4042.hs
+1
-1
testsuite/tests/simplCore/T9646/readme.txt
testsuite/tests/simplCore/T9646/readme.txt
+1
-1
testsuite/tests/typecheck/should_fail/tcfail162.hs
testsuite/tests/typecheck/should_fail/tcfail162.hs
+1
-1
utils/ghc-pkg/Main.hs
utils/ghc-pkg/Main.hs
+1
-1
No files found.
compiler/basicTypes/Demand.hs
View file @
e8f5efb5
...
...
@@ -1112,7 +1112,7 @@ unboxed thing to f, and have it reboxed in the error cases....]
However we *don't* want to do this when the argument is not actually
taken apart in the function at all. Otherwise we risk decomposing a
mass
s
ive tuple which is barely used. Example:
massive tuple which is barely used. Example:
f :: ((Int,Int) -> String) -> (Int,Int) -> a
f g pr = error (g pr)
...
...
compiler/cmm/CmmSink.hs
View file @
e8f5efb5
...
...
@@ -336,7 +336,7 @@ shouldSink _ _other = Nothing
--
-- discard dead assignments. This doesn't do as good a job as
-- removeDeadAss
s
ignments, because it would need multiple passes
-- removeDeadAssignments, because it would need multiple passes
-- to get all the dead code, but it catches the common case of
-- superfluous reloads from the stack that the stack allocator
-- leaves behind.
...
...
compiler/codeGen/StgCmmCon.hs
View file @
e8f5efb5
...
...
@@ -174,7 +174,7 @@ Now for @Char@-like closures. We generate an assignment of the
address of the closure to a temporary. It would be possible simply to
generate no code, and record the addressing mode in the environment,
but we'd have to be careful if the argument wasn't a constant --- so
for simplicity we just always ass
s
ign to a temporary.
for simplicity we just always assign to a temporary.
Last special case: @Int@-like closures. We only special-case the
situation in which the argument is a literal in the range
...
...
compiler/coreSyn/CoreUtils.hs
View file @
e8f5efb5
...
...
@@ -639,7 +639,7 @@ refineDefaultAlt :: [Unique] -> TyCon -> [Type]
->
[
AltCon
]
-- Constructors that cannot match the DEFAULT (if any)
->
[
CoreAlt
]
->
(
Bool
,
[
CoreAlt
])
-- Refine the default alter
a
ntive to a DataAlt,
-- Refine the default altern
a
tive to a DataAlt,
-- if there is a unique way to do so
refineDefaultAlt
us
tycon
tys
imposs_deflt_cons
all_alts
|
(
DEFAULT
,
_
,
rhs
)
:
rest_alts
<-
all_alts
...
...
compiler/ghci/ByteCodeGen.hs
View file @
e8f5efb5
...
...
@@ -1660,7 +1660,7 @@ atomPrimRep (AnnVar v) = bcIdPrimRep v
atomPrimRep
(
AnnLit
l
)
=
typePrimRep1
(
literalType
l
)
-- Trac #12128:
-- A case express
s
ion can be an atom because empty cases evaluate to bottom.
-- A case expression can be an atom because empty cases evaluate to bottom.
-- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs
atomPrimRep
(
AnnCase
_
_
ty
_
)
=
ASSERT
(
typePrimRep
ty
==
[
LiftedRep
])
LiftedRep
atomPrimRep
(
AnnCoercion
{})
=
VoidRep
...
...
compiler/prelude/TysPrim.hs
View file @
e8f5efb5
...
...
@@ -425,7 +425,7 @@ GHC needs to be able to figure out how 'v' is represented at runtime.
It expects 'rep' to be form
TyConApp rr_dc args
where 'rr_dc' is a promoteed data constructor from RuntimeRep. So
now we need to go from 'dc' to the correponding PrimRep. We store this
now we need to go from 'dc' to the corre
s
ponding PrimRep. We store this
PrimRep in the promoted data constructor itself: see TyCon.promDcRepInfo.
-}
...
...
compiler/simplCore/OccurAnal.hs
View file @
e8f5efb5
...
...
@@ -1141,7 +1141,7 @@ otherwise), the loop does not unravel nicely.
@occAnalUnfolding@ deals with the question of bindings where the Id is marked
by an INLINE pragma. For these we record that anything which occurs
in its RHS occurs many times. This pessimistically assumes that ths
in its RHS occurs many times. This pessimistically assumes that th
i
s
inlined binder also occurs many times in its scope, but if it doesn't
we'll catch it next time round. At worst this costs an extra simplifier pass.
ToDo: try using the occurrence info for the inline'd binder.
...
...
compiler/simplCore/SetLevels.hs
View file @
e8f5efb5
...
...
@@ -461,7 +461,7 @@ lvlCase env scrut_fvs scrut' case_bndr ty alts
incd_lvl
=
incMinorLvl
(
le_ctxt_lvl
env
)
dest_lvl
=
maxFvLevel
(
const
True
)
env
scrut_fvs
-- Don't abstact over type variables, hence const True
-- Don't abst
r
act over type variables, hence const True
lvl_alt
alts_env
(
con
,
bs
,
rhs
)
=
do
{
rhs'
<-
lvlMFE
new_env
True
rhs
...
...
@@ -478,7 +478,7 @@ Consider this:
f x vs = case x of { MkT y ->
let f vs = ...(case y of I# w -> e)...f..
in f vs
Here we can float the (case y ...) out
, because y is sure
Here we can float the (case y ...) out, because y is sure
to be evaluated, to give
f x vs = case x of { MkT y ->
caes y of I# w ->
...
...
@@ -659,7 +659,7 @@ escape a value lambda (and hence save work), for two reasons:
* (Minor) Doing so may turn a dynamic allocation (done by machine
instructions) into a static one. Minor because we are assuming
we are not escaping a value lambda
we are not escaping a value lambda
.
But do not so if:
- the context is a strict, and
...
...
@@ -699,7 +699,7 @@ Exammples:
we don't (see the use of idStrictness in lvlApp). It's not clear
if this test is worth the bother: it's only about CAFs!
It's controlled by a flag (floatConsts)
, because doing this too
It's controlled by a flag (floatConsts), because doing this too
early loses opportunities for RULES which (needless to say) are
important in some nofib programs (gcd is an example). [SPJ note:
I think this is obselete; the flag seems always on.]
...
...
@@ -745,7 +745,7 @@ we'd like to float the call to error, to get
* Bottoming floats (1): Furthermore, we want to float a bottoming
expression even if it has free variables:
f = \x. g (let v = h x in error ("urk" ++ v))
Then we'd like to abstact over 'x' can float the whole arg of g:
Then we'd like to abst
r
act over 'x' can float the whole arg of g:
lvl = \x. let v = h x in error ("urk" ++ v)
f = \x. g (lvl x)
To achieve this we pass is_bot to destLevel
...
...
@@ -798,7 +798,7 @@ in exchange we build a thunk, which is bad. This case reduces allocation
by 7% in spectral/puzzle (a rather strange benchmark) and 1.2% in real/fem.
Doesn't change any other allocation at all.
We will make a separate decision for the scrutinees and alter
a
ntives.
We will make a separate decision for the scrutinees and altern
a
tives.
Note [Join points and MFEs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
...
...
@@ -1144,7 +1144,7 @@ lvlFloatRhs abs_vars dest_lvl env rec mb_join_arity rhs
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When float the RHS of a let-binding, we don't always want to apply
lvlMFE to the body of a lambda, as we usually do, because the entire
binding body is already going to the right place (dest_lvl)
binding body is already going to the right place (dest_lvl)
.
A particular example is the top level. Consider
concat = /\ a -> foldr ..a.. (++) []
...
...
@@ -1165,7 +1165,7 @@ But we must be careful! If we had
we /would/ want to float that (factorial 20) out! Functions are treated
differently: see the use of isFunction in the calls to destLevel. If
there are only type lambdas, then destLevel will say "go to top, and
abstract over the free tyars" and we don't want that here.
abstract over the free ty
v
ars" and we don't want that here.
Conclusion: use lvlMFE if there are any value lambdas, lvlExpr
otherwise. A little subtle, and I got it wrong to start with.
...
...
compiler/simplCore/Simplify.hs
View file @
e8f5efb5
...
...
@@ -2893,7 +2893,7 @@ So instead we do both: we pass 'c' and 'c#' , and record in c's inlining
Absence analysis may later discard 'c'.
NB: take great care when doing strictness analysis;
see Note [Lamba-bound unfoldings] in DmdAnal.
see Note [Lamb
d
a-bound unfoldings] in DmdAnal.
Also note that we can still end up passing stuff that isn't used. Before
strictness analysis we have
...
...
compiler/stranal/DmdAnal.hs
View file @
e8f5efb5
...
...
@@ -1019,7 +1019,7 @@ mentioned in the (unsound) strictness signature, conservatively approximate the
demand put on them (topDmd), and add that to the "lazy_fv" returned by "dmdFix".
Note [Lamba-bound unfoldings]
Note [Lamb
d
a-bound unfoldings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We allow a lambda-bound variable to carry an unfolding, a facility that is used
exclusively for join points; see Note [Case binders and join points]. If so,
...
...
compiler/typecheck/TcEvidence.hs
View file @
e8f5efb5
...
...
@@ -593,7 +593,7 @@ Conceptually, this class has infinitely many instances:
...
In practice, we solve `KnownNat` predicates in the type-checker
(see typecheck/TcInteract.hs) because we can't have infin
a
tely many instances.
(see typecheck/TcInteract.hs) because we can't have infin
i
tely many instances.
The evidence (aka "dictionary") for `KnownNat` is of the form `EvLit (EvNum n)`.
We make the following assumptions about dictionaries in GHC:
...
...
compiler/typecheck/TcMatches.hs
View file @
e8f5efb5
...
...
@@ -237,7 +237,7 @@ tcMatch ctxt pat_tys rhs_ty match
tc_grhss
_
(
Just
{})
_
_
=
panic
"tc_ghrss"
-- Rejected by renamer
-- For (\x -> e), tcExpr has already said "In the express
s
ion \x->e"
-- For (\x -> e), tcExpr has already said "In the expression \x->e"
-- so we don't want to add "In the lambda abstraction \x->e"
add_match_ctxt
match
thing_inside
=
case
mc_what
ctxt
of
...
...
compiler/typecheck/TcRnTypes.hs
View file @
e8f5efb5
...
...
@@ -3050,7 +3050,7 @@ data CtOrigin
-- actual desugaring to MonadFail.fail is live.
|
Shouldn'tHappenOrigin
String
-- the user should never see this one,
-- unless
s
ImpredicativeTypes is on, where all
-- unless ImpredicativeTypes is on, where all
-- bets are off
|
InstProvidedOrigin
Module
ClsInst
-- Skolem variable arose when we were testing if an instance
...
...
compiler/typecheck/TcSimplify.hs
View file @
e8f5efb5
...
...
@@ -1971,7 +1971,7 @@ to beta[1], and that means the (a ~ beta[1]) will be stuck, as it should be.
applyDefaultingRules
::
WantedConstraints
->
TcS
Bool
-- True <=> I did some defaulting, by unifying a meta-tyvar
-- I
m
put WantedConstraints are not necessarily zonked
-- I
n
put WantedConstraints are not necessarily zonked
applyDefaultingRules
wanteds
|
isEmptyWC
wanteds
...
...
compiler/types/Unify.hs
View file @
e8f5efb5
...
...
@@ -574,7 +574,7 @@ a substitution to make two types say True to eqType. NB: eqType is
itself not purely syntactic; it accounts for CastTys;
see Note [Non-trivial definitional equality] in TyCoRep
Unlike the "impure unifers" in the typechecker (the eager unifier in
Unlike the "impure unif
i
ers" in the typechecker (the eager unifier in
TcUnify, and the constraint solver itself in TcCanonical), the pure
unifier It does /not/ work up to ~.
...
...
compiler/vectorise/Vectorise.hs
View file @
e8f5efb5
...
...
@@ -71,7 +71,7 @@ vectModule guts@(ModGuts { mg_tcs = tycons
-- Vectorise the type environment. This will add vectorised
-- type constructors, their representations, and the
-- co
n
rresponding data constructors. Moreover, we produce
-- corresponding data constructors. Moreover, we produce
-- bindings for dfuns and family instances of the classes
-- and type families used in the DPH library to represent
-- array types.
...
...
docs/users_guide/glasgow_exts.rst
View file @
e8f5efb5
...
...
@@ -6877,7 +6877,7 @@ completely covers the cases covered by the instance head.
- A historical note. In the past (but no longer), GHC allowed you to
write *multiple* type or data family instances for a single
ass
s
ociated type. For example: ::
associated type. For example: ::
instance GMapKey Flob where
data GMap Flob [v] = G1 v
...
...
ghc/GHCi/UI.hs
View file @
e8f5efb5
...
...
@@ -3362,7 +3362,7 @@ findBreakByLine line arr
(
comp
,
incomp
)
=
partition
ends_here
starts_here
where
ends_here
(
_
,
pan
)
=
GHC
.
srcSpanEndLine
pan
==
line
-- The aim is to find the breakp
i
onts for all the RHSs of the
-- The aim is to find the breakpo
i
nts for all the RHSs of the
-- equations corresponding to a binding. So we find all breakpoints
-- for
-- (a) this binder only (not a nested declaration)
...
...
libraries/base/GHC/ExecutionStack/Internal.hsc
View file @
e8f5efb5
...
...
@@ -49,7 +49,7 @@ data SrcLoc = SrcLoc { sourceFile :: String
, sourceColumn :: Int
}
-- | Location information about an address
s
from a backtrace.
-- | Location information about an address from a backtrace.
data Location = Location { objectName :: String
, functionName :: String
, srcLoc :: Maybe SrcLoc
...
...
testsuite/tests/parser/should_fail/readFail027.hs
View file @
e8f5efb5
...
...
@@ -10,6 +10,6 @@ f x = case x of
-- Update: arguably this should be allowed. The fix to the Haskell
-- layout rule to allow it is simple: in Section 9.3 in the rules that
-- govern the introduction of the <n> and {n} ps
u
edo-tokens, we need
-- govern the introduction of the <n> and {n} pse
u
do-tokens, we need
-- to prevent <n> being inserted before {. This could be a simple
-- side-condition on the rule that introduces <n>.
testsuite/tests/programs/andy_cherry/andy_cherry.stdout
View file @
e8f5efb5
...
...
@@ -974,7 +974,7 @@ his advantage.
18
&
B*d6
&
\\
\end{tabular}
}
|
\end{center}
this is to early, leaving myself underdeveloped.
this is to
o
early, leaving myself underdeveloped.
|18.~Re1, f6; 19.~B*d6, N*d6; 20.~Qd3|
\wupperhand
{}
\begin{center}
|
...
...
testsuite/tests/programs/andy_cherry/mygames.pgn
View file @
e8f5efb5
...
...
@@ -151,7 +151,7 @@ but black can easily win back the pawn.}) 15... Rac8? (15... d6 16. d4
exd4 17. e5 Qe7 18. exd6 Nxd6 19. Bxd6 Qxd6 {<ab>}) 16. Bxe5 Qg6 17. d4 (
17. Bg3 Rfe8 18. Ne5 Qf6 19. Nxd7 Qxb2 20. Re1 {<aw> white should now
try use his center pawns to push home his advantage.}) 17... Bd6 18.
Bxd6 {this is to early, leaving myself underdeveloped.} (18. Re1 f6 19.
Bxd6 {this is to
o
early, leaving myself underdeveloped.} (18. Re1 f6 19.
Bxd6 Nxd6 20. Qd3 {<aw>}) 18... Nxd6 19. Ne5 (19. e5 Nc4 20. b3 Na3 21.
Rc1 d6 22. Re1 {<aw>}) 19... Qxe4 20. Nxd7 Rfe8 21. Nc5 Qg6? (21...
Qe2 22. Re1 Qc4 23. Qd2 Rcd8 24. Rad1 a5 {<aw> white is a clear pawn up.})
...
...
testsuite/tests/programs/galois_raytrace/Data.hs
View file @
e8f5efb5
...
...
@@ -15,7 +15,7 @@ import Surface
import
Debug.Trace
-- Now the parsed (express
s
ion) language
-- Now the parsed (expression) language
type
Name
=
String
...
...
testsuite/tests/rename/should_fail/T4042.hs
View file @
e8f5efb5
...
...
@@ -6,7 +6,7 @@ f :: A -> A
f
-- The above line is a naked Template Haskell splice
-- When compiling without -XTemplateHaskell we don't
-- want a confusing error mess
s
age saying "A is not in scope"
-- want a confusing error message saying "A is not in scope"
data
A
=
A
testsuite/tests/simplCore/T9646/readme.txt
View file @
e8f5efb5
...
...
@@ -4,7 +4,7 @@ The problem addressed in that ticket was that under some circumstances,
GHC < 7.10.3 was failing to perform eta reduction deterministically.
Compiling this code now (2016/03/16) under ghc-7.8.4 and git HEAD shows that
ghc-7.8.4 produces more complicated code, with a number of extra lamb
a
das which
ghc-7.8.4 produces more complicated code, with a number of extra lambdas which
are completely absent in the fast version.
Git HEAD current produces:
...
...
testsuite/tests/typecheck/should_fail/tcfail162.hs
View file @
e8f5efb5
-- Kind error mess
s
age should not contain bangs
-- Kind error message should not contain bangs
module
ShouldFail
where
...
...
utils/ghc-pkg/Main.hs
View file @
e8f5efb5
...
...
@@ -532,7 +532,7 @@ readPackageArg AsDefault str = Id `fmap` readGlobPkgId str
data
PackageDB
=
PackageDB
{
location
,
locationAbsolute
::
!
FilePath
,
-- We need both possibly-relative and defin
a
tely-absolute package
-- We need both possibly-relative and defin
i
tely-absolute package
-- db locations. This is because the relative location is used as
-- an identifier for the db, so it is important we do not modify it.
-- On the other hand we need the absolute path in a few places
...
...
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