X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcType.lhs;h=8426310f011af86e8ebb293f463c6755fc6cc015;hb=7b0181919416d8f04324575b7e17031ca692f5b0;hp=530e41a90f7fb9fece4b663978dd594cee08b72a;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 530e41a..8426310 100644
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -20,7 +20,7 @@ module TcType (
 
   tcInstTyVars,    -- TyVar -> NF_TcM s (TcTyVar s)
   tcInstSigTyVars, 
-  tcInstType, tcInstTcType, tcInstTheta,
+  tcInstType, tcInstTcType, tcInstTheta, tcInstId,
 
     zonkTcTyVars,	-- TcTyVarSet s -> NF_TcM s (TcTyVarSet s)
     zonkTcType,		-- TcType s -> NF_TcM s (TcType s)
@@ -32,22 +32,25 @@ module TcType (
 
 
 -- friends:
-import Type	( Type(..), ThetaType(..), GenType(..), tyVarsOfTypes, getTyVar_maybe )
+import Type	( Type(..), ThetaType(..), GenType(..),
+		  tyVarsOfTypes, getTyVar_maybe,
+		  splitForAllTy, splitRhoTy
+		)
 import TyVar	( TyVar(..), GenTyVar(..), TyVarSet(..), GenTyVarSet(..), 
 		  tyVarSetToList
 		)
 
 -- others:
-import Kind	( Kind )
-import Usage	( Usage(..), GenUsage, UVar(..), duffUsage )
 import Class	( GenClass )
+import Id	( idType )
+import Kind	( Kind )
 import TcKind	( TcKind )
 import TcMonad
+import Usage	( Usage(..), GenUsage, UVar(..), duffUsage )
 
 import Ubiq
 import Unique		( Unique )
 import UniqFM		( UniqFM )
-import Name		( getNameShortName )
 import Maybes		( assocMaybe )
 import Util		( panic, pprPanic )
 
@@ -194,7 +197,24 @@ tcInstTheta tenv theta
     go (clas,ty) = tcInstType tenv ty 	`thenNF_Tc` \ tc_ty ->
 		   returnNF_Tc (clas, tc_ty)
 
---???tcSpecTy :: Type -> NF_TcM s (
+-- A useful function that takes an occurrence of a global thing
+-- and instantiates its type with fresh type variables
+tcInstId :: Id
+	 -> NF_TcM s ([TcTyVar s], 	-- It's instantiated type
+		      TcThetaType s,	--
+		      TcType s)		--
+
+tcInstId id
+  = let
+      (tyvars, rho) = splitForAllTy (idType id)
+    in
+    tcInstTyVars tyvars		`thenNF_Tc` \ (tyvars', arg_tys, tenv) ->
+    tcInstType tenv rho		`thenNF_Tc` \ rho' ->
+    let
+	(theta', tau') = splitRhoTy rho'
+    in
+    returnNF_Tc (tyvars', theta', tau')
+
 
 tcInstTcType ::  [(TcTyVar s,TcType s)] -> TcType s -> NF_TcM s (TcType s)
 tcInstTcType tenv ty_to_inst