module TcHsSyn (
TcIdBndr(..), TcIdOcc(..),
- TcMonoBinds(..), TcHsBinds(..), TcBind(..), TcPat(..), TcExpr(..), TcGRHSsAndBinds(..),
- TcGRHS(..), TcMatch(..), TcQual(..), TcStmt(..), TcArithSeqInfo(..), TcHsModule(..),
+ TcMonoBinds(..), TcHsBinds(..), TcBind(..), TcPat(..),
+ TcExpr(..), TcGRHSsAndBinds(..), TcGRHS(..), TcMatch(..),
+ TcQual(..), TcStmt(..), TcArithSeqInfo(..), TcRecordBinds(..),
+ TcHsModule(..),
- TypecheckedHsBinds(..), TypecheckedBind(..), TypecheckedMonoBinds(..),
- TypecheckedPat(..), TypecheckedHsExpr(..), TypecheckedArithSeqInfo(..),
- TypecheckedQual(..), TypecheckedStmt(..), TypecheckedMatch(..),
- TypecheckedHsModule(..), TypecheckedGRHSsAndBinds(..), TypecheckedGRHS(..),
+ TypecheckedHsBinds(..), TypecheckedBind(..),
+ TypecheckedMonoBinds(..), TypecheckedPat(..),
+ TypecheckedHsExpr(..), TypecheckedArithSeqInfo(..),
+ TypecheckedQual(..), TypecheckedStmt(..),
+ TypecheckedMatch(..), TypecheckedHsModule(..),
+ TypecheckedGRHSsAndBinds(..), TypecheckedGRHS(..),
+ TypecheckedRecordBinds(..),
mkHsTyApp, mkHsDictApp,
mkHsTyLam, mkHsDictLam,
+ tcIdType,
zonkBinds,
zonkInst,
-- friends:
import HsSyn -- oodles of it
import Id ( GenId(..), IdDetails, PragmaInfo, -- Can meddle modestly with Ids
- DictVar(..)
+ DictVar(..), idType
)
-- others:
type TcQual s = Qual (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
type TcStmt s = Stmt (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
type TcArithSeqInfo s = ArithSeqInfo (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
+type TcRecordBinds s = HsRecordBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
type TcHsModule s = HsModule (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
type TypecheckedPat = OutPat TyVar UVar Id
type TypecheckedMatch = Match TyVar UVar Id TypecheckedPat
type TypecheckedGRHSsAndBinds = GRHSsAndBinds TyVar UVar Id TypecheckedPat
type TypecheckedGRHS = GRHS TyVar UVar Id TypecheckedPat
+type TypecheckedRecordBinds = HsRecordBinds TyVar UVar Id TypecheckedPat
type TypecheckedHsModule = HsModule TyVar UVar Id TypecheckedPat
\end{code}
mkHsDictLam [] expr = expr
mkHsDictLam dicts expr = DictLam dicts expr
+
+tcIdType :: TcIdOcc s -> TcType s
+tcIdType (TcId id) = idType id
+tcIdType other = panic "tcIdType"
\end{code}
ppr sty (RealId id) = ppr sty id
instance NamedThing (TcIdOcc s) where
- getOccurrenceName (TcId id) = getOccurrenceName id
- getOccurrenceName (RealId id) = getOccurrenceName id
+ getName (TcId id) = getName id
+ getName (RealId id) = getName id
\end{code}
zonkExpr expr `thenNF_Tc` \ new_expr ->
returnNF_Tc (VarMonoBind new_var new_expr)
-zonkMonoBinds (FunMonoBind name ms locn)
+zonkMonoBinds (FunMonoBind name inf ms locn)
= zonkId name `thenNF_Tc` \ new_name ->
mapNF_Tc zonkMatch ms `thenNF_Tc` \ new_ms ->
- returnNF_Tc (FunMonoBind new_name new_ms locn)
+ returnNF_Tc (FunMonoBind new_name inf new_ms locn)
\end{code}
%************************************************************************
= zonkGRHSsAndBinds grhss_w_binds `thenNF_Tc` \ new_grhss_w_binds ->
returnNF_Tc (GRHSMatch new_grhss_w_binds)
+zonkMatch (SimpleMatch expr)
+ = zonkExpr expr `thenNF_Tc` \ new_expr ->
+ returnNF_Tc (SimpleMatch new_expr)
+
-------------------------------------------------------------------------
zonkGRHSsAndBinds :: TcGRHSsAndBinds s
-> NF_TcM s TypecheckedGRHSsAndBinds
zonkExpr e2 `thenNF_Tc` \ new_e2 ->
returnNF_Tc (OpApp new_e1 new_op new_e2)
+zonkExpr (NegApp _) = panic "zonkExpr:NegApp"
+zonkExpr (HsPar _) = panic "zonkExpr:HsPar"
+
zonkExpr (SectionL expr op)
= zonkExpr expr `thenNF_Tc` \ new_expr ->
zonkExpr op `thenNF_Tc` \ new_op ->
zonkExpr expr `thenNF_Tc` \ new_expr ->
returnNF_Tc (SectionR new_op new_expr)
-zonkExpr (CCall fun args may_gc is_casm result_ty)
- = mapNF_Tc zonkExpr args `thenNF_Tc` \ new_args ->
- zonkTcTypeToType result_ty `thenNF_Tc` \ new_result_ty ->
- returnNF_Tc (CCall fun new_args may_gc is_casm new_result_ty)
-
-zonkExpr (HsSCC label expr)
- = zonkExpr expr `thenNF_Tc` \ new_expr ->
- returnNF_Tc (HsSCC label new_expr)
-
zonkExpr (HsCase expr ms src_loc)
= zonkExpr expr `thenNF_Tc` \ new_expr ->
mapNF_Tc zonkMatch ms `thenNF_Tc` \ new_ms ->
returnNF_Tc (HsCase new_expr new_ms src_loc)
+zonkExpr (HsIf e1 e2 e3 src_loc)
+ = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
+ zonkExpr e2 `thenNF_Tc` \ new_e2 ->
+ zonkExpr e3 `thenNF_Tc` \ new_e3 ->
+ returnNF_Tc (HsIf new_e1 new_e2 new_e3 src_loc)
+
zonkExpr (HsLet binds expr)
= zonkBinds binds `thenNF_Tc` \ new_binds ->
zonkExpr expr `thenNF_Tc` \ new_expr ->
returnNF_Tc (HsLet new_binds new_expr)
+zonkExpr (HsDo _ _) = panic "zonkExpr:HsDo"
+
zonkExpr (HsDoOut stmts m_id mz_id src_loc)
= zonkStmts stmts `thenNF_Tc` \ new_stmts ->
zonkId m_id `thenNF_Tc` \ m_new ->
zonkQuals quals `thenNF_Tc` \ new_quals ->
returnNF_Tc (ListComp new_expr new_quals)
---ExplicitList: not in typechecked exprs
+zonkExpr (ExplicitList _) = panic "zonkExpr:ExplicitList"
zonkExpr (ExplicitListOut ty exprs)
= zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
= panic "zonkExpr:RecordCon"
zonkExpr (RecordUpd exp rbinds)
= panic "zonkExpr:RecordUpd"
+zonkExpr (RecordUpdOut exp ids rbinds)
+ = panic "zonkExpr:RecordUpdOut"
-zonkExpr (HsIf e1 e2 e3 src_loc)
- = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
- zonkExpr e2 `thenNF_Tc` \ new_e2 ->
- zonkExpr e3 `thenNF_Tc` \ new_e3 ->
- returnNF_Tc (HsIf new_e1 new_e2 new_e3 src_loc)
+zonkExpr (ExprWithTySig _ _) = panic "zonkExpr:ExprWithTySig"
+zonkExpr (ArithSeqIn _) = panic "zonkExpr:ArithSeqIn"
zonkExpr (ArithSeqOut expr info)
= zonkExpr expr `thenNF_Tc` \ new_expr ->
zonkArithSeq info `thenNF_Tc` \ new_info ->
returnNF_Tc (ArithSeqOut new_expr new_info)
+zonkExpr (CCall fun args may_gc is_casm result_ty)
+ = mapNF_Tc zonkExpr args `thenNF_Tc` \ new_args ->
+ zonkTcTypeToType result_ty `thenNF_Tc` \ new_result_ty ->
+ returnNF_Tc (CCall fun new_args may_gc is_casm new_result_ty)
+
+zonkExpr (HsSCC label expr)
+ = zonkExpr expr `thenNF_Tc` \ new_expr ->
+ returnNF_Tc (HsSCC label new_expr)
+
zonkExpr (TyLam tyvars expr)
= mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars ->
zonkExpr expr `thenNF_Tc` \ new_expr ->
= zonkId name `thenNF_Tc` \ new_name ->
returnNF_Tc (SingleDict new_name)
+zonkExpr (HsCon con tys vargs)
+ = mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys ->
+ mapNF_Tc zonkExpr vargs `thenNF_Tc` \ new_vargs ->
+ returnNF_Tc (HsCon con new_tys new_vargs)
+
-------------------------------------------------------------------------
zonkArithSeq :: TcArithSeqInfo s -> NF_TcM s TypecheckedArithSeqInfo