Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-holes-branch
http://hackage.haskell.org/trac/ghc/changeset/7980ff9b243d548268aa9087b297e733c97ec180 >--------------------------------------------------------------- commit 7980ff9b243d548268aa9087b297e733c97ec180 Author: Thijs Alkemade <[email protected]> Date: Wed Aug 15 14:24:28 2012 +0200 Cleanup everything that ./validate whined about. >--------------------------------------------------------------- compiler/typecheck/TcCanonical.lhs | 15 --------------- compiler/typecheck/TcErrors.lhs | 7 +++---- compiler/typecheck/TcRnDriver.lhs | 4 ++-- compiler/typecheck/TcRnTypes.lhs | 2 -- compiler/typecheck/TcSimplify.lhs | 10 ++++------ 5 files changed, 9 insertions(+), 29 deletions(-) diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs index 916a125..38c7c49 100644 --- a/compiler/typecheck/TcCanonical.lhs +++ b/compiler/typecheck/TcCanonical.lhs @@ -238,21 +238,6 @@ canTuple d fl tys add_to_work fl = addToWork $ canEvVar d fl (classifyPredType (ctEvPred fl)) \end{code} - -\begin{code} -canHole :: SubGoalDepth -- Depth - -> CtEvidence - -> Type -> TcS StopOrContinue -canHole d fl ty - = do { (xi,co) <- flatten d FMFullFlatten fl ty - ; mb <- rewriteCtFlavor fl xi co - ; case mb of - Just new_fl -> continueWith $ CHoleCan { cc_ev = new_fl - , cc_hole_ty = xi - , cc_depth = d } - Nothing -> return Stop } -\end{code} - %************************************************************************ %* * %* Class Canonicalization diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index 8340e49..8b44dce 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -1,5 +1,5 @@ \begin{code} -{-# LANGUAGE ScopedTypeVariables, Holes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and @@ -45,7 +45,6 @@ import Outputable import DynFlags import Data.List ( partition, mapAccumL ) import UniqFM -import BasicTypes \end{code} %************************************************************************ @@ -63,8 +62,8 @@ now? -- trigger; this is handy for -fwarn--type-errors type ErrEnv = VarEnv [ErrMsg] -reportUnsolved :: Bool -> WantedConstraints -> TcM (Bag EvBind) -reportUnsolved runtimeCoercionErrors wanted +reportUnsolved :: WantedConstraints -> TcM (Bag EvBind) +reportUnsolved wanted | isEmptyWC wanted = return emptyBag | otherwise diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 712e6fb..ab8ee9b 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -42,7 +42,7 @@ import FamInstEnv import TcAnnotations import TcBinds import HeaderInfo ( mkPrelImports ) -import TcType ( tidyTopType ) +import TcType ( tidyTopType ) import TcDefaults import TcEnv import TcRules @@ -1377,8 +1377,8 @@ tcUserStmt (L loc (ExprStmt expr _ _ _)) do { _ <- checkNoErrs (tcGhciStmts [let_stmt]) --- checkNoErrs defeats the error recovery of let-bindings ; tcGhciStmts [let_stmt, print_it] } ] - ; fix_env <- getFixityEnv + ; traceRn (text "tcRnStmt" <+> ppr (plan, fix_env)) ; return (plan, fix_env) } tcUserStmt rdr_stmt@(L loc _) diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 0c0e706..72b0fc3 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -123,8 +123,6 @@ import FastString import Util import Data.Set (Set) - -import UniqSet \end{code} diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 75a3cae..41139a0 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -95,8 +95,7 @@ simplifyTop wanteds = do { eb1 <- TcRnMonad.getTcEvBinds ev_binds_var ; traceTc "reportUnsolved {" empty -- See Note [Deferring coercion errors to runtime] - ; runtimeCoercionErrors <- doptM Opt_DeferTypeErrors - ; eb2 <- reportUnsolved runtimeCoercionErrors wc_residual + ; eb2 <- reportUnsolved wc_residual ; traceTc "reportUnsolved }" empty ; return (eb1 `unionBags` eb2) } \end{code} @@ -213,7 +212,7 @@ simplifyDeriv orig pred tvs theta -- We never want to defer these errors because they are errors in the -- compiler! Hence the `False` below - ; _ev_binds2 <- reportUnsolved False (residual_wanted { wc_flat = bad }) + ; _ev_binds2 <- reportUnsolved (residual_wanted { wc_flat = bad }) ; let min_theta = mkMinimalBySCs (bagToList good) ; return (substTheta subst_skol min_theta) } @@ -372,7 +371,7 @@ simplifyInfer _top_lvl apply_mr name_taus (untch,wanteds) -- Step 3) Fail fast if there is an insoluble constraint, -- unless we are deferring errors to runtime ; when (not runtimeCoercionErrors && insolubleWC wanted_transformed) $ - do { _ev_binds <- reportUnsolved False wanted_transformed; failM } + do { _ev_binds <- reportUnsolved wanted_transformed; failM } -- Step 4) Candidates for quantification are an approximation of wanted_transformed ; let quant_candidates = approximateWC wanted_transformed @@ -707,8 +706,7 @@ simplifyCheck wanteds ; traceTc "reportUnsolved {" empty -- See Note [Deferring coercion errors to runtime] - ; runtimeCoercionErrors <- doptM Opt_DeferTypeErrors - ; eb2 <- reportUnsolved runtimeCoercionErrors unsolved + ; eb2 <- reportUnsolved unsolved ; traceTc "reportUnsolved }" empty ; return (eb1 `unionBags` eb2) } _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
