Commit f53d761d authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari
Browse files

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
parent 0177c85b
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment