X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FcoreSyn%2FCoreArity.lhs;h=f0f6c752cc3ecd66c89ea78526f5c85432a4f158;hb=8d6feaef4dce4c9256817be8e7e6da25c21d23d7;hp=e63d12176d3d5659b2f733e3a7f9728a3d978d70;hpb=635952097df211953c4bd0456b37eba64c485f60;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreArity.lhs b/compiler/coreSyn/CoreArity.lhs index e63d121..f0f6c75 100644 --- a/compiler/coreSyn/CoreArity.lhs +++ b/compiler/coreSyn/CoreArity.lhs @@ -612,7 +612,7 @@ etaExpand n orig_expr -- Strip off existing lambdas and casts -- Note [Eta expansion and SCCs] go 0 expr = expr - go n (Lam v body) | isTyVar v = Lam v (go n body) + go n (Lam v body) | isTyCoVar v = Lam v (go n body) | otherwise = Lam v (go (n-1) body) go n (Cast expr co) = Cast (go n expr) co go n expr = -- pprTrace "ee" (vcat [ppr orig_expr, ppr expr, ppr etas]) $ @@ -655,7 +655,7 @@ etaInfoApp :: Subst -> CoreExpr -> [EtaInfo] -> CoreExpr etaInfoApp subst (Lam v1 e) (EtaVar v2 : eis) = etaInfoApp subst' e eis where - subst' | isTyVar v1 = CoreSubst.extendTvSubst subst v1 (mkTyVarTy v2) + subst' | isTyCoVar v1 = CoreSubst.extendTvSubst subst v1 (mkTyVarTy v2) | otherwise = CoreSubst.extendIdSubst subst v1 (Var v2) etaInfoApp subst (Cast e co1) eis @@ -723,9 +723,10 @@ mkEtaWW orig_n in_scope orig_ty -- coerce T (\x::[T] -> (coerce ([T]->Int) e) x) go n subst ty' (EtaCo (Type.substTy subst co) : eis) - | otherwise -- We have an expression of arity > 0, + | otherwise -- We have an expression of arity > 0, + -- but its type isn't a function. = WARN( True, ppr orig_n <+> ppr orig_ty ) - (getTvInScope subst, reverse eis) -- but its type isn't a function. + (getTvInScope subst, reverse eis) -- This *can* legitmately happen: -- e.g. coerce Int (\x. x) Essentially the programmer is -- playing fast and loose with types (Happy does this a lot).