[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