Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/cae91683a9d58abfacbf23553c686915ccbf9d49 >--------------------------------------------------------------- commit cae91683a9d58abfacbf23553c686915ccbf9d49 Author: Dimitrios Vytiniotis <[email protected]> Date: Sat Nov 26 18:12:21 2011 +0000 Implemented -dsuppress-var-kinds flag to remove silly kinds when dppr-debug is on. Adding commentary, and fixing a knot-tie related bug. Commentary only. >--------------------------------------------------------------- compiler/basicTypes/Var.lhs | 5 +++- compiler/main/StaticFlagParser.hs | 1 + compiler/main/StaticFlags.hs | 6 +++++ compiler/typecheck/TcHsSyn.lhs | 40 ++++++++++++++++++++++++++++++------ compiler/typecheck/TcRnTypes.lhs | 2 +- 5 files changed, 45 insertions(+), 9 deletions(-) diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index 1692520..8e31fef 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -85,6 +85,8 @@ import FastTypes import FastString import Outputable +import StaticFlags ( opt_SuppressVarKinds ) + import Data.Data \end{code} @@ -211,7 +213,8 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds \begin{code} instance Outputable Var where ppr var = ifPprDebug (text "(") <+> ppr (varName var) <+> ifPprDebug (brackets (ppr_debug var)) - <+> ifPprDebug (text "::" <+> ppr (tyVarKind var) <+> text ")") + <+> if (not opt_SuppressVarKinds) then ifPprDebug (text "::" <+> ppr (tyVarKind var) <+> text ")") + else empty ppr_debug :: Var -> SDoc ppr_debug (TyVar {}) = ptext (sLit "tv") diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs index 1db5ef6..07eb214 100644 --- a/compiler/main/StaticFlagParser.hs +++ b/compiler/main/StaticFlagParser.hs @@ -132,6 +132,7 @@ static_flags = [ , Flag "dsuppress-module-prefixes" (PassFlag addOpt) , Flag "dsuppress-type-applications" (PassFlag addOpt) , Flag "dsuppress-idinfo" (PassFlag addOpt) + , Flag "dsuppress-var-kinds" (PassFlag addOpt) , Flag "dsuppress-type-signatures" (PassFlag addOpt) , Flag "dopt-fuel" (AnySuffix addOpt) , Flag "dtrace-level" (AnySuffix addOpt) diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index e89d9b3..c2f8674 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -41,6 +41,7 @@ module StaticFlags ( opt_SuppressTypeApplications, opt_SuppressIdInfo, opt_SuppressTypeSignatures, + opt_SuppressVarKinds, -- profiling opts opt_SccProfilingOn, @@ -223,6 +224,11 @@ opt_SuppressCoercions = lookUp (fsLit "-dsuppress-all") || lookUp (fsLit "-dsuppress-coercions") +opt_SuppressVarKinds :: Bool +opt_SuppressVarKinds + = lookUp (fsLit "-dsuppress-all") + || lookUp (fsLit "-dsuppress-var-kinds") + -- | Suppress module id prefixes on variables. opt_SuppressModulePrefixes :: Bool opt_SuppressModulePrefixes diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index 12bb282..72f64dd 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -1117,9 +1117,9 @@ zonkEvBinds env binds add (EvBind var _) vars = var : vars zonkEvBind :: ZonkEnv -> EvBind -> TcM EvBind - - zonkEvBind env (EvBind var term) + -- This function has some special cases for avoiding re-zonking the + -- same types many types. See Note [Optimized Evidence Binding Zonking] = case term of -- Fast path for reflexivity coercions: EvCoercionBox co @@ -1131,17 +1131,16 @@ zonkEvBind env (EvBind var term) -- Fast path for variable-variable bindings -- NB: could be optimized further! (e.g. SymCo cv) - | Just {} <- getCoVar_maybe co - -> do { term'@(EvCoercionBox (CoVarCo cv')) <- zonkEvTerm env term - ; let var' = setVarType var (varType cv') + | Just cv <- getCoVar_maybe co + -> do { let cv' = zonkIdOcc env cv -- Just lazily look up + term' = EvCoercionBox (CoVarCo cv') + var' = setVarType var (varType cv') ; return (EvBind var' term') } - -- Ugly safe and slow path _ -> do { var' <- {-# SCC "zonkEvBndr" #-} zonkEvBndr env var ; term' <- zonkEvTerm env term ; return (EvBind var' term') } - \end{code} %************************************************************************ @@ -1196,6 +1195,33 @@ The type of Phantom is (forall (k : BOX). forall (a : k). Int). Both `a` and we have a type or a kind variable; for kind variables we just return AnyK (and not the ill-kinded Any BOX). +Note [Optimized Evidence Binding Zonking] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +When optimising evidence binds we may come accross situations where +a coercion is just reflexivity: + cv = ReflCo ty +In such a case it is a waste of time to zonk both ty and the type +of the coercion, especially if the types involved are huge. For this +reason this case is optimized to only zonk 'ty' and set the type of +the variable to be that zonked type. + +Another case that hurts a lot are simple coercion bindings of the form: + cv1 = cv2 + cv3 = cv1 + cv4 = cv2 +etc. In all such cases it is very easy to just get the zonked type of +cv2 and use it to set the type of the LHS coercion variable without zonking +twice. Though this case is funny, it can happen due the way that evidence +from spontaneously solved goals is now used. +See Note [Optimizing Spontaneously Solved Goals] about this. + +NB: That these optimizations are independently useful, regardless of the +constraint solver strategy. + +DV, TODO: followup on this note mentioning new examples I will add to perf/ + + \begin{code} mkZonkTcTyVar :: (TcTyVar -> TcM Type) -- What to do for an *mutable Flexi* var -> (TcTyVar -> Type) -- What to do for an immutable var diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index a7074e6..12f3184 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -1214,7 +1214,7 @@ data GivenKind -- Is given as result of being solved, maybe provisionally on -- some other wanted constraints. We cache the evidence term -- sometimes here as well /as well as/ in the EvBinds, - -- see note [Optimizing Spontaneously Solved Coercions] + -- see Note [Optimizing Spontaneously Solved Coercions] instance Outputable CtFlavor where ppr (Given _ GivenOrig) = ptext (sLit "[G]") _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
