Comments, small refactor

* Remove outdated Note [HsForAllTy tyvar binders] and [Context quantification].
  Since the wildcard refactor 1e041b7382, HsForAllTy no longer has an flag
  controlling explicity. The field `hsq_implicit` is gone too.
  The current situation is covered by Note [HsType binders] which is already
  linked from LHsQTyVars.
* Small refactor in CoreLint, extracting common code to a function
* Remove "not so sure about WpFun" in TcEvidence, per Richard's comment
  https://gitlab.haskell.org/ghc/ghc/merge_requests/852#note_223226
* Use mkIfThenElse in Foreign/Call, as it does exactly what we need.

5 files changed, 13 insertions, 68 deletions

diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs
index dabedb5fb6..d25e25b209 100644
--- a/compiler/GHC/Hs/Types.hs
+++ b/compiler/GHC/Hs/Types.hs
@@ -327,7 +327,6 @@ data LHsQTyVars pass   -- See Note [HsType binders]
 
            , hsq_explicit :: [LHsTyVarBndr pass]
                 -- Explicit variables, written by the user
-                -- See Note [HsForAllTy tyvar binders]
     }
   | XLHsQTyVars (XXLHsQTyVars pass)
 
@@ -761,29 +760,6 @@ data HsTyLit
 
 
 {-
-Note [HsForAllTy tyvar binders]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-After parsing:
-  * Implicit => empty
-    Explicit => the variables the user wrote
-
-After renaming
-  * Implicit => the *type* variables free in the type
-    Explicit => the variables the user wrote (renamed)
-
-Qualified currently behaves exactly as Implicit,
-but it is deprecated to use it for implicit quantification.
-In this case, GHC 7.10 gives a warning; see
-Note [Context quantification] in GHC.Rename.Types, and #4426.
-In GHC 8.0, Qualified will no longer bind variables
-and this will become an error.
-
-The kind variables bound in the hsq_implicit field come both
-  a) from the kind signatures on the kind vars (eg k1)
-  b) from the scope of the forall (eg k2)
-Example:   f :: forall (a::k1) b. T a (b::k2)
-
-
 Note [Unit tuples]
 ~~~~~~~~~~~~~~~~~~
 Consider the type
diff --git a/compiler/GHC/HsToCore/Foreign/Call.hs b/compiler/GHC/HsToCore/Foreign/Call.hs
index ce39cf4d3c..bebb677772 100644
--- a/compiler/GHC/HsToCore/Foreign/Call.hs
+++ b/compiler/GHC/HsToCore/Foreign/Call.hs
@@ -154,10 +154,7 @@ unboxArg arg
   = do dflags <- getDynFlags
        prim_arg <- newSysLocalDs intPrimTy
        return (Var prim_arg,
-              \ body -> Case (mkWildCase arg arg_ty intPrimTy
-                                       [(DataAlt falseDataCon,[],mkIntLit dflags 0),
-                                        (DataAlt trueDataCon, [],mkIntLit dflags 1)])
-                                        -- In increasing tag order!
+              \ body -> Case (mkIfThenElse arg (mkIntLit dflags 1) (mkIntLit dflags 0))
                              prim_arg
                              (exprType body)
                              [(DEFAULT,[],body)])
diff --git a/compiler/GHC/Rename/Types.hs b/compiler/GHC/Rename/Types.hs
index ed65453c64..a2d887bad0 100644
--- a/compiler/GHC/Rename/Types.hs
+++ b/compiler/GHC/Rename/Types.hs
@@ -350,25 +350,6 @@ rnImplicitBndrs bind_free_tvs
 rnHsType is here because we call it from loadInstDecl, and I didn't
 want a gratuitous knot.
 
-Note [Context quantification]
------------------------------
-Variables in type signatures are implicitly quantified
-when (1) they are in a type signature not beginning
-with "forall" or (2) in any qualified type T => R.
-We are phasing out (2) since it leads to inconsistencies
-(#4426):
-
-data A = A (a -> a)           is an error
-data A = A (Eq a => a -> a)   binds "a"
-data A = A (Eq a => a -> b)   binds "a" and "b"
-data A = A (() => a -> b)     binds "a" and "b"
-f :: forall a. a -> b         is an error
-f :: forall a. () => a -> b   is an error
-f :: forall a. a -> (() => b) binds "a" and "b"
-
-This situation is now considered to be an error. See rnHsTyKi for case
-HsForAllTy Qualified.
-
 Note [QualTy in kinds]
 ~~~~~~~~~~~~~~~~~~~~~~
 I was wondering whether QualTy could occur only at TypeLevel.  But no,
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 3bdd2f8fb4..bca567cff5 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -647,10 +647,7 @@ lintRhs bndr rhs
       = lintCoreExpr rhs
 
     lint_join_lams n tot enforce (Lam var expr)
-      = addLoc (LambdaBodyOf var) $
-        lintBinder LambdaBind var $ \ var' ->
-        do { body_ty <- lint_join_lams (n-1) tot enforce expr
-           ; return $ mkLamType var' body_ty }
+      = lintLambda var $ lint_join_lams (n-1) tot enforce expr
 
     lint_join_lams n tot True _other
       = failWithL $ mkBadJoinArityMsg bndr tot (tot-n) rhs
@@ -671,12 +668,7 @@ lintRhs _bndr rhs = fmap lf_check_static_ptrs getLintFlags >>= go
       = markAllJoinsBad $
         foldr
         -- imitate @lintCoreExpr (Lam ...)@
-        (\var loopBinders ->
-          addLoc (LambdaBodyOf var) $
-            lintBinder LambdaBind var $ \var' ->
-              do { body_ty <- loopBinders
-                 ; return $ mkLamType var' body_ty }
-        )
+        lintLambda
         -- imitate @lintCoreExpr (App ...)@
         (do fun_ty <- lintCoreExpr fun
             lintCoreArgs fun_ty [Type t, info, e]
@@ -825,11 +817,8 @@ lintCoreExpr e@(App _ _)
     (fun, args) = collectArgs e
 
 lintCoreExpr (Lam var expr)
-  = addLoc (LambdaBodyOf var) $
-    markAllJoinsBad $
-    lintBinder LambdaBind var $ \ var' ->
-    do { body_ty <- lintCoreExpr expr
-       ; return $ mkLamType var' body_ty }
+  = markAllJoinsBad $
+    lintLambda var $ lintCoreExpr expr
 
 lintCoreExpr (Case scrut var alt_ty alts)
   = lintCaseExpr scrut var alt_ty alts
@@ -880,16 +869,19 @@ lintCoreFun (Lam var body) nargs
   -- Act like lintCoreExpr of Lam, but *don't* call markAllJoinsBad; see
   -- Note [Beta redexes]
   | nargs /= 0
-  = addLoc (LambdaBodyOf var) $
-    lintBinder LambdaBind var $ \ var' ->
-    do { body_ty <- lintCoreFun body (nargs - 1)
-       ; return $ mkLamType var' body_ty }
+  = lintLambda var $ lintCoreFun body (nargs - 1)
 
 lintCoreFun expr nargs
   = markAllJoinsBadIf (nargs /= 0) $
       -- See Note [Join points are less general than the paper]
     lintCoreExpr expr
-
+------------------
+lintLambda :: Var -> LintM Type -> LintM Type
+lintLambda var lintBody =
+    addLoc (LambdaBodyOf var) $
+    lintBinder LambdaBind var $ \ var' ->
+      do { body_ty <- lintBody
+         ; return (mkLamType var' body_ty) }
 ------------------
 checkDeadIdOcc :: Id -> LintM ()
 -- Occurrences of an Id should never be dead....
diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs
index fb6fa71ada..0794157ed0 100644
--- a/compiler/typecheck/TcEvidence.hs
+++ b/compiler/typecheck/TcEvidence.hs
@@ -362,7 +362,6 @@ isErasableHsWrapper = go
   where
     go WpHole                  = True
     go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2
-    -- not so sure about WpFun. But it eta-expands, so...
     go WpFun{}                 = False
     go WpCast{}                = True
     go WpEvLam{}               = False -- case in point