TysWiredIn: Use UniqFM lookup for built-in OccNames

Previously we would unpack the OccName into a String, then pattern match
against this string. Due to the implementation of `unpackFS`, this
actually unpacks the entire contents, even though we often only need to
look at the first few characters.

Here we take another approach: build a UniqFM with the known built-in
OccNames, allowing us to use `FastString`'s hash-based comparison
instead.

Reviewers: simonpj, austin, simonmar

Reviewed By: simonmar

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2385

GHC Trac Issues: #12357

1 files changed, 25 insertions, 27 deletions

diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 51f5555dd3..8465cd98a2 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -134,6 +134,7 @@ import {-# SOURCE #-} ConLike
 import TyCon
 import Class            ( Class, mkClass )
 import RdrName
+import UniqFM
 import Name
 import NameSet          ( NameSet, mkNameSet, elemNameSet )
 import BasicTypes       ( Arity, Boxity(..),
@@ -635,39 +636,36 @@ decl in GHC.Classes, so I think this part may not work properly. But
 it's unused I think.
 -}
 
-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 occNameString occ of
-        "[]"             -> choose_ns listTyConName nilDataConName
-        ":"              -> Just consDataConName
-        "[::]"           -> Just parrTyConName
-        "()"             -> tup_name Boxed      0
-        "(##)"           -> tup_name Unboxed    0
-        '(':',':rest     -> parse_tuple Boxed   2 rest
-        '(':'#':',':rest -> parse_tuple Unboxed 2 rest
-        _other           -> Nothing
+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] ]
   where
-    ns = occNameSpace occ
-
-    parse_tuple sort n rest
-      | (',' : rest2) <- rest   = parse_tuple sort (n+1) rest2
-      | tail_matches sort rest  = tup_name sort n
-      | otherwise               = Nothing
-
-    tail_matches Boxed   ")" = True
-    tail_matches Unboxed "#)" = True
-    tail_matches _       _    = False
+    choose_ns :: Name -> Name -> OccName -> Name
+    choose_ns tc dc occ
+      | isTcClsNameSpace ns   = tc
+      | isDataConNameSpace ns = dc
+      | otherwise             = pprPanic "tup_name" (ppr occ)
+      where ns = occNameSpace occ
 
     tup_name boxity arity
       = choose_ns (getName (tupleTyCon   boxity arity))
                   (getName (tupleDataCon boxity arity))
 
-    choose_ns tc dc
-      | isTcClsNameSpace ns   = Just tc
-      | isDataConNameSpace ns = Just dc
-      | otherwise             = pprPanic "tup_name" (ppr occ)
+
+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