Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Glasgow Haskell Compiler
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
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
Shayne Fletcher
Glasgow Haskell Compiler
Commits
50512c6b
Commit
50512c6b
authored
Mar 14, 2017
by
Gabor Greif
💬
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Typos in manual and comments
parent
08e73ccf
Changes
19
Hide whitespace changes
Inline
Side-by-side
Showing
19 changed files
with
26 additions
and
26 deletions
+26
-26
compiler/basicTypes/Demand.hs
compiler/basicTypes/Demand.hs
+1
-1
compiler/ghci/ByteCodeGen.hs
compiler/ghci/ByteCodeGen.hs
+1
-1
compiler/nativeGen/RegAlloc/Graph/Stats.hs
compiler/nativeGen/RegAlloc/Graph/Stats.hs
+2
-2
compiler/simplCore/SimplEnv.hs
compiler/simplCore/SimplEnv.hs
+1
-1
compiler/typecheck/FunDeps.hs
compiler/typecheck/FunDeps.hs
+1
-1
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcBinds.hs
+6
-6
compiler/typecheck/TcPat.hs
compiler/typecheck/TcPat.hs
+1
-1
compiler/typecheck/TcRules.hs
compiler/typecheck/TcRules.hs
+1
-1
compiler/typecheck/TcSigs.hs
compiler/typecheck/TcSigs.hs
+1
-1
compiler/typecheck/TcTypeable.hs
compiler/typecheck/TcTypeable.hs
+1
-1
compiler/typecheck/TcValidity.hs
compiler/typecheck/TcValidity.hs
+1
-1
compiler/types/TyCoRep.hs
compiler/types/TyCoRep.hs
+1
-1
compiler/utils/GraphColor.hs
compiler/utils/GraphColor.hs
+1
-1
compiler/utils/GraphOps.hs
compiler/utils/GraphOps.hs
+1
-1
docs/rts/rts.tex
docs/rts/rts.tex
+1
-1
libraries/base/GHC/Base.hs
libraries/base/GHC/Base.hs
+2
-2
libraries/ghc-compact/GHC/Compact.hs
libraries/ghc-compact/GHC/Compact.hs
+1
-1
testsuite/tests/profiling/should_run/heapprof001.hs
testsuite/tests/profiling/should_run/heapprof001.hs
+1
-1
testsuite/tests/safeHaskell/overlapping/SH_Overlap3.hs
testsuite/tests/safeHaskell/overlapping/SH_Overlap3.hs
+1
-1
No files found.
compiler/basicTypes/Demand.hs
View file @
50512c6b
...
...
@@ -1229,7 +1229,7 @@ diverge, and we do not anything being passed to b.
Note [Asymmetry of 'both' for DmdType and DmdResult]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'both' for DmdTypes is *as
sy
metrical*, because there is only one
'both' for DmdTypes is *as
ym
metrical*, because there is only one
result! For example, given (e1 e2), we get a DmdType dt1 for e1, use
its arg demand to analyse e2 giving dt2, and then do (dt1 `bothType` dt2).
Similarly with
...
...
compiler/ghci/ByteCodeGen.hs
View file @
50512c6b
...
...
@@ -180,7 +180,7 @@ coreExprToBCOs hsc_env this_mod expr
where
dflags
=
hsc_dflags
hsc_env
-- The regular freeVars function gives more information than is useful to
-- us here. simpleFreeVars does the imped
e
nce matching.
-- us here. simpleFreeVars does the imped
a
nce matching.
simpleFreeVars
::
CoreExpr
->
AnnExpr
Id
DVarSet
simpleFreeVars
=
go
.
freeVars
where
...
...
compiler/nativeGen/RegAlloc/Graph/Stats.hs
View file @
50512c6b
...
...
@@ -60,7 +60,7 @@ data RegAllocStats statics instr
-- | Partially colored graph.
,
raGraph
::
Color
.
Graph
VirtualReg
RegClass
RealReg
-- | The regs that were coaleced.
-- | The regs that were coale
s
ced.
,
raCoalesced
::
UniqFM
VirtualReg
-- | Spiller stats.
...
...
@@ -84,7 +84,7 @@ data RegAllocStats statics instr
-- | Coalesced and colored graph.
,
raGraphColored
::
Color
.
Graph
VirtualReg
RegClass
RealReg
-- | Regs that were coaleced.
-- | Regs that were coale
s
ced.
,
raCoalesced
::
UniqFM
VirtualReg
-- | Code with coalescings applied.
...
...
compiler/simplCore/SimplEnv.hs
View file @
50512c6b
...
...
@@ -790,7 +790,7 @@ the letrec.
{-
************************************************************************
* *
Imped
e
nce matching to type substitution
Imped
a
nce matching to type substitution
* *
************************************************************************
-}
...
...
compiler/typecheck/FunDeps.hs
View file @
50512c6b
...
...
@@ -212,7 +212,7 @@ improveFromInstEnv inst_env mk_loc pred
-- because there often are none!
,
let
trimmed_tcs
=
trimRoughMatchTcs
cls_tvs
fd
rough_tcs
-- Trim the rough_tcs based on the head of the fundep.
-- Remember that instanceCantMatch treats both argum
n
ents
-- Remember that instanceCantMatch treats both arguments
-- symmetrically, so it's ok to trim the rough_tcs,
-- rather than trimming each inst_tcs in turn
,
ispec
<-
instances
...
...
compiler/typecheck/TcBinds.hs
View file @
50512c6b
...
...
@@ -831,7 +831,7 @@ mkExport prag_fn qtvs theta
;
spec_prags
<-
tcSpecPrags
poly_id
prag_sigs
-- tcPrags requires a zonked poly_id
-- See Note [Imped
e
nce matching]
-- See Note [Imped
a
nce matching]
-- NB: we have already done checkValidType, including an ambiguity check,
-- on the type; either when we checked the sig or in mkInferredPolyId
;
let
poly_ty
=
idType
poly_id
...
...
@@ -843,7 +843,7 @@ mkExport prag_fn qtvs theta
then
return
idHsWrapper
-- Fast path; also avoids complaint when we infer
-- an ambiguouse type and have AllowAmbiguousType
-- e..g infer x :: forall a. F a -> Int
else
addErrCtxtM
(
mk_imped
e
nce_match_msg
mono_info
sel_poly_ty
poly_ty
)
$
else
addErrCtxtM
(
mk_imped
a
nce_match_msg
mono_info
sel_poly_ty
poly_ty
)
$
tcSubType_NC
sig_ctxt
sel_poly_ty
poly_ty
;
warn_missing_sigs
<-
woptM
Opt_WarnMissingLocalSignatures
...
...
@@ -869,7 +869,7 @@ mkInferredPolyId qtvs inferred_theta poly_name mb_sig_inst mono_ty
|
otherwise
-- Either no type sig or partial type sig
=
checkNoErrs
$
-- The checkNoErrs ensures that if the type is ambiguous
-- we don't carry on to the imped
e
nce matching, and generate
-- we don't carry on to the imped
a
nce matching, and generate
-- a duplicate ambiguity error. There is a similar
-- checkNoErrs for complete type signatures too.
do
{
fam_envs
<-
tcGetFamInstEnvs
...
...
@@ -966,11 +966,11 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
mk_ctuple
preds
=
do
{
tc
<-
tcLookupTyCon
(
cTupleTyConName
(
length
preds
))
;
return
(
mkTyConApp
tc
preds
)
}
mk_imped
e
nce_match_msg
::
MonoBindInfo
mk_imped
a
nce_match_msg
::
MonoBindInfo
->
TcType
->
TcType
->
TidyEnv
->
TcM
(
TidyEnv
,
SDoc
)
-- This is a rare but rather awkward error messages
mk_imped
e
nce_match_msg
(
MBI
{
mbi_poly_name
=
name
,
mbi_sig
=
mb_sig
})
mk_imped
a
nce_match_msg
(
MBI
{
mbi_poly_name
=
name
,
mbi_sig
=
mb_sig
})
inf_ty
sig_ty
tidy_env
=
do
{
(
tidy_env1
,
inf_ty
)
<-
zonkTidyTcType
tidy_env
inf_ty
;
(
tidy_env2
,
sig_ty
)
<-
zonkTidyTcType
tidy_env1
sig_ty
...
...
@@ -1077,7 +1077,7 @@ Examples that might fail:
- an inferred type that includes unboxed tuples
Note [Imped
e
nce matching]
Note [Imped
a
nce matching]
~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
f 0 x = x
...
...
compiler/typecheck/TcPat.hs
View file @
50512c6b
...
...
@@ -243,7 +243,7 @@ subsumption, not equality, check against the context type. e.g.
Since 'blah' returns a value of type T, its payload is a polymorphic
function of type (forall a. a->a). And that's enough to bind the
less-polymorphic function 'f', but we need some imped
e
nce matching
less-polymorphic function 'f', but we need some imped
a
nce matching
to witness the instantiation.
...
...
compiler/typecheck/TcRules.hs
View file @
50512c6b
...
...
@@ -285,7 +285,7 @@ These don't have a name, so we can't quantify over them directly.
Instead, because we really do want to quantify here, invent a new
EvVar for the coercion, fill the hole with the invented EvVar, and
then quantify over the EvVar. Not too tricky -- just some
imped
e
nce matching, really.
imped
a
nce matching, really.
Note [Simplify cloned constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
...
...
compiler/typecheck/TcSigs.hs
View file @
50512c6b
...
...
@@ -470,7 +470,7 @@ the signature types for f and g, we'll end up unifying 'a' and 'b'
So we instantiate f and g's signature with SigTv skolems
(newMetaSigTyVars) that can unify with each other. If too much
unification takes place, we'll find out when we do the final
imped
e
nce-matching check in TcBinds.mkExport
imped
a
nce-matching check in TcBinds.mkExport
See Note [Signature skolems] in TcType
...
...
compiler/typecheck/TcTypeable.hs
View file @
50512c6b
...
...
@@ -450,7 +450,7 @@ typeIsTypeable (CoercionTy{}) = panic "typeIsTypeable(Coercion)"
type
KindRepEnv
=
TypeMap
(
Id
,
Maybe
(
LHsExpr
Id
))
-- | A monad within which we will generate 'KindRep's. Here we keep an
-- environment
s
containing 'KindRep's which we've already generated so we can
-- environment containing 'KindRep's which we've already generated so we can
-- re-use them opportunistically.
newtype
KindRepM
a
=
KindRepM
{
unKindRepM
::
StateT
KindRepEnv
TcRn
a
}
deriving
(
Functor
,
Applicative
,
Monad
)
...
...
compiler/typecheck/TcValidity.hs
View file @
50512c6b
...
...
@@ -118,7 +118,7 @@ and fail.
So in fact we use this as our *definition* of ambiguity. We use a
very similar test for *inferred* types, to ensure that they are
unambiguous. See Note [Imped
e
nce matching] in TcBinds.
unambiguous. See Note [Imped
a
nce matching] in TcBinds.
This test is very conveniently implemented by calling
tcSubType <type> <type>
...
...
compiler/types/TyCoRep.hs
View file @
50512c6b
...
...
@@ -954,7 +954,7 @@ mentions the same name with different kinds, but it *is* well-kinded, noting
that `(tv1:k2) |> sym kind_co` has kind k1.
This all really would work storing just a Name in the ForAllCo. But we can't
add Names to, e.g., VarSets, and there generally is just an imped
e
nce mismatch
add Names to, e.g., VarSets, and there generally is just an imped
a
nce mismatch
in a bunch of places. So we use tv1. When we need tv2, we can use
setTyVarKind.
...
...
compiler/utils/GraphColor.hs
View file @
50512c6b
...
...
@@ -45,7 +45,7 @@ colorGraph
->
(
Graph
k
cls
color
-- the colored graph.
,
UniqSet
k
-- the set of nodes that we couldn't find a color for.
,
UniqFM
k
)
-- map of regs (r1 -> r2) that were coaleced
,
UniqFM
k
)
-- map of regs (r1 -> r2) that were coale
s
ced
-- r1 should be replaced by r2 in the source
colorGraph
iterative
spinCount
colors
triv
spill
graph0
...
...
compiler/utils/GraphOps.hs
View file @
50512c6b
...
...
@@ -279,7 +279,7 @@ addPreference (u, c) color
-- | Do aggressive coalescing on this graph.
-- returns the new graph and the list of pairs of nodes that got coaleced together.
-- returns the new graph and the list of pairs of nodes that got coale
s
ced together.
-- for each pair, the resulting node will have the least key and be second in the pair.
--
coalesceGraph
...
...
docs/rts/rts.tex
View file @
50512c6b
...
...
@@ -309,7 +309,7 @@ Functions can take multiple arguments as easily as they can take one
argument: there's no cost for adding another argument. But functions
can only return one result: the cost of adding a second ``result'' is
that the function must construct a tuple of ``results'' on the heap.
The as
sy
metry is rather galling and can make certain programming
The as
ym
metry is rather galling and can make certain programming
styles quite expensive. For example, consider a simple state transformer
monad:
\begin{verbatim}
...
...
libraries/base/GHC/Base.hs
View file @
50512c6b
...
...
@@ -974,14 +974,14 @@ The rules for map work like this.
* The "mapFB" rule optimises compositions of map
* The "mapFB/id" rule get
rids
of 'map id' calls.
* The "mapFB/id" rule get
s rid
of 'map id' calls.
You might think that (mapFB c id) will turn into c simply
when mapFB is inlined; but before that happens the "mapList"
rule turns
(foldr (mapFB (:) id) [] a
back into
map id
Which is not very cleve
e
r.
Which is not very clever.
* Any similarity to the Functor laws for [] is expected.
-}
...
...
libraries/ghc-compact/GHC/Compact.hs
View file @
50512c6b
...
...
@@ -103,7 +103,7 @@ import GHC.Types
-- separate copy of the data.
--
-- The cost of compaction is similar to the cost of GC for the same
-- data, but it is perfomed only once. However, because
-- data, but it is perfo
r
med only once. However, because
-- "Data.Compact.compact" does not stop-the-world, retaining internal
-- sharing during the compaction process is very costly. The user
-- can choose whether to 'compact' or 'compactWithSharing'.
...
...
testsuite/tests/profiling/should_run/heapprof001.hs
View file @
50512c6b
...
...
@@ -169,7 +169,7 @@ split p = split' p []
spri
(
Ast
x
:
Lex
c
:
s
)
=
opri
c
spri
s
=
0
-- does any symbol appear in both consequent and anteced
a
nt of clause
-- does any symbol appear in both consequent and anteced
e
nt of clause
tautclause
(
c
,
a
)
=
[
x
|
x
<-
c
,
x
`
elem
`
a
]
/=
[]
-- form unique clausal axioms excluding tautologies
...
...
testsuite/tests/safeHaskell/overlapping/SH_Overlap3.hs
View file @
50512c6b
...
...
@@ -2,7 +2,7 @@
{-# LANGUAGE FlexibleInstances #-}
-- | Same as SH_Overlap1, but module where overlap occurs (SH_Overlap3) is
-- marked `Unsafe`. Compilation should succeed (symetry with inferring safety).
-- marked `Unsafe`. Compilation should succeed (sym
m
etry with inferring safety).
module
SH_Overlap3
where
import
SH_Overlap3_A
...
...
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