checker.
\begin{code}
+{-# OPTIONS_GHC -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+-- for details
+
module TcHsSyn (
mkHsConApp, mkHsDictLet, mkHsApp,
hsLitType, hsLPatType, hsPatType,
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
= 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}
%************************************************************************
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 rbinds
- = mappM zonk_rbind rbinds
+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, [])