[project @ 1996-06-26 10:26:00 by partain]

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

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index a237dc6..5b18277 100644 (file)
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -22,7 +22,7 @@ module TcType (
 
   tcInstTyVars,
   tcInstSigTyVars, 
-  tcInstType, tcInstSigType, tcInstTcType,
+  tcInstType, tcInstSigType, tcInstTcType, tcInstSigTcType,
   tcInstTheta, tcInstId,
 
   zonkTcTyVars,
@@ -36,13 +36,13 @@ module TcType (
 
 
 -- friends:
-import Type    ( Type(..), ThetaType(..), GenType(..),
+import Type    ( SYN_IE(Type), SYN_IE(ThetaType), GenType(..),
                  tyVarsOfTypes, getTyVar_maybe,
                  splitForAllTy, splitRhoTy,
                  mkForAllTys, instantiateTy
                )
-import TyVar   ( TyVar(..), GenTyVar(..), TyVarSet(..), GenTyVarSet(..), 
-                 TyVarEnv(..), lookupTyVarEnv, addOneToTyVarEnv,
+import TyVar   ( SYN_IE(TyVar), GenTyVar(..), SYN_IE(TyVarSet), SYN_IE(GenTyVarSet), 
+                 SYN_IE(TyVarEnv), lookupTyVarEnv, addOneToTyVarEnv,
                  nullTyVarEnv, mkTyVarEnv,
                  tyVarSetToList
                )
@@ -53,7 +53,7 @@ import Id     ( idType )
 import Kind    ( Kind )
 import TcKind  ( TcKind )
 import TcMonad hiding ( rnMtoTcM )
-import Usage   ( Usage(..), GenUsage, UVar(..), duffUsage )
+import Usage   ( SYN_IE(Usage), GenUsage, SYN_IE(UVar), duffUsage )
 
 import TysPrim         ( voidTy )
 
@@ -170,6 +170,15 @@ tcInstTcType ty
   where
     (tyvars, rho) = splitForAllTy ty
 
+tcInstSigTcType :: TcType s -> NF_TcM s ([TcTyVar s], TcType s)
+tcInstSigTcType ty
+  = case tyvars of
+       []    -> returnNF_Tc ([], ty)   -- Nothing to do
+       other -> tcInstSigTyVars tyvars         `thenNF_Tc` \ (tyvars', _, tenv)  ->
+                returnNF_Tc (tyvars', instantiateTy tenv rho)
+  where
+    (tyvars, rho) = splitForAllTy ty
+
 tcInstType :: [(GenTyVar flexi,TcType s)] 
           -> GenType (GenTyVar flexi) UVar 
           -> NF_TcM s (TcType s)