[commit: ghc] master: TysWiredIn: Use UniqFM lookup for built-in OccNames (f53d761)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/f53d761df9762232b54ec57a950d301011cd21f8/ghc

>---------------------------------------------------------------

commit f53d761df9762232b54ec57a950d301011cd21f8
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Sat Jul 9 21:03:46 2016 +0200

    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


>---------------------------------------------------------------

f53d761df9762232b54ec57a950d301011cd21f8
 compiler/prelude/TysWiredIn.hs | 52 ++++++++++++++++++++----------------------
 1 file changed, 25 insertions(+), 27 deletions(-)

diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 51f5555..8465cd9 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