[project @ 2002-04-22 11:50:21 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcType.lhs

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 1752026..d498e7b 100644 (file)
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -17,7 +17,7 @@ is the principal client.
 module TcType (
   --------------------------------
   -- Types 
-  TcType, TcSigmaType, TcPhiType, TcTauType, TcPredType, TcThetaType, 
+  TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType, 
   TcTyVar, TcTyVarSet, TcKind, 
 
   --------------------------------
@@ -27,12 +27,12 @@ module TcType (
 
   --------------------------------
   -- Builders
-  mkRhoTy, mkSigmaTy, 
+  mkPhiTy, mkSigmaTy, 
 
   --------------------------------
   -- Splitters  
   -- These are important because they do not look through newtypes
-  tcSplitForAllTys, tcSplitRhoTy, 
+  tcSplitForAllTys, tcSplitPhiTy, 
   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy,
   tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
   tcSplitAppTy_maybe, tcSplitAppTy, tcSplitSigmaTy,
@@ -87,7 +87,7 @@ module TcType (
   Type, SourceType(..), PredType, ThetaType, 
   mkForAllTy, mkForAllTys, 
   mkFunTy, mkFunTys, zipFunTys, 
-  mkTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
+  mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
   mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys, 
 
   isUnLiftedType,      -- Source types are always lifted
@@ -115,7 +115,7 @@ import Type         (       -- Re-exports
                          unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
                          mkForAllTy, mkForAllTys, defaultKind, isTypeKind, isAnyTypeKind,
                          mkFunTy, mkFunTys, zipFunTys, 
-                         mkTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
+                         mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
                          mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
                          isUnLiftedType, isUnboxedTupleType, isPrimitiveType,
                          splitNewType_maybe, splitTyConApp_maybe,
@@ -132,7 +132,7 @@ import VarSet
 
 -- others:
 import CmdLineOpts     ( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
-import Name            ( Name, NamedThing(..), mkLocalName, getSrcLoc )
+import Name            ( Name, NamedThing(..), mkInternalName, getSrcLoc )
 import OccName         ( OccName, mkDictOcc )
 import NameSet
 import PrelNames       -- Lots (e.g. in isFFIArgumentTy)
@@ -155,7 +155,7 @@ import Outputable
 The type checker divides the generic Type world into the 
 following more structured beasts:
 
-sigma ::= forall tyvars. theta => phi
+sigma ::= forall tyvars. phi
        -- A sigma type is a qualified type
        --
        -- Note that even if 'tyvars' is empty, theta
@@ -166,7 +166,9 @@ sigma ::= forall tyvars. theta => phi
        -- A 'phi' type has no foralls to the right of
        -- an arrow
 
-phi ::= sigma -> phi
+phi :: theta => rho
+
+rho ::= sigma -> rho
      |  tau
 
 -- A 'tau' type has no quantification anywhere
@@ -182,7 +184,7 @@ tau ::= tyvar
 
 \begin{code}
 type SigmaType = Type
-type PhiType   = Type
+type RhoType   = Type
 type TauType   = Type
 \end{code}
 
@@ -199,7 +201,7 @@ type TcType = Type          -- A TcType can have mutable type variables
 type TcPredType     = PredType
 type TcThetaType    = ThetaType
 type TcSigmaType    = TcType
-type TcPhiType      = TcType
+type TcRhoType      = TcType
 type TcTauType      = TcType
 type TcKind         = TcType
 \end{code}
@@ -250,7 +252,9 @@ isUserTyVar tv = case mutTyVarDetails tv of
 
 isSkolemTyVar :: TcTyVar -> Bool
 isSkolemTyVar tv = case mutTyVarDetails tv of
-                     SigTv -> True
+                     SigTv  -> True
+                     ClsTv  -> True
+                     InstTv -> True
                      oteher -> False
 
 isHoleTyVar :: TcTyVar -> Bool
@@ -285,10 +289,10 @@ tyVarBindingInfo tv
 %************************************************************************
 
 \begin{code}
-mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkRhoTy theta tau)
+mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
 
-mkRhoTy :: [SourceType] -> Type -> Type
-mkRhoTy theta ty = foldr (\p r -> FunTy (mkPredTy p) r) ty theta
+mkPhiTy :: [SourceType] -> Type -> Type
+mkPhiTy theta ty = foldr (\p r -> FunTy (mkPredTy p) r) ty theta
 \end{code}
 
 
@@ -346,8 +350,8 @@ tcIsForAllTy (ForAllTy tv ty) = True
 tcIsForAllTy (NoteTy n ty)    = tcIsForAllTy ty
 tcIsForAllTy t               = False
 
-tcSplitRhoTy :: Type -> ([PredType], Type)
-tcSplitRhoTy ty = split ty ty []
+tcSplitPhiTy :: Type -> ([PredType], Type)
+tcSplitPhiTy ty = split ty ty []
  where
   split orig_ty (FunTy arg res) ts = case tcSplitPredTy_maybe arg of
                                        Just p  -> split res res (p:ts)
@@ -356,7 +360,7 @@ tcSplitRhoTy ty = split ty ty []
   split orig_ty ty             ts = (reverse ts, orig_ty)
 
 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
-                       (tvs, rho) -> case tcSplitRhoTy rho of
+                       (tvs, rho) -> case tcSplitPhiTy rho of
                                        (theta, tau) -> (tvs, theta, tau)
 
 tcTyConAppTyCon :: Type -> TyCon
@@ -371,11 +375,11 @@ tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
                        Nothing    -> pprPanic "tcSplitTyConApp" (pprType ty)
 
 tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
--- Newtypes are opaque, so they may be split
 tcSplitTyConApp_maybe (TyConApp tc tys)        = Just (tc, tys)
 tcSplitTyConApp_maybe (FunTy arg res)          = Just (funTyCon, [arg,res])
 tcSplitTyConApp_maybe (NoteTy n ty)            = tcSplitTyConApp_maybe ty
 tcSplitTyConApp_maybe (SourceTy (NType tc tys)) = Just (tc,tys)
+       -- Newtypes are opaque, so they may be split
        -- However, predicates are not treated
        -- as tycon applications by the type checker
 tcSplitTyConApp_maybe other                    = Nothing
@@ -515,8 +519,8 @@ predHasFDs (IParam _ _)   = True
 predHasFDs (ClassP cls _) = classHasFDs cls
 
 mkPredName :: Unique -> SrcLoc -> SourceType -> Name
-mkPredName uniq loc (ClassP cls tys) = mkLocalName uniq (mkDictOcc (getOccName cls)) loc
-mkPredName uniq loc (IParam ip ty)   = mkLocalName uniq (getOccName (ipNameName ip)) loc
+mkPredName uniq loc (ClassP cls tys) = mkInternalName uniq (mkDictOcc (getOccName cls)) loc
+mkPredName uniq loc (IParam ip ty)   = mkInternalName uniq (getOccName (ipNameName ip)) loc
 \end{code}
 
 
@@ -733,10 +737,13 @@ hoistForAllTys ty
     hoist orig_ty (ForAllTy tv ty) = case hoist ty ty of
                                        (tvs,theta,tau) -> (tv:tvs,theta,tau)
     hoist orig_ty (FunTy arg res)
-       | isPredTy arg             = case hoist res res of
-                                       (tvs,theta,tau) -> (tvs,arg:theta,tau)
+       | isPredTy arg'            = case hoist res res of
+                                       (tvs,theta,tau) -> (tvs,arg':theta,tau)
        | otherwise                = case hoist res res of
-                                       (tvs,theta,tau) -> (tvs,theta,mkFunTy arg tau)
+                                       (tvs,theta,tau) -> (tvs,theta,mkFunTy arg' tau)
+       where
+         arg' = hoistForAllTys arg     -- Don't forget to apply hoist recursively
+                                       -- to the argument type
 
     hoist orig_ty (NoteTy _ ty)    = hoist orig_ty ty
     hoist orig_ty ty              = ([], [], orig_ty)