[project @ 1999-05-18 15:03:54 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 7305d51..72d4eb7 100644 (file)
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -26,6 +26,7 @@ module TcType (
   tcSplitRhoTy,
 
   tcInstTyVars,
+  tcInstSigVar,
   tcInstTcType,
 
   typeToTcType,
@@ -53,11 +54,11 @@ module TcType (
 import PprType         ( pprType )
 import Type            ( Type(..), Kind, ThetaType, TyNote(..), 
                          mkAppTy, mkTyConApp,
-                         splitDictTy_maybe, splitForAllTys,
+                         splitDictTy_maybe, splitForAllTys, isNotUsgTy,
                          isTyVarTy, mkTyVarTy, mkTyVarTys, 
-                         fullSubstTy, substTopTy, 
                          typeCon, openTypeKind, boxedTypeKind, boxedKind, superKind, superBoxity
                        )
+import Subst           ( Subst, mkTopTyVarSubst, substTy )
 import TyCon           ( tyConKind, mkPrimTyCon )
 import PrimRep         ( PrimRep(VoidRep) )
 import VarEnv
@@ -169,16 +170,19 @@ Instantiating a bunch of type variables
 
 \begin{code}
 tcInstTyVars :: [TyVar] 
-            -> NF_TcM s ([TcTyVar], [TcType], TyVarEnv TcType)
+            -> NF_TcM s ([TcTyVar], [TcType], Subst)
 
 tcInstTyVars tyvars
-  = mapNF_Tc inst_tyvar tyvars `thenNF_Tc` \ tc_tyvars ->
+  = mapNF_Tc tcInstTyVar tyvars        `thenNF_Tc` \ tc_tyvars ->
     let
        tys = mkTyVarTys tc_tyvars
     in
-    returnNF_Tc (tc_tyvars, tys, zipVarEnv tyvars tys)
+    returnNF_Tc (tc_tyvars, tys, mkTopTyVarSubst tyvars tys)
+               -- Since the tyvars are freshly made,
+               -- they cannot possibly be captured by
+               -- any existing for-alls.  Hence mkTopTyVarSubst
 
-inst_tyvar tyvar       -- Could use the name from the tyvar?
+tcInstTyVar tyvar
   = tcGetUnique                `thenNF_Tc` \ uniq ->
     let
        name = setNameUnique (tyVarName tyvar) uniq
@@ -208,6 +212,15 @@ inst_tyvar tyvar   -- Could use the name from the tyvar?
        returnNF_Tc kind)       `thenNF_Tc` \ kind' ->
 
     tcNewMutTyVar name kind'
+
+tcInstSigVar tyvar     -- Very similar to tcInstTyVar
+  = tcGetUnique        `thenNF_Tc` \ uniq ->
+    let 
+       name = setNameUnique (tyVarName tyvar) uniq
+       kind = tyVarKind tyvar
+    in
+    ASSERT( not (kind == openTypeKind) )       -- Shouldn't happen
+    tcNewSigTyVar name kind
 \end{code}
 
 @tcInstTcType@ instantiates the outer-level for-alls of a TcType with
@@ -219,10 +232,7 @@ tcInstTcType ty
   = case splitForAllTys ty of
        ([], _)       -> returnNF_Tc ([], ty)   -- Nothing to do
        (tyvars, rho) -> tcInstTyVars tyvars            `thenNF_Tc` \ (tyvars', _, tenv)  ->
-                        returnNF_Tc (tyvars', fullSubstTy tenv emptyVarSet rho)
-                                       -- Since the tyvars are freshly made,
-                                       -- they cannot possibly be captured by
-                                       -- any existing for-alls.  Hence emptyVarSet
+                        returnNF_Tc (tyvars', substTy tenv rho)
 \end{code}
 
 
@@ -361,7 +371,7 @@ zonkTcTypeToType ty = zonkType zonk_unbound_tyvar ty
     mk_void_tycon tv kind      -- Make a new TyCon with the same kind as the 
                                -- type variable tv.  Same name too, apart from
                                -- making it start with a colon (sigh)
-       = mkPrimTyCon tc_name kind 0 VoidRep
+       = mkPrimTyCon tc_name kind 0 [] VoidRep
        where
          tc_name = mkDerivedName mkDerivedTyConOcc (getName tv) (getUnique tv)
 
@@ -423,6 +433,9 @@ zonkType unbound_var_fn ty
 
     go (NoteTy (FTVNote _) ty2)   = go ty2     -- Discard free-tyvar annotations
 
+    go (NoteTy (UsgNote usg) ty2) = go ty2             `thenNF_Tc` \ ty2' ->
+                                   returnNF_Tc (NoteTy (UsgNote usg) ty2')
+
     go (FunTy arg res)           = go arg              `thenNF_Tc` \ arg' ->
                                    go res              `thenNF_Tc` \ res' ->
                                    returnNF_Tc (FunTy arg' res')
@@ -453,7 +466,8 @@ zonkTyVar unbound_var_fn tyvar
   =  tcGetTyVar tyvar  `thenNF_Tc` \ maybe_ty ->
      case maybe_ty of
          Nothing       -> unbound_var_fn tyvar                 -- Mutable and unbound
-         Just other_ty -> zonkType unbound_var_fn other_ty     -- Bound
+         Just other_ty -> ASSERT( isNotUsgTy other_ty )
+                           zonkType unbound_var_fn other_ty    -- Bound
 \end{code}
 
 %************************************************************************