[project @ 2002-09-06 14:40:28 by simonmar]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcType.lhs
index 3bcb389..531709a 100644 (file)
@@ -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,
@@ -44,13 +44,13 @@ module TcType (
   tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred,
   isSigmaTy, isOverloadedTy, 
   isDoubleTy, isFloatTy, isIntTy,
-  isIntegerTy, isAddrTy, isBoolTy, isUnitTy, isForeignPtrTy, 
+  isIntegerTy, isAddrTy, isBoolTy, isUnitTy,
   isTauTy, tcIsTyVarTy, tcIsForAllTy,
   allDistinctTyVars,
 
   ---------------------------------
   -- Misc type manipulators
-  hoistForAllTys, deNoteType,
+  deNoteType, 
   namesOfType, namesOfDFunHead,
   getDFunTyKey,
 
@@ -92,7 +92,7 @@ module TcType (
 
   isUnLiftedType,      -- Source types are always lifted
   isUnboxedTupleType,  -- Ditto
-  isPrimitiveType,
+  isPrimitiveType, isTyVarTy,
 
   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,
-                         mkFunTy, mkFunTys, zipFunTys, 
+                         mkFunTy, mkFunTys, zipFunTys, isTyVarTy,
                          mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
                          mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
                          isUnLiftedType, isUnboxedTupleType, isPrimitiveType,
@@ -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}
@@ -287,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}
 
 
@@ -348,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)
@@ -358,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
@@ -697,7 +699,6 @@ isOverloadedTy _               = False
 \begin{code}
 isFloatTy      = is_tc floatTyConKey
 isDoubleTy     = is_tc doubleTyConKey
-isForeignPtrTy = is_tc foreignPtrTyConKey
 isIntegerTy    = is_tc integerTyConKey
 isIntTy        = is_tc intTyConKey
 isAddrTy       = is_tc addrTyConKey
@@ -719,33 +720,6 @@ is_tc uniq ty = case tcSplitTyConApp_maybe ty of
 %************************************************************************
 
 \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
@@ -855,8 +829,7 @@ legalFEArgTyCon :: TyCon -> Bool
 -- bytearrays from a _ccall_ / foreign declaration
 -- (or be passed them as arguments in foreign exported functions).
 legalFEArgTyCon tc
-  | getUnique tc `elem` [ foreignObjTyConKey, foreignPtrTyConKey,
-                         byteArrayTyConKey, mutableByteArrayTyConKey ] 
+  | getUnique tc `elem` [ byteArrayTyConKey, mutableByteArrayTyConKey ] 
   = False
   -- It's also illegal to make foreign exports that take unboxed
   -- arguments.  The RTS API currently can't invoke such things.  --SDM 7/2000
@@ -866,16 +839,14 @@ legalFEArgTyCon tc
 legalFIResultTyCon :: DynFlags -> TyCon -> Bool
 legalFIResultTyCon dflags tc
   | getUnique tc `elem`
-       [ foreignObjTyConKey, foreignPtrTyConKey,
-         byteArrayTyConKey, mutableByteArrayTyConKey ]  = False
+       [ byteArrayTyConKey, mutableByteArrayTyConKey ]  = False
   | tc == unitTyCon = True
   | otherwise      = marshalableTyCon dflags tc
 
 legalFEResultTyCon :: TyCon -> Bool
 legalFEResultTyCon tc
   | getUnique tc `elem` 
-       [ foreignObjTyConKey, foreignPtrTyConKey,
-         byteArrayTyConKey, mutableByteArrayTyConKey ]  = False
+       [ byteArrayTyConKey, mutableByteArrayTyConKey ]  = False
   | tc == unitTyCon = True
   | otherwise       = boxedMarshalableTyCon tc
 
@@ -898,8 +869,7 @@ boxedMarshalableTyCon tc
                         , word32TyConKey, word64TyConKey
                         , floatTyConKey, doubleTyConKey
                         , addrTyConKey, ptrTyConKey, funPtrTyConKey
-                        , charTyConKey, foreignObjTyConKey
-                        , foreignPtrTyConKey
+                        , charTyConKey
                         , stablePtrTyConKey
                         , byteArrayTyConKey, mutableByteArrayTyConKey
                         , boolTyConKey