[commit: ghc] master: Fix Trac #7681. (7b098b6)
Simon Peyton-Jones
simonpj at microsoft.com
Tue Feb 12 16:18:56 CET 2013
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 at cis.upenn.edu]
| Sent: 12 February 2013 15:08
| To: Simon Peyton-Jones
| Cc: ghc-devs at 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 <simonpj at 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-bounces at haskell.org [mailto:ghc-commits-
| > | bounces at haskell.org] On Behalf Of Richard Eisenberg
| > | Sent: 12 February 2013 04:10
| > | To: ghc-commits at 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 <eir at 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-commits at haskell.org
| > | http://www.haskell.org/mailman/listinfo/ghc-commits
| >
More information about the ghc-devs
mailing list