Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/b597182dc291935c26e5c34f1100ced344ca7fe1 >--------------------------------------------------------------- commit b597182dc291935c26e5c34f1100ced344ca7fe1 Author: Simon Peyton Jones <simo...@microsoft.com> Date: Fri Oct 19 01:04:47 2012 +0100 Fix a long-standing bug in tidying This showed up when looking at some type error messages. We were tidying some open types in a way that mapped two distinct variables to the same thing. Urk! >--------------------------------------------------------------- compiler/basicTypes/OccName.lhs | 55 ++++++++++++++++++++++++++++---------- compiler/typecheck/TcType.lhs | 34 +++++------------------ 2 files changed, 48 insertions(+), 41 deletions(-) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 74fbeb7..ae5ba96 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -758,29 +758,54 @@ There's a wrinkle for operators. Consider '>>='. We can't use '>>=1' because that isn't a single lexeme. So we encode it to 'lle' and *then* tack on the '1', if necessary. +Note [TidyOccEnv] +~~~~~~~~~~~~~~~~~ +type TidyOccEnv = UniqFM Int + +* Domain = The OccName's FastString. These FastStrings are "taken"; + make sure that we don't re-use + +* Int, n = A plausible starting point for new guesses + There is no guarantee that "FSn" is available; + you must look that up in the TidyOccEnv. But + it's a good place to start looking. + +* When looking for a renaming for "foo2" we strip off the "2" and start + with "foo". Otherwise if we tidy twice we get silly names like foo23. + \begin{code} -type TidyOccEnv = OccEnv Int -- The in-scope OccNames - -- Range gives a plausible starting point for new guesses +type TidyOccEnv = UniqFM Int -- The in-scope OccNames + -- See Note [TidyOccEnv] emptyTidyOccEnv :: TidyOccEnv -emptyTidyOccEnv = emptyOccEnv +emptyTidyOccEnv = emptyUFM initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid! -initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv +initTidyOccEnv = foldl add emptyUFM + where + add env (OccName _ fs) = addToUFM env fs 1 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName) - -tidyOccName in_scope occ@(OccName occ_sp fs) - = case lookupOccEnv in_scope occ of - Nothing -> -- Not already used: make it used - (extendOccEnv in_scope occ 1, occ) - - Just n -> -- Already used: make a new guess, - -- change the guess base, and try again - tidyOccName (extendOccEnv in_scope occ (n+1)) - (mkOccName occ_sp (base_occ ++ show n)) +tidyOccName env occ@(OccName occ_sp fs) + = case lookupUFM env fs of + Just n -> find n + Nothing -> (addToUFM env fs 1, occ) where - base_occ = reverse (dropWhile isDigit (reverse (unpackFS fs))) + base :: String -- Drop trailing digits (see Note [TidyOccEnv]) + base = reverse (dropWhile isDigit (reverse (unpackFS fs))) + + find n + = case lookupUFM env new_fs of + Just n' -> find (n1 `max` n') + -- The max ensures that n increases, avoiding loops + Nothing -> (addToUFM (addToUFM env fs n1) new_fs n1, + OccName occ_sp new_fs) + -- We update only the beginning and end of the + -- chain that find explores; it's a little harder to + -- update the middle and there's no real need. + where + n1 = n+1 + new_fs = mkFastString (base ++ show n) \end{code} %************************************************************************ diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index aedf11d..aa69d75 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -554,31 +554,9 @@ tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv -- ^ Add the free 'TyVar's to the env in tidy form, -- so that we can tidy the type they are free in tidyFreeTyVars (full_occ_env, var_env) tyvars - = fst (tidyOpenTyVars (full_occ_env, var_env) tv_list) + = fst (tidyOpenTyVars (full_occ_env, var_env) (varSetElems tyvars)) - where - tv_list = varSetElems tyvars - -{- - -- The idea here was that we restrict the new TidyEnv to the - -- _free_ vars of the type, so that we don't gratuitously rename - -- the _bound_ variables of the type. - -- - -- But the idea goes badly wrong if we tidy more than - -- one open type, e.g. a_99 and (a_77 -> a_99). Then - -- we tidy the former to a0, and the latter to a0 -> a0! - trimmed_occ_env = foldr mk_occ_env emptyOccEnv tv_list - - mk_occ_env :: TyVar -> TidyOccEnv -> TidyOccEnv - mk_occ_env tv env - = case lookupOccEnv full_occ_env occ of - Just n -> extendOccEnv env occ n - Nothing -> env - where - occ = getOccName tv --} - ---------------- + --------------- tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar]) tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars @@ -620,9 +598,13 @@ tidyType env (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty) -- and then uses 'tidyType' to work over the type itself tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type) tidyOpenType env ty - = (env', tidyType env' ty) + = (env', tidyType (trimmed_occ_env, var_env) ty) where - env' = tidyFreeTyVars env (tyVarsOfType ty) + (env'@(_, var_env), tvs') = tidyOpenTyVars env (varSetElems (tyVarsOfType ty)) + trimmed_occ_env = initTidyOccEnv (map getOccName tvs') + -- The idea here was that we restrict the new TidyEnv to the + -- _free_ vars of the type, so that we don't gratuitously rename + -- the _bound_ variables of the type. --------------- tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type]) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
