X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreArity.lhs;h=d0092b26c52d5fbcdeaa24a1a67c2726f51c3c00;hp=e63d12176d3d5659b2f733e3a7f9728a3d978d70;hb=66413c79385a5b30a668e91789b8a334f6977ca9;hpb=635952097df211953c4bd0456b37eba64c485f60

diff --git a/compiler/coreSyn/CoreArity.lhs b/compiler/coreSyn/CoreArity.lhs
index e63d121..d0092b2 100644
--- a/compiler/coreSyn/CoreArity.lhs
+++ b/compiler/coreSyn/CoreArity.lhs
@@ -95,11 +95,11 @@ in exprArity.  That is a less local change, so I'm going to leave it for today!
 \begin{code}
 manifestArity :: CoreExpr -> Arity
 -- ^ manifestArity sees how many leading value lambdas there are
-manifestArity (Lam v e) | isId v    = 1 + manifestArity e
-			| otherwise = manifestArity e
-manifestArity (Note _ e)	    = manifestArity e
-manifestArity (Cast e _)            = manifestArity e
-manifestArity _                     = 0
+manifestArity (Lam v e) | isId v    	= 1 + manifestArity e
+			| otherwise 	= manifestArity e
+manifestArity (Note n e) | notSccNote n	= manifestArity e
+manifestArity (Cast e _)            	= manifestArity e
+manifestArity _                     	= 0
 
 exprArity :: CoreExpr -> Arity
 -- ^ An approximate, fast, version of 'exprEtaExpandArity'
@@ -108,7 +108,7 @@ exprArity e = go e
     go (Var v) 	       	           = idArity v
     go (Lam x e) | isId x    	   = go e + 1
     		 | otherwise 	   = go e
-    go (Note _ e)                  = go e
+    go (Note n e) | notSccNote n   = go e
     go (Cast e co)                 = go e `min` length (typeArity (snd (coercionKind co)))
        	       			     	-- Note [exprArity invariant]
     go (App e (Type _))            = go e
@@ -554,7 +554,8 @@ arityType dicts_cheap (Let b e)
 	-- See Note [Dictionary-like types] in TcType.lhs for why we use
 	-- isDictLikeTy here rather than isDictTy
 
-arityType dicts_cheap (Note _ e) = arityType dicts_cheap e
+arityType dicts_cheap (Note n e) 
+  | notSccNote n                 = arityType dicts_cheap e
 arityType dicts_cheap (Cast e _) = arityType dicts_cheap e
 arityType _           _          = vanillaArityType
 \end{code}
@@ -612,7 +613,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 +656,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 +724,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).