diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 5c5e8e4e02a76f32ae53c3c9110e37371e4b5afc..efefd17e4a5aef4716f2256eab559d17d016aace 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -772,7 +772,7 @@ However, some code is internally generated, and in some places
 parens are absolutely required; so for these places we use
 pprParendExpr (but don't print double parens of course).
 
-For operator applications we don't add parens, because the oprerator
+For operator applications we don't add parens, because the operator
 fixities should do the job, except in debug mode (-dppr-debug) so we
 can see the structure of the parse tree.
 -}
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index f9e61a5ac52b4d162644885c0f3acc8c9eff48ec..818bb73332870e03ec23b9b624088f457cd6400d 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -97,7 +97,7 @@ label_self thread_name = do
 --
 -- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
 -- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
--- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module.  Thus if you want to
+-- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module.  Thus if you want
 -- changes to the 'DynFlags' to take effect you need to call this function
 -- again.
 --
diff --git a/compiler/simplCore/SimplMonad.hs b/compiler/simplCore/SimplMonad.hs
index 7eb6a54ced70078cc560560589a26a5839b6cd5d..bd60a7942c2d05007befd014e54b77916c0c77ad 100644
--- a/compiler/simplCore/SimplMonad.hs
+++ b/compiler/simplCore/SimplMonad.hs
@@ -91,7 +91,7 @@ computeMaxTicks dflags size
         -- MAGIC NUMBER, multiplies the simplTickFactor
         -- We can afford to be generous; this is really
         -- just checking for loops, and shouldn't usually fire
-        -- A figure of 20 was too small: see Trac #553
+        -- A figure of 20 was too small: see Trac #5539.
 
 {-# INLINE thenSmpl #-}
 {-# INLINE thenSmpl_ #-}
diff --git a/compiler/types/TypeRep.hs b/compiler/types/TypeRep.hs
index c78c9c597513b83fda8fd67654de566d743525e1..3e46de342a2d116cdb305fa79131d39cdec1043a 100644
--- a/compiler/types/TypeRep.hs
+++ b/compiler/types/TypeRep.hs
@@ -98,7 +98,7 @@ import qualified Data.Data        as Data hiding ( TyCon )
 data Type
   = TyVarTy Var -- ^ Vanilla type or kind variable (*never* a coercion variable)
 
-  | AppTy         -- See Note [AppTy invariant]
+  | AppTy         -- See Note [AppTy rep]
         Type
         Type            -- ^ Type application to something other than a 'TyCon'. Parameters:
                         --
@@ -107,10 +107,10 @@ data Type
                         --
                         --  2) Argument type
 
-  | TyConApp      -- See Note [AppTy invariant]
+  | TyConApp      -- See Note [AppTy rep]
         TyCon
         [KindOrType]    -- ^ Application of a 'TyCon', including newtypes /and/ synonyms.
-                        -- Invariant: saturated appliations of 'FunTyCon' must
+                        -- Invariant: saturated applications of 'FunTyCon' must
                         -- use 'FunTy' and saturated synonyms must use their own
                         -- constructors. However, /unsaturated/ 'FunTyCon's
                         -- do appear as 'TyConApp's.
diff --git a/ghc.mk b/ghc.mk
index 3638a1ba62b7b6632e8973007e5c9dcf3324dea1..b9bba13199536856446cb7e9a12184c461190a97 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -49,18 +49,18 @@
 #           o Build utils/ghc-pkg
 #           o Build utils/hsc2hs
 #     * For each package:
-#	    o configure, generate package-data.mk and inplace-pkg-info
+#	    o configure, generate package-data.mk and inplace-pkg-config
 #           o register each package into inplace/lib/package.conf
 #     * build libffi (if not disabled by --with-system-libffi)
 #     * With bootstrapping compiler:
 #	    o Build libraries/{filepath,hpc,Cabal}
 #           o Build compiler (stage 1)
-#     * With stage 1:
+#     * With stage 1 compiler:
 #           o Build libraries/*
 #	    o Build rts
 #           o Build utils/* (except haddock)
 #           o Build compiler (stage 2)
-#     * With stage 2:
+#     * With stage 2 compiler:
 #           o Build utils/haddock
 #           o Build compiler (stage 3) (optional)
 #     * With haddock:
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 5b566cb47a25f8a451778b50340fcb1ace9373a0..3bc738667d1911ed017afc16df2f189757e7f4b6 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -1,6 +1,6 @@
 
 # This test needs to come before the setTestOpts calls below, as we want
-# to run it if !compiler_profiled
+# to run it if compiler_profiled.
 test('T4255', unless(compiler_profiled(), skip), compile_fail, ['-v0'])
 
 def f(name, opts):
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index bf9de0fee9dca4b6194f238c4ac5988efa4078c6..1389723c62d74c0d81fa851852cd8ec09e385811 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -325,7 +325,7 @@ data PackageArg
     -- match a single entry in the package database.
     | IPId InstalledPackageId
     -- | A glob against the package name.  The first string is the literal
-    -- glob, the second is a function which returns @True@ if the the argument
+    -- glob, the second is a function which returns @True@ if the argument
     -- matches.
     | Substring String (String->Bool)
 
@@ -2023,5 +2023,7 @@ removeFileSafe fn =
   removeFile fn `catchIO` \ e ->
     when (not $ isDoesNotExistError e) $ ioError e
 
+-- | Turn a path relative to the current directory into a (normalised)
+-- absolute path.
 absolutePath :: FilePath -> IO FilePath
 absolutePath path = return . normalise . (</> path) =<< getCurrentDirectory