mkHsAppTy, mkSimpleHsAlt,
nlHsIntLit, mkVanillaTuplePat,
+ mkArbitraryType, -- Put this elsewhere?
-- re-exported from TcMonad
TcId, TcIdSet, TcDictBinds,
import TcRnMonad
import Type
import TcType
-import qualified Type
import TcMType
import TysPrim
import TysWiredIn
import TyCon
-import {- Kind parts of -} Type
import Name
import Var
import VarSet
= zonkIdBndr env global `thenM` \ new_global ->
mapM zonk_prag prags `thenM` \ new_prags ->
returnM (tyvars, new_global, zonkIdOcc env local, new_prags)
- zonk_prag prag@(InlinePrag {}) = return prag
- zonk_prag (SpecPrag expr ty ds inl) = do { expr' <- zonkExpr env expr
- ; ty' <- zonkTcTypeToType env ty
- ; let ds' = zonkIdOccs env ds
- ; return (SpecPrag expr' ty' ds' inl) }
+ zonk_prag prag@(L _ (InlinePrag {})) = return prag
+ zonk_prag (L loc (SpecPrag expr ty ds inl))
+ = do { expr' <- zonkExpr env expr
+ ; ty' <- zonkTcTypeToType env ty
+ ; let ds' = zonkIdOccs env ds
+ ; return (L loc (SpecPrag expr' ty' ds' inl)) }
\end{code}
%************************************************************************
zonkRbinds env rbinds `thenM` \ new_rbinds ->
returnM (RecordCon data_con new_con_expr new_rbinds)
-zonkExpr env (RecordUpd expr rbinds in_ty out_ty)
- = zonkLExpr env expr `thenM` \ new_expr ->
- zonkTcTypeToType env in_ty `thenM` \ new_in_ty ->
- zonkTcTypeToType env out_ty `thenM` \ new_out_ty ->
- zonkRbinds env rbinds `thenM` \ new_rbinds ->
- returnM (RecordUpd new_expr new_rbinds new_in_ty new_out_ty)
+zonkExpr env (RecordUpd expr rbinds cons in_tys out_tys)
+ = zonkLExpr env expr `thenM` \ new_expr ->
+ mapM (zonkTcTypeToType env) in_tys `thenM` \ new_in_tys ->
+ mapM (zonkTcTypeToType env) out_tys `thenM` \ new_out_tys ->
+ zonkRbinds env rbinds `thenM` \ new_rbinds ->
+ returnM (RecordUpd new_expr new_rbinds cons new_in_tys new_out_tys)
zonkExpr env (ExprWithTySigOut e ty)
= do { e' <- zonkLExpr env e
= zonkLExpr env expr `thenM` \ new_expr ->
returnM (HsSCC lbl new_expr)
+zonkExpr env (HsTickPragma info expr)
+ = zonkLExpr env expr `thenM` \ new_expr ->
+ returnM (HsTickPragma info new_expr)
+
-- hdaume: core annotations
zonkExpr env (HsCoreAnn lbl expr)
= zonkLExpr env expr `thenM` \ new_expr ->
= do { e' <- zonkExpr env e; return (HsIntegral i e') }
zonkOverLit env (HsFractional r e)
= do { e' <- zonkExpr env e; return (HsFractional r e') }
+zonkOverLit env (HsIsString s e)
+ = do { e' <- zonkExpr env e; return (HsIsString s e') }
-------------------------------------------------------------------------
zonkArithSeq :: ZonkEnv -> ArithSeqInfo TcId -> TcM (ArithSeqInfo Id)
-------------------------------------------------------------------------
zonkRbinds :: ZonkEnv -> HsRecordBinds TcId -> TcM (HsRecordBinds Id)
-zonkRbinds env rbinds
- = mappM zonk_rbind rbinds
+zonkRbinds env (HsRecordBinds rbinds)
+ = mappM zonk_rbind rbinds >>= return . HsRecordBinds
where
zonk_rbind (field, expr)
= zonkLExpr env expr `thenM` \ new_expr ->
-- Make up an arbitrary type whose kind is the same as the tyvar.
-- We'll use this to instantiate the (unbound) tyvar.
mkArbitraryType tv
- | liftedTypeKind `isSubKind` kind = voidTy -- The vastly common case
+ | liftedTypeKind `isSubKind` kind = anyPrimTy -- The vastly common case
| otherwise = mkTyConApp tycon []
where
kind = tyVarKind tv
(args,res) = splitKindFunTys kind
- tycon | eqKind kind (tyConKind listTyCon) -- *->*
- = listTyCon -- No tuples this size
+ tycon | eqKind kind (tyConKind anyPrimTyCon1) -- *->*
+ = anyPrimTyCon1 -- No tuples this size
| all isLiftedTypeKind args && isLiftedTypeKind res
= tupleTyCon Boxed (length args) -- *-> ... ->*->*
+ -- Horrible hack to make less use of mkAnyPrimTyCon
| otherwise
- = pprTrace "Urk! Inventing strangely-kinded void TyCon:" (ppr tc_name $$ ppr kind) $
- mkPrimTyCon tc_name kind 0 VoidRep
+ = mkAnyPrimTyCon (getUnique tv) kind
-- Same name as the tyvar, apart from making it start with a colon (sigh)
-- I dread to think what will happen if this gets out into an
-- interface file. Catastrophe likely. Major sigh.
-
- tc_name = mkInternalName (getUnique tv) (mkDerivedTyConOcc (getOccName tv)) noSrcLoc
\end{code}