summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2020-02-17 17:57:34 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-02-24 20:54:35 -0500
commit354e2787be08fb6d973de1a39e58080ff8e107f8 (patch)
tree1d2c829e8c0a6a4796d8c24d7ac048752b4eca0d
parente295a02440db8b1d96cebad22c5ee48774774681 (diff)
downloadhaskell-354e2787be08fb6d973de1a39e58080ff8e107f8.tar.gz
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.
-rw-r--r--compiler/GHC/Hs/Types.hs24
-rw-r--r--compiler/GHC/HsToCore/Foreign/Call.hs5
-rw-r--r--compiler/GHC/Rename/Types.hs19
-rw-r--r--compiler/coreSyn/CoreLint.hs32
-rw-r--r--compiler/typecheck/TcEvidence.hs1
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