[project @ 2002-06-21 13:34:42 by simonpj]

[ghc-hetmet.git] / ghc / compiler / types / Type.lhs

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index dc642d0..ad7d1c9 100644 (file)
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -33,7 +33,7 @@ module Type (
        mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, splitFunTys, 
        funResultTy, funArgTy, zipFunTys, isFunTy,
 
-       mkTyConApp, mkTyConTy, 
+       mkGenTyConApp, mkTyConApp, mkTyConTy, 
        tyConAppTyCon, tyConAppArgs, 
        splitTyConApp_maybe, splitTyConApp,
 
@@ -89,7 +89,7 @@ import Var    ( TyVar, tyVarKind, tyVarName, setTyVarName )
 import VarEnv
 import VarSet
 
-import Name    ( NamedThing(..), mkLocalName, tidyOccName )
+import Name    ( NamedThing(..), mkInternalName, tidyOccName )
 import Class   ( classTyCon )
 import TyCon   ( TyCon, isRecursiveTyCon, isPrimTyCon,
                  isUnboxedTupleTyCon, isUnLiftedTyCon,
@@ -194,8 +194,16 @@ mkAppTy orig_ty1 orig_ty2
     mk_app orig_ty1
   where
     mk_app (NoteTy _ ty1)    = mk_app ty1
-    mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
+    mk_app (TyConApp tc tys) = mkGenTyConApp tc (tys ++ [orig_ty2])
     mk_app ty1              = AppTy orig_ty1 orig_ty2
+       -- We call mkGenTyConApp because the TyConApp could be an 
+       -- under-saturated type synonym.  GHC allows that; e.g.
+       --      type Foo k = k a -> k a
+       --      type Id x = x
+       --      foo :: Foo Id -> Foo Id
+       --
+       -- Here Id is partially applied in the type sig for Foo,
+       -- but once the type synonyms are expanded all is well
 
 mkAppTys :: Type -> [Type] -> Type
 mkAppTys orig_ty1 []       = orig_ty1
@@ -306,6 +314,11 @@ funArgTy ty                 = pprPanic "funArgTy" (pprType ty)
 as apppropriate.
 
 \begin{code}
+mkGenTyConApp :: TyCon -> [Type] -> Type
+mkGenTyConApp tc tys
+  | isSynTyCon tc = mkSynTy tc tys
+  | otherwise     = mkTyConApp tc tys
+
 mkTyConApp :: TyCon -> [Type] -> Type
 -- Assumes TyCon is not a SynTyCon; use mkSynTy instead for those
 mkTyConApp tycon tys
@@ -358,7 +371,10 @@ mkSynTy tycon tys
   | n_args == arity    -- Exactly saturated
   = mk_syn tys
   | n_args >  arity    -- Over-saturated
-  = case splitAt arity tys of { (as,bs) -> foldl AppTy (mk_syn as) bs }
+  = case splitAt arity tys of { (as,bs) -> mkAppTys (mk_syn as) bs }
+       -- Its important to use mkAppTys, rather than (foldl AppTy),
+       -- because (mk_syn as) might well return a partially-applied
+       -- type constructor; indeed, usually will!
   | otherwise          -- Un-saturated
   = TyConApp tycon tys
        -- For the un-saturated case we build TyConApp directly
@@ -586,12 +602,27 @@ tyVarsOfType :: Type -> TyVarSet
 tyVarsOfType (TyVarTy tv)              = unitVarSet tv
 tyVarsOfType (TyConApp tycon tys)      = tyVarsOfTypes tys
 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
-tyVarsOfType (NoteTy (SynNote ty1) ty2)        = tyVarsOfType ty1
+tyVarsOfType (NoteTy (SynNote ty1) ty2)        = tyVarsOfType ty2      -- See note [Syn] below
 tyVarsOfType (SourceTy sty)            = tyVarsOfSourceType sty
 tyVarsOfType (FunTy arg res)           = tyVarsOfType arg `unionVarSet` tyVarsOfType res
 tyVarsOfType (AppTy fun arg)           = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
 tyVarsOfType (ForAllTy tyvar ty)       = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
 
+--                     Note [Syn]
+-- Consider
+--     type T a = Int
+-- What are the free tyvars of (T x)?  Empty, of course!  
+-- Here's the example that Ralf Laemmel showed me:
+--     foo :: (forall a. C u a -> C u a) -> u
+--     mappend :: Monoid u => u -> u -> u
+--
+--     bar :: Monoid u => u
+--     bar = foo (\t -> t `mappend` t)
+-- We have to generalise at the arg to f, and we don't
+-- want to capture the constraint (Monad (C u a)) because
+-- it appears to mention a.  Pretty silly, but it was useful to him.
+
+
 tyVarsOfTypes :: [Type] -> TyVarSet
 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
 
@@ -634,7 +665,7 @@ tidyTyVarBndr (tidy_env, subst) tyvar
                    where
                        subst' = extendVarEnv subst tyvar tyvar'
                        tyvar' = setTyVarName tyvar name'
-                       name'  = mkLocalName (getUnique name) occ' noSrcLoc
+                       name'  = mkInternalName (getUnique name) occ' noSrcLoc
                                -- Note: make a *user* tyvar, so it printes nicely
                                -- Could extract src loc, but no need.
   where