X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcUnify.lhs;h=d7399f5cd3a50a2a92f73f83f06efca882f3f03a;hb=30c122df62ec75f9ed7f392f24c2925675bf1d06;hp=86928b7099341d7e2d3978db4a9a25edf9bebc6a;hpb=351d6c8923f7f21afe974d2c90f89bf5ed9d4eed;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 86928b7..d7399f5 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -60,6 +60,7 @@ import BasicTypes import Util import Outputable import Unique +import FastString import Control.Monad \end{code} @@ -904,12 +905,13 @@ tcGen expected_ty extra_tvs thing_inside -- We expect expected_ty to be a forall ; let skol_info = GenSkol forall_tvs (mkPhiTy theta rho_ty) ; return ((forall_tvs, theta, rho_ty), skol_info) }) -#ifdef DEBUG - ; traceTc (text "tcGen" <+> vcat [text "extra_tvs" <+> ppr extra_tvs, - text "expected_ty" <+> ppr expected_ty, - text "inst ty" <+> ppr tvs' <+> ppr theta' <+> ppr rho', - text "free_tvs" <+> ppr free_tvs]) -#endif + ; when debugIsOn $ + traceTc (text "tcGen" <+> vcat [ + text "extra_tvs" <+> ppr extra_tvs, + text "expected_ty" <+> ppr expected_ty, + text "inst ty" <+> ppr tvs' <+> ppr theta' + <+> ppr rho', + text "free_tvs" <+> ppr free_tvs]) -- Type-check the arg and unify with poly type ; (result, lie) <- getLIE (thing_inside tvs' rho') @@ -1487,17 +1489,17 @@ uMetaVar outer swapped tv1 BoxTv ref1 ps_ty2 non_var_ty2 -- -- It should not be the case that tv1 occurs in ty2 -- (i.e. no occurs check should be needed), but if perchance - -- it does, the unbox operation will fill it, and the DEBUG + -- it does, the unbox operation will fill it, and the debug code -- checks for that. - do { final_ty <- unBox ps_ty2 -#ifdef DEBUG - ; meta_details <- readMutVar ref1 - ; case meta_details of - Indirect ty -> WARN( True, ppr tv1 <+> ppr ty ) - return () -- This really should *not* happen - Flexi -> return () -#endif - ; checkUpdateMeta swapped tv1 ref1 final_ty + do { final_ty <- unBox ps_ty2 + ; when debugIsOn $ do + { meta_details <- readMutVar ref1 + ; case meta_details of + Indirect ty -> WARN( True, ppr tv1 <+> ppr ty ) + return () -- This really should *not* happen + Flexi -> return () + } + ; checkUpdateMeta swapped tv1 ref1 final_ty ; return IdCo } @@ -1637,7 +1639,6 @@ unBox :: BoxyType -> TcM TcType -- -- For once, it's safe to treat synonyms as opaque! -unBox (NoteTy n ty) = do { ty' <- unBox ty; return (NoteTy n ty') } unBox (TyConApp tc tys) = do { tys' <- mapM unBox tys; return (TyConApp tc tys') } unBox (AppTy f a) = do { f' <- unBox f; a' <- unBox a; return (mkAppTy f' a') } unBox (FunTy f a) = do { f' <- unBox f; a' <- unBox a; return (FunTy f' a') }