X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=ae46a8baba1769785e166a950ac58986b9d7a752;hp=f32d5b1482c386aaf21d6979c22b8b7ad99e0962;hb=794c2f4c8829ba3166c9bdb471856bc00c21f001;hpb=94fd9ad3745d9d270648aa5d7d87f49a0dafabd4 diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index f32d5b1..ae46a8b 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -42,6 +42,7 @@ import CoreSyn import PprCore () -- Instances import OccurAnal import CoreSubst hiding( substTy ) +import CoreFVs ( exprFreeVars ) import CoreUtils import Id import DataCon @@ -54,6 +55,7 @@ import TcType ( tcSplitDFunTy ) import Type import Coercion import PrelNames +import VarEnv ( mkInScopeSet ) import Bag import Util import FastTypes @@ -1110,6 +1112,9 @@ exprIsConApp_maybe expr analyse _ _ = Nothing ----------- + in_scope = mkInScopeSet (exprFreeVars expr) + + ----------- beta (Lam v body) pairs (arg : args) | isTypeArg arg = beta body ((v,arg):pairs) args @@ -1118,12 +1123,13 @@ exprIsConApp_maybe expr = Nothing beta fun pairs args - = case analyse (substExpr (mkOpenSubst pairs) fun) args of + = case analyse (substExpr subst fun) args of Nothing -> -- pprTrace "Bale out! exprIsConApp_maybe" doc $ Nothing Just ans -> -- pprTrace "Woo-hoo! exprIsConApp_maybe" doc $ Just ans where + subst = mkOpenSubst in_scope pairs -- doc = vcat [ppr fun, ppr expr, ppr pairs, ppr args]