Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC

Commits:

27 changed files:

Changes:

  • compiler/GHC/Builtin/Names.hs
    ... ... @@ -120,15 +120,10 @@ import GHC.Unit.Types
    120 120 
     import GHC.Types.Name.Occurrence
    121 121 
     import GHC.Types.Name.Reader
    122 122 
     import GHC.Types.Unique
    123 
    -import GHC.Types.Unique.FM
    124 123 
     import GHC.Types.Name
    125 124 
     import GHC.Types.SrcLoc
    126 125
    127 126 
     import GHC.Builtin.Uniques
    128 
    -import GHC.Builtin.Names.TH( thKnownKeyTable )
    129 
    -
    130 
    -import GHC.Utils.Panic
    131 
    -import GHC.Utils.Misc( HasDebugCallStack )
    132 127
    133 128 
     import GHC.Data.FastString
    134 129 
     import GHC.Data.List.Infinite (Infinite (..))
    ... ... @@ -185,27 +180,9 @@ names with uniques. These ones are the *non* wired-in ones. The
    185 180 
     wired in ones are defined in GHC.Builtin.Types etc.
    186 181 
     -}
    187 182
    188 
    --- | `knownKeyOccMap` maps the OccName of a known-key to its Unique
    189 
    -knownKeyOccMap :: OccEnv KnownKey
    190 
    -knownKeyOccMap = mkOccEnv knownKeyTable
    191 
    -
    192 
    -knownKeyUniqMap :: UniqFM KnownKey OccName
    193 
    -knownKeyUniqMap = listToUFM [ (uniq, occ) | (occ, uniq) <- knownKeyTable ]
    194 
    -
    195 
    -knownKeyTable :: [(OccName, KnownKey)]
    196 
    -knownKeyTable = basicKnownKeyTable ++ thKnownKeyTable
    197 
    -
    198 
    -knownKeyOccName :: HasDebugCallStack => KnownKey -> OccName
    199 
    --- Find the OccName from the KnownKey,
    200 
    --- by looking in the knownKeyUniqMap
    201 
    -knownKeyOccName std_uniq
    202 
    -  = case lookupUFM knownKeyUniqMap std_uniq of
    203 
    -        Just occ -> occ
    204 
    -        Nothing  -> pprPanic "knownKeyOccName" (pprKnownKey std_uniq)
    205 
    -
    206 183 
     basicKnownKeyTable :: [(OccName, KnownKey)]
    207 184 
     basicKnownKeyTable
    208 
    -  = [ (mkTcOcc "Rational",     rationalTyConKey)
    185 
    +  = [ (rationalTyConOcc,     rationalTyConKey)
    209 186 
         , (mkTcOcc "Show",         showClassKey)
    210 187 
         , (mkTcOcc "Foldable",     foldableClassKey)
    211 188 
         , (mkTcOcc "Traversable",  traversableClassKey)
    ... ... @@ -255,9 +232,9 @@ basicKnownKeyTable
    255 232
    256 233 
         -- Class Monad, MonadFix, MonadZip
    257 234 
         , (mkTcOcc "Monad",        monadClassKey)
    258 
    -    , (mkVarOcc ">>",          thenMClassOpKey)
    235 
    +    , (thenMClassOpOcc,        thenMClassOpKey)
    259 236 
         , (mkVarOcc ">>=",         bindMClassOpKey)
    260 
    -    , (mkVarOcc "return",      returnMClassOpKey)
    237 
    +    , (returnMClassOpOcc,      returnMClassOpKey)
    261 238 
         , (mkVarOcc "fail",        failMClassOpKey)
    262 239 
         , (mkVarOcc "guard",       guardMIdKey)
    263 240 
         , (mkVarOcc "mfix",        mfixIdKey)
    ... ... @@ -267,14 +244,14 @@ basicKnownKeyTable
    267 244 
         , (mkTcOcc "Applicative",  applicativeClassKey)
    268 245 
         , (mkVarOcc "mzip",        mzipIdKey)
    269 246 
         , (mkVarOcc "<*>",         apAClassOpKey)
    270 
    -    , (mkVarOcc "pure",        pureAClassOpKey)
    271 
    -    , (mkVarOcc "*>",          thenAClassOpKey)
    247 
    +    , (pureAClassOpOcc,        pureAClassOpKey)
    248 
    +    , (thenAClassOpOcc,        thenAClassOpKey)
    272 249
    273 250 
         -- Class Semigroup, Monoid
    274 251 
         , (mkTcOcc "Semigroup",    semigroupClassKey)
    275 252 
         , (mkTcOcc "Monoid",       monoidClassKey)
    276 
    -    , (mkVarOcc "<>",          sappendClassOpKey)
    277 
    -    , (mkVarOcc "mappend",     mappendClassOpKey)
    253 
    +    , (sappendClassOpOcc,      sappendClassOpKey)
    254 
    +    , (mappendClassOpOcc,      mappendClassOpKey)
    278 255 
         , (mkVarOcc "mempty",      memptyClassOpKey)
    279 256
    280 257 
         -- Class IsString
    ... ... @@ -297,9 +274,9 @@ basicKnownKeyTable
    297 274 
         -- , (mkVarOcc "setField",  setFieldClassOpKey)
    298 275
    299 276 
         -- FromList
    300 
    -    , (mkVarOcc "isList",   fromListClassOpKey)
    301 
    -    , (mkVarOcc "isList",  fromListNClassOpKey)
    302 
    -    , (mkVarOcc "isList",     toListClassOpKey)
    277 
    +    , (mkVarOcc "fromList",   fromListClassOpKey)
    278 
    +    , (mkVarOcc "fromListN",  fromListNClassOpKey)
    279 
    +    , (mkVarOcc "toList",     toListClassOpKey)
    303 280
    304 281 
         -- Arrows
    305 282 
         , (mkVarOcc "arr",        arrAIdKey)
    ... ... @@ -1184,14 +1161,31 @@ clsQual modu str unique = mk_known_key_name clsName modu str unique
    1184 1161 
     dcQual   modu str unique = mk_known_key_name dataName modu str unique
    1185 1162
    1186 1163
    1187 
    -{-
    1188 
    -************************************************************************
    1164 
    +{- *********************************************************************
    1189 1165 
     *                                                                      *
    1190 
    -\subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
    1166 
    +                 Statically-known occurrence names
    1191 1167 
     *                                                                      *
    1192 
    -************************************************************************
    1193 
    ---MetaHaskell extension hand allocate keys here
    1194 
    --}
    1168 
    +********************************************************************* -}
    1169 
    +
    1170 
    +integerTyConOcc, rationalTyConOcc :: KnownOcc
    1171 
    +rationalTyConOcc = mkTcOcc "Rational"
    1172 
    +integerTyConOcc  = mkTcOcc "Integer"
    1173 
    +
    1174 
    +sappendClassOpOcc, pureAClassOpOcc, thenAClassOpOcc,
    1175 
    +  returnMClassOpOcc, thenMClassOpOcc, mappendClassOpOcc :: KnownOcc
    1176 
    +sappendClassOpOcc = mkVarOcc "<>"
    1177 
    +pureAClassOpOcc   = mkVarOcc "pure"
    1178 
    +returnMClassOpOcc = mkVarOcc "return"
    1179 
    +thenMClassOpOcc   = mkVarOcc ">>"
    1180 
    +thenAClassOpOcc   = mkVarOcc "*>"
    1181 
    +mappendClassOpOcc = mkVarOcc "mappend"
    1182 
    +
    1183 
    +
    1184 
    +{- *********************************************************************
    1185 
    +*                                                                      *
    1186 
    +                 Statically-known keys
    1187 
    +*                                                                      *
    1188 
    +********************************************************************* -}
    1195 1189
    1196 1190 
     boundedClassKey, enumClassKey, eqClassKey, floatingClassKey,
    1197 1191 
         fractionalClassKey, integralClassKey, monadClassKey, dataClassKey,
    ... ... @@ -1948,11 +1942,10 @@ ghciStepIoMClassOpKey = mkPreludeMiscIdUnique 197
    1948 1942
    1949 1943 
     -- Overloaded lists
    1950 1944 
     isListClassKey, fromListClassOpKey, fromListNClassOpKey, toListClassOpKey :: KnownKey
    1951 
    -isListClassKey = mkPreludeMiscIdUnique 198
    1952 
    -fromListClassOpKey = mkPreludeMiscIdUnique 199
    1953 
    -
    1945 
    +isListClassKey      = mkPreludeMiscIdUnique 198
    1946 
    +fromListClassOpKey  = mkPreludeMiscIdUnique 199
    1954 1947 
     fromListNClassOpKey = mkPreludeMiscIdUnique 500
    1955 
    -toListClassOpKey = mkPreludeMiscIdUnique 501
    1948 
    +toListClassOpKey    = mkPreludeMiscIdUnique 501
    1956 1949
    1957 1950 
     proxyHashKey :: KnownKey
    1958 1951 
     proxyHashKey = mkPreludeMiscIdUnique 502

  • compiler/GHC/Builtin/Names/TH.hs
    ... ... @@ -9,8 +9,8 @@ module GHC.Builtin.Names.TH where
    9 9 
     import GHC.Prelude ()
    10 10
    11 11 
     import GHC.Unit.Types
    12 
    -import GHC.Types.Name( Name, mk_known_key_name )
    13 
    -import GHC.Types.Name.Occurrence( OccName, tcName, clsName, dataName, varName, fieldName )
    12 
    +import GHC.Types.Name( Name, KnownOcc, mk_known_key_name )
    13 
    +import GHC.Types.Name.Occurrence
    14 14 
     import GHC.Types.Unique ( Unique )
    15 15 
     import GHC.Builtin.Uniques
    16 16 
     import GHC.Data.FastString
    ... ... @@ -26,6 +26,11 @@ import Language.Haskell.Syntax.Module.Name
    26 26 
     thKnownKeyTable :: [(OccName,Unique)]
    27 27 
     thKnownKeyTable = []
    28 28
    29 
    +templateHaskellOccs :: [OccName]
    30 
    +templateHaskellOccs
    31 
    +  = [ expTyConOcc
    32 
    +    , litPOcc ]
    33 
    +
    29 34 
     templateHaskellNames :: [Name]
    30 35 
     -- The names that are implicitly mentioned by ``bracket''
    31 36 
     -- Should stay in sync with the import list of GHC.HsToCore.Quote
    ... ... @@ -44,11 +49,6 @@ templateHaskellNames = [
    44 49 
         charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
    45 50 
         floatPrimLName, doublePrimLName, rationalLName, stringPrimLName,
    46 51 
         charPrimLName,
    47 
    -    -- Pat
    48 
    -    litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName,
    49 
    -    conPName, tildePName, bangPName, infixPName,
    50 
    -    asPName, wildPName, recPName, listPName, sigPName, viewPName,
    51 
    -    typePName, invisPName, orPName,
    52 52 
         -- FieldPat
    53 53 
         fieldPatName,
    54 54 
         -- Match
    ... ... @@ -217,6 +217,9 @@ liftClassName = mk_known_key_name clsName liftLib (fsLit "Lift") liftClassKey
    217 217 
     quoteClassName :: Name
    218 218 
     quoteClassName = thMonadCls (fsLit "Quote") quoteClassKey
    219 219
    220 
    +expTyConOcc :: KnownOcc
    221 
    +expTyConOcc = mkTcOcc "Exp"
    222 
    +
    220 223 
     qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
    221 224 
         fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
    222 225 
         matchTyConName, clauseTyConName, funDepTyConName, predTyConName,
    ... ... @@ -280,27 +283,27 @@ stringPrimLName = libFun (fsLit "stringPrimL") stringPrimLIdKey
    280 283 
     charPrimLName   = libFun (fsLit "charPrimL")   charPrimLIdKey
    281 284
    282 285 
     -- data Pat = ...
    283 
    -litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName, conPName,
    284 
    -    infixPName, tildePName, bangPName, asPName, wildPName, recPName, listPName,
    285 
    -    sigPName, viewPName, typePName, invisPName, orPName :: Name
    286 
    -litPName   = libFun (fsLit "litP")   litPIdKey
    287 
    -varPName   = libFun (fsLit "varP")   varPIdKey
    288 
    -tupPName   = libFun (fsLit "tupP")   tupPIdKey
    289 
    -unboxedTupPName = libFun (fsLit "unboxedTupP") unboxedTupPIdKey
    290 
    -unboxedSumPName = libFun (fsLit "unboxedSumP") unboxedSumPIdKey
    291 
    -conPName   = libFun (fsLit "conP")   conPIdKey
    292 
    -infixPName = libFun (fsLit "infixP") infixPIdKey
    293 
    -tildePName = libFun (fsLit "tildeP") tildePIdKey
    294 
    -bangPName  = libFun (fsLit "bangP")  bangPIdKey
    295 
    -asPName    = libFun (fsLit "asP")    asPIdKey
    296 
    -wildPName  = libFun (fsLit "wildP")  wildPIdKey
    297 
    -recPName   = libFun (fsLit "recP")   recPIdKey
    298 
    -listPName  = libFun (fsLit "listP")  listPIdKey
    299 
    -sigPName   = libFun (fsLit "sigP")   sigPIdKey
    300 
    -viewPName  = libFun (fsLit "viewP")  viewPIdKey
    301 
    -orPName    = libFun (fsLit "orP")    orPIdKey
    302 
    -typePName  = libFun (fsLit "typeP")  typePIdKey
    303 
    -invisPName = libFun (fsLit "invisP") invisPIdKey
    286 
    +litPOcc, varPOcc, tupPOcc, unboxedTupPOcc, unboxedSumPOcc, conPOcc,
    287 
    +    infixPOcc, tildePOcc, bangPOcc, asPOcc, wildPOcc, recPOcc, listPOcc,
    288 
    +    sigPOcc, viewPOcc, typePOcc, invisPOcc, orPOcc :: KnownOcc
    289 
    +litPOcc        = mkVarOcc "litP"
    290 
    +varPOcc        = mkVarOcc "varP"
    291 
    +tupPOcc        = mkVarOcc "tupP"
    292 
    +unboxedTupPOcc = mkVarOcc "unboxedTupP"
    293 
    +unboxedSumPOcc = mkVarOcc "unboxedSumP"
    294 
    +conPOcc        = mkVarOcc "conP"
    295 
    +infixPOcc      = mkVarOcc "infixP"
    296 
    +tildePOcc      = mkVarOcc "tildeP"
    297 
    +bangPOcc       = mkVarOcc "bangP"
    298 
    +asPOcc         = mkVarOcc "asP"
    299 
    +wildPOcc       = mkVarOcc "wildP"
    300 
    +recPOcc        = mkVarOcc "recP"
    301 
    +listPOcc       = mkVarOcc "listP"
    302 
    +sigPOcc        = mkVarOcc "sigP"
    303 
    +viewPOcc       = mkVarOcc "viewP"
    304 
    +orPOcc         = mkVarOcc "orP"
    305 
    +typePOcc       = mkVarOcc "typeP"
    306 
    +invisPOcc      = mkVarOcc "invisP"
    304 307
    305 308 
     -- type FieldPat = ...
    306 309 
     fieldPatName :: Name

  • compiler/GHC/Builtin/Utils.hs
    ... ... @@ -18,15 +18,16 @@
    18 18 
     -- about the two types of prelude things in GHC.
    19 19 
     --
    20 20 
     module GHC.Builtin.Utils (
    21 
    +        -- * Main exports
    22 
    +        wiredInNames, wiredInIds, ghcPrimIds,
    23 
    +        knownKeyTable, knownKeyOccMap, knownKeyUniqMap, knownKeyOccName,
    24 
    +
    21 25 
             -- * Known-key names
    22 26 
             oldIsKnownKeyName,
    23 27 
             oldLookupKnownKeyName,
    24 28 
             oldLookupKnownNameInfo,
    25 29
    26 30
    27 
    -        -- * Miscellaneous
    28 
    -        wiredInNames, wiredInIds, ghcPrimIds,
    29 
    -
    30 31 
             ghcPrimExports,
    31 32 
             ghcPrimDeclDocs,
    32 33 
             ghcPrimWarns,
    ... ... @@ -48,8 +49,9 @@ import GHC.Builtin.PrimOps.Ids
    48 49 
     import GHC.Builtin.Types
    49 50 
     import GHC.Builtin.Types.Literals ( typeNatTyCons )
    50 51 
     import GHC.Builtin.Types.Prim
    51 
    -import GHC.Builtin.Names.TH ( templateHaskellNames )
    52 
    -import GHC.Builtin.Names
    52 
    +import GHC.Builtin.Names.TH ( templateHaskellNames, thKnownKeyTable )
    53 
    +import GHC.Builtin.Names( basicKnownKeyTable, basicKnownKeyNames )
    54 
    +import GHC.Builtin.Names( charDataConKey, intDataConKey, numericClassKeys, standardClassKeys )
    53 55
    54 56 
     import GHC.Core.ConLike ( ConLike(..) )
    55 57 
     import GHC.Core.DataCon
    ... ... @@ -63,10 +65,10 @@ import GHC.Types.Name
    63 65 
     import GHC.Types.Name.Env
    64 66 
     import GHC.Types.Id.Make
    65 67 
     import GHC.Types.SourceText
    68 
    +import GHC.Types.Unique
    66 69 
     import GHC.Types.Unique.FM
    67 70 
     import GHC.Types.Unique.Map
    68 71 
     import GHC.Types.TyThing
    69 
    -import GHC.Types.Unique ( isValidKnownKeyUnique, pprUniqueAlways )
    70 72
    71 73 
     import GHC.Utils.Outputable
    72 74 
     import GHC.Utils.Misc as Utils
    ... ... @@ -83,10 +85,38 @@ import GHC.Data.List.SetOps
    83 85 
     import Control.Applicative ((<|>))
    84 86 
     import Data.Maybe
    85 87
    86 
    -{-
    87 
    -************************************************************************
    88 
    +
    89 
    +
    90 
    +{- *********************************************************************
    91 
    +*                                                                      *
    92 
    +                     Known-key things
    93 
    +*                                                                      *
    94 
    +********************************************************************* -}
    95 
    +
    96 
    +-- | `knownKeyOccMap` maps the OccName of a known-key to its Unique
    97 
    +knownKeyOccMap :: OccEnv KnownKey
    98 
    +knownKeyOccMap = mkOccEnv knownKeyTable
    99 
    +
    100 
    +knownKeyUniqMap :: UniqFM KnownKey OccName
    101 
    +knownKeyUniqMap = listToUFM [ (uniq, occ) | (occ, uniq) <- knownKeyTable ]
    102 
    +
    103 
    +knownKeyTable :: [(OccName, KnownKey)]
    104 
    +knownKeyTable = [ (getOccName n, getUnique n) | n <- wiredInNames ] ++
    105 
    +                basicKnownKeyTable ++
    106 
    +                thKnownKeyTable
    107 
    +
    108 
    +knownKeyOccName :: HasDebugCallStack => KnownKey -> OccName
    109 
    +-- Find the OccName from the KnownKey,
    110 
    +-- by looking in the knownKeyUniqMap
    111 
    +knownKeyOccName std_uniq
    112 
    +  = case lookupUFM knownKeyUniqMap std_uniq of
    113 
    +        Just occ -> occ
    114 
    +        Nothing  -> pprPanic "knownKeyOccName" (pprKnownKey std_uniq)
    115 
    +
    116 
    +
    117 
    +{- *********************************************************************
    88 118 
     *                                                                      *
    89 
    -\subsection[builtinNameInfo]{Lookup built-in names}
    119 
    +                     Wired-in things
    90 120 
     *                                                                      *
    91 121 
     ************************************************************************
    92 122
    ... ... @@ -114,7 +144,6 @@ Note [About wired-in things]
    114 144 
     -- code, or in an interface file, you get a Name with the correct known key (See
    115 145 
     -- Note [Known-key names] in "GHC.Builtin.Names")
    116 146 
     wiredInNames :: [Name]
    117 
    --- ToDo: rename to wiredInNames
    118 147 
     wiredInNames
    119 148 
       | debugIsOn
    120 149 
       , Just badNamesDoc <- knownKeyNamesOkay all_names

  • compiler/GHC/HsToCore/Monad.hs
    ... ... @@ -29,6 +29,7 @@ module GHC.HsToCore.Monad (
    29 29 
             dsLookupDataCon, dsLookupConLike,
    30 30 
             dsLookupKnownKeyTyCon, dsLookupKnownKeyId,
    31 31 
             dsLookupKnownKeyName,
    32 
    +        dsLookupKnownOccId, dsLookupKnownOccTyCon,
    32 33
    33 34 
             DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv,
    34 35
    ... ... @@ -566,6 +567,13 @@ mkNamePprCtxDs = ds_name_ppr_ctx <$> getGblEnv
    566 567 
     instance MonadThings (IOEnv (Env DsGblEnv DsLclEnv)) where
    567 568 
         lookupThing = dsLookupGlobal
    568 569
    570 
    +
    571 
    +{- *********************************************************************
    572 
    +*                                                                      *
    573 
    +                Looking things up in the monad
    574 
    +*                                                                      *
    575 
    +********************************************************************* -}
    576 
    +
    569 577 
     dsGetKnownKeySource :: DsM KnownKeyNameSource
    570 578 
     dsGetKnownKeySource
    571 579 
       = do { rebindable_path <- goptM Opt_RebindableKnownKeyNames
    ... ... @@ -574,11 +582,32 @@ dsGetKnownKeySource
    574 582 
                      ; return (KKNS_InScope rdr_env) }
    575 583 
              else return KKNS_FromModule }
    576 584
    585 
    +--------------------------------------
    586 
    +-- Lookups for known-occ things
    587 
    +
    588 
    +dsLookupKnownOccThing :: KnownOcc -> DsM TyThing
    589 
    +dsLookupKnownOccThing occ
    590 
    +  = do { rebindable_src <- dsGetKnownKeySource
    591 
    +       ; dsToIfL $
    592 
    +         do { mb_res <- lookupKnownOccThing occ rebindable_src
    593 
    +            ; case mb_res of
    594 
    +                 Succeeded thing -> return thing
    595 
    +                 Failed msg -> failIfM (pprDiagnostic msg) } }
    596 
    +
    597 
    +dsLookupKnownOccTyCon :: KnownOcc -> DsM TyCon
    598 
    +dsLookupKnownOccTyCon uniq = tyThingTyCon <$> dsLookupKnownOccThing uniq
    599 
    +
    600 
    +dsLookupKnownOccId :: KnownOcc -> DsM Id
    601 
    +dsLookupKnownOccId uniq = tyThingId <$> dsLookupKnownOccThing uniq
    602 
    +
    603 
    +--------------------------------------
    604 
    +-- Lookups for known-key things
    605 
    +
    577 606 
     dsLookupKnownKeyName :: KnownKey -> DsM Name
    578 607 
     dsLookupKnownKeyName uniq
    579 608 
       = do { rebindable_src <- dsGetKnownKeySource
    580 609 
            ; dsToIfL $
    581 
    -         do { mb_res <- lookupKnownKeyName rebindable_src uniq
    610 
    +         do { mb_res <- lookupKnownKeyName uniq rebindable_src
    582 611 
                 ; case mb_res of
    583 612 
                      Succeeded name -> return name
    584 613 
                      Failed msg -> failIfM (pprDiagnostic msg) } }
    ... ... @@ -587,39 +616,41 @@ dsLookupKnownKeyThing :: KnownKey -> DsM TyThing
    587 616 
     dsLookupKnownKeyThing uniq
    588 617 
       = do { rebindable_src <- dsGetKnownKeySource
    589 618 
            ; dsToIfL $
    590 
    -         do { mb_res <- lookupKnownKeyThing rebindable_src uniq
    619 
    +         do { mb_res <- lookupKnownKeyThing uniq rebindable_src
    591 620 
                 ; case mb_res of
    592 621 
                      Succeeded thing -> return thing
    593 622 
                      Failed msg -> failIfM (pprDiagnostic msg) } }
    594 623
    595 624 
     dsLookupKnownKeyTyCon :: KnownKey -> DsM TyCon
    596 
    -dsLookupKnownKeyTyCon uniq
    597 
    -  = tyThingTyCon <$> dsLookupKnownKeyThing uniq
    625 
    +dsLookupKnownKeyTyCon uniq = tyThingTyCon <$> dsLookupKnownKeyThing uniq
    598 626
    599 627 
     dsLookupKnownKeyId :: KnownKey -> DsM Id
    600 
    -dsLookupKnownKeyId uniq
    601 
    -  = tyThingId <$> dsLookupKnownKeyThing uniq
    628 
    +dsLookupKnownKeyId uniq = tyThingId <$> dsLookupKnownKeyThing uniq
    629 
    +
    630 
    +--------------------------------------
    631 
    +-- Lookups given a Name
    602 632
    603 633 
     dsLookupGlobal :: Name -> DsM TyThing
    604 
    --- Very like GHC.Tc.Utils.Env.tcLookupGlobal
    605 634 
     dsLookupGlobal name = dsToIfL (tcIfaceGlobal name)
    606 635
    607 636 
     dsLookupGlobalId :: Name -> DsM Id
    608 
    -dsLookupGlobalId name
    609 
    -  = tyThingId <$> dsLookupGlobal name
    637 
    +dsLookupGlobalId name = tyThingId <$> dsLookupGlobal name
    610 638
    611 639 
     dsLookupTyCon :: Name -> DsM TyCon
    612 
    -dsLookupTyCon name
    613 
    -  = tyThingTyCon <$> dsLookupGlobal name
    640 
    +dsLookupTyCon name = tyThingTyCon <$> dsLookupGlobal name
    614 641
    615 642 
     dsLookupDataCon :: Name -> DsM DataCon
    616 
    -dsLookupDataCon name
    617 
    -  = tyThingDataCon <$> dsLookupGlobal name
    643 
    +dsLookupDataCon name = tyThingDataCon <$> dsLookupGlobal name
    618 644
    619 645 
     dsLookupConLike :: Name -> DsM ConLike
    620 
    -dsLookupConLike name
    621 
    -  = tyThingConLike <$> dsLookupGlobal name
    646 
    +dsLookupConLike name = tyThingConLike <$> dsLookupGlobal name
    647 
    +
    622 648
    649 
    +{- *********************************************************************
    650 
    +*                                                                      *
    651 
    +                Other monadic operations
    652 
    +*                                                                      *
    653 
    +********************************************************************* -}
    623 654
    624 655 
     dsGetFamInstEnvs :: DsM FamInstEnvs
    625 656 
     -- Gets both the external-package inst-env

  • compiler/GHC/HsToCore/Pmc/Solver/Types.hs
    ... ... @@ -55,7 +55,6 @@ import GHC.Utils.Panic.Plain
    55 55 
     import GHC.Utils.Misc (lastMaybe)
    56 56 
     import GHC.Data.Maybe
    57 57 
     import GHC.Core.Type
    58 
    -import GHC.Core.TyCon
    59 58 
     import GHC.Types.Literal
    60 59 
     import GHC.Types.Literal.Floating
    61 60 
     import GHC.Core
    ... ... @@ -63,6 +62,7 @@ import GHC.Core.TyCo.Compare( eqType, nonDetCmpType )
    63 62 
     import GHC.Core.Map.Expr
    64 63 
     import GHC.Core.Utils (exprType)
    65 64 
     import GHC.Builtin.Names
    65 
    +import GHC.Builtin.Utils( knownKeyOccName )
    66 66 
     import GHC.Builtin.Types
    67 67 
     import GHC.Builtin.Types.Prim
    68 68 
     import GHC.Tc.Solver.InertSet (InertSet, emptyInertSet)
    ... ... @@ -703,7 +703,7 @@ coreExprAsPmLit e = case collectArgs e of
    703 703 
         -> Just (PmLit ty (PmLitInt l))
    704 704 
       (Var x, [_ty, n_arg, d_arg])
    705 705 
         | Just dc <- isDataConWorkId_maybe x
    706 
    -    , dataConName dc == ratioDataConName
    706 
    +    , dc `hasKnownKey` ratioDataConKey
    707 707 
         , Just (PmLit _ (PmLitInt n)) <- coreExprAsPmLit n_arg
    708 708 
         , Just (PmLit _ (PmLitInt d)) <- coreExprAsPmLit d_arg
    709 709 
         -> Just (PmLit (exprType e) (PmLitRat (n % d)))
    ... ... @@ -730,7 +730,7 @@ coreExprAsPmLit e = case collectArgs e of
    730 730 
         , [r, exp] <- dropWhile (not . is_ratio) args
    731 731 
         , (Var x, [_ty, n_arg, d_arg]) <- collectArgs r
    732 732 
         , Just dc <- isDataConWorkId_maybe x
    733 
    -    , dataConName dc == ratioDataConName
    733 
    +    , dc `hasKnownKey` ratioDataConKey
    734 734 
         , Just (PmLit _ (PmLitInt n)) <- coreExprAsPmLit n_arg
    735 735 
         , Just (PmLit _ (PmLitInt d)) <- coreExprAsPmLit d_arg
    736 736 
         , Just (_exp_ty,exp') <- bignum_conapp_maybe exp
    ... ... @@ -753,7 +753,7 @@ coreExprAsPmLit e = case collectArgs e of
    753 753 
         , ty `eqType` charTy
    754 754 
         -> literalToPmLit stringTy (mkLitString "")
    755 755 
       (Var x, [Lit l])
    756 
    -    | idName x `elem` [unpackCStringName, unpackCStringUtf8Name]
    756 
    +    | idUnique x `elem` [unpackCStringIdKey, unpackCStringUtf8IdKey]
    757 757 
         -> literalToPmLit stringTy l
    758 758
    759 759 
       _ -> Nothing
    ... ... @@ -775,7 +775,7 @@ coreExprAsPmLit e = case collectArgs e of
    775 775 
         is_ratio (Type _) = False
    776 776 
         is_ratio r
    777 777 
           | Just (tc, _) <- splitTyConApp_maybe (exprType r)
    778 
    -      = tyConName tc == ratioTyConName
    778 
    +      = tc `hasKnownKey` ratioTyConKey
    779 779 
           | otherwise
    780 780 
           = False
    781 781 
         is_larg_exp_ratio x

  • compiler/GHC/HsToCore/Quote.hs
    ... ... @@ -2427,6 +2427,27 @@ rep2X lift_dsm get_wrap n xs = do
    2427 2427 
       ; return (MkC $ (foldl' App (wrap (Var rep_id)) xs)) }
    2428 2428
    2429 2429
    2430 
    +krep2M      ::           KnownOcc -> [CoreExpr] -> MetaM (Core (M a))
    2431 
    +krep2       ::           KnownOcc -> [CoreExpr] -> MetaM (Core (M a))
    2432 
    +krep2_nw    :: NotM a => KnownOcc -> [CoreExpr] -> MetaM (Core a)
    2433 
    +krep2_nwDsM :: NotM a => KnownOcc -> [CoreExpr] -> DsM (Core a)
    2434 
    +krep2  = krep2X lift (asks quoteWrapper)
    2435 
    +krep2M = krep2X lift (asks monadWrapper)
    2436 
    +krep2_nw n xs = lift (krep2_nwDsM n xs)
    2437 
    +krep2_nwDsM   = krep2X id (return id)
    2438 
    +
    2439 
    +krep2X :: Monad m => (forall z . DsM z -> m z)
    2440 
    +      -> m (CoreExpr -> CoreExpr)
    2441 
    +      -> KnownOcc
    2442 
    +      -> [ CoreExpr ]
    2443 
    +      -> m (Core a)
    2444 
    +krep2X lift_dsm get_wrap n xs = do
    2445 
    +  { rep_id <- lift_dsm $ dsLookupKnownOccId n
    2446 
    +  ; wrap <- get_wrap
    2447 
    +  ; return (MkC $ (foldl' App (wrap (Var rep_id)) xs)) }
    2448 
    +
    2449 
    +
    2450 
    +
    2430 2451 
     dataCon' :: Name -> [CoreExpr] -> MetaM (Core a)
    2431 2452 
     dataCon' n args = do { id <- lift $ dsLookupDataCon n
    2432 2453 
                          ; return $ MkC $ mkCoreConApps id args }
    ... ... @@ -2443,63 +2464,63 @@ dataCon n = dataCon' n []
    2443 2464
    2444 2465 
     --------------- Patterns -----------------
    2445 2466 
     repPlit   :: Core TH.Lit -> MetaM (Core (M TH.Pat))
    2446 
    -repPlit (MkC l) = rep2 litPName [l]
    2467 
    +repPlit (MkC l) = krep2 litPOcc [l]
    2447 2468
    2448 2469 
     repPvar :: Core TH.Name -> MetaM (Core (M TH.Pat))
    2449 
    -repPvar (MkC s) = rep2 varPName [s]
    2470 
    +repPvar (MkC s) = krep2 varPOcc [s]
    2450 2471
    2451 2472 
     repPtup :: Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
    2452 
    -repPtup (MkC ps) = rep2 tupPName [ps]
    2473 
    +repPtup (MkC ps) = krep2 tupPOcc [ps]
    2453 2474
    2454 2475 
     repPunboxedTup :: Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
    2455 
    -repPunboxedTup (MkC ps) = rep2 unboxedTupPName [ps]
    2476 
    +repPunboxedTup (MkC ps) = krep2 unboxedTupPOcc [ps]
    2456 2477
    2457 2478 
     repPunboxedSum :: Core (M TH.Pat) -> TH.SumAlt -> TH.SumArity -> MetaM (Core (M TH.Pat))
    2458 2479 
     -- Note: not Core TH.SumAlt or Core TH.SumArity; it's easier to be direct here
    2459 2480 
     repPunboxedSum (MkC p) alt arity
    2460 2481 
      = do { platform <- getPlatform
    2461 
    -      ; rep2 unboxedSumPName [ p
    2482 
    +      ; krep2 unboxedSumPOcc [ p
    2462 2483 
                                  , mkIntExprInt platform alt
    2463 2484 
                                  , mkIntExprInt platform arity ] }
    2464 2485
    2465 2486 
     repPcon   :: Core TH.Name -> Core [(M TH.Type)] -> Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
    2466 
    -repPcon (MkC s) (MkC ts) (MkC ps) = rep2 conPName [s, ts, ps]
    2487 
    +repPcon (MkC s) (MkC ts) (MkC ps) = krep2 conPOcc [s, ts, ps]
    2467 2488
    2468 2489 
     repPrec   :: Core TH.Name -> Core [M (TH.Name, TH.Pat)] -> MetaM (Core (M TH.Pat))
    2469 
    -repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
    2490 
    +repPrec (MkC c) (MkC rps) = krep2 recPOcc [c,rps]
    2470 2491
    2471 2492 
     repPinfix :: Core (M TH.Pat) -> Core TH.Name -> Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
    2472 
    -repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
    2493 
    +repPinfix (MkC p1) (MkC n) (MkC p2) = krep2 infixPOcc [p1, n, p2]
    2473 2494
    2474 2495 
     repPtilde :: Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
    2475 
    -repPtilde (MkC p) = rep2 tildePName [p]
    2496 
    +repPtilde (MkC p) = krep2 tildePOcc [p]
    2476 2497
    2477 2498 
     repPbang :: Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
    2478 
    -repPbang (MkC p) = rep2 bangPName [p]
    2499 
    +repPbang (MkC p) = krep2 bangPOcc [p]
    2479 2500
    2480 2501 
     repPaspat :: Core TH.Name -> Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
    2481 
    -repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
    2502 
    +repPaspat (MkC s) (MkC p) = krep2 asPOcc [s, p]
    2482 2503
    2483 2504 
     repPwild  :: MetaM (Core (M TH.Pat))
    2484 
    -repPwild = rep2 wildPName []
    2505 
    +repPwild = krep2 wildPOcc []
    2485 2506
    2486 2507 
     repPlist :: Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
    2487 
    -repPlist (MkC ps) = rep2 listPName [ps]
    2508 
    +repPlist (MkC ps) = krep2 listPOcc [ps]
    2488 2509
    2489 2510 
     repPview :: Core (M TH.Exp) -> Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
    2490 
    -repPview (MkC e) (MkC p) = rep2 viewPName [e,p]
    2511 
    +repPview (MkC e) (MkC p) = krep2 viewPOcc [e,p]
    2491 2512
    2492 2513 
     repPor :: Core (NonEmpty (M TH.Pat)) -> MetaM (Core (M TH.Pat))
    2493 
    -repPor (MkC ps) = rep2 orPName [ps]
    2514 
    +repPor (MkC ps) = krep2 orPOcc [ps]
    2494 2515
    2495 2516 
     repPsig :: Core (M TH.Pat) -> Core (M TH.Type) -> MetaM (Core (M TH.Pat))
    2496 
    -repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
    2517 
    +repPsig (MkC p) (MkC t) = krep2 sigPOcc [p, t]
    2497 2518
    2498 2519 
     repPtype :: Core (M TH.Type) -> MetaM (Core (M TH.Pat))
    2499 
    -repPtype (MkC t) = rep2 typePName [t]
    2520 
    +repPtype (MkC t) = krep2 typePOcc [t]
    2500 2521
    2501 2522 
     repPinvis :: Core (M TH.Type) -> MetaM (Core (M TH.Pat))
    2502 
    -repPinvis (MkC t) = rep2 invisPName [t]
    2523 
    +repPinvis (MkC t) = krep2 invisPOcc [t]
    2503 2524
    2504 2525 
     --------------- Expressions -----------------
    2505 2526 
     repVarOrCon :: Name -> Core TH.Name -> MetaM (Core (M TH.Exp))

  • compiler/GHC/Iface/Binary.hs
    ... ... @@ -32,8 +32,7 @@ module GHC.Iface.Binary (
    32 32
    33 33 
     import GHC.Prelude
    34 34
    35 
    -import GHC.Builtin.Utils   ( oldIsKnownKeyName, oldLookupKnownKeyName )
    36 
    -import GHC.Builtin.Names   ( knownKeyOccMap )
    35 
    +import GHC.Builtin.Utils   ( knownKeyOccMap, oldIsKnownKeyName, oldLookupKnownKeyName )
    37 36 
     import GHC.Utils.Panic
    38 37 
     import GHC.Utils.Binary as Binary
    39 38 
     import GHC.Utils.Outputable

  • compiler/GHC/Iface/Load.hs
    ... ... @@ -20,8 +20,10 @@ module GHC.Iface.Load (
    20 20 
             loadGlobalName,
    21 21
    22 22 
             -- Known-key things
    23 
    -        KnownKeyNameSource(..), lookupKnownKeyThing,
    24 
    -        lookupKnownKeyName, loadKnownKeyOccMaps,
    23 
    +        KnownKeyNameSource(..),
    24 
    +        lookupKnownKeyThing, lookupKnownKeyName,
    25 
    +        lookupKnownOccThing, lookupKnownOccName,
    26 
    +        loadKnownKeyOccMaps,
    25 27
    26 28 
             -- RnM/TcM functions
    27 29 
             loadModuleInterface, loadModuleInterfaces,
    ... ... @@ -155,24 +157,24 @@ instance Outputable KnownKeyNameSource where
    155 157 
       ppr (KKNS_InScope env) = text "InScope" <> braces (ppr env)
    156 158
    157 159 
     lookupKnownKeyThing :: HasDebugCallStack
    158 
    -                    => KnownKeyNameSource -> KnownKey
    160 
    +                    => KnownKey -> KnownKeyNameSource
    159 161 
                         -> IfM lcl (MaybeErr IfaceMessage TyThing)
    160 
    -lookupKnownKeyThing mb_gbl_rdr_env key
    161 
    -  = do { mb_name <- lookupKnownKeyName mb_gbl_rdr_env key
    162 
    +lookupKnownKeyThing key mb_gbl_rdr_env
    163 
    +  = do { mb_name <- lookupKnownKeyName key mb_gbl_rdr_env
    162 164 
            ; case mb_name of
    163 165 
                  Failed err     -> return (Failed err)
    164 166 
                  Succeeded name -> lookupGlobalName name }
    165 167
    166 168 
     lookupKnownKeyName :: HasDebugCallStack
    167 
    -                   => KnownKeyNameSource -> KnownKey
    169 
    +                   => KnownKey -> KnownKeyNameSource
    168 170 
                        -> IfM lcl (MaybeErr IfaceMessage Name)
    169 
    -lookupKnownKeyName KKNS_FromModule uniq
    171 
    +lookupKnownKeyName uniq KKNS_FromModule
    170 172 
       = do { (kk_map, _) <- loadKnownKeyOccMaps
    171 173 
            ; case lookupUFM kk_map uniq of
    172 174 
                Just name -> return (Succeeded name)
    173 175 
                Nothing   -> return (Failed (MissingKnownKey1 uniq)) }
    174 176
    175 
    -lookupKnownKeyName (KKNS_InScope gbl_rdr_env) uniq
    177 
    +lookupKnownKeyName uniq (KKNS_InScope gbl_rdr_env)
    176 178 
       -- Just gbl_rdr_env: we have -frebindable-known-key-names on, and
    177 179 
       --                   here is the top-level GlobalRdrEnv
    178 180 
       -- Look up the /un-qualified/ known-key OccName in the GlobalRdrEnv
    ... ... @@ -180,7 +182,7 @@ lookupKnownKeyName (KKNS_InScope gbl_rdr_env) uniq
    180 182 
       | Just (occ :: OccName) <- lookupUFM knownKeyUniqMap uniq
    181 183 
       = case lookupGRE gbl_rdr_env (LookupRdrName (mkRdrUnqual occ) SameNameSpace) of
    182 184 
            [gre] -> do { let name = greName gre
    183 
    -                   ; traceIf $ hang (text "lookupKnownKeyName NoImplicitKnownKeyNames")
    185 
    +                   ; traceIf $ hang (text "lookupKnownKeyName1 NoImplicitKnownKeyNames")
    184 186 
                                       2 (ppr name <+> ppr uniq)
    185 187 
                        ; return (Succeeded name) }
    186 188 
            gres  -> return (Failed (KnownKeyScopeError occ gres))
    ... ... @@ -188,6 +190,36 @@ lookupKnownKeyName (KKNS_InScope gbl_rdr_env) uniq
    188 190 
       | otherwise
    189 191 
       = return (Failed (MissingKnownKey2 uniq))
    190 192
    193 
    +lookupKnownOccThing :: HasDebugCallStack
    194 
    +                    => KnownOcc -> KnownKeyNameSource
    195 
    +                    -> IfM lcl (MaybeErr IfaceMessage TyThing)
    196 
    +lookupKnownOccThing occ mb_gbl_rdr_env
    197 
    +  = do { mb_name <- lookupKnownOccName occ mb_gbl_rdr_env
    198 
    +       ; case mb_name of
    199 
    +             Failed err     -> return (Failed err)
    200 
    +             Succeeded name -> lookupGlobalName name }
    201 
    +
    202 
    +lookupKnownOccName :: HasDebugCallStack
    203 
    +                   => KnownOcc -> KnownKeyNameSource
    204 
    +                   -> IfM lcl (MaybeErr IfaceMessage Name)
    205 
    +lookupKnownOccName occ KKNS_FromModule
    206 
    +  = do { (_, occ_map) <- loadKnownKeyOccMaps
    207 
    +       ; case lookupOccEnv occ_map occ of
    208 
    +           Just name -> return (Succeeded name)
    209 
    +           Nothing   -> return (Failed (MissingKnownKey3 occ)) }
    210 
    +
    211 
    +lookupKnownOccName occ (KKNS_InScope gbl_rdr_env)
    212 
    +  -- Just gbl_rdr_env: we have -frebindable-known-key-names on, and
    213 
    +  --                   here is the top-level GlobalRdrEnv
    214 
    +  -- Look up the /un-qualified/ known-key OccName in the GlobalRdrEnv
    215 
    +  -- If we get a unique hit, use it; if not, panic.
    216 
    +  = case lookupGRE gbl_rdr_env (LookupRdrName (mkRdrUnqual occ) SameNameSpace) of
    217 
    +       [gre] -> do { let name = greName gre
    218 
    +                   ; traceIf $ hang (text "lookupKnownKeyName2 NoImplicitKnownKeyNames")
    219 
    +                                  2 (ppr name <+> ppr occ)
    220 
    +                   ; return (Succeeded name) }
    221 
    +       gres  -> return (Failed (KnownKeyScopeError occ gres))
    222 
    +
    191 223 
     loadKnownKeyOccMaps :: IfM lcl KnownKeyNameMaps
    192 224 
     loadKnownKeyOccMaps
    193 225 
       = do { eps <- getEps
    ... ... @@ -234,7 +266,9 @@ checkKnownKeyNamesIface :: UniqFM KnownKey Name -> Maybe SDoc
    234 266 
     -- and the the uniques and occ-names agree
    235 267 
     checkKnownKeyNamesIface known_key_names_occ_map
    236 268 
       | null bad_ones = Nothing
    237 
    -  | otherwise     = Just (ppr bad_ones)
    269 
    +  | otherwise     = Just $ braces $ fsep $
    270 
    +                    [ parens (ppr occ <> comma <+> pprKnownKey key)
    271 
    +                    | (occ,key) <- bad_ones ]
    238 272 
       where
    239 273 
         bad_ones = filter is_bad knownKeyTable
    240 274 
         is_bad (occ, key)

  • compiler/GHC/Rename/Env.hs
    ... ... @@ -58,7 +58,6 @@ import GHC.Prelude
    58 58
    59 59 
     import GHC.Iface.Load
    60 60 
     import GHC.Iface.Env
    61 
    -import GHC.Iface.Errors.Types( IfaceMessage(..) )
    62 61 
     import GHC.Hs
    63 62 
     import GHC.Types.Name.Reader
    64 63 
     import GHC.Tc.Errors.Types
    ... ... @@ -68,40 +67,48 @@ import GHC.Tc.Types.LclEnv
    68 67 
     import GHC.Tc.Utils.Monad
    69 68 
     import GHC.Parser.PostProcess ( setRdrNameSpace )
    70 69
    70 
    +import GHC.Rename.Unbound
    71 
    +import GHC.Rename.Utils
    72 
    +
    71 73 
     import GHC.Builtin.Types
    72 
    -import GHC.Builtin.Names
    74 
    +import GHC.Builtin.Names( rOOT_MAIN )
    75 
    +import GHC.Builtin.Utils( knownKeyOccMap, knownKeyOccName )
    73 76
    74 
    -import GHC.Types.Name
    75 
    -import GHC.Types.Name.Set
    76 
    -import GHC.Types.Name.Env
    77 
    -import GHC.Types.Avail
    78 
    -import GHC.Types.Hint
    79 77 
     import GHC.Unit.Module
    80 78 
     import GHC.Unit.Module.ModIface
    79 
    +
    81 80 
     import GHC.Core.ConLike
    82 81 
     import GHC.Core.DataCon
    83 82 
     import GHC.Core.TyCon
    84 
    -import GHC.Types.Basic  ( TupleSort(..), tupleSortBoxity )
    85 
    -import GHC.Types.TyThing ( tyThingGREInfo )
    86 
    -import GHC.Types.SrcLoc as SrcLoc
    87 
    -import GHC.Utils.Outputable as Outputable
    83 
    +
    84 
    +import GHC.Driver.Env
    85 
    +import GHC.Driver.Session
    86 
    +
    87 
    +import GHC.Types.Unique
    88 88 
     import GHC.Types.Unique.FM
    89 89 
     import GHC.Types.Unique.DSet
    90 90 
     import GHC.Types.Unique.Set
    91 
    +import GHC.Types.TyThing ( tyThingGREInfo )
    92 
    +import GHC.Types.SrcLoc as SrcLoc
    93 
    +import GHC.Types.Name
    94 
    +import GHC.Types.Name.Set
    95 
    +import GHC.Types.Name.Env
    96 
    +import GHC.Types.Avail
    97 
    +import GHC.Types.Hint
    98 
    +import GHC.Types.CompleteMatch
    99 
    +import GHC.Types.PkgQual
    100 
    +import GHC.Types.GREInfo
    101 
    +import GHC.Types.Basic  ( TupleSort(..), tupleSortBoxity )
    102 
    +
    103 
    +import GHC.Utils.Outputable as Outputable
    91 104 
     import GHC.Utils.Misc
    92 105 
     import GHC.Utils.Panic
    106 
    +
    107 
    +import qualified GHC.LanguageExtensions as LangExt
    93 108 
     import GHC.Data.Maybe
    94 
    -import GHC.Driver.Env
    95 
    -import GHC.Driver.Session
    96 109 
     import GHC.Data.FastString
    97 110 
     import GHC.Data.List.SetOps ( minusList )
    98 
    -import qualified GHC.LanguageExtensions as LangExt
    99 
    -import GHC.Rename.Unbound
    100 
    -import GHC.Rename.Utils
    101 111 
     import GHC.Data.Bag
    102 
    -import GHC.Types.CompleteMatch
    103 
    -import GHC.Types.PkgQual
    104 
    -import GHC.Types.GREInfo
    105 112
    106 113 
     import Control.Monad
    107 114 
     import Data.Either      ( partitionEithers )
    ... ... @@ -1021,29 +1028,11 @@ we'll miss the fact that the qualified import is redundant.
    1021 1028 
     rnLookupKnownOccName :: HasDebugCallStack => KnownOcc -> RnM Name
    1022 1029 
     rnLookupKnownOccName occ
    1023 1030 
       = do { kk_source <- getKnownKeySource
    1024 
    -       ; mb_res <- lookup_known_occ kk_source occ
    1031 
    +       ; mb_res <- initIfaceTcRn (lookupKnownOccName occ kk_source)
    1025 1032 
            ; case mb_res of
    1026 1033 
                Failed err     -> failWithTc (TcRnInterfaceError err)
    1027 1034 
                Succeeded name -> return name }
    1028 1035
    1029 
    -lookup_known_occ :: HasDebugCallStack
    1030 
    -                   => KnownKeyNameSource -> KnownOcc
    1031 
    -                   -> RnM (MaybeErr IfaceMessage Name)
    1032 
    -lookup_known_occ KKNS_FromModule occ
    1033 
    -  = do { (_, occ_map) <- initIfaceTcRn loadKnownKeyOccMaps
    1034 
    -       ; case lookupOccEnv occ_map occ of
    1035 
    -           Just name -> return (Succeeded name)
    1036 
    -           Nothing   -> return (Failed (MissingKnownKey3 occ)) }
    1037 
    -
    1038 
    -lookup_known_occ (KKNS_InScope gbl_rdr_env) occ
    1039 
    -  = case lookupGRE gbl_rdr_env (LookupOccName occ SameNameSpace) of
    1040 
    -       [gre] -> do { let name = greName gre
    1041 
    -                   ; addUsedGRE NoDeprecationWarnings gre
    1042 
    -                   ; traceIf $ hang (text "lookupKnownKeyOcc NoImplicitKnownKeyNames")
    1043 
    -                                  2 (ppr name <+> ppr occ)
    1044 
    -                   ; return (Succeeded name) }
    1045 
    -       gres  -> return (Failed (KnownKeyScopeError occ gres))
    1046 
    -
    1047 1036 
     lookupLocatedOccRn :: WhatLooking
    1048 1037 
                        -> GenLocated (EpAnn ann) RdrName
    1049 1038 
                        -> TcRn (GenLocated (EpAnn ann) Name)

  • compiler/GHC/Tc/Deriv/RdrNames.hs
    ... ... @@ -26,8 +26,9 @@ import GHC.Types.Id.Make( coerceName ) -- `coerce` is wired-in
    26 26 
     import GHC.Builtin.PrimOps
    27 27 
     import GHC.Builtin.Types  -- A bunch of wired-in TyCons and DataCons
    28 28 
     import GHC.Builtin.PrimOps.Ids (primOpId)
    29 
    -import GHC.Builtin.Names
    29 
    +import GHC.Builtin.Utils( knownKeyOccName )
    30 30 
     import GHC.Builtin.Names.TH( unsafeCodeCoerceName, liftTypedName )
    31 
    +import GHC.Builtin.Names
    31 32
    32 33 
     import GHC.Data.List.Infinite (Infinite (..))
    33 34 
     import qualified GHC.Data.List.Infinite as Inf

  • compiler/GHC/Tc/Errors/Ppr.hs
    ... ... @@ -38,11 +38,8 @@ import qualified GHC.Boot.TH.Syntax as TH
    38 38 
     --            import "ghc-internal"     qualified GHC.Internal.TH.Syntax as TH
    39 39 
     import qualified GHC.Boot.TH.Ppr as TH
    40 40
    41 
    -import GHC.Builtin.Names
    42 
    -import GHC.Builtin.Types
    43 
    -  ( boxedRepDataConTyCon, tYPETyCon
    44 
    -  , pretendNameIsInScope
    45 
    -  )
    41 
    +import GHC.Builtin.Types( boxedRepDataConTyCon, tYPETyCon, pretendNameIsInScope )
    42 
    +import GHC.Builtin.Names -- A bunch of keys
    46 43
    47 44 
     import GHC.Types.Name.Reader
    48 45 
     import GHC.Unit.Module.ModIface
    ... ... @@ -6556,18 +6553,16 @@ suggestNonCanonicalDefinition reason =
    6556 6553 
       where
    6557 6554 
         action = case reason of
    6558 6555 
           NonCanonicalMonoid sub -> case sub of
    6559 
    -        NonCanonical_Sappend -> move sappendClassOpKey mappendClassOpKey
    6560 
    -        NonCanonical_Mappend -> remove mappendClassOpKey sappendClassOpKey
    6556 
    +        NonCanonical_Sappend -> move sappendClassOpOcc mappendClassOpOcc
    6557 
    +        NonCanonical_Mappend -> remove mappendClassOpOcc sappendClassOpOcc
    6561 6558 
           NonCanonicalMonad sub  -> case sub of
    6562 
    -        NonCanonical_Pure    -> move   pureAClassOpKey   returnMClassOpKey
    6563 
    -        NonCanonical_ThenA   -> move   thenAClassOpKey   thenMClassOpKey
    6564 
    -        NonCanonical_Return  -> remove returnMClassOpKey pureAClassOpKey
    6565 
    -        NonCanonical_ThenM   -> remove thenMClassOpKey   thenAClassOpKey
    6566 
    -
    6567 
    -    move lhs_key rhs_key
    6568 
    -       = SuggestMoveNonCanonicalDefinition (knownKeyOccName lhs_key) (knownKeyOccName rhs_key)
    6569 
    -    remove lhs_key rhs_key
    6570 
    -       = SuggestRemoveNonCanonicalDefinition  (knownKeyOccName lhs_key) (knownKeyOccName rhs_key)
    6559 
    +        NonCanonical_Pure    -> move   pureAClassOpOcc   returnMClassOpOcc
    6560 
    +        NonCanonical_ThenA   -> move   thenAClassOpOcc   thenMClassOpOcc
    6561 
    +        NonCanonical_Return  -> remove returnMClassOpOcc pureAClassOpOcc
    6562 
    +        NonCanonical_ThenM   -> remove thenMClassOpOcc   thenAClassOpOcc
    6563 
    +
    6564 
    +    move lhs_occ rhs_occ   = SuggestMoveNonCanonicalDefinition   lhs_occ rhs_occ
    6565 
    +    remove lhs_occ rhs_occ = SuggestRemoveNonCanonicalDefinition lhs_occ rhs_occ
    6571 6566
    6572 6567 
         doc = case reason of
    6573 6568 
           NonCanonicalMonoid _ -> doc_monoid

  • compiler/GHC/Tc/Gen/Splice.hs
    ... ... @@ -707,7 +707,7 @@ tcTypedBracket rn_expr expr res_ty
    707 707 
            ; meta_ty <- tcCodeTy m_var expr_ty
    708 708 
            ; ps' <- readMutVar ps_var
    709 709 
            ; codeco <- tcLookupId unsafeCodeCoerceName
    710 
    -       ; bracket_ty <- mkAppTy m_var <$> tcMetaTy expTyConName
    710 
    +       ; bracket_ty <- mkAppTy m_var <$> tcMetaKnownOccTy expTyConOcc
    711 711 
            ; let brack_tc = HsBracketTc { hsb_quote = ExpBr noExtField expr, hsb_ty = bracket_ty
    712 712 
                                         , hsb_wrap  = Just wrapper, hsb_splices = ps' }
    713 713 
                  -- The tc_expr is stored here so that the expression can be used in HIE files.

  • compiler/GHC/Tc/Utils/Env.hs
    ... ... @@ -29,9 +29,10 @@ module GHC.Tc.Utils.Env(
    29 29 
             addTypecheckedBinds, addEvBinds, addTopEvBinds,
    30 30 
             failIllegalTyCon, failIllegalTyVar,
    31 31
    32 
    -        tcLookupKnownKeyGlobal, tcLookupKnownKeyTyCon, tcLookupKnownKeyClass,
    33 
    -        tcLookupKnownKeyId, rnLookupKnownKeyName,
    34 
    -        rnLookupKnownKeyRdr, getKnownKeySource,
    32 
    +        tcLookupKnownKeyGlobal, tcLookupKnownKeyTyCon,
    33 
    +        tcLookupKnownKeyClass, tcLookupKnownKeyId,
    34 
    +        tcLookupKnownOccTyCon, tcLookupKnownOccId,
    35 
    +        rnLookupKnownKeyName, rnLookupKnownKeyRdr, getKnownKeySource,
    35 36
    36 37 
             -- Local environment
    37 38 
             tcExtendKindEnv, tcExtendKindEnvList,
    ... ... @@ -63,7 +64,7 @@ module GHC.Tc.Utils.Env(
    63 64
    64 65 
             -- Template Haskell stuff
    65 66 
             LevelCheckReason(..),
    66 
    -        tcMetaTy, tcMetaKnownKeyTy,
    67 
    +        tcMetaTy, tcMetaKnownOccTy,
    67 68 
             thLevelIndex, isBrackLevel,
    68 69
    69 70 
             -- New Ids
    ... ... @@ -507,6 +508,19 @@ to bring the data constructor A into scope. We thus emit the following message:
    507 508 
     ************************************************************************
    508 509 
     -}
    509 510
    511 
    +tcMetaKnownOccTy :: HasDebugCallStack => KnownOcc -> TcM Type
    512 
    +tcMetaKnownOccTy occ
    513 
    +  = do { tc <- tcLookupKnownOccTyCon occ
    514 
    +       ; return (mkTyConTy tc) }
    515 
    +
    516 
    +tcMetaTy :: Name -> TcM Type
    517 
    +-- Given the name of a Template Haskell data type,
    518 
    +-- return the type
    519 
    +-- E.g. given the name "Expr" return the type "Expr"
    520 
    +tcMetaTy tc_name
    521 
    +  = do { t <- tcLookupTyCon tc_name
    522 
    +       ; return (mkTyConTy t) }
    523 
    +
    510 524 
     getKnownKeySource :: TcRn KnownKeyNameSource
    511 525 
     -- Used by both renamer and typechecker and renamer
    512 526 
     getKnownKeySource
    ... ... @@ -516,46 +530,69 @@ getKnownKeySource
    516 530 
                      ; return (KKNS_InScope rdr_env) }
    517 531 
              else return KKNS_FromModule }
    518 532
    519 
    -rnLookupKnownKeyName :: HasDebugCallStack => KnownKey -> RnM Name
    520 
    -rnLookupKnownKeyName uniq
    533 
    +tcrn_wrapper :: (KnownKeyNameSource -> IfG (MaybeErr IfaceMessage a)) -> TcRn a
    534 
    +tcrn_wrapper do_the_lookup
    521 535 
       = do { kk_source <- getKnownKeySource
    522 
    -       ; mb_res <- initIfaceTcRn (lookupKnownKeyName kk_source uniq)
    536 
    +       ; mb_res <- initIfaceTcRn (do_the_lookup kk_source)
    523 537 
            ; case mb_res of
    524 
    -           Failed err     -> failWithTc (TcRnInterfaceError err)
    525 
    -           Succeeded name -> return name }
    538 
    +           Failed err    -> failWithTc (TcRnInterfaceError err)
    539 
    +           Succeeded res -> return res }
    540 
    +
    541 
    +
    542 
    +------------------------------------------------------
    543 
    +-- Known-key functions
    526 544
    527 545 
     rnLookupKnownKeyRdr :: HasDebugCallStack => KnownKey -> RnM RdrName
    528 546 
     rnLookupKnownKeyRdr uniq
    529 547 
       = do { nm <- rnLookupKnownKeyName uniq
    530 548 
            ; return (nameRdrName nm) }
    531 549
    550 
    +rnLookupKnownKeyName :: HasDebugCallStack => KnownKey -> RnM Name
    551 
    +rnLookupKnownKeyName = tcrn_wrapper . lookupKnownKeyName
    552 
    +
    532 553 
     tcLookupKnownKeyGlobal :: HasDebugCallStack => KnownKey -> TcM TyThing
    533 
    -tcLookupKnownKeyGlobal uniq
    534 
    -  = do { kk_source <- getKnownKeySource
    535 
    -       ; traceTc "tcLookupKnownKeyGlobal" (ppr kk_source)
    536 
    -       ; mb_thing <- initIfaceTcRn (lookupKnownKeyThing kk_source uniq)
    537 
    -       ; case mb_thing of
    538 
    -           Succeeded thing -> return thing
    539 
    -           Failed msg      -> failWithTc (TcRnInterfaceError msg) }
    554 
    +tcLookupKnownKeyGlobal = tcrn_wrapper . lookupKnownKeyThing
    540 555
    541 556 
     tcLookupKnownKeyClass :: HasDebugCallStack => KnownKey -> TcM Class
    542 
    -tcLookupKnownKeyClass uniq
    543 
    -  = do { thing <- tcLookupKnownKeyGlobal uniq
    557 
    +tcLookupKnownKeyClass = get_class . tcLookupKnownKeyGlobal
    558 
    +
    559 
    +tcLookupKnownKeyTyCon :: HasDebugCallStack => KnownKey -> TcM TyCon
    560 
    +tcLookupKnownKeyTyCon = get_tycon . tcLookupKnownKeyGlobal
    561 
    +
    562 
    +tcLookupKnownKeyId :: HasDebugCallStack => KnownKey -> TcM Id
    563 
    +tcLookupKnownKeyId = get_id . tcLookupKnownKeyGlobal
    564 
    +
    565 
    +------------------------------------------------------
    566 
    +-- Known-occ functions
    567 
    +
    568 
    +tcLookupKnownOccGlobal :: HasDebugCallStack => KnownOcc -> TcM TyThing
    569 
    +tcLookupKnownOccGlobal = tcrn_wrapper . lookupKnownOccThing
    570 
    +
    571 
    +tcLookupKnownOccTyCon :: HasDebugCallStack => KnownOcc -> TcM TyCon
    572 
    +tcLookupKnownOccTyCon = get_tycon . tcLookupKnownOccGlobal
    573 
    +
    574 
    +tcLookupKnownOccId :: HasDebugCallStack => KnownOcc -> TcM Id
    575 
    +tcLookupKnownOccId = get_id . tcLookupKnownOccGlobal
    576 
    +
    577 
    +-------------------------------------------------------
    578 
    +get_class :: TcRn TyThing -> TcRn Class
    579 
    +get_class do_the_lookup
    580 
    +  = do { thing <- do_the_lookup
    544 581 
            ; case thing of
    545 582 
                ATyCon tc | Just cls <- tyConClass_maybe tc
    546 583 
                          -> return cls
    547 584 
                _  -> wrongThingErr WrongThingClass (AGlobal thing) (getName thing) }
    548 585
    549 
    -tcLookupKnownKeyTyCon :: HasDebugCallStack => KnownKey -> TcM TyCon
    550 
    -tcLookupKnownKeyTyCon uniq
    551 
    -  = do { thing <- tcLookupKnownKeyGlobal uniq
    586 
    +get_tycon :: TcRn TyThing -> TcRn TyCon
    587 
    +get_tycon do_the_lookup
    588 
    +  = do { thing <- do_the_lookup
    552 589 
            ; case thing of
    553 590 
                ATyCon tc -> return tc
    554 591 
                _  -> wrongThingErr WrongThingClass (AGlobal thing) (getName thing) }
    555 592
    556 
    -tcLookupKnownKeyId :: HasDebugCallStack => KnownKey -> TcM Id
    557 
    -tcLookupKnownKeyId uniq
    558 
    -  = do { thing <- tcLookupKnownKeyGlobal uniq
    593 
    +get_id :: TcRn TyThing -> TcRn Id
    594 
    +get_id do_the_lookup
    595 
    +  = do { thing <- do_the_lookup
    559 596 
            ; case thing of
    560 597 
                AnId id -> return id
    561 598 
                _  -> wrongThingErr WrongThingClass (AGlobal thing) (getName thing) }
    ... ... @@ -1018,18 +1055,6 @@ tcExtendRules lcl_rules thing_inside
    1018 1055 
     ************************************************************************
    1019 1056 
     -}
    1020 1057
    1021 
    -tcMetaKnownKeyTy :: HasDebugCallStack => Unique -> TcM Type
    1022 
    -tcMetaKnownKeyTy uniq
    1023 
    -  = do { tc <- tcLookupKnownKeyTyCon uniq
    1024 
    -       ; return (mkTyConTy tc) }
    1025 
    -
    1026 
    -tcMetaTy :: Name -> TcM Type
    1027 
    --- Given the name of a Template Haskell data type,
    1028 
    --- return the type
    1029 
    --- E.g. given the name "Expr" return the type "Expr"
    1030 
    -tcMetaTy tc_name
    1031 
    -  = do { t <- tcLookupTyCon tc_name
    1032 
    -       ; return (mkTyConTy t) }
    1033 1058
    1034 1059 
     isBrackLevel :: ThLevel -> Bool
    1035 1060 
     isBrackLevel (Brack {}) = True
    ... ... @@ -1091,13 +1116,14 @@ tcGetDefaultTys
    1091 1116 
                   -- Not one of the built-in units
    1092 1117 
                   -- @default Num (Integer, Double)@, plus extensions
    1093 1118 
                   { extDef <- if extended_defaults
    1094 
    -                          then do { list_ty <- tcMetaTy listTyConName
    1095 
    -                                  ; integer_ty <- tcMetaTy integerTyConName
    1119 
    +                          then do { list_tc       <- tcLookupKnownKeyTyCon listTyConKey
    1120 
    +                                  ; integer_tc    <- tcLookupKnownKeyTyCon integerTyConKey
    1096 1121 
                                       ; foldableClass <- tcLookupKnownKeyClass foldableClassKey
    1097 
    -                                  ; showClass <- tcLookupKnownKeyClass showClassKey
    1098 
    -                                  ; eqClass <- tcLookupKnownKeyClass eqClassKey
    1122 
    +                                  ; showClass     <- tcLookupKnownKeyClass showClassKey
    1123 
    +                                  ; eqClass       <- tcLookupKnownKeyClass eqClassKey
    1124 
    +                                  ; let integer_ty = mkTyConTy integer_tc
    1099 1125 
                                       ; pure $ defaultEnv
    1100 
    -                                    [ builtinDefaults foldableClass [list_ty]
    1126 
    +                                    [ builtinDefaults foldableClass [mkTyConTy list_tc]
    1101 1127 
                                         , builtinDefaults showClass [unitTy, integer_ty, doubleTy]
    1102 1128 
                                         , builtinDefaults eqClass [unitTy, integer_ty, doubleTy]
    1103 1129 
                                         ]
    ... ... @@ -1111,10 +1137,10 @@ tcGetDefaultTys
    1111 1137 
                               else pure emptyDefaultEnv
    1112 1138 
                   ; checkWiredInTyCon doubleTyCon
    1113 1139 
                   ; numDef <- case lookupDefaultEnv_Directly user_defaults numClassKey of
    1114 
    -                   Nothing -> do { integer_ty <- tcMetaTy integerTyConName
    1140 
    +                   Nothing -> do { integer_tc <- tcLookupKnownKeyTyCon integerTyConKey
    1115 1141 
                                      ; numClass   <- tcLookupKnownKeyClass numClassKey
    1116 1142 
                                      ; pure $ unitDefaultEnv $
    1117 
    -                                   builtinDefaults numClass [integer_ty, doubleTy] }
    1143 
    +                                   builtinDefaults numClass [mkTyConTy integer_tc, doubleTy] }
    1118 1144
    1119 1145 
                        _ -> -- The Num class is already user-defaulted, so
    1120 1146 
                             -- no need to construct the builtin default

  • compiler/GHC/Tc/Utils/Instantiate.hs
    ... ... @@ -40,8 +40,7 @@ import GHC.Prelude
    40 40 
     import GHC.Driver.Session
    41 41 
     import GHC.Driver.Env
    42 42
    43 
    -import GHC.Builtin.Types  ( integerTyConName )
    44 
    -import GHC.Builtin.Names
    43 
    +import GHC.Builtin.Names( integerTyConOcc, rationalTyConOcc )
    45 44
    46 45 
     import GHC.Hs
    47 46 
     import GHC.Hs.Syn.Type   ( hsLitType )
    ... ... @@ -786,11 +785,11 @@ newNonTrivialOverloadedLit
    786 785 
     ------------
    787 786 
     mkOverLit :: OverLitVal -> TcM (HsLit GhcTc)
    788 787 
     mkOverLit (HsIntegral i)
    789 
    -  = do  { integer_ty <- tcMetaTy integerTyConName
    788 
    +  = do  { integer_ty <- tcMetaKnownOccTy integerTyConOcc
    790 789 
             ; return (XLit $ HsInteger  (il_text i) (il_value i) integer_ty) }
    791 790
    792 791 
     mkOverLit (HsFractional r)
    793 
    -  = do  { rat_ty <- tcMetaKnownKeyTy rationalTyConKey
    792 
    +  = do  { rat_ty <- tcMetaKnownOccTy rationalTyConOcc
    794 793 
             ; return (XLit $ HsRat r rat_ty) }
    795 794
    796 795 
     mkOverLit (HsIsString src s) = return (HsString src s)

  • libraries/base/src/Control/Applicative.hs
    ... ... @@ -52,6 +52,8 @@ module Control.Applicative (
    52 52 
         thenA,
    53 53 
         ) where
    54 54
    55 
    +
    56 
    +import GHC.Internal.Base
    55 57 
     import GHC.Internal.Control.Category hiding ((.), id)
    56 58 
     import GHC.Internal.Control.Arrow
    57 59 
     import GHC.Internal.Data.Maybe
    ... ... @@ -62,12 +64,7 @@ import GHC.Internal.Data.Functor.Const (Const(..))
    62 64 
     import GHC.Internal.Data.Typeable (Typeable)
    63 65 
     import GHC.Internal.Data.Data (Data)
    64 66
    65 
    -import GHC.Internal.Base (
    66 
    -    Alternative(..), Applicative(..), Functor(..), Monad(..), MonadPlus(..),
    67 
    -    ap, const, liftA, liftA3, liftM, liftM2, thenA, (.), (<**>),
    68 
    -  )
    69 67 
     import GHC.Internal.Functor.ZipList (ZipList(..))
    70 
    -import GHC.Internal.Types
    71 68 
     import GHC.Generics
    72 69 
     import GHC.Internal.Num( Num ) -- For -frebindable-known-key-names (defaulting)
    73 70

  • libraries/base/src/Data/Fixed.hs
    ... ... @@ -86,6 +86,8 @@ module Data.Fixed
    86 86 
         divMod'
    87 87 
     ) where
    88 88
    89 
    +import Prelude
    90 
    +import GHC.KnownKeyNames
    89 91 
     import GHC.Internal.Data.Data
    90 92 
     import GHC.Internal.TypeLits (KnownNat, natVal)
    91 93 
     import GHC.Internal.Read
    ... ... @@ -94,7 +96,6 @@ import GHC.Internal.Text.Read.Lex
    94 96 
     import qualified GHC.Internal.TH.Monad as TH
    95 97 
     import qualified GHC.Internal.TH.Lift as TH
    96 98 
     import Data.Typeable
    97 
    -import Prelude
    98 99
    99 100 
     -- $setup
    100 101 
     -- >>> import Prelude

  • libraries/base/src/GHC/KnownKeyNames.hs
    ... ... @@ -20,13 +20,17 @@ module GHC.KnownKeyNames
    20 20 
         , Foldable, Traversable
    21 21 
         , Functor, fmap
    22 22 
         , Monad, (>>), (>>=), return, fail, guard, mfix, join
    23 
    -    , Applicative, pure, mzip, (<*>)
    24 23 
         , Alternative
    25 
    -    , Semigroup, Monoid
    26 
    -    , (<>), mappend
    27 24
    28 25 
         -- Misc
    29 
    -    , (.), (&&), not
    26 
    +    , (.), (&&), not, map, foldr, build
    27 
    +
    28 
    +    -- Applicative
    29 
    +    , Applicative, pure, mzip, (<*>), (*>)
    30 
    +
    31 
    +    -- Semigroup, Monoid
    32 
    +    , Semigroup, Monoid
    33 
    +    , (<>), mappend, mempty
    30 34
    31 35 
         -- Enum
    32 36 
         , Enum
    ... ... @@ -72,6 +76,8 @@ module GHC.KnownKeyNames
    72 76 
         -- Records and lists
    73 77 
         , HasField
    74 78 
         , fromLabel, getField
    79 
    +
    80 
    +    -- Overloaded lists
    75 81 
         , IL.fromList, IL.fromListN, IL.toList
    76 82
    77 83 
         -- Arrows
    ... ... @@ -80,6 +86,9 @@ module GHC.KnownKeyNames
    80 86 
         -- IO
    81 87 
         , thenIO, bindIO, returnIO, print
    82 88
    89 
    +    -- Unsatisfiable
    90 
    +    , Unsatisfiable, unsatisfiable
    91 
    +
    83 92 
         -- Static pointers
    84 93 
         , IsStatic( fromStaticPtr ), makeStatic
    85 94
    ... ... @@ -104,9 +113,30 @@ module GHC.KnownKeyNames
    104 113 
         , integerMod, integerDivMod#, integerQuotRem#, integerEncodeFloat#, integerEncodeDouble#
    105 114 
         , integerGcd, integerLcm, integerAnd, integerOr, integerXor
    106 115 
         , integerComplement, integerBit#, integerTestBit#, integerShiftL#, integerShiftR#
    116 
    +
    117 
    +    -- Template Haskell
    118 
    +    , Q, Name, FieldExp, Dec, Decs, TH.Type, FunDep
    119 
    +    , Pred, Code, InjectivityAnn, Overlap, ModName, QuasiQuoter
    120 
    +    , sequenceQ, newName, mkName, mkNameG_v, mkNameG_d, mkNameG_tc, mkNameG_fld, mkNameL
    121 
    +    , mkNameQ, mkNameS, mkModName, unType, unTypeCode, unsafeCodeCoerce
    122 
    +    , liftString, liftTyped
    123 
    +    , Lit, charL, stringL, integerL, intPrimL, wordPrimL, floatPrimL
    124 
    +         , doublePrimL, rationalL, stringPrimL, charPrimL
    125 
    +    , Pat, litP, varP, tupP, unboxedTupP, unboxedSumP, conP, infixP, tildeP
    126 
    +         , bangP, asP, wildP, recP, listP, sigP, viewP, orP, typeP, invisP
    127 
    +    , Exp, varE, conE, litE, appE, appTypeE, infixE, infixApp, sectionL, sectionR
    128 
    +         , lamE, lamCaseE, lamCasesE, tupE, unboxedTupE, unboxedSumE, condE
    129 
    +         , multiIfE, letE, caseE, doE, mdoE, compE, fromE, fromThenE, fromToE, fromThenToE
    130 
    +         , listE, sigE, recConE, recUpdE, staticE, unboundVarE, labelE, implicitParamVarE
    131 
    +         , getFieldE, projectionE, typeE, forallE, forallVisE, constrainedE
    132 
    +    , FieldPat, fieldPat
    133 
    +    , Match, match
    134 
    +    , Clause, clause
    107 135 
         ) where
    108 136
    109 
    -import Prelude
    137 
    +import GHC.Internal.Show
    138 
    +import GHC.Internal.Num
    139 
    +import GHC.Internal.Real
    110 140 
     import Data.String( IsString )
    111 141 
     import GHC.Internal.Base
    112 142 
     import GHC.Internal.Ix
    ... ... @@ -114,14 +144,18 @@ import GHC.Internal.Magic( inline )
    114 144 
     import GHC.Internal.Enum
    115 145 
     import GHC.Internal.Data.Data
    116 146 
     import GHC.Internal.Data.String( fromString )
    147 
    +import GHC.Internal.Data.Foldable( Foldable )
    148 
    +import GHC.Internal.Data.Traversable( Traversable )
    117 149 
     import GHC.Internal.Real( mkRationalBase2, mkRationalBase10 )
    118 
    -import GHC.Internal.Control.Monad( guard )
    150 
    +import GHC.Internal.Control.Monad( fail, guard )
    119 151 
     import GHC.Internal.Control.Monad.Fix( mfix, loop )
    120 152 
     import GHC.Internal.Control.Monad.Zip( mzip )
    121 153 
     import GHC.Internal.Control.Arrow( arr, (>>>), first, app, (|||) )
    122 154 
     import GHC.Internal.OverloadedLabels( fromLabel )
    123 155 
     import GHC.Internal.Records( HasField, getField )
    124 156 
     import GHC.Internal.CString as CS
    157 
    +import GHC.Internal.TypeError( Unsatisfiable, unsatisfiable )
    158 
    +import GHC.Internal.System.IO( print )
    125 159 
     import qualified GHC.Internal.IsList as IL
    126 160
    127 161 
     import GHC.Internal.Unsafe.Coerce( UnsafeEquality(..), unsafeEqualityProof )
    ... ... @@ -132,6 +166,9 @@ import GHC.Internal.StaticPtr.Internal( makeStatic )
    132 166 
     import GHC.Internal.Data.Typeable( Typeable, gcast1, gcast2 )
    133 167 
     import GHC.Internal.Generics
    134 168
    135 
    -import GHC.Internal.Bignum.Integer
    136 
    -import GHC.Internal.Bignum.Natural
    137 169 
     import GHC.Internal.Bignum.BigNat
    170 
    +
    171 
    +import GHC.Internal.TH.Syntax as TH
    172 
    +import GHC.Internal.TH.Lib hiding( InjectivityAnn, Role )
    173 
    +import GHC.Internal.TH.Lift
    174 
    +import GHC.Internal.TH.Monad

  • libraries/base/src/GHC/RTS/Flags.hs
    ... ... @@ -56,6 +56,7 @@ module GHC.RTS.Flags
    56 56 
       ) where
    57 57
    58 58 
     import Prelude (Show,IO,Bool,Maybe,String,Int,Enum,FilePath,Double,Eq,(<$>))
    59 
    +import GHC.KnownKeyNames
    59 60
    60 61 
     import GHC.Generics (Generic)
    61 62 
     import qualified GHC.Internal.RTS.Flags as Internal

  • libraries/base/src/GHC/Stats.hs
    ... ... @@ -37,7 +37,7 @@ module GHC.Stats
    37 37
    38 38
    39 39 
     import Prelude (Bool,IO,Read,Show,(<$>))
    40 
    -import Prelude (Num) -- For -frebindable-known-key-names (defaulting)
    40 
    +import GHC.KnownKeyNames -- For -frebindable-known-key-names (defaulting)
    41 41
    42 42 
     import qualified GHC.Internal.Stats as Internal
    43 43 
     import GHC.Generics (Generic)

  • libraries/base/src/System/Console/GetOpt.hs
    ... ... @@ -62,7 +62,8 @@ module System.Console.GetOpt (
    62 62 
        -- $example2
    63 63 
     ) where
    64 64
    65 
    -import Prelude
    65 
    +import Prelude hiding( foldr )
    66 
    +import GHC.KnownKeyNames
    66 67 
     import GHC.Internal.Data.List ( isPrefixOf, find )
    67 68
    68 69 
     -- |What to do with options following non-options

  • libraries/base/src/System/Info.hs
    ... ... @@ -27,6 +27,7 @@ module System.Info
    27 27 
       ) where
    28 28
    29 29 
     import GHC.Internal.Data.Version (Version (..))
    30 
    +import GHC.KnownKeyNames
    30 31 
     import Prelude
    31 32
    32 33 
     -- | The version of 'compilerName' with which the program was compiled

  • libraries/base/src/Text/Printf.hs
    ... ... @@ -93,7 +93,9 @@ module Text.Printf(
    93 93 
     ) where
    94 94
    95 95 
     import Prelude
    96 
    +import GHC.KnownKeyNames( build )
    96 97 
     import Data.Char
    98 
    +
    97 99 
     import GHC.Internal.Int
    98 100 
     import GHC.Internal.Data.List (stripPrefix)
    99 101 
     import GHC.Internal.Word
    ... ... @@ -484,7 +486,7 @@ intModifierMap = [
    484 486
    485 487 
     parseIntFormat :: a -> String -> FormatParse
    486 488 
     parseIntFormat _ s =
    487 
    -  case foldr matchPrefix Nothing intModifierMap of
    489 
    +  case Prelude.foldr matchPrefix Nothing intModifierMap of
    488 490 
         Just m -> m
    489 491 
         Nothing ->
    490 492 
           case s of

  • libraries/ghc-internal/src/GHC/Internal/Base.hs
    ... ... @@ -438,6 +438,7 @@ W4:
    438 438 
       The derived Lift instance references various identifiers in
    439 439 
       GHC.Internal.TH.Lib, so it is an import of GHC.Internal.TH.Lift.
    440 440
    441 
    +** TODO: Fix me when the reinstallable base stuff has settled **
    441 442
    442 443 
     W5:
    443 444 
       If no explicit "default" declaration is present, the assumed

  • libraries/ghc-internal/src/GHC/Internal/IsList.hs
    ... ... @@ -2,9 +2,8 @@
    2 2 
     {-# LANGUAGE NoImplicitPrelude #-}
    3 3 
     {-# LANGUAGE TypeFamilies #-}
    4 4
    5 
    --- We need known-key names fromList, fromListN, toList, but
    6 
    --- alas class Foldable also has a method toList.
    7 
    --- So we export proxies from GHC.KnownKeyNames
    5 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    6 
    +    -- Defines toList, fromList etc
    8 7
    9 8 
     -----------------------------------------------------------------------------
    10 9 
     -- |

  • libraries/ghc-internal/src/GHC/Internal/StaticPtr/Internal.hs
    ... ... @@ -14,6 +14,10 @@
    14 14 
     -- which otherwise would bias GHC to conclude that any code using
    15 15 
     -- the static form would fail.
    16 16 
     {-# OPTIONS_GHC -fomit-interface-pragmas #-}
    17 
    +
    18 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    19 
    +    -- Defines makeStatic
    20 
    +
    17 21 
     module GHC.Internal.StaticPtr.Internal (makeStatic) where
    18 22
    19 23 
     import GHC.Internal.Base (($), (++))

  • libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
    ... ... @@ -33,6 +33,7 @@ import GHC.Internal.Base hiding( Type )
    33 33 
     import GHC.Internal.TH.Syntax
    34 34 
     import GHC.Internal.TH.Monad
    35 35 
     import qualified GHC.Internal.TH.Lib as Lib (litE)
    36 
    +import GHC.Internal.TH.Lib( appE ) -- For known-key names
    36 37 
         -- See wrinkle (W4) of Note [Tracking dependencies on primitives]
    37 38 
     import GHC.Internal.Base( Monad ) -- Needed for known-key lookup
    38 39

  • libraries/ghc-internal/src/GHC/Internal/Unicode/Version.hs
    1 1 
     -- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell.
    2 2
    3 3 
     {-# LANGUAGE NoImplicitPrelude #-}
    4 
    +{-# LANGUAGE Trustworthy #-}   -- ToDo: this isn't right
    4 5 
     {-# OPTIONS_HADDOCK hide #-}
    5 6
    6 7 
     -----------------------------------------------------------------------------

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help