[commit: ghc] ghc-8.0: Use the in_scope set in lint_app (865e746)
git at git.haskell.org
git at git.haskell.org
Tue Feb 2 22:56:28 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.0
Link : http://ghc.haskell.org/trac/ghc/changeset/865e7462dd5171c5ec6c5b7092545fae986261b8/ghc
>---------------------------------------------------------------
commit 865e7462dd5171c5ec6c5b7092545fae986261b8
Author: Bartosz Nitka <niteria at gmail.com>
Date: Wed Jan 27 11:59:02 2016 -0800
Use the in_scope set in lint_app
This makes the call to `substTy` satisfy the invariant from
Note [The substitution invariant] in TyCoRep.
Test Plan: ./validate --slow
Reviewers: goldfire, austin, bgamari, simonpj
Reviewed By: simonpj
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1861
GHC Trac Issues: #11371
(cherry picked from commit 63700a193557ed63a1da18a6a059cb7ec5596796)
>---------------------------------------------------------------
865e7462dd5171c5ec6c5b7092545fae986261b8
compiler/coreSyn/CoreLint.hs | 17 ++++++++++-------
1 file changed, 10 insertions(+), 7 deletions(-)
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 43dbdaa..7fc386f 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -1136,25 +1136,28 @@ lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lint_app doc kfn kas
- = foldlM go_app kfn kas
+ = do { in_scope <- getInScope
+ -- We need the in_scope set to satisfy the invariant in
+ -- Note [The substitution invariant] in TyCoRep
+ ; foldlM (go_app in_scope) kfn kas }
where
fail_msg = vcat [ hang (text "Kind application error in") 2 doc
, nest 2 (text "Function kind =" <+> ppr kfn)
, nest 2 (text "Arg kinds =" <+> ppr kas) ]
- go_app kfn ka
+ go_app in_scope kfn ka
| Just kfn' <- coreView kfn
- = go_app kfn' ka
+ = go_app in_scope kfn' ka
- go_app (ForAllTy (Anon kfa) kfb) (_,ka)
+ go_app _ (ForAllTy (Anon kfa) kfb) (_,ka)
= do { unless (ka `eqType` kfa) (addErrL fail_msg)
; return kfb }
- go_app (ForAllTy (Named kv _vis) kfn) (ta,ka)
+ go_app in_scope (ForAllTy (Named kv _vis) kfn) (ta,ka)
= do { unless (ka `eqType` tyVarKind kv) (addErrL fail_msg)
- ; return (substTyWith [kv] [ta] kfn) }
+ ; return (substTyWithInScope in_scope [kv] [ta] kfn) }
- go_app _ _ = failWithL fail_msg
+ go_app _ _ _ = failWithL fail_msg
{- *********************************************************************
* *
More information about the ghc-commits
mailing list