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
hsPatType (NPat lit _ _ ty) = ty
hsPatType (NPlusKPat id _ _ _) = idType (unLoc id)
hsPatType (CoPat _ _ ty) = ty
-hsPatType (DictPat ds ms) = case (ds ++ ms) of
- [] -> unitTy
- [d] -> idType d
- ds -> mkTupleTy Boxed (length ds) (map idType ds)
-
hsLitType :: HsLit -> TcType
hsLitType (HsChar c) = charTy
returnM (ExplicitTuple new_exprs boxed)
zonkExpr env (RecordCon data_con con_expr rbinds)
- = zonkExpr env con_expr `thenM` \ new_con_expr ->
- zonkRbinds env rbinds `thenM` \ new_rbinds ->
- returnM (RecordCon data_con new_con_expr new_rbinds)
+ = do { new_con_expr <- zonkExpr env con_expr
+ ; new_rbinds <- zonkRecFields env rbinds
+ ; return (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)
+ = do { new_expr <- zonkLExpr env expr
+ ; new_in_tys <- mapM (zonkTcTypeToType env) in_tys
+ ; new_out_tys <- mapM (zonkTcTypeToType env) out_tys
+ ; new_rbinds <- zonkRecFields env rbinds
+ ; return (RecordUpd new_expr new_rbinds cons new_in_tys new_out_tys) }
zonkExpr env (ExprWithTySigOut e ty)
= do { e' <- zonkLExpr env e
-------------------------------------------------------------------------
-zonkRbinds :: ZonkEnv -> HsRecordBinds TcId -> TcM (HsRecordBinds Id)
-
-zonkRbinds env (HsRecordBinds rbinds)
- = mappM zonk_rbind rbinds >>= return . HsRecordBinds
+zonkRecFields :: ZonkEnv -> HsRecordBinds TcId -> TcM (HsRecordBinds TcId)
+zonkRecFields env (HsRecFields flds dd)
+ = do { flds' <- mappM zonk_rbind flds
+ ; return (HsRecFields flds' dd) }
where
- zonk_rbind (field, expr)
- = zonkLExpr env expr `thenM` \ new_expr ->
- returnM (fmap (zonkIdOcc env) field, new_expr)
+ zonk_rbind fld
+ = do { new_expr <- zonkLExpr env (hsRecFieldArg fld)
+ ; return (fld { hsRecFieldArg = new_expr }) }
+ -- Field selectors have declared types; hence no zonking
-------------------------------------------------------------------------
mapIPNameTc :: (a -> TcM b) -> IPName a -> TcM (IPName b)
; e2' <- zonkExpr env e2
; return (extendZonkEnv1 env n', NPlusKPat (L loc n') lit' e1' e2') }
-zonk_pat env (DictPat ds ms)
- = do { ds' <- zonkIdBndrs env ds
- ; ms' <- zonkIdBndrs env ms
- ; return (extendZonkEnv env (ds' ++ ms'), DictPat ds' ms') }
-
zonk_pat env (CoPat co_fn pat ty)
= do { (env', co_fn') <- zonkCoFn env co_fn
; (env'', pat') <- zonkPat env' (noLoc pat)
; (env', p2') <- zonkPat env1 p2
; return (env', InfixCon p1' p2') }
-zonkConStuff env (RecCon rpats)
- = do { let (fields, pats) = unzip [ (f, p) | HsRecField f p _ <- rpats ]
- ; (env', pats') <- zonkPats env pats
- ; let recCon = RecCon [ mkRecField f p | (f, p) <- zip fields pats' ]
- ; returnM (env', recCon) }
+zonkConStuff env (RecCon (HsRecFields rpats dd))
+ = do { (env', pats') <- zonkPats env (map hsRecFieldArg rpats)
+ ; let rpats' = zipWith (\rp p' -> rp { hsRecFieldArg = p' }) rpats pats'
+ ; returnM (env', RecCon (HsRecFields rpats' dd)) }
+ -- Field selectors have declared types; hence no zonking
---------------------------
zonkPats env [] = return (env, [])