Utils.hs 11.4 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

-}
5

6
{-# LANGUAGE CPP #-}
7

Sylvain Henry's avatar
Sylvain Henry committed
8
-- | The @GHC.Builtin.Utils@ interface to the compiler's prelude knowledge.
9 10 11 12 13 14 15 16 17 18 19
--
-- This module serves as the central gathering point for names which the
-- compiler knows something about. This includes functions for,
--
--  * discerning whether a 'Name' is known-key
--
--  * given a 'Unique', looking up its corresponding known-key 'Name'
--
-- See Note [Known-key names] and Note [About wired-in things] for information
-- about the two types of prelude things in GHC.
--
Sylvain Henry's avatar
Sylvain Henry committed
20
module GHC.Builtin.Utils (
21 22 23
        -- * Known-key names
        isKnownKeyName,
        lookupKnownKeyName,
24
        lookupKnownNameInfo,
25 26 27 28 29 30 31 32

        -- ** Internal use
        -- | 'knownKeyNames' is exported to seed the original name cache only;
        -- if you find yourself wanting to look at it you might consider using
        -- 'lookupKnownKeyName' or 'isKnownKeyName'.
        knownKeyNames,

        -- * Miscellaneous
33 34
        wiredInIds, ghcPrimIds,
        primOpRules, builtinRules,
35

36
        ghcPrimExports,
mniip's avatar
mniip committed
37
        ghcPrimDeclDocs,
38
        primOpId,
39

40
        -- * Random other things
41
        maybeCharLikeCon, maybeIntLikeCon,
42

43
        -- * Class categories
44
        isNumericClass, isStandardClass
45

46 47
    ) where

48
#include "HsVersions.h"
sof's avatar
sof committed
49

50
import GHC.Prelude
51

Sylvain Henry's avatar
Sylvain Henry committed
52
import GHC.Builtin.Uniques
Sylvain Henry's avatar
Sylvain Henry committed
53
import GHC.Types.Unique ( isValidKnownKeyUnique )
54

Sylvain Henry's avatar
Sylvain Henry committed
55
import GHC.Core.ConLike ( ConLike(..) )
Sylvain Henry's avatar
Sylvain Henry committed
56 57
import GHC.Builtin.Names.TH ( templateHaskellNames )
import GHC.Builtin.Names
Sylvain Henry's avatar
Sylvain Henry committed
58
import GHC.Core.Opt.ConstantFold
Sylvain Henry's avatar
Sylvain Henry committed
59
import GHC.Types.Avail
Sylvain Henry's avatar
Sylvain Henry committed
60
import GHC.Builtin.PrimOps
Sylvain Henry's avatar
Sylvain Henry committed
61
import GHC.Core.DataCon
62
import GHC.Types.Basic
Sylvain Henry's avatar
Sylvain Henry committed
63 64 65 66
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Id.Make
67
import GHC.Utils.Outputable
Sylvain Henry's avatar
Sylvain Henry committed
68 69
import GHC.Builtin.Types.Prim
import GHC.Builtin.Types
Sylvain Henry's avatar
Sylvain Henry committed
70
import GHC.Driver.Types
Sylvain Henry's avatar
Sylvain Henry committed
71 72
import GHC.Core.Class
import GHC.Core.TyCon
Sylvain Henry's avatar
Sylvain Henry committed
73
import GHC.Types.Unique.FM
74
import GHC.Utils.Misc
Sylvain Henry's avatar
Sylvain Henry committed
75
import GHC.Builtin.Types.Literals ( typeNatTyCons )
mniip's avatar
mniip committed
76
import GHC.Hs.Doc
77

78
import Control.Applicative ((<|>))
79
import Data.List        ( intercalate , find )
Ian Lynagh's avatar
Ian Lynagh committed
80
import Data.Array
81
import Data.Maybe
mniip's avatar
mniip committed
82
import qualified Data.Map as Map
83

84 85
{-
************************************************************************
86
*                                                                      *
87
\subsection[builtinNameInfo]{Lookup built-in names}
Austin Seipp's avatar
Austin Seipp committed
88 89
*                                                                      *
************************************************************************
90

91 92
Note [About wired-in things]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Ian Lynagh's avatar
Ian Lynagh committed
93
* Wired-in things are Ids\/TyCons that are completely known to the compiler.
94 95
  They are global values in GHC, (e.g.  listTyCon :: TyCon).

Sylvain Henry's avatar
Sylvain Henry committed
96
* A wired-in Name contains the thing itself inside the Name:
97 98
        see Name.wiredInNameTyThing_maybe
  (E.g. listTyConName contains listTyCon.
99 100

* The name cache is initialised with (the names of) all wired-in things
Sylvain Henry's avatar
Sylvain Henry committed
101
  (except tuples and sums; see Note [Infinite families of known-key names])
102

103 104 105
* The type environment itself contains no wired in things. The type
  checker sees if the Name is wired in before looking up the name in
  the type environment.
106

Sylvain Henry's avatar
Sylvain Henry committed
107
* GHC.Iface.Make prunes out wired-in things before putting them in an interface file.
108
  So interface files never contain wired-in things.
Austin Seipp's avatar
Austin Seipp committed
109
-}
110

111

Ben Gamari's avatar
Ben Gamari committed
112 113
-- | This list is used to ensure that when you say "Prelude.map" in your source
-- code, or in an interface file, you get a Name with the correct known key (See
114
-- Note [Known-key names] in "GHC.Builtin.Names")
115 116
knownKeyNames :: [Name]
knownKeyNames
117 118 119 120 121 122 123 124 125 126 127
  | debugIsOn
  , Just badNamesStr <- knownKeyNamesOkay all_names
  = panic ("badAllKnownKeyNames:\n" ++ badNamesStr)
       -- NB: We can't use ppr here, because this is sometimes evaluated in a
       -- context where there are no DynFlags available, leading to a cryptic
       -- "<<details unavailable>>" error. (This seems to happen only in the
       -- stage 2 compiler, for reasons I [Richard] have no clue of.)
  | otherwise
  = all_names
  where
    all_names =
128 129
      -- We exclude most tuples from this list—see
      -- Note [Infinite families of known-key names] in GHC.Builtin.Names.
130
      -- We make an exception for Solo (i.e., the boxed 1-tuple), since it does
131 132 133 134
      -- not use special syntax like other tuples.
      -- See Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)
      -- in GHC.Builtin.Types.
      tupleTyConName BoxedTuple 1 : tupleDataConName Boxed 1 :
135
      concat [ wired_tycon_kk_names funTyCon
Ben Gamari's avatar
Ben Gamari committed
136 137 138 139 140
             , concatMap wired_tycon_kk_names primTyCons
             , concatMap wired_tycon_kk_names wiredInTyCons
             , concatMap wired_tycon_kk_names typeNatTyCons
             , map idName wiredInIds
             , map (idName . primOpId) allThePrimOps
141
             , map (idName . primOpWrapperId) allThePrimOps
Ben Gamari's avatar
Ben Gamari committed
142 143 144
             , basicKnownKeyNames
             , templateHaskellNames
             ]
145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172
    -- All of the names associated with a wired-in TyCon.
    -- This includes the TyCon itself, its DataCons and promoted TyCons.
    wired_tycon_kk_names :: TyCon -> [Name]
    wired_tycon_kk_names tc =
        tyConName tc : (rep_names tc ++ implicits)
      where implicits = concatMap thing_kk_names (implicitTyConThings tc)

    wired_datacon_kk_names :: DataCon -> [Name]
    wired_datacon_kk_names dc =
      dataConName dc : rep_names (promoteDataCon dc)

    thing_kk_names :: TyThing -> [Name]
    thing_kk_names (ATyCon tc)                 = wired_tycon_kk_names tc
    thing_kk_names (AConLike (RealDataCon dc)) = wired_datacon_kk_names dc
    thing_kk_names thing                       = [getName thing]

    -- The TyConRepName for a known-key TyCon has a known key,
    -- but isn't itself an implicit thing.  Yurgh.
    -- NB: if any of the wired-in TyCons had record fields, the record
    --     field names would be in a similar situation.  Ditto class ops.
    --     But it happens that there aren't any
    rep_names tc = case tyConRepName_maybe tc of
                        Just n  -> [n]
                        Nothing -> []

-- | Check the known-key names list of consistency.
knownKeyNamesOkay :: [Name] -> Maybe String
knownKeyNamesOkay all_names
173 174 175 176
  | ns@(_:_) <- filter (not . isValidKnownKeyUnique . getUnique) all_names
  = Just $ "    Out-of-range known-key uniques: ["
        ++ intercalate ", " (map (occNameString . nameOccName) ns) ++
         "]"
177 178 179 180
  | null badNamesPairs
  = Nothing
  | otherwise
  = Just badNamesStr
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
181
  where
182 183
    namesEnv      = foldl' (\m n -> extendNameEnv_Acc (:) singleton m n n)
                           emptyUFM all_names
184
    badNamesEnv   = filterNameEnv (\ns -> ns `lengthExceeds` 1) namesEnv
185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
    badNamesPairs = nonDetUFMToList badNamesEnv
      -- It's OK to use nonDetUFMToList here because the ordering only affects
      -- the message when we get a panic
    badNamesStrs  = map pairToStr badNamesPairs
    badNamesStr   = unlines badNamesStrs

    pairToStr (uniq, ns) = "        " ++
                           show uniq ++
                           ": [" ++
                           intercalate ", " (map (occNameString . nameOccName) ns) ++
                           "]"

-- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
-- known-key thing.
lookupKnownKeyName :: Unique -> Maybe Name
lookupKnownKeyName u =
201
    knownUniqueName u <|> lookupUFM_Directly knownKeysMap u
202 203 204 205 206 207

-- | Is a 'Name' known-key?
isKnownKeyName :: Name -> Bool
isKnownKeyName n =
    isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap

208 209 210 211 212 213 214
-- | Maps 'Unique's to known-key names.
--
-- The type is @UniqFM Name Name@ to denote that the 'Unique's used
-- in the domain are 'Unique's associated with 'Name's (as opposed
-- to some other namespace of 'Unique's).
knownKeysMap :: UniqFM Name Name
knownKeysMap = listToIdentityUFM knownKeyNames
215

216 217 218 219
-- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by
-- GHCi's ':info' command.
lookupKnownNameInfo :: Name -> SDoc
lookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of
220
    -- If we do find a doc, we add comment delimiters to make the output
221 222 223 224 225 226 227 228 229
    -- of ':info' valid Haskell.
    Nothing  -> empty
    Just doc -> vcat [text "{-", doc, text "-}"]

-- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390)
knownNamesInfo :: NameEnv SDoc
knownNamesInfo = unitNameEnv coercibleTyConName $
    vcat [ text "Coercible is a special constraint with custom solving rules."
         , text "It is not a class."
230 231
         , text "Please see section `The Coercible constraint`"
         , text "of the user's guide for details." ]
232

Austin Seipp's avatar
Austin Seipp committed
233
{-
234 235 236
We let a lot of "non-standard" values be visible, so that we can make
sense of them in interface pragmas. It's cool, though they all have
"non-standard" names, so they won't get past the parser in user code.
237

Austin Seipp's avatar
Austin Seipp committed
238 239
************************************************************************
*                                                                      *
240
                PrimOpIds
Austin Seipp's avatar
Austin Seipp committed
241 242 243
*                                                                      *
************************************************************************
-}
244

245
primOpIds :: Array Int Id
246
-- A cache of the PrimOp Ids, indexed by PrimOp tag
247 248
primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op)
                                   | op <- allThePrimOps ]
249 250 251 252

primOpId :: PrimOp -> Id
primOpId op = primOpIds ! primOpTag op

Austin Seipp's avatar
Austin Seipp committed
253 254 255
{-
************************************************************************
*                                                                      *
256
            Export lists for pseudo-modules (GHC.Prim)
Austin Seipp's avatar
Austin Seipp committed
257 258
*                                                                      *
************************************************************************
259

260
GHC.Prim "exports" all the primops and primitive types, some
261
wired-in Ids.
Austin Seipp's avatar
Austin Seipp committed
262
-}
263

264
ghcPrimExports :: [IfaceExport]
265
ghcPrimExports
266 267
 = map (avail . idName) ghcPrimIds ++
   map (avail . idName . primOpId) allThePrimOps ++
Adam Gundry's avatar
Adam Gundry committed
268
   [ AvailTC n [n] []
269
   | tc <- funTyCon : exposedPrimTyCons, let n = tyConName tc  ]
270

mniip's avatar
mniip committed
271
ghcPrimDeclDocs :: DeclDocMap
272 273 274 275 276 277 278 279 280
ghcPrimDeclDocs = DeclDocMap $ Map.fromList $ mapMaybe findName primOpDocs
  where
    names = map idName ghcPrimIds ++
            map (idName . primOpId) allThePrimOps ++
            map tyConName (funTyCon : exposedPrimTyCons)
    findName (nameStr, doc)
      | Just name <- find ((nameStr ==) . getOccString) names
      = Just (name, mkHsDocString doc)
      | otherwise = Nothing
mniip's avatar
mniip committed
281

Austin Seipp's avatar
Austin Seipp committed
282 283 284
{-
************************************************************************
*                                                                      *
285
            Built-in keys
Austin Seipp's avatar
Austin Seipp committed
286 287
*                                                                      *
************************************************************************
288

289
ToDo: make it do the ``like'' part properly (as in 0.26 and before).
Austin Seipp's avatar
Austin Seipp committed
290
-}
291

292
maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
293 294
maybeCharLikeCon con = con `hasKey` charDataConKey
maybeIntLikeCon  con = con `hasKey` intDataConKey
295

Austin Seipp's avatar
Austin Seipp committed
296 297 298
{-
************************************************************************
*                                                                      *
299
            Class predicates
Austin Seipp's avatar
Austin Seipp committed
300 301 302
*                                                                      *
************************************************************************
-}
303

304
isNumericClass, isStandardClass :: Class -> Bool
sof's avatar
sof committed
305 306 307

isNumericClass     clas = classKey clas `is_elem` numericClassKeys
isStandardClass    clas = classKey clas `is_elem` standardClassKeys
Ian Lynagh's avatar
Ian Lynagh committed
308 309

is_elem :: Eq a => a -> [a] -> Bool
310
is_elem = isIn "is_X_Class"