diff options
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/Builtin/Names.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/Builtin/Types.hs | 84 | ||||
| -rw-r--r-- | compiler/GHC/Builtin/Uniques.hs | 12 | ||||
| -rw-r--r-- | compiler/GHC/Types/Name.hs | 16 | ||||
| -rw-r--r-- | compiler/GHC/Types/Name/Cache.hs | 20 | ||||
| -rw-r--r-- | compiler/GHC/Types/Name/Ppr.hs | 3 |
6 files changed, 113 insertions, 23 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index 1c26e1aaa9..34bd17a23f 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -2796,6 +2796,7 @@ Situations in which we apply this special logic: pretendNameIsInScope :: Name -> Bool pretendNameIsInScope n = isBuiltInSyntax n + || isTupleTyConName n || any (n `hasKey`) [ liftedTypeKindTyConKey, unliftedTypeKindTyConKey , liftedDataConKey, unliftedDataConKey diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs index 44d22f3676..59970daa3c 100644 --- a/compiler/GHC/Builtin/Types.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -18,7 +18,7 @@ module GHC.Builtin.Types ( mkWiredInIdName, -- used in GHC.Types.Id.Make -- * All wired in things - wiredInTyCons, isBuiltInOcc_maybe, isPunOcc_maybe, + wiredInTyCons, isBuiltInOcc_maybe, isTupleTyOcc_maybe, isPunOcc_maybe, -- * Bool boolTy, boolTyCon, boolTyCon_RDR, boolTyConName, @@ -209,6 +209,10 @@ import qualified Data.ByteString.Char8 as BS import Data.Foldable import Data.List ( elemIndex, intersperse ) +import Numeric ( showInt ) + +import Text.Read (readMaybe) +import Data.Char (ord, isDigit) alpha_tyvar :: [TyVar] alpha_tyvar = [alphaTyVar] @@ -734,16 +738,16 @@ Basically it keeps everything uniform. However the /naming/ of the type/data constructors for one-tuples is a bit odd: - 3-tuples: (,,) (,,)# - 2-tuples: (,) (,)# + 3-tuples: Tuple3 (,,)# + 2-tuples: Tuple2 (,)# 1-tuples: ?? - 0-tuples: () ()# + 0-tuples: Unit ()# Zero-tuples have used up the logical name. So we use 'Solo' and 'Solo#' for one-tuples. So in ghc-prim:GHC.Tuple we see the declarations: - data () = () + data Unit = () data Solo a = MkSolo a - data (a,b) = (a,b) + data Tuple2 a b = (a,b) There is no way to write a boxed one-tuple in Haskell using tuple syntax. They can, however, be written using other methods: @@ -852,13 +856,54 @@ isBuiltInOcc_maybe occ = choose_ns tc dc | isTcClsNameSpace ns = tc | isDataConNameSpace ns = dc - | otherwise = pprPanic "tup_name" (ppr occ) + | otherwise = pprPanic "tup_name" (ppr occ <+> parens (pprNameSpace ns)) where ns = occNameSpace occ tup_name boxity arity = choose_ns (getName (tupleTyCon boxity arity)) (getName (tupleDataCon boxity arity)) +isTupleTyOcc_maybe :: Module -> OccName -> Maybe Name +isTupleTyOcc_maybe mod occ + | mod == gHC_TUPLE_PRIM + = match_occ + where + match_occ + | occ == occName unitTyConName = Just unitTyConName + | occ == occName soloTyConName = Just soloTyConName + | otherwise = isTupleNTyOcc_maybe occ +isTupleTyOcc_maybe _ _ = Nothing + + +-- | This is only for Tuple<n>, not for Unit or Solo +isTupleNTyOcc_maybe :: OccName -> Maybe Name +isTupleNTyOcc_maybe occ = + case occNameString occ of + 'T':'u':'p':'l':'e':str | Just n <- readInt str, n > 1 + -> Just (tupleTyConName BoxedTuple n) + _ -> Nothing + +-- | See Note [Small Ints parsing] +readInt :: String -> Maybe Int +readInt s = case s of + [c] | isDigit c -> Just (digit_to_int c) + [c1, c2] | isDigit c1, isDigit c2 + -> Just (digit_to_int c1 * 10 + digit_to_int c2) + _ -> readMaybe s + where + digit_to_int :: Char -> Int + digit_to_int c = ord c - ord '0' + +{- +Note [Small Ints parsing] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Currently, tuples in Haskell have a maximum arity of 64. +To parse strings of length 1 and 2 more efficiently, we +can utilize an ad-hoc solution that matches their characters. +This results in a speedup of up to 40 times compared to using +`readMaybe @Int` on my machine. +-} + -- When resolving names produced by Template Haskell (see thOrigRdrName -- in GHC.ThToHs), we want ghc-prim:GHC.Types.List to yield an Exact name, not -- an Orig name. @@ -872,6 +917,10 @@ isPunOcc_maybe :: Module -> OccName -> Maybe Name isPunOcc_maybe mod occ | mod == gHC_TYPES, occ == occName listTyConName = Just listTyConName + | mod == gHC_TUPLE_PRIM, occ == occName unitTyConName + = Just unitTyConName + | mod == gHC_TUPLE_PRIM + = isTupleNTyOcc_maybe occ isPunOcc_maybe _ _ = Nothing mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName @@ -887,10 +936,15 @@ mkTupleStr Boxed = mkBoxedTupleStr mkTupleStr Unboxed = const mkUnboxedTupleStr mkBoxedTupleStr :: NameSpace -> Arity -> String -mkBoxedTupleStr _ 0 = "()" -mkBoxedTupleStr ns 1 | isDataConNameSpace ns = "MkSolo" -- See Note [One-tuples] -mkBoxedTupleStr _ 1 = "Solo" -- See Note [One-tuples] -mkBoxedTupleStr _ ar = '(' : commas ar ++ ")" +mkBoxedTupleStr ns 0 + | isDataConNameSpace ns = "()" + | otherwise = "Unit" +mkBoxedTupleStr ns 1 + | isDataConNameSpace ns = "MkSolo" -- See Note [One-tuples] + | otherwise = "Solo" +mkBoxedTupleStr ns ar + | isDataConNameSpace ns = '(' : commas ar ++ ")" + | otherwise = "Tuple" ++ showInt ar "" mkUnboxedTupleStr :: Arity -> String mkUnboxedTupleStr 0 = "(##)" @@ -1052,7 +1106,7 @@ mk_tuple Boxed arity = (tycon, tuple_con) boxity = Boxed modu = gHC_TUPLE_PRIM tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq - (ATyCon tycon) BuiltInSyntax + (ATyCon tycon) UserSyntax dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq (AConLike (RealDataCon tuple_con)) BuiltInSyntax tc_uniq = mkTupleTyConUnique boxity arity @@ -1126,6 +1180,9 @@ mk_ctuple arity = (tycon, tuple_con, sc_sel_ids_arr) unitTyCon :: TyCon unitTyCon = tupleTyCon Boxed 0 +unitTyConName :: Name +unitTyConName = tyConName unitTyCon + unitTyConKey :: Unique unitTyConKey = getUnique unitTyCon @@ -1138,6 +1195,9 @@ unitDataConId = dataConWorkId unitDataCon soloTyCon :: TyCon soloTyCon = tupleTyCon Boxed 1 +soloTyConName :: Name +soloTyConName = tyConName soloTyCon + pairTyCon :: TyCon pairTyCon = tupleTyCon Boxed 2 diff --git a/compiler/GHC/Builtin/Uniques.hs b/compiler/GHC/Builtin/Uniques.hs index 9da937f8c5..1a440792e5 100644 --- a/compiler/GHC/Builtin/Uniques.hs +++ b/compiler/GHC/Builtin/Uniques.hs @@ -19,6 +19,7 @@ module GHC.Builtin.Uniques -- *** Vanilla , mkTupleTyConUnique , mkTupleDataConUnique + , isTupleTyConUnique -- *** Constraint , mkCTupleTyConUnique , mkCTupleDataConUnique @@ -266,6 +267,17 @@ mkTupleTyConUnique :: Boxity -> Arity -> Unique mkTupleTyConUnique Boxed a = mkUnique '4' (2*a) mkTupleTyConUnique Unboxed a = mkUnique '5' (2*a) +-- | This function is an inverse of `mkTupleTyConUnique` +isTupleTyConUnique :: Unique -> Maybe (Boxity, Arity) +isTupleTyConUnique u = + case (tag, i) of + ('4', 0) -> Just (Boxed, arity) + ('5', 0) -> Just (Unboxed, arity) + _ -> Nothing + where + (tag, n) = unpkUnique u + (arity, i) = quotRem n 2 + getTupleTyConName :: Boxity -> Int -> Name getTupleTyConName boxity n = case n `divMod` 2 of diff --git a/compiler/GHC/Types/Name.hs b/compiler/GHC/Types/Name.hs index d201cfa5f0..7d441039e9 100644 --- a/compiler/GHC/Types/Name.hs +++ b/compiler/GHC/Types/Name.hs @@ -64,7 +64,7 @@ module GHC.Types.Name ( isSystemName, isInternalName, isExternalName, isTyVarName, isTyConName, isDataConName, isValName, isVarName, isDynLinkName, - isWiredInName, isWiredIn, isBuiltInSyntax, + isWiredInName, isWiredIn, isBuiltInSyntax, isTupleTyConName, isHoleName, wiredInNameTyThing_maybe, nameIsLocalOrFrom, nameIsExternalOrFrom, nameIsHomePackage, @@ -103,6 +103,8 @@ import GHC.Utils.Panic import Control.DeepSeq import Data.Data import qualified Data.Semigroup as S +import GHC.Types.Basic (Boxity(Boxed)) +import GHC.Builtin.Uniques (isTupleTyConUnique) {- ************************************************************************ @@ -282,6 +284,9 @@ isBuiltInSyntax :: Name -> Bool isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True isBuiltInSyntax _ = False +isTupleTyConName :: Name -> Bool +isTupleTyConName = isJust . isTupleTyConUnique . getUnique + isExternalName (Name {n_sort = External _}) = True isExternalName (Name {n_sort = WiredIn _ _ _}) = True isExternalName _ = False @@ -339,7 +344,14 @@ is_interactive_or_from from mod = from == mod || isInteractiveModule mod -- Return the pun for a name if available. -- Used for pretty-printing under ListTuplePuns. namePun_maybe :: Name -> Maybe FastString -namePun_maybe name | getUnique name == getUnique listTyCon = Just (fsLit "[]") +namePun_maybe name + | getUnique name == getUnique listTyCon = Just (fsLit "[]") + + | Just (Boxed, ar) <- isTupleTyConUnique (getUnique name) + , ar /= 1 = Just (fsLit $ '(' : commas ar ++ ")") + where + commas ar = replicate (ar-1) ',' + namePun_maybe _ = Nothing nameIsLocalOrFrom :: Module -> Name -> Bool diff --git a/compiler/GHC/Types/Name/Cache.hs b/compiler/GHC/Types/Name/Cache.hs index 6e18c77b32..ef25b25f80 100644 --- a/compiler/GHC/Types/Name/Cache.hs +++ b/compiler/GHC/Types/Name/Cache.hs @@ -1,4 +1,3 @@ - {-# LANGUAGE RankNTypes #-} -- | The Name Cache @@ -30,6 +29,8 @@ import GHC.Utils.Panic import Control.Concurrent.MVar import Control.Monad +import Control.Applicative + {- @@ -58,8 +59,8 @@ site, we fix it up. Note [Built-in syntax and the OrigNameCache] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Built-in syntax like tuples and unboxed sums are quite ubiquitous. To lower -their cost we use two tricks, +Built-in syntax like unboxed sums and punned syntax like tuples are quite +ubiquitous. To lower their cost we use two tricks, a. We specially encode tuple and sum Names in interface files' symbol tables to avoid having to look up their names while loading interface files. @@ -69,13 +70,14 @@ their cost we use two tricks, in GHC.Iface.Binary and for details. b. 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. + OccNames (in isBuiltInOcc_maybe and isPunOcc_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, +emits built-in and punned syntax directly as Exact RdrNames, and 2) built-in +and punned 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 and punned syntax, * If you use setRdrNameSpace on an Exact RdrName it may be turned into an Orig RdrName. @@ -103,7 +105,7 @@ takeUniqFromNameCache (NameCache c _) = uniqFromMask c lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name lookupOrigNameCache nc mod occ | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE_PRIM - , Just name <- isBuiltInOcc_maybe occ + , Just name <- isBuiltInOcc_maybe occ <|> isPunOcc_maybe mod occ = -- See Note [Known-key names], 3(c) in GHC.Builtin.Names -- Special case for tuples; there are too many -- of them to pre-populate the original-name cache diff --git a/compiler/GHC/Types/Name/Ppr.hs b/compiler/GHC/Types/Name/Ppr.hs index 2670b27cd9..206ee2e782 100644 --- a/compiler/GHC/Types/Name/Ppr.hs +++ b/compiler/GHC/Types/Name/Ppr.hs @@ -23,6 +23,7 @@ import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Builtin.Types.Prim ( fUNTyConName ) import GHC.Builtin.Types +import Data.Maybe (isJust) {- @@ -120,7 +121,9 @@ mkQualName env = qual_name where , tYPETyConName , fUNTyConName, unrestrictedFunTyConName , oneDataConName + , listTyConName , manyDataConName ] + || isJust (isTupleTyOcc_maybe mod occ) right_name gre = greDefinitionModule gre == Just mod |