diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index a1287379e44e3a91bfbce3831b4e0ec76a9da100..ef1555f58b865b8a42847a04c04f8324ee1ece5f 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -2091,7 +2091,7 @@ rhsIsStatic :: Platform -- -- (ii) We treat partial applications as redexes, because in fact we -- make a thunk for them that runs and builds a PAP --- at run-time. The only appliations that are treated as +-- at run-time. The only applications that are treated as -- static are *saturated* applications of constructors. -- We used to try to be clever with nested structures like this: diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 2632fd19feeae6f7527b043580f8d213f6b8963c..4c7417fa21fe5415140aafa95f55a5045996dc67 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -306,7 +306,7 @@ People write so much, where runST :: (forall s. ST s a) -> a that I have finally given in and written a special type-checking -rule just for saturated appliations of ($). +rule just for saturated applications of ($). * Infer the type of the first argument * Decompose it; should be of form (arg2_ty -> res_ty), where arg2_ty might be a polytype @@ -1938,7 +1938,7 @@ getFixedTyVars upd_fld_occs univ_tvs cons -- Universally-quantified tyvars that -- appear in any of the *implicit* -- arguments to the constructor are fixed - -- See Note [Implict type sharing] + -- See Note [Implicit type sharing] fixed_tys = [ty | (fl, ty) <- zip flds arg_tys , not (flLabel fl `elem` upd_fld_occs)] diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 24a335831c072335d319a24ee0dce68c15376733..6987191443378d5c790f4a2ce489e355f117e6d6 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -432,7 +432,7 @@ Assuming NOT rewriting wanteds with wanteds [G] V a ~ f_aBg Worklist includes [W] Scalar fmv_aBi ~ fmv_aBk - fmv_aBi, fmv_aBk are flatten unificaiton variables + fmv_aBi, fmv_aBk are flatten unification variables Work item: [W] V fsk_aBh ~ fmv_aBi diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 50e4c54d50ac20aa5083f1f898d6e90f21a0f6a8..672f4b3660f68e08b8994caea44a9f96e44a543b 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1591,7 +1591,7 @@ a polytype. E.g. The type checker checks this code, and it currently requires -XImpredicativeTypes to permit that polymorphic type instantiation, -so ew have to switch that flag on locally in TcDeriv.genInst. +so we have to switch that flag on locally in TcDeriv.genInst. See #8503 for more discussion. diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index aa97075449b982c4334ed2d8d48a6a1c3c315fc0..1a46a0ac08226b89c8dd58294982dccab29eb246 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -941,7 +941,7 @@ Notice that be usused in some, but dead-code elimination will drop it.) We achieve this by putting the the evidence variable for the overall - instance implicaiton into the AbsBinds for each method/superclass. + instance implication into the AbsBinds for each method/superclass. Hence the 'dfun_ev_binds' passed into tcMethods and tcSuperClasses. (And that in turn is why the abs_ev_binds field of AbBinds is a [TcEvBinds] rather than simply TcEvBinds. diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index af87483a6dc6e4f1d67e8626717ce94d7e42812c..ff0ee9ea491e10482f922fe0dab66c0684b9d255 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -379,7 +379,7 @@ checkingExpType err et = pprPanic "checkingExpType" (text err $$ ppr et) tauifyExpType :: ExpType -> TcM ExpType -- ^ Turn a (Infer hole) type into a (Check alpha), --- where alpha is a fresh unificaiton variable +-- where alpha is a fresh unification variable tauifyExpType (Check ty) = return (Check ty) -- No-op for (Check ty) tauifyExpType (Infer inf_res) = do { ty <- inferResultToType inf_res ; return (Check ty) } diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 05943136f0ef07b52828bcc90e58e0368c6e02ed..c23b3171ab99cbd56dd09f1b49a449eafc53187d 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1553,8 +1553,8 @@ of progress. Trac #8474 is a classic example: exponentially many) iterations! Conclusion: we should call solveNestedImplications only if we did -some unifiction in solveSimpleWanteds; because that's the only way -we'll get more Givens (a unificaiton is like adding a Given) to +some unification in solveSimpleWanteds; because that's the only way +we'll get more Givens (a unification is like adding a Given) to allow the implication to make progress. -} diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index f073c7b0f72c1a0e9c21e621ac346b9ff057faaf..d194321fe47cba800316c91aa94e0a1f7fec7d5f 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -999,7 +999,7 @@ with constraints Here we abstract over the '->' inside the forall, in case that is subject to an equality constraint from a GADT match. -Note that we kept the outer (->) becuase that's part of +Note that we kept the outer (->) because that's part of the polymorphic "shape". And becauuse of impredicativity, GADT matches can't give equalities that affect polymorphic shape. diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index b78db7c6daf60835c0f63982b4d55ddc71e7f59f..70ea2e42b9616215eecb14864a15c9f4238e3f43 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -275,7 +275,7 @@ vectTopBind b@(Rec binds) -- Add a vectorised binding to an imported top-level variable that has a VECTORISE pragma -- in this module. -- --- RESTIRCTION: Currently, we cannot use the pragma for mutually recursive definitions. +-- RESTRICTION: Currently, we cannot use the pragma for mutually recursive definitions. -- vectImpBind :: (Id, CoreExpr) -> VM CoreBind vectImpBind (var, expr) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 9cda16a97038bc2d70e664ae5ac2adfaf9a5ac21..af5879243e94b116c349014a80acb3e965857f5b 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9493,13 +9493,13 @@ your ``forall``\s explicitly. Indeed, doing so is strongly advised for rank-2 types. Sometimes there *is* no "outermost level", in which case no -implicit quanification happens: :: +implicit quantification happens: :: data PackMap a b s t = PackMap (Monad f => (a -> f b) -> s -> f t) This is rejected because there is no "outermost level" for the types on the RHS (it would obviously be terrible to add extra parameters to ``PackMap``), -so no implicit quantificaiton happens, and the declaration is rejected +so no implicit quantification happens, and the declaration is rejected (with "``f`` is out of scope"). Solution: use an explicit ``forall``: :: data PackMap a b s t = PackMap (forall f. Monad f => (a -> f b) -> s -> f t) @@ -11590,7 +11590,7 @@ optionally had by adding ``!`` in front of a variable. In ordinary Haskell, ``f`` is lazy in its argument and hence in ``x``; and ``g`` is strict in its argument and hence also strict in ``x``. With ``Strict``, both become strict because ``f``'s argument - gets an implict bang. + gets an implicit bang. .. _strict-modularity: diff --git a/testsuite/tests/typecheck/should_fail/tcfail174.hs b/testsuite/tests/typecheck/should_fail/tcfail174.hs index 85c5e1c961da870f79f1c9aa2988ff9483998b2f..c3328ea4e7b8a226c2e78b75e4879e3870cc8cda 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail174.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail174.hs @@ -8,7 +8,7 @@ data Capture a = Base a g :: Capture (forall a . a -> a) g = Base id -- Fails; need a rigid signature on 'id' -- Actually, succeeds now, with visible type application - -- Disagree: should not succeed becuase it instantiates + -- Disagree: should not succeed because it instantiates -- Base with a forall type -- This function should definitely be rejected, with or without type signature