[commit: ghc] master: IfaceEnv: Only check for built-in OccNames if mod is GHC.Types (ffe4660)
git at git.haskell.org
git at git.haskell.org
Sat Jul 16 21:40:33 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/ffe4660510a7ba4adce846f316db455ccd91142a/ghc
>---------------------------------------------------------------
commit ffe4660510a7ba4adce846f316db455ccd91142a
Author: Ben Gamari <bgamari.foss at gmail.com>
Date: Sat Jul 16 23:38:51 2016 +0200
IfaceEnv: Only check for built-in OccNames if mod is GHC.Types
This check is not entirely cheap and will not succeed unless we are
looking for something in the module where built-in syntax lives,
GHC.Types.
Reviewers: simonpj, austin
Subscribers: simonpj, thomie, osa1
Differential Revision: https://phabricator.haskell.org/D2400
>---------------------------------------------------------------
ffe4660510a7ba4adce846f316db455ccd91142a
compiler/iface/IfaceEnv.hs | 28 +++++++++++-----
compiler/prelude/TysWiredIn.hs | 67 ++++++++++++++++++++++++-------------
testsuite/tests/perf/compiler/all.T | 4 ++-
3 files changed, 66 insertions(+), 33 deletions(-)
diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs
index 0c8d8e9..ff2f648 100644
--- a/compiler/iface/IfaceEnv.hs
+++ b/compiler/iface/IfaceEnv.hs
@@ -33,6 +33,7 @@ import Module
import FastString
import FastStringEnv
import IfaceType
+import PrelNames ( gHC_TYPES, gHC_PRIM, gHC_TUPLE )
import UniqSupply
import SrcLoc
import Util
@@ -184,26 +185,37 @@ See Note [The Name Cache] above.
Note [Built-in syntax and the OrigNameCache]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-You might think that usin isBuiltInOcc_maybe in lookupOrigNameCache is
-unnecessary because tuple TyCon/DataCons are parsed as Exact RdrNames
-and *don't* appear as original names in interface files (because
-serialization gives them special treatment), so we will never look
-them up in the original name cache.
-However, there are two reasons why we might look up an Orig RdrName:
+Built-in syntax like tuples and unboxed sums are quite ubiquitous. To lower
+their cost we use two tricks,
+
+ b. We specially encode tuple Names in interface files' symbols tables to avoid
+ having to look up their names at all while loading interface files. See
+ Note [Symbol table representation of names] in BinIface for details.
+
+ a. We don't include them in the Orig name cache but instead parse their
+ OccNames (in isBuiltInOcc_maybe) to avoid bloating the name cache with
+ them.
+
+Why is the second measure necessary? Good question; afterall, 1) the parser
+emits built-in syntax directly as Exact RdrNames, and 2) built-in syntax never
+needs to looked-up during interface loading due to (a). It turns out that there
+are two reasons why we might look up an Orig RdrName for built-in syntax,
* If you use setRdrNameSpace on an Exact RdrName it may be
turned into an Orig RdrName.
* Template Haskell turns a BuiltInSyntax Name into a TH.NameG
(DsMeta.globalVar), and parses a NameG into an Orig RdrName
- (Convert.thRdrName). So, eg $(do { reify '(,); ... }) will
+ (Convert.thRdrName). So, e.g. $(do { reify '(,); ... }) will
go this route (Trac #8954).
+
-}
lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache nc mod occ
- | Just name <- isBuiltInOcc_maybe occ
+ | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE
+ , Just name <- isBuiltInOcc_maybe occ
= -- See Note [Known-key names], 3(c) in PrelNames
-- Special case for tuples; there are too many
-- of them to pre-populate the original-name cache
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 8465cd9..86f1dde 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -5,6 +5,7 @@
-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
-- | This module is about types that can be defined in Haskell, but which
-- must be wired into the compiler nonetheless. C.f module TysPrim
@@ -134,7 +135,6 @@ import {-# SOURCE #-} ConLike
import TyCon
import Class ( Class, mkClass )
import RdrName
-import UniqFM
import Name
import NameSet ( NameSet, mkNameSet, elemNameSet )
import BasicTypes ( Arity, Boxity(..),
@@ -148,6 +148,12 @@ import Outputable
import Util
import BooleanFormula ( mkAnd )
+import qualified Data.ByteString.Char8 as BS
+#if !MIN_VERSION_bytestring(0,10,8)
+import qualified Data.ByteString.Internal as BSI
+import qualified Data.ByteString.Unsafe as BSU
+#endif
+
alpha_tyvar :: [TyVar]
alpha_tyvar = [alphaTyVar]
@@ -181,8 +187,7 @@ names in PrelNames, so they use wTcQual, wDataQual, etc
-- define here.
--
-- Because of their infinite nature, this list excludes tuples, Any and implicit
--- parameter TyCons. Instead, we have a hack in lookupOrigNameCache to deal with
--- these names.
+-- parameter TyCons (see Note [Built-in syntax and the OrigNameCache]).
--
-- See also Note [Known-key names]
wiredInTyCons :: [TyCon]
@@ -636,19 +641,42 @@ decl in GHC.Classes, so I think this part may not work properly. But
it's unused I think.
-}
-builtInOccNames :: UniqFM (OccName -> Name)
-builtInOccNames = listToUFM $
- [ (fsLit "[]", choose_ns listTyConName nilDataConName)
- , (fsLit ":" , const consDataConName)
- , (fsLit "[::]", const parrTyConName)
- , (fsLit "()", tup_name Boxed 0)
- , (fsLit "(##)", tup_name Unboxed 0)
- ] ++
- [ (fsLit $ "("++replicate n ','++")", tup_name Boxed (n+1)) | n <- [1..62] ] ++
- [ (fsLit $ "(#"++replicate n ','++"#)", tup_name Unboxed (n+1)) | n <- [1..62] ]
+-- | Built in syntax isn't "in scope" so these OccNames map to wired-in Names
+-- with BuiltInSyntax. However, this should only be necessary while resolving
+-- names produced by Template Haskell splices since we take care to encode
+-- built-in syntax names specially in interface files. See
+-- Note [Symbol table representation of names].
+isBuiltInOcc_maybe :: OccName -> Maybe Name
+isBuiltInOcc_maybe occ =
+ case name of
+ "[]" -> Just $ choose_ns listTyConName nilDataConName
+ ":" -> Just consDataConName
+ "[::]" -> Just parrTyConName
+ "()" -> Just $ tup_name Boxed 0
+ "(##)" -> Just $ tup_name Unboxed 0
+ _ | Just rest <- "(" `stripPrefix` name
+ , (commas, rest') <- BS.span (==',') rest
+ , ")" <- rest'
+ -> Just $ tup_name Boxed (1+BS.length commas)
+ _ | Just rest <- "(#" `stripPrefix` name
+ , (commas, rest') <- BS.span (==',') rest
+ , "#)" <- rest'
+ -> Just $ tup_name Unboxed (1+BS.length commas)
+ _ -> Nothing
where
- choose_ns :: Name -> Name -> OccName -> Name
- choose_ns tc dc occ
+ -- TODO: Drop when bytestring 0.10.8 can be assumed
+#if MIN_VERSION_bytestring(0,10,8)
+ stripPrefix = BS.stripPrefix
+#else
+ stripPrefix bs1@(BSI.PS _ _ l1) bs2
+ | bs1 `BS.isPrefixOf` bs2 = Just (BSU.unsafeDrop l1 bs2)
+ | otherwise = Nothing
+#endif
+
+ name = fastStringToByteString $ occNameFS occ
+
+ choose_ns :: Name -> Name -> Name
+ choose_ns tc dc
| isTcClsNameSpace ns = tc
| isDataConNameSpace ns = dc
| otherwise = pprPanic "tup_name" (ppr occ)
@@ -658,15 +686,6 @@ builtInOccNames = listToUFM $
= choose_ns (getName (tupleTyCon boxity arity))
(getName (tupleDataCon boxity arity))
-
-isBuiltInOcc_maybe :: OccName -> Maybe Name
--- Built in syntax isn't "in scope" so these OccNames
--- map to wired-in Names with BuiltInSyntax
-isBuiltInOcc_maybe occ
- = case lookupUFM builtInOccNames (occNameFS occ) of
- Just f -> Just (f occ)
- Nothing -> Nothing
-
mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
-- No need to cache these, the caching is done in mk_tuple
mkTupleOcc ns Boxed ar = mkOccName ns (mkBoxedTupleStr ar)
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 386040c..f0308bf 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -513,7 +513,7 @@ test('T5321FD',
# 2014-07-31: 211699816 (Windows) (-11%)
# (due to better optCoercion, 5e7406d9, #9233)
# 2016-04-06: 250757460 (x86/Linux)
- (wordsize(64), 532365376, 10)])
+ (wordsize(64), 477840432, 10)])
# prev: 418306336
# 29/08/2012: 492905640
# (increase due to new codegen)
@@ -532,6 +532,8 @@ test('T5321FD',
# not recognize that the application is bottom)
# 2015-10-28: 532365376
# D757: emit Typeable instances at site of type definition
+ # 2016-07-16: 477840432
+ # Optimize handling of built-in OccNames
],
compile,[''])
More information about the ghc-commits
mailing list