I was working in a ghc tree that I thought was clean (i.e. was a checkout of HEAD), but evidently was not.
In my other work, I needed to update lookupType_mod, but wasn't sure how to. So, I looked for use sites. When I found none, I must have gone into this ghc tree, removed the exports, and checked to make sure everything compiled. There were no problems, and I guess I forgot to undo my test change. When fixing #7681, the exports were still missing, causing the warning and validate failure. I'm happy to bring lookupType_mod back if it is expected to be needed somewhere. Richard On Feb 12, 2013, at 3:08 AM, Simon Peyton-Jones <simo...@microsoft.com> wrote: > Thanks for fixing. > > You removed lookupType_mod from TrieMap. It was defined and exported but not > called. How did validate spot that? I'm sure there are quite a few such > functions in GHC. > > Simon > > | -----Original Message----- > | From: ghc-commits-boun...@haskell.org [mailto:ghc-commits- > | boun...@haskell.org] On Behalf Of Richard Eisenberg > | Sent: 12 February 2013 04:10 > | To: ghc-comm...@haskell.org > | Subject: [commit: ghc] master: Fix Trac #7681. (7b098b6) > | > | Repository : ssh://darcs.haskell.org//srv/darcs/ghc > | > | On branch : master > | > | http://hackage.haskell.org/trac/ghc/changeset/7b098b6009727a012cb1f3ff0c > | a51698d302cae1 > | > | >--------------------------------------------------------------- > | > | commit 7b098b6009727a012cb1f3ff0ca51698d302cae1 > | Author: Richard Eisenberg <e...@cis.upenn.edu> > | Date: Mon Feb 11 23:07:25 2013 -0500 > | > | Fix Trac #7681. > | > | Removed checks for empty lists for case expressions and lambda-case. > | If -XEmptyCase is not enabled, compilation still fails > | (appropriately) > | in the renamer. > | > | Had to remove dead code from TrieMap to pass the validator. > | > | >--------------------------------------------------------------- > | > | compiler/coreSyn/TrieMap.lhs | 38 +---------------------------------- > | --- > | compiler/deSugar/DsMeta.hs | 6 ++++-- > | compiler/hsSyn/Convert.lhs | 8 ++------ > | libraries/random | 2 +- > | 4 files changed, 8 insertions(+), 46 deletions(-) > | > | diff --git a/compiler/coreSyn/TrieMap.lhs b/compiler/coreSyn/TrieMap.lhs > | index 148464b..c013b5d 100644 > | --- a/compiler/coreSyn/TrieMap.lhs > | +++ b/compiler/coreSyn/TrieMap.lhs > | @@ -14,7 +14,7 @@ > | {-# LANGUAGE TypeFamilies #-} > | module TrieMap( > | CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap, > | - TypeMap, foldTypeMap, lookupTypeMap_mod, > | + TypeMap, foldTypeMap, -- lookupTypeMap_mod, > | CoercionMap, > | MaybeMap, > | ListMap, > | @@ -32,8 +32,6 @@ import UniqFM > | import Unique( Unique ) > | import FastString(FastString) > | > | -import Unify ( niFixTvSubst ) > | - > | import qualified Data.Map as Map > | import qualified Data.IntMap as IntMap > | import VarEnv > | @@ -632,40 +630,6 @@ lkT env ty m > | go (ForAllTy tv ty) = tm_forall >.> lkT (extendCME env tv) ty >=> > | lkBndr env tv > | > | > | -lkT_mod :: CmEnv > | - -> TyVarEnv Type -- TvSubstEnv > | - -> Type > | - -> TypeMap b -> Maybe b > | -lkT_mod env s ty m > | - | EmptyTM <- m = Nothing > | - | Just ty' <- coreView ty > | - = lkT_mod env s ty' m > | - | [] <- candidates > | - = go env s ty m > | - | otherwise > | - = Just $ snd (head candidates) -- Yikes! > | - where > | - -- Hopefully intersects is much smaller than traversing the whole > | vm_fvar > | - intersects = eltsUFM $ > | - intersectUFM_C (,) s (vm_fvar $ tm_var m) > | - candidates = [ (u,ct) | (u,ct) <- intersects > | - , Type.substTy (niFixTvSubst s) u `eqType` ty > | ] > | - > | - go env _s (TyVarTy v) = tm_var >.> lkVar env v > | - go env s (AppTy t1 t2) = tm_app >.> lkT_mod env s t1 >=> > | lkT_mod env s t2 > | - go env s (FunTy t1 t2) = tm_fun >.> lkT_mod env s t1 >=> > | lkT_mod env s t2 > | - go env s (TyConApp tc tys) = tm_tc_app >.> lkNamed tc >=> lkList > | (lkT_mod env s) tys > | - go _env _s (LitTy l) = tm_tylit >.> lkTyLit l > | - go _env _s (ForAllTy _tv _ty) = const Nothing > | - > | - {- DV TODO: Add proper lookup for ForAll -} > | - > | -lookupTypeMap_mod :: TyVarEnv a -- A substitution to be applied to the > | /keys/ of type map > | - -> (a -> Type) > | - -> Type > | - -> TypeMap b -> Maybe b > | -lookupTypeMap_mod s f = lkT_mod emptyCME (mapVarEnv f s) > | - > | ----------------- > | xtT :: CmEnv -> Type -> XT a -> TypeMap a -> TypeMap a xtT env ty f m > | diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs > | index 9a9f89d..4f5ba2d 100644 > | --- a/compiler/deSugar/DsMeta.hs > | +++ b/compiler/deSugar/DsMeta.hs > | @@ -920,7 +920,8 @@ repE (HsLit l) = do { a <- repLiteral l; > | repLit a } > | repE (HsLam (MG { mg_alts = [m] })) = repLambda m repE (HsLamCase _ > | (MG { mg_alts = ms })) > | = do { ms' <- mapM repMatchTup ms > | - ; repLamCase (nonEmptyCoreList ms') } > | + ; core_ms <- coreList matchQTyConName ms' > | + ; repLamCase core_ms } > | repE (HsApp x y) = do {a <- repLE x; b <- repLE y; repApp a b} > | > | repE (OpApp e1 op _ e2) = > | @@ -938,7 +939,8 @@ repE (SectionR x y) = do { a <- repLE x; b <- > | repLE y; repSectionR a b } > | repE (HsCase e (MG { mg_alts = ms })) > | = do { arg <- repLE e > | ; ms2 <- mapM repMatchTup ms > | - ; repCaseE arg (nonEmptyCoreList ms2) } > | + ; core_ms2 <- coreList matchQTyConName > | ms2 > | + ; repCaseE arg core_ms2 } > | repE (HsIf _ x y z) = do > | a <- repLE x > | b <- repLE y > | diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs > | index a21caf4..ce15071 100644 > | --- a/compiler/hsSyn/Convert.lhs > | +++ b/compiler/hsSyn/Convert.lhs > | @@ -524,9 +524,7 @@ cvtl e = wrapL (cvt e) > | cvt (AppE x y) = do { x' <- cvtl x; y' <- cvtl y; return $ > | HsApp x' y' } > | cvt (LamE ps e) = do { ps' <- cvtPats ps; e' <- cvtl e > | ; return $ HsLam (mkMatchGroup > | [mkSimpleMatch ps' e']) } > | - cvt (LamCaseE ms) > | - | null ms = failWith (ptext (sLit "Lambda-case expression > | with no alternatives")) > | - | otherwise = do { ms' <- mapM cvtMatch ms > | + cvt (LamCaseE ms) = do { ms' <- mapM cvtMatch ms > | ; return $ HsLamCase placeHolderType > | (mkMatchGroup ms') > | } > | @@ -543,9 +541,7 @@ cvtl e = wrapL (cvt e) > | ; return $ HsMultiIf placeHolderType alts' > | } > | cvt (LetE ds e) = do { ds' <- cvtLocalDecs (ptext (sLit "a let > | expression")) ds > | ; e' <- cvtl e; return $ HsLet ds' e' } > | - cvt (CaseE e ms) > | - | null ms = failWith (ptext (sLit "Case expression with no > | alternatives")) > | - | otherwise = do { e' <- cvtl e; ms' <- mapM cvtMatch ms > | + cvt (CaseE e ms) = do { e' <- cvtl e; ms' <- mapM cvtMatch ms > | ; return $ HsCase e' (mkMatchGroup ms') } > | cvt (DoE ss) = cvtHsDo DoExpr ss > | cvt (CompE ss) = cvtHsDo ListComp ss > | diff --git a/libraries/random b/libraries/random index 0531d37..69bfde2 > | 160000 > | --- a/libraries/random > | +++ b/libraries/random > | @@ -1 +1 @@ > | -Subproject commit 0531d37602d6e7c0b2b5adbf2d5fdd2d01830216 > | +Subproject commit 69bfde219bab869729fdbe9c1496371f912bf41e > | > | > | > | _______________________________________________ > | ghc-commits mailing list > | ghc-comm...@haskell.org > | http://www.haskell.org/mailman/listinfo/ghc-commits > _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://www.haskell.org/mailman/listinfo/ghc-devs