diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs index 37d92c207d4f5de8d05f9324fb8053242a5c37f8..f852d54b3437f117151f8a4866a8f633c864b18f 100644 --- a/compiler/cmm/CmmType.hs +++ b/compiler/cmm/CmmType.hs @@ -436,7 +436,7 @@ Cons: Currently for GHC, the foreign call point is moot, because we do our own promotion of sub-word-sized values to word-sized values. The Int8 -type is represnted by an Int# which is kept sign-extended at all times +type is represented by an Int# which is kept sign-extended at all times (this is slightly naughty, because we're making assumptions about the C calling convention rather early on in the compiler). However, given this, the cons outweigh the pros. diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index 240e63b5b66be62d0030f11458e1f8cda1ea3e9a..3e48ec3a8a679fea48687ccf1bf36580f009d122 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -74,7 +74,7 @@ See #7730, #8776 for details -} -------------------- -- | Pretty-prints a 'FamInst' (type/data family instance) with its defining location. pprFamInst :: FamInst -> SDoc --- * For data instances we go via pprTyThing of the represntational TyCon, +-- * For data instances we go via pprTyThing of the representational TyCon, -- because there is already much cleverness associated with printing -- data type declarations that I don't want to duplicate -- * For type instances we print directly here; there is no TyCon diff --git a/compiler/typecheck/Flattening-notes b/compiler/typecheck/Flattening-notes index 657e91e0faa9a2b15828824dcc118bf2f7fa329a..ffe39ab5e5fa28592d76b60d376f90c651357cc0 100644 --- a/compiler/typecheck/Flattening-notes +++ b/compiler/typecheck/Flattening-notes @@ -37,7 +37,7 @@ such that (WF2) if (a -f-> t) is in S, then t /= a Definition: applying a generalised substitution. -If S is a generalised subsitution +If S is a generalised substitution S(f,a) = t, if (a -fs-> t) in S, and fs >= f = a, otherwise Application extends naturally to types S(f,t) @@ -62,7 +62,7 @@ A generalised substitution S is "inert" iff ---------------------------------------------------------------- Our main invariant: - the inert CTyEqCans should be an inert generalised subsitution + the inert CTyEqCans should be an inert generalised substitution ---------------------------------------------------------------- Note that inertness is not the same as idempotence. To apply S to a @@ -100,7 +100,7 @@ The idea is that not satisfy (K1-3), then we remove it from S by "kicking it out", and re-processing it. -* Note that kicking out is a Bad Thing, becuase it means we have to +* Note that kicking out is a Bad Thing, because it means we have to re-process a constraint. The less we kick out, the better. * Assume we have G>=G, G>=W, D>=D, and that's all. Then, when performing diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 13aa8e724f3b55eb7c85e702d5e06db74c1998b6..97ab0e83cf75d9a4b110990cac038308a0329968 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -815,7 +815,7 @@ canEqTyVarTyVar ev swapped tv1 tv2 co2 -- So tv1 is not a meta tyvar -- If only one is a meta tyvar, put it on the left - -- This is not because it'll be solved; but becuase + -- This is not because it'll be solved; but because -- the floating step looks for meta tyvars on the left | isMetaTyVar tv2 = True diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index d52a7216da4c36710cbdee6cd118f4dd4fbfbe2b..457720708fbddc4d404eaca81778f36890d61a33 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -557,7 +557,7 @@ deriveAutoTypeable auto_typeable done_specs tycl_decls | spec <- done_specs , className (earlyDSClass spec) == typeableClassName ] -- Check if an automatically generated DS for deriving Typeable should be - -- ommitted because the user had manually requested an instance + -- omitted because the user had manually requested an instance do_one cls (L _ decl) = do { tc <- tcLookupTyCon (tcdName decl) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 6409d6d18637bb1d6dcebebed010b4617b76f70c..56c33b15fec4a911b82b0bb189ba0c2b81fb7aeb 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1467,7 +1467,7 @@ relevantBindings want_filtering ctxt ct ct_tvs = tyVarsOfCt ct `unionVarSet` extra_tvs -- For *kind* errors, report the relevant bindings of the - -- enclosing *type* equality, becuase that's more useful for the programmer + -- enclosing *type* equality, because that's more useful for the programmer extra_tvs = case ctLocOrigin loc of KindEqOrigin t1 t2 _ -> tyVarsOfTypes [t1,t2] _ -> emptyVarSet diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 57adb1ccab5f34746b1b6b6c0bf46ce0e70c054e..c9281088edfca7e17fb51c819e5e946b501ecd3a 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -2316,7 +2316,7 @@ We often want to make a top-level auxiliary binding. E.g. for comparison we hae Of course these top-level bindings should all have distinct name, and we are generating RdrNames here. We can't just use the TyCon or DataCon to distinguish -becuase with standalone deriving two imported TyCons might both be called T! +because with standalone deriving two imported TyCons might both be called T! (See Trac #7947.) So we use the *unique* from the parent name (T in this example) as part of the diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index c6e9fb6324f9eb95096433dd6edc3521f21ac1d8..edb3303abd6df941f98d66bb0053b208c4f58e51 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -968,7 +968,7 @@ kick_out new_ev new_tv (IC { inert_eqs = tv_eqs -- NB: Notice that don't rewrite -- inert_solved_dicts, and inert_solved_funeqs -- optimistically. But when we lookup we have to - -- take the subsitution into account + -- take the substitution into account inert_cans_in = IC { inert_eqs = tv_eqs_in , inert_dicts = dicts_in , inert_funeqs = feqs_in @@ -2270,7 +2270,7 @@ instance would fail: But MkT was in scope, *and* if we used it before decomposing on T, we'd unwrap the newtype (on both sides) to get Coercible Bool (F Int) -whic succeeds. +which succeeds. So our current decision is to apply case 3 (newtype-unwrapping) first, followed by decomposition (case 4). This is strictly more powerful diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 74c5ff4b48068e3ceb4cf2e802ef2be588ae695c..5945bdecfa3f47c4a66be63101472b83dcb8fc8a 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1274,7 +1274,7 @@ Here we need to instantiate 'error' with a polytype. But 'error' has an OpenTypeKind type variable, precisely so that we can instantiate it with Int#. So we also allow such type variables -to be instantiate with foralls. It's a bit of a hack, but seems +to be instantiated with foralls. It's a bit of a hack, but seems straightforward. ************************************************************************ diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index 0f1d9610efba1ad1d812fa5973eef21a79185a48..9cc941012bb7a760583c8c56ffb7c00736abc9f5 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -161,7 +161,7 @@ data (~) a b = Eq# ((~#) a b) -- -- /Since: 4.7.0.0/ data Coercible a b = MkCoercible ((~#) a b) --- It's really ~R# (represntational equality), not ~#, +-- It's really ~R# (representational equality), not ~#, -- but * we don't yet have syntax for ~R#, -- * the compiled code is the same either way -- * TysWiredIn has the truthful types diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 0023ce83c1d31a53f81206d1794365053abbfbf3..5eda5a20af749881ae8f581c09491bbffe07eaa0 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -405,7 +405,7 @@ test('T5321Fun', # 15/05/2013: 628341952 # (reason for decrease unknown) # 24/06/2013: 694019152 # (reason for re-increase unknown) # 12/05/2014: 614409344 # (specialisation and inlining changes) - # 10/09/2014: 601629032 # post-AMP-cleanp + # 10/09/2014: 601629032 # post-AMP-cleanup # 06/11/2014: 541287000 # Simon's flat-skol changes to the constraint solver ], compile,[''])