[project @ 2002-07-29 13:19:52 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 8286f64..8a13a77 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 
 module TcType (
   --------------------------------
   -- Types 

-  TcType, TcSigmaType, TcPhiType, TcTauType, TcPredType, TcThetaType, 
+  TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType, 

   TcTyVar, TcTyVarSet, TcKind, 
 
   --------------------------------
   TcTyVar, TcTyVarSet, TcKind, 
 
   --------------------------------

@@ -27,12 +27,12 @@ module TcType (
 
   --------------------------------
   -- Builders
 
   --------------------------------
   -- Builders

-  mkRhoTy, mkSigmaTy, 
+  mkPhiTy, mkSigmaTy, 

 
   --------------------------------
   -- Splitters  
   -- These are important because they do not look through newtypes
 
   --------------------------------
   -- 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,
   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy,
   tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
   tcSplitAppTy_maybe, tcSplitAppTy, tcSplitSigmaTy,

@@ -50,7 +50,7 @@ module TcType (
 
   ---------------------------------
   -- Misc type manipulators
 
   ---------------------------------
   -- Misc type manipulators

-  hoistForAllTys, deNoteType,
+  deNoteType, 

   namesOfType, namesOfDFunHead,
   getDFunTyKey,
 
   namesOfType, namesOfDFunHead,
   getDFunTyKey,
 

@@ -92,7 +92,7 @@ module TcType (
 
   isUnLiftedType,      -- Source types are always lifted
   isUnboxedTupleType,  -- Ditto
 
   isUnLiftedType,      -- Source types are always lifted
   isUnboxedTupleType,  -- Ditto

-  isPrimitiveType,
+  isPrimitiveType, isTyVarTy,

 
   tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
   tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars,
 
   tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
   tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars,

@@ -114,7 +114,7 @@ import Type         (       -- Re-exports
                          Kind, Type, SourceType(..), PredType, ThetaType, 
                          unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
                          mkForAllTy, mkForAllTys, defaultKind, isTypeKind, isAnyTypeKind,
                          Kind, Type, SourceType(..), PredType, ThetaType, 
                          unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
                          mkForAllTy, mkForAllTys, defaultKind, isTypeKind, isAnyTypeKind,

-                         mkFunTy, mkFunTys, zipFunTys, 
+                         mkFunTy, mkFunTys, zipFunTys, isTyVarTy,

                          mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
                          mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
                          isUnLiftedType, isUnboxedTupleType, isPrimitiveType,
                          mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
                          mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
                          isUnLiftedType, isUnboxedTupleType, isPrimitiveType,

@@ -132,7 +132,7 @@ import VarSet
 
 -- others:
 import CmdLineOpts     ( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
 
 -- 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)
 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:
 
 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
        -- 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
 
        -- 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
      |  tau
 
 -- A 'tau' type has no quantification anywhere

@@ -182,7 +184,7 @@ tau ::= tyvar
 
 \begin{code}
 type SigmaType = Type
 
 \begin{code}
 type SigmaType = Type

-type PhiType   = Type
+type RhoType   = Type

 type TauType   = Type
 \end{code}
 
 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 TcPredType     = PredType
 type TcThetaType    = ThetaType
 type TcSigmaType    = TcType

-type TcPhiType      = TcType
+type TcRhoType      = TcType

 type TcTauType      = TcType
 type TcKind         = TcType
 \end{code}
 type TcTauType      = TcType
 type TcKind         = TcType
 \end{code}

@@ -287,10 +289,10 @@ tyVarBindingInfo tv
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \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}
 
 
 \end{code}
 
 

@@ -348,8 +350,8 @@ tcIsForAllTy (ForAllTy tv ty) = True
 tcIsForAllTy (NoteTy n ty)    = tcIsForAllTy ty
 tcIsForAllTy t               = False
 
 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)
  where
   split orig_ty (FunTy arg res) ts = case tcSplitPredTy_maybe arg of
                                        Just p  -> split res res (p:ts)

@@ -358,7 +360,7 @@ tcSplitRhoTy ty = split ty ty []
   split orig_ty ty             ts = (reverse ts, orig_ty)
 
 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
   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
                                        (theta, tau) -> (tvs, theta, tau)
 
 tcTyConAppTyCon :: Type -> TyCon

@@ -517,8 +519,8 @@ predHasFDs (IParam _ _)   = True
 predHasFDs (ClassP cls _) = classHasFDs cls
 
 mkPredName :: Unique -> SrcLoc -> SourceType -> Name
 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}
 
 
 \end{code}
 
 

@@ -719,33 +721,6 @@ is_tc uniq ty = case tcSplitTyConApp_maybe ty of
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-hoistForAllTys :: Type -> Type
--- Used for user-written type signatures only
--- Move all the foralls and constraints to the top
--- e.g.  T -> forall a. a        ==>   forall a. T -> a
---      T -> (?x::Int) -> Int   ==>   (?x::Int) -> T -> Int
---
--- We want to 'look through' type synonyms when doing this
--- so it's better done on the Type than the HsType
-
-hoistForAllTys ty
-  = case hoist ty ty of 
-       (tvs, theta, body) -> mkForAllTys tvs (mkFunTys theta body)
-  where
-    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)
-       | otherwise                = case hoist res res of
-                                       (tvs,theta,tau) -> (tvs,theta,mkFunTy arg tau)
-
-    hoist orig_ty (NoteTy _ ty)    = hoist orig_ty ty
-    hoist orig_ty ty              = ([], [], orig_ty)
-\end{code}
-
-
-\begin{code}

 deNoteType :: Type -> Type
        -- Remove synonyms, but not source types
 deNoteType ty@(TyVarTy tyvar)  = ty
 deNoteType :: Type -> Type
        -- Remove synonyms, but not source types
 deNoteType ty@(TyVarTy tyvar)  = ty