[commit: ghc] master: Build a correct substitution in dataConInstPat (62943d2)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/62943d2adc51c4a7a61bb1f48fd245791acfffe9/ghc

>---------------------------------------------------------------

commit 62943d2adc51c4a7a61bb1f48fd245791acfffe9
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Wed Apr 20 09:35:47 2016 -0700

    Build a correct substitution in dataConInstPat
    
    This adds the tyvars of the domain of the substitution into the in-scope
    set as well.
    What I'm not sure here is if the kinds can have any free vars that
    should be in the in-scope set as well.
    
    Test Plan: ./validate
    
    Reviewers: goldfire, austin, bgamari, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: thomie, simonmar
    
    Differential Revision: https://phabricator.haskell.org/D2094
    
    GHC Trac Issues: #11371


>---------------------------------------------------------------

62943d2adc51c4a7a61bb1f48fd245791acfffe9
 compiler/coreSyn/CoreUtils.hs | 6 +++---
 compiler/types/Type.hs        | 1 +
 2 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 82be8d9..887c313 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -1564,8 +1564,8 @@ dataConInstPat fss uniqs con inst_tys
                                        (zip3 ex_tvs ex_fss ex_uniqs)
 
     mk_ex_var :: TCvSubst -> (TyVar, FastString, Unique) -> (TCvSubst, TyVar)
-    mk_ex_var subst (tv, fs, uniq) = (Type.extendTvSubst subst tv
-                                       (mkTyVarTy new_tv)
+    mk_ex_var subst (tv, fs, uniq) = (Type.extendTvSubstWithClone subst tv
+                                       new_tv
                                      , new_tv)
       where
         new_tv = mkTyVar (mkSysTvName uniq fs) kind
@@ -1574,7 +1574,7 @@ dataConInstPat fss uniqs con inst_tys
       -- Make value vars, instantiating types
     arg_ids = zipWith4 mk_id_var id_uniqs id_fss arg_tys arg_strs
     mk_id_var uniq fs ty str
-      = mkLocalIdOrCoVarWithInfo name (Type.substTyUnchecked full_subst ty) info
+      = mkLocalIdOrCoVarWithInfo name (Type.substTy full_subst ty) info
       where
         name = mkInternalName uniq (mkVarOccFS fs) noSrcSpan
         info | isMarkedStrict str = vanillaIdInfo `setUnfoldingInfo` evaldUnfolding
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 9559123..93f4df2 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -158,6 +158,7 @@ module Type (
         extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
         extendTCvSubst, extendCvSubst,
         extendTvSubst, extendTvSubstList, extendTvSubstAndInScope,
+        extendTvSubstWithClone,
         isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv,
         isEmptyTCvSubst, unionTCvSubst,