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

Commits:

10 changed files:

Changes:

  • compiler/GHC/Builtin.hs
    1 
    +{-# LANGUAGE CPP #-}
    2 
    +
    1 3 
     {-
    2 4 
     (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    3 5
    ... ... @@ -40,7 +42,9 @@ module GHC.Builtin (
    40 42 
             maybeCharLikeCon, maybeIntLikeCon,
    41 43
    42 44 
             -- * Class categories
    43 
    -        isNumericClass, isStandardClass
    45 
    +        isNumericClass, isStandardClass,
    46 
    +        numericClassKeys, fractionalClassKeys, standardClassKeys,
    47 
    +        derivableClassKeys, interactiveClassKeys
    44 48
    45 49 
         ) where
    46 50
    ... ... @@ -53,8 +57,7 @@ import GHC.Builtin.Types
    53 57 
     import GHC.Builtin.Types.Literals ( typeNatTyCons )
    54 58 
     import GHC.Builtin.Types.Prim
    55 59 
     import GHC.Builtin.TH ( templateHaskellNames, thKnownKeyTable )
    56 
    -import GHC.Builtin.Names( basicKnownKeyTable, basicKnownKeyNames )
    57 
    -import GHC.Builtin.Names( charDataConKey, intDataConKey, numericClassKeys, standardClassKeys )
    60 
    +import GHC.Builtin.Names
    58 61
    59 62 
     import GHC.Core.ConLike ( ConLike(..) )
    60 63 
     import GHC.Core.DataCon
    ... ... @@ -378,6 +381,92 @@ knownVarOccRdrName :: String -> RdrName
    378 381 
     knownVarOccRdrName s = knownOccRdrName (mkVarOcc s)
    379 382
    380 383
    384 
    +
    385 
    +{-
    386 
    +************************************************************************
    387 
    +*                                                                      *
    388 
    +              Groups of keys
    389 
    +*                                                                      *
    390 
    +************************************************************************
    391 
    +
    392 
    +NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@
    393 
    +even though every numeric class has these two as a superclass,
    394 
    +because the list of ambiguous dictionaries hasn't been simplified.
    395 
    +-}
    396 
    +
    397 
    +numericClassKeys :: [KnownKey]
    398 
    +numericClassKeys
    399 
    +  = checkKnownKeys
    400 
    +      [ numClassKey
    401 
    +      , realClassKey
    402 
    +      , integralClassKey
    403 
    +      ]
    404 
    +    ++ fractionalClassKeys
    405 
    +
    406 
    +fractionalClassKeys :: [KnownKey]
    407 
    +fractionalClassKeys
    408 
    +  = checkKnownKeys
    409 
    +        [ fractionalClassKey
    410 
    +        , floatingClassKey
    411 
    +        , realFracClassKey
    412 
    +        , realFloatClassKey
    413 
    +        ]
    414 
    +
    415 
    +-- The "standard classes" are used in defaulting (Haskell 98 report 4.3.4),
    416 
    +-- and are: "classes defined in the Prelude or a standard library"
    417 
    +standardClassKeys :: [KnownKey]
    418 
    +standardClassKeys
    419 
    +  = derivableClassKeys
    420 
    +    ++ numericClassKeys
    421 
    +    ++ checkKnownKeys
    422 
    +          [ randomClassKey, randomGenClassKey
    423 
    +          , functorClassKey
    424 
    +          , monadClassKey, monadPlusClassKey, monadFailClassKey
    425 
    +          , semigroupClassKey, monoidClassKey
    426 
    +          , isStringClassKey
    427 
    +          , applicativeClassKey, foldableClassKey
    428 
    +          , traversableClassKey, alternativeClassKey
    429 
    +          ]
    430 
    +
    431 
    +{-
    432 
    +@derivableClassKeys@ is also used in checking \tr{deriving} constructs
    433 
    +(@GHC.Tc.Deriv@).
    434 
    +-}
    435 
    +
    436 
    +derivableClassKeys :: [KnownKey]
    437 
    +derivableClassKeys
    438 
    +  = checkKnownKeys [ eqClassKey, ordClassKey, enumClassKey, ixClassKey
    439 
    +                   , boundedClassKey, showClassKey, readClassKey ]
    440 
    +
    441 
    +interactiveClassKeys :: [KnownKey]
    442 
    +-- These are the "interactive classes" that are consulted when doing
    443 
    +-- defaulting. Does not include Num or IsString, which have special
    444 
    +-- handling.
    445 
    +interactiveClassKeys
    446 
    +  = checkKnownKeys [ showClassKey, eqClassKey, ordClassKey
    447 
    +                   , foldableClassKey, traversableClassKey ]
    448 
    +
    449 
    +checkKnownKeys :: [KnownKey] -> [KnownKey]
    450 
    +-- An assertion check, that checks that these alleged known-keys do
    451 
    +-- actually appear in the knownKeyTable.
    452 
    +#ifdef DEBUG
    453 
    +checkKnownKeys keys
    454 
    +  | null bad_keys = keys
    455 
    +  | otherwise     = pprPanic "checkKnownKeys" (vcat (map pprKnownKey bad_keys))
    456 
    +  where
    457 
    +    bad_keys = filter (not . (`elemUFM` knownKeyUniqMap)) keys
    458 
    +#else
    459 
    +checkKnownKeys keys = keys
    460 
    +#endif
    461 
    +
    462 
    +isNumericClass, isStandardClass :: Class -> Bool
    463 
    +isNumericClass     clas = classKey clas `is_elem` numericClassKeys
    464 
    +isStandardClass    clas = classKey clas `is_elem` standardClassKeys
    465 
    +
    466 
    +is_elem :: Eq a => a -> [a] -> Bool
    467 
    +is_elem = isIn "is_X_Class"
    468 
    +
    469 
    +
    381 470 
     {- *********************************************************************
    382 471 
     *                                                                      *
    383 472 
                          Wired-in things
    ... ... @@ -652,18 +741,3 @@ maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
    652 741 
     maybeCharLikeCon con = con `hasKey` charDataConKey
    653 742 
     maybeIntLikeCon  con = con `hasKey` intDataConKey
    654 743
    655 
    -{-
    656 
    -************************************************************************
    657 
    -*                                                                      *
    658 
    -            Class predicates
    659 
    -*                                                                      *
    660 
    -************************************************************************
    661 
    --}
    662 
    -
    663 
    -isNumericClass, isStandardClass :: Class -> Bool
    664 
    -
    665 
    -isNumericClass     clas = classKey clas `is_elem` numericClassKeys
    666 
    -isStandardClass    clas = classKey clas `is_elem` standardClassKeys
    667 
    -
    668 
    -is_elem :: Eq a => a -> [a] -> Bool
    669 
    -is_elem = isIn "is_X_Class"

  • compiler/GHC/Builtin/Names.hs
    ... ... @@ -187,8 +187,6 @@ basicKnownKeyTable
    187 187 
         , (mkTcOcc "Foldable",     foldableClassKey)
    188 188 
         , (mkTcOcc "Traversable",  traversableClassKey)
    189 189 
         , (mkTcOcc "Bounded",      boundedClassKey)
    190 
    -    , (mkTcOcc "Integral",     integralClassKey)
    191 
    -    , (mkTcOcc "Real",         realClassKey)
    192 190 
         , (mkTcOcc "Data",         dataClassKey)
    193 191 
         , (mkTcOcc "Ix",           ixClassKey)
    194 192 
         , (mkTcOcc "Alternative",  alternativeClassKey)
    ... ... @@ -216,6 +214,11 @@ basicKnownKeyTable
    216 214
    217 215 
         -- Numeric operations
    218 216 
         , (mkTcOcc "Num",               numClassKey)
    217 
    +    , (mkTcOcc "Integral",          integralClassKey)
    218 
    +    , (mkTcOcc "Real",              realClassKey)
    219 
    +    , (mkTcOcc "Fractional",        fractionalClassKey)
    220 
    +    , (mkTcOcc "RealFloat",         realFloatClassKey)
    221 
    +--    , (mkTcOcc "RealFrac",          realFracClassKey)
    219 222 
         , (mkVarOcc "-",                minusClassOpKey)
    220 223 
         , (mkVarOcc "negate",           negateClassOpKey)
    221 224 
         , (mkVarOcc "fromInteger",      fromIntegerClassOpKey)
    ... ... @@ -270,8 +273,7 @@ basicKnownKeyTable
    270 273 
         , (mkTcOcc "HasField",   hasFieldClassKey)
    271 274 
         , (mkVarOcc "fromLabel", fromLabelClassOpKey)
    272 275 
         , (mkVarOcc "getField",  getFieldClassOpKey)
    273 
    -    -- setField is not yet defined in ghc-internal
    274 
    -    -- , (mkVarOcc "setField",  setFieldClassOpKey)
    276 
    +    , (mkVarOcc "setField",  setFieldClassOpKey)
    275 277
    276 278 
         -- FromList
    277 279 
         , (mkVarOcc "fromList",   fromListClassOpKey)
    ... ... @@ -2149,61 +2151,3 @@ bignatCompareWordIdKey = mkPreludeMiscIdUnique 693
    2149 2151 
     mkRationalBase2IdKey, mkRationalBase10IdKey :: KnownKey
    2150 2152 
     mkRationalBase2IdKey  = mkPreludeMiscIdUnique 700
    2151 2153 
     mkRationalBase10IdKey = mkPreludeMiscIdUnique 701 :: KnownKey
    2152 
    -
    2153 
    -{-
    2154 
    -************************************************************************
    2155 
    -*                                                                      *
    2156 
    -\subsection[Class-std-groups]{Standard groups of Prelude classes}
    2157 
    -*                                                                      *
    2158 
    -************************************************************************
    2159 
    -
    2160 
    -NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@
    2161 
    -even though every numeric class has these two as a superclass,
    2162 
    -because the list of ambiguous dictionaries hasn't been simplified.
    2163 
    --}
    2164 
    -
    2165 
    -numericClassKeys :: [KnownKey]
    2166 
    -numericClassKeys =
    2167 
    -        [ numClassKey
    2168 
    -        , realClassKey
    2169 
    -        , integralClassKey
    2170 
    -        ]
    2171 
    -        ++ fractionalClassKeys
    2172 
    -
    2173 
    -fractionalClassKeys :: [KnownKey]
    2174 
    -fractionalClassKeys =
    2175 
    -        [ fractionalClassKey
    2176 
    -        , floatingClassKey
    2177 
    -        , realFracClassKey
    2178 
    -        , realFloatClassKey
    2179 
    -        ]
    2180 
    -
    2181 
    --- The "standard classes" are used in defaulting (Haskell 98 report 4.3.4),
    2182 
    --- and are: "classes defined in the Prelude or a standard library"
    2183 
    -standardClassKeys :: [KnownKey]
    2184 
    -standardClassKeys = derivableClassKeys ++ numericClassKeys
    2185 
    -                  ++ [randomClassKey, randomGenClassKey,
    2186 
    -                      functorClassKey,
    2187 
    -                      monadClassKey, monadPlusClassKey, monadFailClassKey,
    2188 
    -                      semigroupClassKey, monoidClassKey,
    2189 
    -                      isStringClassKey,
    2190 
    -                      applicativeClassKey, foldableClassKey,
    2191 
    -                      traversableClassKey, alternativeClassKey
    2192 
    -                     ]
    2193 
    -
    2194 
    -{-
    2195 
    -@derivableClassKeys@ is also used in checking \tr{deriving} constructs
    2196 
    -(@GHC.Tc.Deriv@).
    2197 
    --}
    2198 
    -
    2199 
    -derivableClassKeys :: [KnownKey]
    2200 
    -derivableClassKeys
    2201 
    -  = [ eqClassKey, ordClassKey, enumClassKey, ixClassKey,
    2202 
    -      boundedClassKey, showClassKey, readClassKey ]
    2203 
    -
    2204 
    -interactiveClassKeys :: [KnownKey]
    2205 
    --- These are the "interactive classes" that are consulted when doing
    2206 
    --- defaulting. Does not include Num or IsString, which have special
    2207 
    --- handling.
    2208 
    -interactiveClassKeys = [ showClassKey, eqClassKey, ordClassKey
    2209 
    -                       , foldableClassKey, traversableClassKey ]

  • compiler/GHC/Tc/Gen/Default.hs
    ... ... @@ -12,7 +12,9 @@ module GHC.Tc.Gen.Default ( tcDefaultDecls, extendDefaultEnvWithLocalDefaults )
    12 12 
     import GHC.Prelude
    13 13 
     import GHC.Hs
    14 14
    15 
    +import GHC.Builtin( interactiveClassKeys )
    15 16 
     import GHC.Builtin.Names
    17 
    +
    16 18 
     import GHC.Core.Class
    17 19 
     import GHC.Core.Predicate ( Pred (..), classifyPredType )
    18 20

  • libraries/base/src/Data/Fixed.hs
    ... ... @@ -4,6 +4,9 @@
    4 4 
     {-# LANGUAGE FlexibleInstances #-}
    5 5 
     {-# LANGUAGE TemplateHaskellQuotes #-}
    6 6
    7 
    +{-# OPTIONS_GHC -fno-rebindable-known-key-names #-}
    8 
    +    -- We are importing Prelude, hence GHC.KnownKeyNames is available
    9 
    +
    7 10 
     -----------------------------------------------------------------------------
    8 11 
     -- |
    9 12 
     -- Module      :  Data.Fixed
    ... ... @@ -87,7 +90,6 @@ module Data.Fixed
    87 90 
     ) where
    88 91
    89 92 
     import Prelude
    90 
    -import GHC.KnownKeyNames
    91 93 
     import GHC.Internal.Data.Data
    92 94 
     import GHC.Internal.TypeLits (KnownNat, natVal)
    93 95 
     import GHC.Internal.Read
    ... ... @@ -95,7 +97,6 @@ import GHC.Internal.Text.ParserCombinators.ReadPrec( ReadPrec, pfail )
    95 97 
     import GHC.Internal.Text.Read.Lex
    96 98 
     import qualified GHC.Internal.TH.Monad as TH
    97 99 
     import qualified GHC.Internal.TH.Lift as TH
    98 
    -import GHC.Internal.TH.Lift( lift )  -- Unqualified for known-occ names
    99 100 
     import Data.Typeable
    100 101
    101 102 
     -- $setup

  • libraries/base/src/GHC/KnownKeyNames.hs
    ... ... @@ -59,7 +59,7 @@ module GHC.KnownKeyNames
    59 59 
         , dataToTag#
    60 60
    61 61 
         -- Numbers
    62 
    -    , Num, Integral, Real, Fractional
    62 
    +    , Num, Integral, Real, Fractional, RealFloat
    63 63 
         , (+), (-), (*), negate, fromInteger
    64 64 
         , fromRational
    65 65 
         , mkRationalBase2, mkRationalBase10
    ... ... @@ -71,7 +71,7 @@ module GHC.KnownKeyNames
    71 71
    72 72 
         -- Records
    73 73 
         , HasField
    74 
    -    , fromLabel, getField
    74 
    +    , fromLabel, getField, setField
    75 75
    76 76 
         -- Overloaded lists
    77 77 
         , IL.fromList, IL.fromListN, IL.toList
    ... ... @@ -157,13 +157,14 @@ import GHC.Internal.Data.Data
    157 157 
     import GHC.Internal.Data.String( fromString )
    158 158 
     import GHC.Internal.Data.Foldable( Foldable )
    159 159 
     import GHC.Internal.Data.Traversable( Traversable )
    160 
    +import GHC.Internal.Float( RealFloat )
    160 161 
     import GHC.Internal.Real( mkRationalBase2, mkRationalBase10 )
    161 162 
     import GHC.Internal.Control.Monad( fail, guard )
    162 163 
     import GHC.Internal.Control.Monad.Fix( mfix, loop )
    163 164 
     import GHC.Internal.Control.Monad.Zip( mzip )
    164 165 
     import GHC.Internal.Control.Arrow( arr, (>>>), first, app, (|||) )
    165 166 
     import GHC.Internal.OverloadedLabels( fromLabel )
    166 
    -import GHC.Internal.Records( HasField, getField )
    167 
    +import GHC.Internal.Records
    167 168 
     import GHC.Internal.CString as CS
    168 169 
     import GHC.Internal.TypeError( Unsatisfiable, unsatisfiable )
    169 170 
     import GHC.Internal.System.IO( print )

  • libraries/base/src/System/Console/GetOpt.hs
    1 1 
     {-# LANGUAGE Safe #-}
    2 2
    3 
    +{-# OPTIONS_GHC -fno-rebindable-known-key-names #-}
    4 
    +    -- We are importing Prelude, hence GHC.KnownKeyNames is available
    3 5 
     -----------------------------------------------------------------------------
    4 6 
     -- |
    5 7 
     -- Module      :  System.Console.GetOpt
    ... ... @@ -62,8 +64,7 @@ module System.Console.GetOpt (
    62 64 
        -- $example2
    63 65 
     ) where
    64 66
    65 
    -import Prelude hiding( foldr )
    66 
    -import GHC.KnownKeyNames
    67 
    +import Prelude
    67 68 
     import GHC.Internal.Data.List ( isPrefixOf, find )
    68 69
    69 70 
     -- |What to do with options following non-options

  • libraries/ghc-internal/src/GHC/Internal/Float.hs
    ... ... @@ -9,6 +9,10 @@
    9 9 
     {-# LANGUAGE CApiFFI #-}
    10 10 
     -- We believe we could deorphan this module, by moving lots of things
    11 11 
     -- around, but we haven't got there yet:
    12 
    +
    13 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    14 
    +   -- Defines RealFloat
    15 
    +
    12 16 
     {-# OPTIONS_GHC -Wno-orphans #-}
    13 17 
     {-# OPTIONS_HADDOCK not-home #-}
    14 18 
     {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

  • libraries/ghc-internal/src/GHC/Internal/IO.hs
    ... ... @@ -50,14 +50,12 @@ module GHC.Internal.IO (
    50 50 
         ) where
    51 51
    52 52 
     import GHC.Internal.Base
    53 
    -import GHC.Internal.Magic ( lazy )
    54 53 
     import GHC.Internal.Maybe ( Maybe(..) )
    55 54 
     import GHC.Internal.Prim (
    56 55 
         RealWorld, State#, catch#, getMaskingState#, maskAsyncExceptions#,
    57 56 
         maskUninterruptible#, raiseIO#, unmaskAsyncExceptions#,
    58 57 
       )
    59 58 
     import GHC.Internal.ST
    60 
    -import GHC.Internal.Types ( Char, IO(..) )
    61 59 
     import GHC.Internal.Exception
    62 60 
     import GHC.Internal.Exception.Type (NoBacktrace(..), whileHandling, WhileHandling(..), HasExceptionContext, ExceptionWithContext(..))
    63 61 
     import GHC.Internal.Show

  • libraries/ghc-internal/src/GHC/Internal/Records.hs
    ... ... @@ -6,6 +6,7 @@
    6 6 
     {-# LANGUAGE StandaloneKindSignatures #-}
    7 7 
     {-# LANGUAGE Trustworthy #-}
    8 8
    9 
    +{-# OPTIONS_GHC -Wno-unused-foralls #-}
    9 10 
     {-# OPTIONS_GHC -fdefines-known-key-names #-}
    10 11 
        -- Defines GetField
    11 12 
     -----------------------------------------------------------------------------
    ... ... @@ -26,10 +27,11 @@
    26 27 
     -----------------------------------------------------------------------------
    27 28
    28 29 
     module GHC.Internal.Records
    29 
    -       ( HasField(..)
    30 
    +       ( HasField(..), setField
    30 31 
            ) where
    31 32
    32 
    -import GHC.Internal.Types (TYPE, Constraint)
    33 
    +import GHC.Internal.Types (TYPE, Type, Constraint)
    34 
    +import GHC.Internal.Err( error )
    33 35
    34 36 
     -- | Constraint representing the fact that the field @x@ belongs to
    35 37 
     -- the record type @r@ and has field type @a@.  This will be solved
    ... ... @@ -45,3 +47,13 @@ type HasField :: forall {k} {r_rep} {a_rep} . k -> TYPE r_rep -> TYPE a_rep -> C
    45 47 
     class HasField x r a | x r -> a where
    46 48 
       -- | Selector function to extract the field from the record.
    47 49 
       getField :: r -> a
    50 
    +
    51 
    +
    52 
    +setField :: forall {k} (x::k) (r :: Type) (a :: Type). a -> r -> r
    53 
    +-- This setField is never used
    54 
    +--   -XRebindableSyntax is required if -XOverloadedRecordUpdate is enabled
    55 
    +-- But we still want to export setField from GHC.KnownKeyNames, so that
    56 
    +--   * We can have a known-key for setField (see uses of setFieldClassOpKey)
    57 
    +--   * The assertion check that GHC.KnownKeyNames exports every known-key
    58 
    +--     should not fail
    59 
    +setField = error "Yikes! setField is not implemented yet"

  • testsuite/tests/th/T26568.stderr
    1 1 
     T26568.hs:5:3: error: [GHC-28914]
    2 2 
         • Level error:
    3 3 
           instance for ‘GHC.Internal.Base.Monad GHC.Internal.TH.Monad.Q’
    4 
    -      is bound at levels {} but used at level -1
    4 
    +      is bound at level 0 but used at level -1
    5 5 
         • In a stmt of a 'do' block: _ <- _
    6 6 
           In the expression:
    7 7 
             do _ <- _

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