[project @ 2003-07-28 12:04:27 by simonpj]

--------------------------
  Fix an obscure but long-standing bug in Type.applyTys
	   --------------------------

The interesting case, which previously killed GHC 6.0, is this
	applyTys (forall a.a) [forall b.b, Int]
This really can happen, via dressing up polymorphic types with newtype
clothing.  Here's an example:
	newtype R = R (forall a. a->a)
	foo = case undefined :: R of

Test simplCore/should_compile/simpl0009 uses this as a test case.

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index 455c6cb..9a9fae2 100644 (file)
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -472,7 +472,13 @@ dropForAlls ty = snd (splitForAllTys ty)
 
 -- (mkPiType now in CoreUtils)
 
-Applying a for-all to its arguments.  Lift usage annotation as required.
+applyTy, applyTys
+~~~~~~~~~~~~~~~~~
+Instantiate a for-all type with one or more type arguments.
+Used when we have a polymorphic function applied to type args:
+       f t1 t2
+Then we use (applyTys type-of-f [t1,t2]) to compute the type of
+the expression. 
 
 \begin{code}
 applyTy :: Type -> Type -> Type
@@ -482,18 +488,32 @@ applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
 applyTy other           arg = panic "applyTy"
 
 applyTys :: Type -> [Type] -> Type
-applyTys orig_fun_ty arg_tys
- = substTyWith tvs arg_tys ty
- where
-   (tvs, ty) = split orig_fun_ty arg_tys
-   
-   split fun_ty               []         = ([], fun_ty)
-   split (NoteTy _ fun_ty)    args       = split fun_ty args
-   split (SourceTy p)        args       = split (sourceTypeRep p) args
-   split (ForAllTy tv fun_ty) (arg:args) = case split fun_ty args of
-                                                 (tvs, ty) -> (tv:tvs, ty)
-   split other_ty             args       = panic "applyTys"
-       -- No show instance for Type yet
+-- This function is interesting because 
+--     a) the function may have more for-alls than there are args
+--     b) less obviously, it may have fewer for-alls
+-- For case (b) think of 
+--     applyTys (forall a.a) [forall b.b, Int]
+-- This really can happen, via dressing up polymorphic types with newtype
+-- clothing.  Here's an example:
+--     newtype R = R (forall a. a->a)
+--     foo = case undefined :: R of
+--             R f -> f ()
+
+applyTys orig_fun_ty []      = orig_fun_ty
+applyTys orig_fun_ty arg_tys 
+  | n_tvs == n_args    -- The vastly common case
+  = substTyWith tvs arg_tys rho_ty
+  | n_tvs > n_args     -- Too many for-alls
+  = substTyWith (take n_args tvs) arg_tys 
+               (mkForAllTys (drop n_args tvs) rho_ty)
+  | otherwise          -- Too many type args
+  = ASSERT2( n_tvs > 0, pprType orig_fun_ty )  -- Zero case gives infnite loop!
+    applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
+            (drop n_tvs arg_tys)
+  where
+    (tvs, rho_ty) = splitForAllTys orig_fun_ty 
+    n_tvs = length tvs
+    n_args = length arg_tys     
 \end{code}