-- friends:
import TypeRep ( Type(..), Kind, TyNote(..) ) -- friend
-import Type ( ThetaType, PredType(..),
- getTyVar, mkAppTy, mkTyConApp, mkPredTy,
- splitPredTy_maybe, splitForAllTys, isNotUsgTy,
+import Type ( PredType(..),
+ getTyVar, mkAppTy, mkUTy,
+ splitPredTy_maybe, splitForAllTys,
isTyVarTy, mkTyVarTy, mkTyVarTys,
openTypeKind, boxedTypeKind,
superKind, superBoxity,
defaultKind, boxedBoxity
)
import Subst ( Subst, mkTopTyVarSubst, substTy )
-import TyCon ( tyConKind, mkPrimTyCon )
+import TyCon ( mkPrimTyCon )
import PrimRep ( PrimRep(VoidRep) )
import Var ( TyVar, tyVarKind, tyVarName, isTyVar, isMutTyVar, mkTyVar )
import TysWiredIn ( voidTy )
import Name ( Name, NamedThing(..), setNameUnique, mkSysLocalName,
- mkDerivedName, mkDerivedTyConOcc
+ mkLocalName, mkDerivedTyConOcc
)
-import Unique ( Unique, Uniquable(..) )
+import Unique ( Uniquable(..) )
+import SrcLoc ( noSrcLoc )
import Util ( nOfThem )
import Outputable
\end{code}
case maybe_ty of
Just ty | not (isTyVarTy ty) -> go syn_t ty ts
other -> returnNF_Tc (reverse ts, syn_t)
+ go syn_t (UsageTy _ t) ts = go syn_t t ts
go syn_t t ts = returnNF_Tc (reverse ts, syn_t)
\end{code}
Putting is easy:
\begin{code}
-tcPutTyVar tyvar ty = tcWriteMutTyVar tyvar (Just ty) `thenNF_Tc_`
+tcPutTyVar tyvar ty = UASSERT2( not (isUTy ty), ppr tyvar <+> ppr ty )
+ tcWriteMutTyVar tyvar (Just ty) `thenNF_Tc_`
returnNF_Tc ty
\end{code}
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
+ -- I dread to think what will happen if this gets out into an
+ -- interface file. Catastrophe likely. Major sigh.
+ = pprTrace "Urk! Inventing strangely-kinded void TyCon" (ppr tc_name) $
+ mkPrimTyCon tc_name kind 0 [] VoidRep
where
- tc_name = mkDerivedName mkDerivedTyConOcc (getName tv) (getUnique tv)
+ tc_name = mkLocalName (getUnique tv) (mkDerivedTyConOcc (getOccName tv)) noSrcLoc
-- zonkTcTyVarToTyVar is applied to the *binding* occurrence
-- of a type variable, at the *end* of type checking. It changes
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 (NoteTy (UsgForAll uv) ty2)= go ty2 `thenNF_Tc` \ ty2' ->
- returnNF_Tc (NoteTy (UsgForAll uv) ty2')
-
go (PredTy p) = go_pred p `thenNF_Tc` \ p' ->
returnNF_Tc (PredTy p')
go arg `thenNF_Tc` \ arg' ->
returnNF_Tc (mkAppTy fun' arg')
+ go (UsageTy u ty) = go u `thenNF_Tc` \ u' ->
+ go ty `thenNF_Tc` \ ty' ->
+ returnNF_Tc (mkUTy u' ty')
+
-- The two interesting cases!
go (TyVarTy tyvar) = 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 -> ASSERT( isNotUsgTy other_ty )
- zonkType unbound_var_fn other_ty -- Bound
+ Just other_ty -> zonkType unbound_var_fn other_ty -- Bound
\end{code}