I doubt it matters. I was just curious. But it might do no harm to have it there, commented out, because it's an example of how do to the "modify" operation on TrieMaps S | -----Original Message----- | From: Richard Eisenberg [mailto:eir@cis.upenn.edu] | Sent: 12 February 2013 15:08 | To: Simon Peyton-Jones | Cc: ghc-devs@haskell.org | Subject: Re: [commit: ghc] master: Fix Trac #7681. (7b098b6) | | 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 | 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-bounces@haskell.org [mailto:ghc-commits- | > | bounces@haskell.org] On Behalf Of Richard Eisenberg | > | Sent: 12 February 2013 04:10 | > | To: ghc-commits@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/7b098b6009727a012cb1f3 | > | ff0c | > | a51698d302cae1 | > | | > | >--------------------------------------------------------------- | > | | > | commit 7b098b6009727a012cb1f3ff0ca51698d302cae1 | > | Author: Richard Eisenberg | > | 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-commits@haskell.org | > | http://www.haskell.org/mailman/listinfo/ghc-commits | >