Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC

Commits:

6 changed files:

Changes:

  • compiler/GHC/Builtin.hs
    ... ... @@ -26,15 +26,11 @@ module GHC.Builtin (
    26 26 
             knownKeyTable, knownKeyOccMap, knownKeyUniqMap,
    27 27 
             knownKeyOccName, knownKeyOccName_maybe,
    28 28
    29 
    -        -- * Known-occ names
    30 
    -        oldIsKnownKeyName,
    31 
    -        oldLookupKnownKeyName,
    32 
    -        oldLookupKnownNameInfo,
    33 
    -
    34 29 
             -- * Random other things
    35 30 
             maybeCharLikeCon, maybeIntLikeCon,
    36 31 
             allNameStrings, allNameStringList,
    37 32 
             itName, mkUnboundName, isUnboundName,
    33 
    +        lookupKnownNameInfo,
    38 34
    39 35 
             -- * Class categories
    40 36 
             isNumericClass, isStandardClass,
    ... ... @@ -46,7 +42,6 @@ module GHC.Builtin (
    46 42 
     import GHC.Prelude
    47 43
    48 44
    49 
    -import GHC.Builtin.Uniques
    50 45 
     import GHC.Builtin.PrimOps
    51 46 
     import GHC.Builtin.PrimOps.Ids
    52 47 
     import GHC.Builtin.WiredIn.Types
    ... ... @@ -77,10 +72,6 @@ import GHC.Data.List.SetOps
    77 72 
     import GHC.Data.FastString
    78 73 
     import qualified GHC.Data.List.Infinite as Inf
    79 74
    80 
    -import Control.Applicative ((<|>))
    81 
    -import Data.Maybe
    82 
    -
    83 
    -
    84 75
    85 76 
     {- *********************************************************************
    86 77 
     *                                                                      *
    ... ... @@ -579,17 +570,11 @@ wiredInNames
    579 570 
                             Nothing -> []
    580 571
    581 572 
     -- | Check the known-key names list of consistency.
    582 
    --- (a) Unique is in-range (ToDo: get rid of this)
    583 
    --- (b) Distinct uniques
    573 
    +-- (a) Distinct uniques
    584 574 
     knownKeyNamesOkay :: [Name] -> Maybe SDoc
    585 575 
     knownKeyNamesOkay all_names
    586 
    -  | ns@(_:_) <- filter (not . isValidKnownKeyUnique . getUnique) all_names
    587 
    -  = Just $ text "    Out-of-range known-key uniques: " <>
    588 
    -           brackets (pprWithCommas (ppr . nameOccName) ns)
    589 
    -  | null badNamesPairs
    590 
    -  = Nothing
    591 
    -  | otherwise
    592 
    -  = Just badNamesDoc
    576 
    +  | null badNamesPairs = Nothing
    577 
    +  | otherwise = Just badNamesDoc
    593 578 
       where
    594 579 
         namesEnv      = foldl' (\m n -> extendNameEnv_Acc (:) Utils.singleton m n n)
    595 580 
                                emptyUFM all_names
    ... ... @@ -606,42 +591,18 @@ knownKeyNamesOkay all_names
    606 591 
                                text ": " <>
    607 592 
                                brackets (pprWithCommas (ppr . nameOccName) ns)
    608 593
    609 
    ----------------  ToDo: get rid of these old-mechanism functions
    610 
    ----------------        when we complete the known-key tranitition
    611 
    ---------------   See #27013
    612 
    -
    613 
    --- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
    614 
    --- known-key thing.
    615 
    -oldLookupKnownKeyName :: Unique -> Maybe Name
    616 
    -oldLookupKnownKeyName u =
    617 
    -    knownUniqueName u <|> lookupUFM_Directly oldKnownKeysMap u
    618 
    -
    619 
    --- TODO: remove this once all knownkey names come from providers
    620 
    --- | Is a 'Name' known-key?
    621 
    -oldIsKnownKeyName :: Name -> Bool
    622 
    -oldIsKnownKeyName n =
    623 
    -    isJust (knownUniqueName $ nameUnique n) || elemUFM n oldKnownKeysMap
    624 
    -
    625 
    --- | Maps 'Unique's to known-key names.
    626 
    ---
    627 
    --- The type is @UniqFM Name Name@ to denote that the 'Unique's used
    628 
    --- in the domain are 'Unique's associated with 'Name's (as opposed
    629 
    --- to some other namespace of 'Unique's).
    630 
    -oldKnownKeysMap :: UniqFM Name Name
    631 
    -oldKnownKeysMap = listToIdentityUFM wiredInNames
    632 
    -
    633 594 
     -- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by
    634 595 
     -- GHCi's ':info' command.
    635 
    -oldLookupKnownNameInfo :: Name -> SDoc
    636 
    -oldLookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of
    596 
    +lookupKnownNameInfo :: Name -> SDoc
    597 
    +lookupKnownNameInfo name = case lookupUFM knownNamesInfo (getUnique name) of
    637 598 
         -- If we do find a doc, we add comment delimiters to make the output
    638 599 
         -- of ':info' valid Haskell.
    639 600 
         Nothing  -> empty
    640 601 
         Just doc -> vcat [text "{-", doc, text "-}"]
    641 602
    642 603 
     -- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390)
    643 
    -knownNamesInfo :: NameEnv SDoc
    644 
    -knownNamesInfo = unitNameEnv coercibleTyConName $
    604 
    +knownNamesInfo :: UniqFM KnownKey SDoc
    605 
    +knownNamesInfo = unitUFM coercibleTyConKey $
    645 606 
         vcat [ text "Coercible is a special constraint with custom solving rules."
    646 607 
              , text "It is not a class."
    647 608 
              , text "Please see section `The Coercible constraint`"

  • compiler/GHC/Builtin/KnownKeys.hs
    ... ... @@ -63,8 +63,6 @@ import GHC.Prelude
    63 63
    64 64 
     import GHC.Builtin.Uniques
    65 65
    66 
    -import GHC.Unit.Types
    67 
    -
    68 66 
     import GHC.Types.Name.Occurrence
    69 67 
     import GHC.Types.Name.Reader
    70 68 
     import GHC.Types.Unique
    ... ... @@ -73,8 +71,6 @@ import GHC.Types.Name
    73 71
    74 72 
     import GHC.Utils.Misc( HasDebugCallStack )
    75 73 
     import GHC.Utils.Panic
    76 
    -
    77 
    -import GHC.Data.FastString
    78 74 
     import GHC.Data.Maybe
    79 75
    80 76
    ... ... @@ -150,6 +146,7 @@ knownKeyTable
    150 146 
         , (mkTcOcc "Num",               numClassKey)
    151 147 
         , (mkTcOcc "Integral",          integralClassKey)
    152 148 
         , (mkTcOcc "Real",              realClassKey)
    149 
    +    , (mkTcOcc "Floating",          floatingClassKey)
    153 150 
         , (mkTcOcc "Fractional",        fractionalClassKey)
    154 151 
         , (mkTcOcc "RealFloat",         realFloatClassKey)
    155 152 
         , (mkTcOcc "RealFrac",          realFracClassKey)
    ... ... @@ -356,50 +353,18 @@ knownKeyTable
    356 353 
     *                                                                      *
    357 354 
     ************************************************************************
    358 355
    359 
    -Many of these Names are not really "built in", but some parts of the
    360 
    -compiler (notably the deriving mechanism) need to mention their names,
    361 
    -and it's convenient to write them all down in one place.
    356 
    +See Note [Overview of known entities]
    362 357 
     -}
    363 358
    364 
    -wildCardName :: Name
    365 
    -wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
    366 
    -
    367 359 
     -- AMP additions
    368 360 
     pureAClassOpKey, thenAClassOpKey, alternativeClassKey :: KnownKey
    369 361 
     pureAClassOpKey     = mkPreludeMiscIdUnique 752
    370 362 
     thenAClassOpKey     = mkPreludeMiscIdUnique 753
    371 363 
     alternativeClassKey = mkPreludeMiscIdUnique 754
    372 364
    373 
    ----------------------------------
    374 
    --- End of ghc-bignum
    375 
    ----------------------------------
    376 
    -
    377 
    --- WithDict
    378 
    -
    379 365 
     genericClassKeys :: [KnownKey]
    380 366 
     genericClassKeys = [genClassKey, gen1ClassKey]
    381 367
    382 
    -{-
    383 
    -************************************************************************
    384 
    -*                                                                      *
    385 
    -\subsection{Local helpers}
    386 
    -*                                                                      *
    387 
    -************************************************************************
    388 
    -
    389 
    -All these are original names; hence mkOrig
    390 
    --}
    391 
    -
    392 
    -{-# INLINE varQual #-}
    393 
    -{-# INLINE tcQual #-}
    394 
    -{-# INLINE clsQual #-}
    395 
    -{-# INLINE dcQual #-}
    396 
    -varQual, tcQual, clsQual, dcQual :: Module -> FastString -> Unique -> Name
    397 
    -varQual  modu str unique = mk_known_key_name varName modu str unique
    398 
    -tcQual   modu str unique = mk_known_key_name tcName modu str unique
    399 
    -clsQual  modu str unique = mk_known_key_name clsName modu str unique
    400 
    -dcQual   modu str unique = mk_known_key_name dataName modu str unique
    401 
    -
    402 
    -
    403 368 
     {- *********************************************************************
    404 369 
     *                                                                      *
    405 370 
                      Statically-known occurrence names
    ... ... @@ -413,6 +378,8 @@ pureAClassOpOcc = mkVarOcc "pure"
    413 378 
     returnMClassOpOcc  = mkVarOcc "return"
    414 379 
     thenMClassOpOcc    = mkVarOcc ">>"
    415 380 
     bindMClassOpOcc    = mkVarOcc ">>="
    381 
    +  -- ROMES:TODO: bindMClassOpOcc does not have a Known Names Table Entry. What
    382 
    +  -- happens to all these occs needed for Quote? Should we make them just KnownOcc?
    416 383 
     thenAClassOpOcc    = mkVarOcc "*>"
    417 384 
     mappendClassOpOcc  = mkVarOcc "mappend"
    418 385 
     getFieldClassOpOcc = mkVarOcc "getField"

  • compiler/GHC/Core/Make.hs
    ... ... @@ -190,6 +190,9 @@ mkWildValBinder w ty = mkLocalIdOrCoVar wildCardName w ty
    190 190 
       -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors
    191 191 
       -- (e.g. see test T15695). Ticket #17291 covers fixing this problem.
    192 192
    193 
    +wildCardName :: Name
    194 
    +wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
    195 
    +
    193 196 
     -- | Make a case expression whose case binder is unused
    194 197 
     -- The alts and res_ty should not have any occurrences of WildId
    195 198 
     mkWildCase :: CoreExpr -- ^ scrutinee

  • compiler/GHC/Iface/Binary.hs
    ... ... @@ -32,14 +32,13 @@ module GHC.Iface.Binary (
    32 32
    33 33 
     import GHC.Prelude
    34 34
    35 
    -import GHC.Builtin   ( knownKeyOccMap, oldIsKnownKeyName, oldLookupKnownKeyName )
    35 
    +import GHC.Builtin   ( knownKeyOccMap )
    36 36 
     import GHC.Utils.Panic
    37 37 
     import GHC.Utils.Binary as Binary
    38 38 
     import GHC.Utils.Outputable
    39 39
    40 40 
     import GHC.Types.Name
    41 41 
     import GHC.Types.Unique.FM
    42 
    -import GHC.Types.Unique
    43 42 
     import GHC.Types.SrcLoc
    44 43 
     import GHC.Types.Name.Cache
    45 44
    ... ... @@ -58,7 +57,6 @@ import Control.Monad
    58 57 
     import Data.Array
    59 58 
     import Data.Array.IO
    60 59 
     import Data.Array.Unsafe
    61 
    -import Data.Char
    62 60 
     import Data.IORef
    63 61 
     import Data.Map.Strict (Map)
    64 62 
     import Data.Word
    ... ... @@ -703,42 +701,11 @@ getSymbolTable bh name_cache
    703 701 
                     ; writeArray mut_arr (fromIntegral i) name
    704 702 
                     ; return new_cache }
    705 703
    706 
    --- ROMES:TODO: KILL THIS from here to the end.
    707 
    --- We no longer put uniques for known-occ names anymore, they'll be looked up
    708 
    --- in the table.
    709 
    --- No uniques in interface files!
    710 
    -
    711 
    -
    712 
    --- Note [Symbol table representation of names]
    713 
    --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    714 
    --- An occurrence of a name in an interface file is serialized as a single 32-bit
    715 
    --- word. The format of this word is:
    716 
    ---  00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
    717 
    ---   A normal name. x is an index into the symbol table
    718 
    ---  10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy
    719 
    ---   A known-key name. x is the Unique's Char, y is the int part. We assume that
    720 
    ---   all known-key uniques fit in this space. This is asserted by
    721 
    ---   GHC.Builtin.knownKeyNamesOkay.
    722 
    ---
    723 
    --- During serialization we check for known-key things using oldIsKnownKeyName.
    724 
    --- During deserialization we use lookupKnownKeyName to get from the unique back
    725 
    --- to its corresponding Name.
    726 
    -
    727 
    -
    728 
    --- See Note [Symbol table representation of names]
    729 704 
     putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO ()
    730 705 
     putName BinSymbolTable{
    731 706 
                    bin_symtab_map = symtab_map_ref,
    732 707 
                    bin_symtab_next = symtab_next }
    733 708 
             bh name
    734 
    -  | oldIsKnownKeyName name
    735 
    -  , let (c, u) = unpkUniqueGrimly (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
    736 
    -  = -- assert (u < 2^(22 :: Int))
    737 
    -    put_ bh (0x80000000
    738 
    -             .|. (fromIntegral (ord c) `shiftL` 22)
    739 
    -             .|. (fromIntegral u :: Word32))
    740 
    -
    741 
    -  | otherwise
    742 709 
       = do symtab_map <- readIORef symtab_map_ref
    743 710 
            case lookupUFM symtab_map name of
    744 711 
              Just (off,_) -> put_ bh (fromIntegral off :: Word32)
    ... ... @@ -750,23 +717,8 @@ putName BinSymbolTable{
    750 717 
                     $! addToUFM symtab_map name (off,name)
    751 718 
                 put_ bh (fromIntegral off :: Word32)
    752 719
    753 
    --- See Note [Symbol table representation of names]
    754 720 
     getSymtabName :: SymbolTable Name
    755 721 
                   -> ReadBinHandle -> IO Name
    756 722 
     getSymtabName symtab bh = do
    757 723 
         i :: Word32 <- get bh
    758 
    -    case i .&. 0xC0000000 of
    759 
    -      0x00000000 -> return $! symtab ! fromIntegral i
    760 
    -
    761 
    -      0x80000000 ->
    762 
    -        let
    763 
    -          tag = chr (fromIntegral ((i .&. 0x3FC00000) `shiftR` 22))
    764 
    -          ix  = fromIntegral i .&. 0x003FFFFF
    765 
    -          u   = mkUniqueGrimilyWithTag tag ix
    766 
    -        in
    767 
    -          return $! case oldLookupKnownKeyName u of
    768 
    -                      Nothing -> pprPanic "getSymtabName:unknown known-key unique"
    769 
    -                                          (ppr i $$ ppr u $$ char tag $$ ppr ix)
    770 
    -                      Just n  -> n
    771 
    -
    772 
    -      _ -> pprPanic "getSymtabName:unknown name tag" (ppr i)
    724 
    +    return $! symtab ! fromIntegral i

  • compiler/GHC/Tc/Gen/HsType.hs
    ... ... @@ -105,7 +105,7 @@ import GHC.Core.TyCo.Rep
    105 105 
     import GHC.Core.TyCo.Ppr
    106 106
    107 107 
     import GHC.Builtin( allNameStrings )
    108 
    -import GHC.Builtin.KnownKeys hiding ( wildCardName )
    108 
    +import GHC.Builtin.KnownKeys
    109 109 
     import GHC.Builtin.WiredIn.Types
    110 110 
     import GHC.Builtin.WiredIn.Prim
    111 111

  • compiler/GHC/Tc/Module.hs
    ... ... @@ -2989,7 +2989,7 @@ tcRnGetInfo hsc_env name
    2989 2989 
            ; thing  <- tcRnLookupName' name
    2990 2990 
            ; fixity <- lookupFixityRn name
    2991 2991 
            ; (cls_insts, fam_insts) <- lookupInsts thing
    2992 
    -       ; let info = oldLookupKnownNameInfo name
    2992 
    +       ; let info = lookupKnownNameInfo name
    2993 2993 
            ; return (thing, fixity, cls_insts, fam_insts, info) }
    2994 2994
    2995 2995

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