X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsSyn.lhs;h=9411a3a2432dcabc67923d9928aef8256138f807;hb=fc867aa70e3bc8753287cf1f5e9a5adb05c38dc6;hp=f4e2587abead7cf07d65bc4c0032861ab7eee652;hpb=d386e0d20c6953b7cba4d53538a1782c4aa9980d;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index f4e2587..9411a3a 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -304,11 +304,12 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_dicts = dicts, = 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} %************************************************************************ @@ -462,12 +463,12 @@ zonkExpr env (RecordCon data_con con_expr rbinds) 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 @@ -564,6 +565,8 @@ zonkOverLit env (HsIntegral i e) = 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) @@ -645,8 +648,8 @@ zonkStmt env (BindStmt pat expr bind_op fail_op) ------------------------------------------------------------------------- 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 ->