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

3 files changed, 66 insertions, 33 deletions

diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs
index 0c8d8e9767..ff2f648a4a 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 8465cd98a2..86f1dde3d4 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 386040c00d..f0308bf2a9 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,[''])