+\begin{code}
+zonkTcKindToKind :: TcKind -> NF_TcM s Kind
+zonkTcKindToKind kind = zonkType zonk_unbound_kind_var kind
+ where
+ -- Zonk a mutable but unbound kind variable to
+ -- (Type Boxed) if it has kind superKind
+ -- Boxed if it has kind superBoxity
+ zonk_unbound_kind_var kv
+ | super_kind == superKind = tcPutTyVar kv boxedTypeKind
+ | otherwise = ASSERT( super_kind == superBoxity )
+ tcPutTyVar kv boxedKind
+ where
+ super_kind = tyVarKind kv
+
+
+zonkTcTypeToType :: TcType -> NF_TcM s Type
+zonkTcTypeToType ty = zonkType zonk_unbound_tyvar ty
+ where
+ -- Zonk a mutable but unbound type variable to
+ -- Void if it has kind (Type Boxed)
+ -- Voidxxx otherwise
+ zonk_unbound_tyvar tv
+ = zonkTcKindToKind (tyVarKind tv) `thenNF_Tc` \ kind ->
+ if kind == boxedTypeKind then
+ tcPutTyVar tv voidTy -- Just to avoid creating a new tycon in
+ -- this vastly common case
+ else
+ tcPutTyVar tv (TyConApp (mk_void_tycon tv kind) [])
+
+ 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
+ where
+ tc_name = mkDerivedName mkDerivedTyConOcc (getName tv) (getUnique tv)
+
+-- zonkTcTyVarToTyVar is applied to the *binding* occurrence
+-- of a type variable, at the *end* of type checking.
+-- It zonks the type variable, to get a mutable, but unbound, tyvar, tv;
+-- zonks its kind, and then makes an immutable version of tv and binds tv to it.
+-- Now any bound occurences of the original type variable will get
+-- zonked to the immutable version.
+
+zonkTcTyVarToTyVar :: TcTyVar -> NF_TcM s TyVar
+zonkTcTyVarToTyVar tv
+ = zonkTcKindToKind (tyVarKind tv) `thenNF_Tc` \ kind ->
+ let
+ -- Make an immutable version
+ immut_tv = mkTyVar (tyVarName tv) kind
+ immut_tv_ty = mkTyVarTy immut_tv
+
+ zap tv = tcPutTyVar tv immut_tv_ty
+ -- Bind the mutable version to the immutable one
+ in
+ -- If the type variable is mutable, then bind it to immut_tv_ty
+ -- so that all other occurrences of the tyvar will get zapped too
+ zonkTyVar zap tv `thenNF_Tc` \ ty2 ->
+ ASSERT2( immut_tv_ty == ty2, ppr tv $$ ppr immut_tv $$ ppr ty2 )
+
+ returnNF_Tc immut_tv
+\end{code}