Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

17 changed files:

Changes:

  • compiler/GHC/Hs/Lit.hs
    ... ... @@ -21,7 +21,7 @@ import GHC.Prelude
    21 21
    22 22 
     import {-# SOURCE #-} GHC.Hs.Expr( pprExpr )
    23 23
    24 
    -import GHC.Data.FastString (unpackFS)
    24 
    +import GHC.Data.FastString (FastString, unpackFS)
    25 25 
     import GHC.Types.Basic (PprPrec(..), topPrec )
    26 26 
     import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
    27 27 
     import GHC.Types.SourceText
    ... ... @@ -209,10 +209,7 @@ Equivalently it's True if
    209 209 
     instance IsPass p => Outputable (HsLit (GhcPass p)) where
    210 210 
         ppr (HsChar st c)       = pprWithSourceText st (pprHsChar c)
    211 211 
         ppr (HsCharPrim st c)   = pprWithSourceText st (pprPrimChar c)
    212 
    -    ppr (HsString st s)     =
    213 
    -      case st of
    214 
    -        NoSourceText -> pprHsString s
    215 
    -        SourceText src -> vcat $ map text $ split '\n' (unpackFS src)
    212 
    +    ppr (HsString st s)     = pprHsStringLit st s
    216 213 
         ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
    217 214 
         ppr (HsInt _ i)
    218 215 
           = pprWithSourceText (il_text i) (integer (il_value i))
    ... ... @@ -233,6 +230,10 @@ instance IsPass p => Outputable (HsLit (GhcPass p)) where
    233 230 
              (HsInteger st i _) -> pprWithSourceText st (integer i)
    234 231 
              (HsRat  f _)       -> ppr f
    235 232
    233 
    +pprHsStringLit :: SourceText -> FastString -> SDoc
    234 
    +pprHsStringLit NoSourceText     s = pprHsString s
    235 
    +pprHsStringLit (SourceText src) _ = vcat $ map text $ split '\n' (unpackFS src)
    236 
    +
    236 237 
     -- in debug mode, print the expression that it's resolved to, too
    237 238 
     instance OutputableBndrId p
    238 239 
            => Outputable (HsOverLit (GhcPass p)) where
    ... ... @@ -242,7 +243,7 @@ instance OutputableBndrId p
    242 243 
     instance Outputable OverLitVal where
    243 244 
       ppr (HsIntegral i)     = pprWithSourceText (il_text i) (integer (il_value i))
    244 245 
       ppr (HsFractional f)   = ppr f
    245 
    -  ppr (HsIsString st s)  = pprWithSourceText st (pprHsString s)
    246 
    +  ppr (HsIsString st s)  = pprHsStringLit st s
    246 247
    247 248 
     negateOverLitVal :: OverLitVal -> OverLitVal
    248 249 
     negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)

  • compiler/GHC/Hs/Type.hs
    ... ... @@ -116,6 +116,7 @@ import GHC.Core.Ppr ( pprOccWithTick)
    116 116 
     import GHC.Core.Type
    117 117 
     import GHC.Core.Multiplicity( pprArrowWithMultiplicity )
    118 118 
     import GHC.Hs.Doc
    119 
    +import GHC.Hs.Lit (pprHsStringLit)
    119 120 
     import GHC.Generics (Generic, Generically(..))
    120 121 
     import GHC.Types.Basic
    121 122 
     import GHC.Types.SrcLoc
    ... ... @@ -1346,7 +1347,7 @@ instance (OutputableBndrId pass) => OutputableBndr (GenLocated SrcSpan (FieldOcc
    1346 1347
    1347 1348 
     ppr_tylit :: (HsTyLit (GhcPass p)) -> SDoc
    1348 1349 
     ppr_tylit (HsNumTy source i) = pprWithSourceText source (integer i)
    1349 
    -ppr_tylit (HsStrTy source s) = pprWithSourceText source (text (show s))
    1350 
    +ppr_tylit (HsStrTy source s) = pprHsStringLit source s
    1350 1351 
     ppr_tylit (HsCharTy source c) = pprWithSourceText source (text (show c))
    1351 1352
    1352 1353 
     pprAnonWildCard :: SDoc

  • compiler/GHC/HsToCore/Pmc/Solver/Types.hs
    ... ... @@ -75,7 +75,7 @@ import GHC.Generics (Generic, Generically(..))
    75 75 
     import Numeric (fromRat)
    76 76 
     import Data.Ratio
    77 77 
     import Data.List( find )
    78 
    -import qualified Data.Map as FM
    78 
    +import qualified Data.Set as Set
    79 79 
     import GHC.Real (Ratio(..))
    80 80 
     import qualified Data.Semigroup as S
    81 81
    ... ... @@ -388,7 +388,7 @@ data PmLitValue
    388 388 
       | PmLitOverString FastString
    389 389
    390 390 
     -- | Syntactic equality.
    391 
    --- We want (Ord PmLit) so that we can use (Map PmLit x) in `PmAltConSet`
    391 
    +-- We want (Ord PmLit) so that we can use (Set PmLit) in `PmAltConSet`
    392 392 
     instance Eq PmLit where
    393 393 
       a == b = (a `compare` b) == EQ
    394 394 
     instance Ord PmLit where
    ... ... @@ -510,34 +510,34 @@ data PmAltCon = PmAltConLike ConLike
    510 510 
                   | PmAltLit     PmLit
    511 511
    512 512 
     data PmAltConSet = PACS !(UniqDSet ConLike)
    513 
    -                        !(FM.Map PmLit PmLit)
    514 
    --- We use a (FM.Map PmLit PmLit) here, at the cost of requiring an Ord
    513 
    +                        !(Set.Set PmLit)
    514 
    +-- We use a (Data.Set.Set PmLit) here, at the cost of requiring an Ord
    515 515 
     -- instance for PmLit, because in extreme cases the set of PmLits can be
    516 516 
     -- very large.  See #26514.
    517 517
    518 518 
     emptyPmAltConSet :: PmAltConSet
    519 
    -emptyPmAltConSet = PACS emptyUniqDSet FM.empty
    519 
    +emptyPmAltConSet = PACS emptyUniqDSet Set.empty
    520 520
    521 521 
     isEmptyPmAltConSet :: PmAltConSet -> Bool
    522 522 
     isEmptyPmAltConSet (PACS cls lits)
    523 
    -  = isEmptyUniqDSet cls && FM.null lits
    523 
    +  = isEmptyUniqDSet cls && Set.null lits
    524 524
    525 525 
     -- | Whether there is a 'PmAltCon' in the 'PmAltConSet' that compares 'Equal' to
    526 526 
     -- the given 'PmAltCon' according to 'eqPmAltCon'.
    527 527 
     elemPmAltConSet :: PmAltCon -> PmAltConSet -> Bool
    528 528 
     elemPmAltConSet (PmAltConLike cl) (PACS cls _   ) = elementOfUniqDSet cl cls
    529 
    -elemPmAltConSet (PmAltLit lit)    (PACS _   lits) = isJust (FM.lookup lit lits)
    529 
    +elemPmAltConSet (PmAltLit lit)    (PACS _   lits) = Set.member lit lits
    530 530
    531 531 
     extendPmAltConSet :: PmAltConSet -> PmAltCon -> PmAltConSet
    532 532 
     extendPmAltConSet (PACS cls lits) (PmAltConLike cl)
    533 533 
       = PACS (addOneToUniqDSet cls cl) lits
    534 534 
     extendPmAltConSet (PACS cls lits) (PmAltLit lit)
    535 
    -  = PACS cls (FM.insert lit lit lits)
    535 
    +  = PACS cls (Set.insert lit lits)
    536 536
    537 537 
     pmAltConSetElems :: PmAltConSet -> [PmAltCon]
    538 538 
     pmAltConSetElems (PACS cls lits)
    539 539 
       = map PmAltConLike (uniqDSetToList cls) ++
    540 
    -    FM.foldr ((:) . PmAltLit) [] lits
    540 
    +    map PmAltLit (Set.toList lits)
    541 541
    542 542 
     instance Outputable PmAltConSet where
    543 543 
       ppr = ppr . pmAltConSetElems

  • compiler/GHC/Tc/Gen/HsType.hs
    ... ... @@ -1264,8 +1264,10 @@ tcHsType _ rn_ty@(HsStarTy _ _) exp_kind
    1264 1264 
       = checkExpKind rn_ty liftedTypeKind liftedTypeKind exp_kind
    1265 1265
    1266 1266 
     --------- Literals
    1267 
    -tcHsType _ rn_ty@(HsTyLit _ (HsNumTy _ n)) exp_kind
    1268 
    -  = do { checkWiredInTyCon naturalTyCon
    1267 
    +tcHsType _ rn_ty@(HsTyLit _ (HsNumTy x n)) exp_kind
    1268 
    +  = do { when (n < 0) $
    1269 
    +           addErr $ TcRnNegativeNumTypeLiteral (HsNumTy x n)
    1270 
    +       ; checkWiredInTyCon naturalTyCon
    1269 1271 
            ; checkExpKind rn_ty (mkNumLitTy n) naturalTy exp_kind }
    1270 1272
    1271 1273 
     tcHsType _ rn_ty@(HsTyLit _ (HsStrTy _ s)) exp_kind

  • compiler/GHC/Tc/Gen/Match.hs
    ... ... @@ -543,9 +543,29 @@ tcGuardStmt _ stmt _ _
    543 543 
     --      potential for non-trivial coercions in tcMcStmt
    544 544
    545 545 
     {-
    546 
    -Note [Binding in list comprehension isn't linear]
    546 
    +Note [List comprehension isn't linear]
    547 547 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    548 
    -In principle, [ y | () <- xs, y <- [0,1]] could be linear in `xs`.
    548 
    +The usefulness of list comprehension in conjunction with linear types is dubious.
    549 
    +After all, statements are made to be run many times, for instance in
    550 
    +
    551 
    +[u | y <- [0,1], stmts]
    552 
    +
    553 
    +both u and stmts are going to be run several times.
    554 
    +
    555 
    +In principle, though, there are some positions in a monad comprehension
    556 
    +expressions which could be considered linear. We could try and make it so that
    557 
    +these positions are considered linear by the typechecker, but in practice the
    558 
    +desugarer doesn't take enough care to ensure that these are indeed desugared to
    559 
    +linear sites. We tried in the past, and it turned out that we'd miss a
    560 
    +desugaring corner case (#25772).
    561 
    +
    562 
    +Until there's a demand for this very specific improvement, let's instead be
    563 
    +conservative, and consider list comprehension to be completely non-linear.
    564 
    +
    565 
    +Here are the case where list comprehension could be linear, together with the
    566 
    +known challenges.
    567 
    +
    568 
    +(LCL1) [ y | () <- xs, y <- [0,1]] could be linear in `xs`.
    549 569 
     But, the way the desugaring works, we get something like
    550 570
    551 571 
     case xs of
    ... ... @@ -566,21 +586,31 @@ isn't linear in `xs` since the elements of `xs` are ignored. So we'd still have
    566 586 
     to call `tcScalingUsage` on `xs` in `tcLcStmt`, we'd just have to create a fresh
    567 587 
     multiplicity variable. We'd also use the same multiplicity variable in the call
    568 588 
     to `tcCheckPat` instead of `unrestricted`.
    589 
    +
    590 
    +(LCL2) [ y | b, y <- [0,1]] could be linear in `b`. This actually works fine
    591 
    +with -O0 (as far as anybody knows), but -O and higher desugar list comprehension
    592 
    +using the `build` combinator (this was the cause of #25772). But `build` isn't
    593 
    +defined to be linear. The consequences of making `build` linear are
    594 
    +unknown. It's not worth trying until a real need arises.
    595 
    +
    596 
    +(LCL3) [ x | ] could be linear in x. But it's unclear why anybody would want to
    597 
    +write this instead of [ x ]. Besides, this syntax is currently rejected by the
    598 
    +parser. The `build` obstacle of (LCL2) applies here too.
    569 599 
     -}
    570 600
    571 601 
     tcLcStmt :: TyCon       -- The list type constructor ([])
    572 602 
              -> TcExprStmtChecker
    573 603
    574 604 
     tcLcStmt _ _ (LastStmt x body noret _) elt_ty thing_inside
    575 
    -  = do { body' <- tcMonoExprNC body elt_ty
    605 
    +  = do { -- see (LCL3) in Note [List comprehension isn't linear]
    606 
    +         body' <- tcScalingUsage ManyTy $ tcMonoExprNC body elt_ty
    576 607 
            ; thing <- thing_inside (panic "tcLcStmt: thing_inside")
    577 608 
            ; return (LastStmt x body' noret noSyntaxExpr, thing) }
    578 609
    579 610 
     -- A generator, pat <- rhs
    580 611 
     tcLcStmt m_tc ctxt (BindStmt _ pat rhs) elt_ty thing_inside
    581 612 
      = do   { pat_ty <- newFlexiTyVarTy liftedTypeKind
    582 
    -          -- About the next `tcScalingUsage ManyTy` and unrestricted
    583 
    -          -- see Note [Binding in list comprehension isn't linear]
    613 
    +          -- see (LCL1) in Note [List comprehension isn't linear]
    584 614 
             ; rhs'   <- tcScalingUsage ManyTy $ tcCheckMonoExpr rhs (mkTyConApp m_tc [pat_ty])
    585 615 
             ; (pat', thing)  <- tcCheckPat (StmtCtxt ctxt) pat (unrestricted pat_ty) $
    586 616 
                                 tcScalingUsage ManyTy $
    ... ... @@ -589,7 +619,9 @@ tcLcStmt m_tc ctxt (BindStmt _ pat rhs) elt_ty thing_inside
    589 619
    590 620 
     -- A boolean guard
    591 621 
     tcLcStmt _ _ (BodyStmt _ rhs _ _) elt_ty thing_inside
    592 
    -  = do  { rhs'  <- tcCheckMonoExpr rhs boolTy
    622 
    +  = do  { -- Regarding the `tcScalingUsage ManyTy` on the `rhs`,
    623 
    +          -- see (LCL2) in Note [List comprehension isn't linear]
    624 
    +          rhs'  <- tcScalingUsage ManyTy $ tcCheckMonoExpr rhs boolTy
    593 625 
             ; thing <- tcScalingUsage ManyTy $ thing_inside elt_ty
    594 626 
             ; return (BodyStmt boolTy rhs' noSyntaxExpr noSyntaxExpr, thing) }
    595 627

  • testsuite/tests/linear/should_compile/LinearListComprehension.hs deleted
    1 
    -{-# LANGUAGE LinearTypes #-}
    2 
    -
    3 
    -module LinearListComprehension where
    4 
    -
    5 
    --- Probably nobody actually cares if monad comprehension realised that it can be
    6 
    --- linear in the first statement. But it can, so we might as well.
    7 
    -
    8 
    -guard :: a %1 -> (a %1 -> Bool) %1 -> [Int]
    9 
    -guard x g = [ y | g x, y <- [0,1] ]
    10 
    -
    11 
    --- This isn't correct syntax, but a singleton list comprehension would
    12 
    --- presumably work too
    13 
    --- last :: a %1 -> [a]
    14 
    --- last x = [ x | ]

  • testsuite/tests/linear/should_compile/all.T
    ... ... @@ -47,7 +47,6 @@ test('LinearRecUpd', normal, compile, [''])
    47 47 
     test('T23814', normal, compile, [''])
    48 48 
     test('LinearLet', normal, compile, [''])
    49 49 
     test('LinearLetPoly', normal, compile, [''])
    50 
    -test('LinearListComprehension', normal, compile, ['-dlinear-core-lint'])
    51 50 
     test('OmitFieldPat', normal, compile, ['-dcore-lint'])
    52 51 
     test('T25515', normal, compile, ['-dcore-lint'])
    53 52 
     test('T25428', normal, compile, [''])

  • testsuite/tests/linear/should_fail/T25081.hs
    ... ... @@ -22,11 +22,16 @@ guard_bind x = [ () | False, _ <- [x]]
    22 22 
     guard_guard :: a %1 -> (a %1 -> Bool) %1 -> [()]
    23 23 
     guard_guard x g = [ () | False, g x ]
    24 24
    25 
    --- This could, in principle, be linear. But see Note [Binding in list
    25 
    +-- This could, in principle, be linear. But see (LCL1) in Note [List
    26 26 
     -- comprehension isn't linear] in GHC.Tc.Gen.Match.
    27 27 
     first_bind :: [()] %1 -> [Int]
    28 28 
     first_bind xs = [ y | () <- xs, y <- [0,1]]
    29 29
    30 
    +-- This could, in principle, be linear. But see (LCL2) in Note [List
    31 
    +-- comprehension isn't linear] in GHC.Tc.Gen.Match.
    32 
    +first_guard :: a %1 -> (a %1 -> Bool) %1 -> [Int]
    33 
    +first_guard x g = [ y | g x, y <- [0,1] ]
    34 
    +
    30 35 
     parallel :: a %1 -> [(a, Bool)]
    31 36 
     parallel x = [(y,z) | y <- [x] | z <- [True]]
    32 37

  • testsuite/tests/linear/should_fail/T25081.stderr
    ... ... @@ -44,20 +44,32 @@ T25081.hs:28:12: error: [GHC-18872]
    44 44 
         • In an equation for ‘first_bind’:
    45 45 
               first_bind xs = [y | () <- xs, y <- [0, 1]]
    46 46
    47 
    -T25081.hs:31:10: error: [GHC-18872]
    47 
    +T25081.hs:33:13: error: [GHC-18872]
    48 
    +    • Couldn't match type ‘Many’ with ‘One’
    49 
    +        arising from multiplicity of ‘x’
    50 
    +    • In an equation for ‘first_guard’:
    51 
    +          first_guard x g = [y | g x, y <- [0, 1]]
    52 
    +
    53 
    +T25081.hs:33:15: error: [GHC-18872]
    54 
    +    • Couldn't match type ‘Many’ with ‘One’
    55 
    +        arising from multiplicity of ‘g’
    56 
    +    • In an equation for ‘first_guard’:
    57 
    +          first_guard x g = [y | g x, y <- [0, 1]]
    58 
    +
    59 
    +T25081.hs:36:10: error: [GHC-18872]
    48 60 
         • Couldn't match type ‘Many’ with ‘One’
    49 61 
             arising from multiplicity of ‘x’
    50 62 
         • In an equation for ‘parallel’:
    51 63 
               parallel x = [(y, z) | y <- [x] |  z <- [True]]
    52 64
    53 
    -T25081.hs:34:16: error: [GHC-18872]
    65 
    +T25081.hs:39:16: error: [GHC-18872]
    54 66 
         • Couldn't match type ‘Many’ with ‘One’
    55 67 
             arising from multiplicity of ‘x’
    56 68 
         • In an equation for ‘parallel_guard’:
    57 69 
               parallel_guard x g
    58 70 
                 = [(y, z) | g x, y <- [0, 1] |  z <- [True, False]]
    59 71
    60 
    -T25081.hs:37:11: error: [GHC-18872]
    72 
    +T25081.hs:42:11: error: [GHC-18872]
    61 73 
         • Couldn't match type ‘Many’ with ‘One’
    62 74 
             arising from multiplicity of ‘x’
    63 75 
         • In an equation for ‘transform’:

  • testsuite/tests/parser/should_fail/T26860ppr_overloaded.hs
    1 
    +{-# LANGUAGE OverloadedStrings #-}
    2 
    +
    3 
    +module T26860ppr_overloaded where
    4 
    +
    5 
    +-- Test that the error message containing the string literal is well-formatted.
    6 
    +-- See also: parser/should_fail/MultilineStringsError
    7 
    +x :: Int
    8 
    +x = "first line \
    9 
    +    \asdf\n\
    10 
    +    \second line"
    11 
    +

  • testsuite/tests/parser/should_fail/T26860ppr_overloaded.stderr
    1 
    +T26860ppr_overloaded.hs:8:5: error: [GHC-39999]
    2 
    +    • No instance for ‘GHC.Internal.Data.String.IsString Int’
    3 
    +        arising from the literal ‘"first line \
    4 
    +                                      \asdf\n\
    5 
    +                                      \second line"’
    6 
    +    • In the expression:
    7 
    +        "first line \
    8 
    +            \asdf\n\
    9 
    +            \second line"
    10 
    +      In an equation for ‘x’:
    11 
    +          x = "first line \
    12 
    +                  \asdf\n\
    13 
    +                  \second line"
    14 
    +

  • testsuite/tests/parser/should_fail/T26860ppr_tylit.hs
    1 
    +{-# LANGUAGE DataKinds #-}
    2 
    +
    3 
    +module T26860ppr_tylit where
    4 
    +
    5 
    +import Data.Kind (Type)
    6 
    +
    7 
    +-- Test that the error message containing the string literal is well-formatted.
    8 
    +-- See also: parser/should_fail/MultilineStringsError
    9 
    +type X :: Type
    10 
    +type X = "first line \
    11 
    +         \asdf\n\
    12 
    +         \second line"
    13 
    +

  • testsuite/tests/parser/should_fail/T26860ppr_tylit.stderr
    1 
    +T26860ppr_tylit.hs:10:10: error: [GHC-83865]
    2 
    +    • Expected a type,
    3 
    +      but ‘"first line \
    4 
    +                    \asdf\n\
    5 
    +                    \second line"’ has kind
    6 
    +      ‘GHC.Internal.Types.Symbol’
    7 
    +    • In the type ‘"first line \
    8 
    +                            \asdf\n\
    9 
    +                            \second line"’
    10 
    +      In the type synonym declaration for ‘X’
    11 
    +

  • testsuite/tests/parser/should_fail/all.T
    ... ... @@ -245,3 +245,5 @@ test('T26418', normal, compile_fail, [''])
    245 245 
     test('T12488c', normal, compile_fail, [''])
    246 246 
     test('T12488d', normal, compile_fail, [''])
    247 247 
     test('T26860ppr', normal, compile_fail, [''])
    248 
    +test('T26860ppr_overloaded', normal, compile_fail, [''])
    249 
    +test('T26860ppr_tylit', normal, compile_fail, [''])

  • testsuite/tests/typecheck/should_fail/T26861.hs
    1 
    +{-# LANGUAGE DataKinds #-}
    2 
    +{-# LANGUAGE NegativeLiterals #-}
    3 
    +{-# LANGUAGE RequiredTypeArguments #-}
    4 
    +
    5 
    +module T26861 where
    6 
    +
    7 
    +import Data.Proxy
    8 
    +import GHC.TypeLits
    9 
    +
    10 
    +main :: IO ()
    11 
    +main = print (natVis (-42))
    12 
    +
    13 
    +natVis :: forall a -> KnownNat a => Integer
    14 
    +natVis n = natVal (Proxy @n)

  • testsuite/tests/typecheck/should_fail/T26861.stderr
    1 
    +T26861.hs:11:23: error: [GHC-93632]
    2 
    +    • Illegal literal in type (type literals must not be negative): -42
    3 
    +    • In the type ‘-42’
    4 
    +      In the first argument of ‘print’, namely ‘(natVis (-42))’
    5 
    +      In the expression: print (natVis (-42))
    6 
    +

  • testsuite/tests/typecheck/should_fail/all.T
    ... ... @@ -752,3 +752,4 @@ test('T23162a', normal, compile_fail, [''])
    752 752 
     test('T23162b', normal, compile_fail, [''])
    753 753 
     test('T23162c', normal, compile, [''])
    754 754 
     test('T23162d', normal, compile, [''])
    755 
    +test('T26861', normal, compile_fail, [''])

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