[commit: ghc] master: TcDeriv: Use a NameEnv instead of association list (5a8b055)
git at git.haskell.org
git at git.haskell.org
Mon Sep 21 21:51:03 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/5a8b055ece4ae63eef1fc794f352b7be66e4a0cd/ghc
>---------------------------------------------------------------
commit 5a8b055ece4ae63eef1fc794f352b7be66e4a0cd
Author: Ben Gamari <bgamari.foss at gmail.com>
Date: Mon Sep 21 16:52:23 2015 -0500
TcDeriv: Use a NameEnv instead of association list
It's unlikely that these lists would have become very large but
nevertheless this is an easy and worthwhile change.
Reviewed By: austin
Differential Revision: https://phabricator.haskell.org/D1265
>---------------------------------------------------------------
5a8b055ece4ae63eef1fc794f352b7be66e4a0cd
compiler/typecheck/TcDeriv.hs | 13 ++++++++-----
1 file changed, 8 insertions(+), 5 deletions(-)
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index a8a83f5..d76302f 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -47,6 +47,7 @@ import DataCon
import Maybes
import RdrName
import Name
+import NameEnv
import NameSet
import TyCon
import TcType
@@ -441,18 +442,19 @@ pprRepTy fi@(FamInst { fi_tys = lhs })
-- As of 24 April 2012, this only shares MetaTyCons between derivations of
-- Generic and Generic1; thus the types and logic are quite simple.
type CommonAuxiliary = MetaTyCons
-type CommonAuxiliaries = [(TyCon, CommonAuxiliary)] -- NSF what is a more efficient map type?
+type CommonAuxiliaries = NameEnv CommonAuxiliary
commonAuxiliaries :: [DerivSpec ()] -> TcM (CommonAuxiliaries, BagDerivStuff)
-commonAuxiliaries = foldM snoc ([], emptyBag) where
+commonAuxiliaries = foldM snoc (emptyNameEnv, emptyBag) where
snoc acc@(cas, stuff) (DS {ds_name = nm, ds_cls = cls, ds_tc = rep_tycon})
| getUnique cls `elem` [genClassKey, gen1ClassKey] =
extendComAux $ genGenericMetaTyCons rep_tycon (nameModule nm)
| otherwise = return acc
where extendComAux m -- don't run m if its already in the accumulator
- | any ((rep_tycon ==) . fst) cas = return acc
+ | elemNameEnv (tyConName rep_tycon) cas = return acc
| otherwise = do (ca, new_stuff) <- m
- return $ ((rep_tycon, ca) : cas, stuff `unionBags` new_stuff)
+ return ( extendNameEnv cas (tyConName rep_tycon) ca
+ , stuff `unionBags` new_stuff)
renameDeriv :: Bool
-> [InstInfo RdrName]
@@ -1982,7 +1984,8 @@ genInst comauxs
| otherwise
= do { (meth_binds, deriv_stuff) <- genDerivStuff loc clas
dfun_name rep_tycon
- (lookup rep_tycon comauxs)
+ (lookupNameEnv comauxs
+ (tyConName rep_tycon))
; inst_spec <- newDerivClsInst theta spec
; traceTc "newder" (ppr inst_spec)
; let inst_info = InstInfo { iSpec = inst_spec
More information about the ghc-commits
mailing list