X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=acf003f6fed2631f24e7ef8302b07b3031fe3bf6;hb=f80b81f8b56ebd0fa0f7f82494a5090e9ab64256;hp=9747c22a724a1d02960d8965ec3bae1a22b79b40;hpb=c455d9a46cbe9b7fa0013a7bcadaa5c738944604;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 9747c22..acf003f 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -35,6 +35,7 @@ import RdrHsSyn ( findSplice ) import PrelNames ( runMainIOName, rootMainKey, rOOT_MAIN, mAIN, main_RDR_Unqual ) import RdrName ( RdrName, mkRdrUnqual, emptyGlobalRdrEnv ) +import TyCon ( isOpenTyCon ) import TcHsSyn ( zonkTopDecls ) import TcExpr ( tcInferRho ) import TcRnMonad @@ -231,9 +232,10 @@ tcRnModule hsc_env hsc_src save_rn_syntax reportDeprecations (hsc_dflags hsc_env) tcg_env ; -- Process the export list - rn_exports <- rnExports export_ies ; + rn_exports <- rnExports export_ies; let { liftM2' fn a b = do a' <- a; b' <- b; return (fn a' b') } ; - exports <- mkExportNameSet (isJust maybe_mod) (liftM2' (,) rn_exports export_ies) ; + exports <- mkExportNameSet (isJust maybe_mod) + (liftM2' (,) rn_exports export_ies) ; -- Check whether the entire module is deprecated -- This happens only once per module @@ -561,6 +563,7 @@ missingBootThing thing = ppr thing <+> ptext SLIT("is defined in the hs-boot file, but not in the module") bootMisMatch thing boot_decl real_decl = ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file") + $+$ (ppr boot_decl) $+$ (ppr real_decl) instMisMatch inst = hang (ppr inst) 2 (ptext SLIT("is defined in the hs-boot file, but not in the module")) @@ -962,15 +965,20 @@ mkPlan stmt@(L loc (BindStmt {})) | [L _ v] <- collectLStmtBinders stmt -- One binder, for a bind stmt = do { let print_v = L loc $ ExprStmt (nlHsApp (nlHsVar printName) (nlHsVar v)) (HsVar thenIOName) placeHolderType + + ; print_bind_result <- doptM Opt_PrintBindResult + ; let print_plan = do + { stuff@([v_id], _) <- tcGhciStmts [stmt, print_v] + ; v_ty <- zonkTcType (idType v_id) + ; ifM (isUnitTy v_ty || not (isTauTy v_ty)) failM + ; return stuff } + -- The plans are: -- [stmt; print v] but not if v::() -- [stmt] - ; runPlans [do { stuff@([v_id], _) <- tcGhciStmts [stmt, print_v] - ; v_ty <- zonkTcType (idType v_id) - ; ifM (isUnitTy v_ty || not (isTauTy v_ty)) failM - ; return stuff }, - tcGhciStmts [stmt] - ]} + ; runPlans ((if print_bind_result then [print_plan] else []) ++ + [tcGhciStmts [stmt]]) + } mkPlan stmt = tcGhciStmts [stmt]