import TcRnMonad
import Type ( Type )
-import TcType ( TcType, TcTyVar, eqKind, isTypeKind, mkTyVarTy,
- tcGetTyVar, isAnyTypeKind, mkTyConApp )
+import TcType ( TcType, TcTyVar, mkTyVarTy, tcGetTyVar, mkTyConApp )
+import Kind ( isLiftedTypeKind, liftedTypeKind, isSubKind )
import qualified Type
import TcMType ( zonkTcTyVarToTyVar, zonkType, zonkTcType, zonkTcTyVars,
putTcTyVar )
import TysWiredIn ( charTy, stringTy, intTy,
mkListTy, mkPArrTy, mkTupleTy, unitTy,
voidTy, listTyCon, tupleTyCon )
-import TyCon ( mkPrimTyCon, tyConKind )
-import PrimRep ( PrimRep(VoidRep) )
+import TyCon ( mkPrimTyCon, tyConKind, PrimRep(..) )
+import Kind ( splitKindFunTys )
import Name ( getOccName, mkInternalName, mkDerivedTyConOcc )
import Var ( Var, isId, isLocalVar, tyVarKind )
import VarSet
zonkRbinds env rbinds `thenM` \ new_rbinds ->
returnM (RecordUpdOut new_expr new_in_ty new_out_ty new_rbinds)
+zonkExpr env (ExprWithTySigOut e ty)
+ = do { e' <- zonkLExpr env e
+ ; return (ExprWithTySigOut e' ty) }
+
zonkExpr env (ExprWithTySig _ _) = panic "zonkExpr env:ExprWithTySig"
zonkExpr env (ArithSeqIn _) = panic "zonkExpr env:ArithSeqIn"
zonkExpr env (PArrSeqIn _) = panic "zonkExpr env:PArrSeqIn"
zonkReboundNames env prs
= mapM zonk prs
where
- zonk (n, e) = zonkLExpr env e `thenM` \ new_e ->
+ zonk (n, e) = zonkExpr env e `thenM` \ new_e ->
returnM (n, new_e)
-- Make up an arbitrary type whose kind is the same as the tyvar.
-- We'll use this to instantiate the (unbound) tyvar.
mkArbitraryType tv
- | isAnyTypeKind kind = voidTy -- The vastly common case
- | otherwise = mkTyConApp tycon []
+ | liftedTypeKind `isSubKind` kind = voidTy -- The vastly common case
+ | otherwise = mkTyConApp tycon []
where
kind = tyVarKind tv
- (args,res) = Type.splitFunTys kind -- Kinds are simple; use Type.splitFunTys
+ (args,res) = splitKindFunTys kind
- tycon | kind `eqKind` tyConKind listTyCon -- *->*
+ tycon | kind == tyConKind listTyCon -- *->*
= listTyCon -- No tuples this size
- | all isTypeKind args && isTypeKind res
+ | all isLiftedTypeKind args && isLiftedTypeKind res
= tupleTyCon Boxed (length args) -- *-> ... ->*->*
| otherwise