Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

18 changed files:

Changes:

  • testsuite/tests/dependent/should_fail/T15588.hs
    1 
    +{- This program used to cause a panic (#15588), but it should possibly even be
    2 
    +accepted. See #15589. -}
    3 
    +{-# LANGUAGE AllowAmbiguousTypes #-}
    4 
    +{-# LANGUAGE DataKinds           #-}
    5 
    +{-# LANGUAGE PolyKinds           #-}
    6 
    +{-# LANGUAGE ScopedTypeVariables #-}
    7 
    +{-# LANGUAGE TypeFamilies        #-}
    8 
    +{-# LANGUAGE TypeOperators       #-}
    9 
    +module T15588 where
    10 
    +
    11 
    +import Data.Proxy
    12 
    +import Data.Type.Equality
    13 
    +import Data.Type.Bool
    14 
    +import Data.Kind
    15 
    +
    16 
    +data SameKind :: forall k. k -> k -> Type
    17 
    +type family IfK (e :: Proxy (j :: Bool)) (f :: m) (g :: n) :: If j m n where
    18 
    +   IfK (_ :: Proxy True)  f _ = f
    19 
    +   IfK (_ :: Proxy False) _ g = g
    20 
    +
    21 
    +y :: forall ck (c :: ck). ck :~: Proxy True -> ()
    22 
    +y Refl = let x :: forall a b (d :: a). SameKind (IfK c b d) d
    23 
    +             x = undefined
    24 
    +         in ()
    25 
    +

  • testsuite/tests/dependent/should_fail/T15588.stderr
    1 
    +T15588.hs:18:9: error: [GHC-25897]
    2 
    +    • Couldn't match kind ‘j’ with ‘True’
    3 
    +      Expected kind ‘Proxy j’,
    4 
    +        but ‘_ :: Proxy True’ has kind ‘Proxy True’
    5 
    +    • In the first argument of ‘IfK’, namely ‘(_ :: Proxy True)’
    6 
    +      In the type family declaration for ‘IfK’
    7 
    +

  • testsuite/tests/dependent/should_fail/all.T
    ... ... @@ -34,6 +34,7 @@ test('T15215', normal, compile_fail, [''])
    34 34 
     test('T15308', normal, compile_fail, ['-fno-print-explicit-kinds'])
    35 35 
     test('T15343', normal, compile_fail, [''])
    36 36 
     test('T15380', normal, compile_fail, [''])
    37 
    +test('T15588', normal, compile_fail, [''])
    37 38 
     test('T15591b', normal, compile_fail, [''])
    38 39 
     test('T15591c', normal, compile_fail, [''])
    39 40 
     test('T15743c', normal, compile_fail, [''])

  • testsuite/tests/simplCore/should_compile/T12640.hs
    1 
    +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
    2 
    +module T12640 where
    3 
    +
    4 
    +class Ex2 a b c | a b -> c where
    5 
    +  (+++) :: a -> b -> c
    6 
    +
    7 
    +instance Ex2 Bool Bool Bool where
    8 
    +  (+++) = ex_or
    9 
    +
    10 
    +{-# INLINE [2] ex_or #-}
    11 
    +ex_or = (||)
    12 
    +
    13 
    +{-# RULES
    14 
    +"force-inline" forall a b . ex_or a b = a || b
    15 
    + #-}
    16 
    +
    17 
    +main = print (True +++ True)
    18 
    +

  • testsuite/tests/simplCore/should_compile/T12640.stderr
    1 
    +Rule fired: Class op show (BUILTIN)
    2 
    +Rule fired: force-inline (T12640)

  • testsuite/tests/simplCore/should_compile/T14908.hs
    1 
    +{-# LANGUAGE OverloadedStrings, LambdaCase #-}
    2 
    +import Data.String
    3 
    +import T14908_Deps
    4 
    +import Data.List (nub, sort)
    5 
    +import System.Environment
    6 
    +
    7 
    +data Expr = Var String | Not Expr | Expr :|: Expr | Expr :&: Expr deriving Eq
    8 
    +
    9 
    +nfd e = if e == e' then e else nfd e'
    10 
    +  where e' = rec e
    11 
    +        rec x@(Var _) = x
    12 
    +        rec x@(Not (Var _)) = x
    13 
    +        rec (Not (Not x)) = x
    14 
    +        rec (Not (a :|: b)) = rec $ Not a :&: Not b
    15 
    +        rec (Not (a :&: b)) = rec $ Not a :|: Not b
    16 
    +        rec ((a :|: b) :&: c) = rec $ (a :&: c) :|: (b :&: c)
    17 
    +        rec (a :&: (b :|: c)) = rec $ (a :&: b) :|: (a :&: c)
    18 
    +        rec (a :&: b) = rec a :&: rec b
    19 
    +        rec (a :|: b) = rec a :|: rec b
    20 
    +
    21 
    +eval :: Expr -> Reader [(String, Bool)] Bool
    22 
    +eval (Var x) = asks (lookup x) >>= maybe (error $ "Var `" ++ x ++ "` not defined!") return
    23 
    +eval (Not x) = not <$> eval x
    24 
    +eval (a :&: b) = (&&) <$> eval a <*> eval b
    25 
    +eval (a :|: b) = (||) <$> eval a <*> eval b
    26 
    +
    27 
    +instance Show Expr where
    28 
    +  show (Var x) = x
    29 
    +  show (Not (Var x)) = "¬" ++ x
    30 
    +  show (Not x) = "¬(" ++ show x ++ ")"
    31 
    +  show (a :|: b) = show' a ++ " ∨ " ++ show' b where show' c@(_ :&: _) = "(" ++ show c ++ ")"; show' c = show c
    32 
    +  show (a :&: b) = show' a ++ " ∧ " ++ show' b where show' c@(_ :|: _) = "(" ++ show c ++ ")"; show' c = show c
    33 
    +
    34 
    +instance IsString Expr where
    35 
    +  fromString = Var
    36 
    +
    37 
    +fullImage e = (runReader (eval e) . zipWith (,) vs) <$> bits (length vs)
    38 
    +  where vs = nub $ sort $ vars e
    39 
    +        vars (Var x) = [x]
    40 
    +        vars (Not x) = vars x
    41 
    +        vars (a :&: b) = vars a ++ vars b
    42 
    +        vars (a :|: b) = vars a ++ vars b
    43 
    +        bits 0 = [[]]
    44 
    +        bits n = ((False:) <$> xs) ++ ((True:) <$> xs) where xs = bits (n - 1)
    45 
    +
    46 
    +testNFD e = fullImage e == fullImage (nfd e)
    47 
    +
    48 
    +instance Arbitrary Expr where
    49 
    +  arbitrary = sized gen
    50 
    +              where gen n = choose (1, max 1 (min 4 n)) >>= \case
    51 
    +                              1 -> (Var . (:"") . (['a'..]!!)) <$> choose (1, 5) -- no más de 5 vars
    52 
    +                              2 -> (:&:) <$> gen (n-1) <*> gen (n-1)
    53 
    +                              3 -> (:|:) <$> gen (n-1) <*> gen (n-1)
    54 
    +                              4 -> Not <$> gen (n-1)
    55 
    +
    56 
    +main = do
    57 
    +  [a,b] <- map (read :: String -> Int) <$> getArgs
    58 
    +  quickCheckWith (stdArgs {maxSize = fromIntegral 10, maxSuccess = fromIntegral 1000}) testNFD

  • testsuite/tests/simplCore/should_compile/T14908_Deps.hs
    1 
    +module T14908_Deps
    2 
    +  ( Reader
    3 
    +  , runReader
    4 
    +  , asks
    5 
    +  , Arbitrary(..)
    6 
    +  , Gen
    7 
    +  , sized
    8 
    +  , choose
    9 
    +  , Args(..)
    10 
    +  , stdArgs
    11 
    +  , quickCheckWith
    12 
    +  ) where
    13 
    +
    14 
    +import System.CPUTime (getCPUTime)
    15 
    +
    16 
    +newtype Reader r a = Reader { runReader :: r -> a }
    17 
    +
    18 
    +instance Functor (Reader r) where
    19 
    +  fmap f (Reader g) = Reader (f . g)
    20 
    +
    21 
    +instance Applicative (Reader r) where
    22 
    +  pure x = Reader (\_ -> x)
    23 
    +  Reader f <*> Reader g = Reader (\r -> f r (g r))
    24 
    +
    25 
    +instance Monad (Reader r) where
    26 
    +  return = pure
    27 
    +  Reader g >>= f = Reader (\r -> runReader (f (g r)) r)
    28 
    +
    29 
    +asks :: (r -> a) -> Reader r a
    30 
    +asks f = Reader f
    31 
    +
    32 
    +newtype Gen a = Gen { runGen :: Int -> Int -> (a, Int) }
    33 
    +
    34 
    +instance Functor Gen where
    35 
    +  fmap f (Gen g) = Gen $ \n s ->
    36 
    +    let (x, s') = g n s
    37 
    +    in (f x, s')
    38 
    +
    39 
    +instance Applicative Gen where
    40 
    +  pure x = Gen (\_ s -> (x, s))
    41 
    +  Gen f <*> Gen g = Gen $ \n s ->
    42 
    +    let (h, s1) = f n s
    43 
    +        (x, s2) = g n s1
    44 
    +    in (h x, s2)
    45 
    +
    46 
    +instance Monad Gen where
    47 
    +  return = pure
    48 
    +  Gen g >>= f = Gen $ \n s ->
    49 
    +    let (x, s1) = g n s
    50 
    +    in runGen (f x) n s1
    51 
    +
    52 
    +class Arbitrary a where
    53 
    +  arbitrary :: Gen a
    54 
    +
    55 
    +sized :: (Int -> Gen a) -> Gen a
    56 
    +sized f = Gen $ \n s -> runGen (f n) n s
    57 
    +
    58 
    +choose :: (Int, Int) -> Gen Int
    59 
    +choose (lo, hi) = Gen $ \_ s ->
    60 
    +  let s' = nextSeed s
    61 
    +      width = hi - lo + 1
    62 
    +      offset = if width <= 0 then 0 else abs s' `mod` width
    63 
    +  in (lo + offset, s')
    64 
    +
    65 
    +data Args = Args
    66 
    +  { maxSize :: Int
    67 
    +  , maxSuccess :: Int
    68 
    +  }
    69 
    +
    70 
    +stdArgs :: Args
    71 
    +stdArgs = Args
    72 
    +  { maxSize = 100
    73 
    +  , maxSuccess = 100
    74 
    +  }
    75 
    +
    76 
    +quickCheckWith :: (Arbitrary a, Show a) => Args -> (a -> Bool) -> IO ()
    77 
    +quickCheckWith args prop = do
    78 
    +  seed0 <- seedFromCPUTime
    79 
    +  loop 0 seed0
    80 
    +  where
    81 
    +    total = max 0 (maxSuccess args)
    82 
    +    maxN = max 1 (maxSize args)
    83 
    +
    84 
    +    loop n seed
    85 
    +      | n >= total = putStrLn ("+++ OK, passed " ++ show total ++ " tests.")
    86 
    +      | otherwise =
    87 
    +          let size = (n `mod` maxN) + 1
    88 
    +              (x, seed') = runGen arbitrary size seed
    89 
    +          in if prop x
    90 
    +               then loop (n + 1) seed'
    91 
    +               else putStrLn ("*** Failed! Falsified with input: " ++ show x)
    92 
    +
    93 
    +seedFromCPUTime :: IO Int
    94 
    +seedFromCPUTime = do
    95 
    +  t <- getCPUTime
    96 
    +  return (fromInteger (t `mod` 2147483647))
    97 
    +
    98 
    +nextSeed :: Int -> Int
    99 
    +nextSeed x =
    100 
    +  fromInteger ((1103515245 * toInteger x + 12345) `mod` 2147483647)

  • testsuite/tests/simplCore/should_compile/T9445.hs
    1 
    +module T9445 (Transform) where
    2 
    +
    3 
    +data Transform = Transform
    4 
    +    { m00 :: !Float, m10 :: !Float, m20 :: !Float
    5 
    +    , m01 :: !Float, m11 :: !Float, m21 :: !Float
    6 
    +    , m02 :: !Float, m12 :: !Float, m22 :: !Float
    7 
    +    }
    8 
    +
    9 
    +instance Num Transform where
    10 
    +  abs (Transform a00 a01 a02 a03 a04 a05 a06 a07 a08) =
    11 
    +        (Transform (abs a00) (abs a01) (abs a02) (abs a03)
    12 
    +            (abs a04) (abs a05) (abs a06) (abs a07) (abs a08))
    13 
    +

  • testsuite/tests/simplCore/should_compile/all.T
    ... ... @@ -190,6 +190,7 @@ test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniq
    190 190 
     test('T9441a', [only_ways(['optasm']), check_errmsg(r'f1 = f2') ], compile, ['-ddump-simpl -dsuppress-ticks'])
    191 191 
     test('T9441b', [only_ways(['optasm']), check_errmsg(r'Rec {') ], compile, ['-ddump-simpl'])
    192 192 
     test('T9441c', [only_ways(['optasm']), check_errmsg(r'Rec {') ], compile, ['-ddump-simpl'])
    193 
    +test('T9445', only_ways(['optasm']), compile, ['-Wno-missing-methods'])
    193 194 
     test('T9583', only_ways(['optasm']), compile, [''])
    194 195 
     test('T9565', only_ways(['optasm']), compile, [''])
    195 196 
     test('T5821', only_ways(['optasm']), compile, [''])
    ... ... @@ -227,6 +228,7 @@ test('T9509',
    227 228 
     test('T12603',
    228 229 
          normal,
    229 230 
          makefile_test, ['T12603'])
    231 
    +test('T12640', [grep_errmsg(r'force-inline')], compile, ['-O2 -ddump-rule-firings'])
    230 232 
     test('T12877', normal, makefile_test, ['T12877'])
    231 233 
     test('T13027', normal, compile, [''])
    232 234 
     test('T13025',
    ... ... @@ -279,6 +281,7 @@ test('T14152a', [extra_files(['T14152.hs']), pre_cmd('cp T14152.hs T14152a.hs'),
    279 281 
                     compile, ['-fno-exitification -ddump-simpl'])
    280 282 
     test('T13990', normal, compile, ['-dcore-lint -O'])
    281 283 
     test('T14650', normal, compile, ['-O2'])
    284 
    +test('T14908', normal, multimod_compile, ['T14908', '-O2 -v0'])
    282 285 
     test('T14959', normal, compile, ['-O'])
    283 286 
     test('T14978',
    284 287 
          normal,

  • testsuite/tests/typecheck/should_compile/T14151.hs
    1 
    +{-# LANGUAGE DataKinds #-}
    2 
    +{-# LANGUAGE GADTs #-}
    3 
    +{-# LANGUAGE KindSignatures #-}
    4 
    +{-# LANGUAGE PolyKinds #-}
    5 
    +{-# LANGUAGE RankNTypes #-}
    6 
    +module T14151 where
    7 
    +
    8 
    +newtype HFix h a = HFix (h (HFix h) a)
    9 
    +
    10 
    +class EqForall f where
    11 
    +  eqForall :: f a -> f a -> Bool
    12 
    +
    13 
    +class EqHetero h where
    14 
    +  eqHetero :: (forall x. f x -> f x -> Bool) -> h f a -> h f a -> Bool
    15 
    +
    16 
    +instance EqHetero h => EqForall (HFix h) where
    17 
    +  eqForall (HFix a) (HFix b) = eqHetero eqForall a b
    18 
    +
    19 
    +instance EqHetero h => Eq (HFix h a) where
    20 
    +  (==) = eqForall

  • testsuite/tests/typecheck/should_compile/all.T
    ... ... @@ -601,6 +601,7 @@ test('T13915b', expect_broken(15245), compile, [''])
    601 601 
     test('T13984', normal, compile, [''])
    602 602 
     test('T14128', normal, multimod_compile, ['T14128Main', '-v0'])
    603 603 
     test('T14149', normal, compile_fail, [''])
    604 
    +test('T14151', normal, compile, [''])
    604 605 
     test('T14154', normal, compile, [''])
    605 606 
     test('T14158', normal, compile, [''])
    606 607 
     test('T13943', normal, compile, ['-fsolve-constant-dicts'])

  • testsuite/tests/typecheck/should_fail/T12694.hs
    1 
    +{-# LANGUAGE GADTs #-}
    2 
    +module T12694 where
    3 
    +
    4 
    +f :: Bool ~ Int => a -> b
    5 
    +f x = x

  • testsuite/tests/typecheck/should_fail/T12694.stderr
    1 
    +T12694.hs:5:7: error: [GHC-25897]
    2 
    +    • Could not deduce ‘a ~ b’
    3 
    +      from the context: Bool ~ Int
    4 
    +        bound by the type signature for:
    5 
    +                   f :: forall a b. (Bool ~ Int) => a -> b
    6 
    +        at T12694.hs:4:1-25
    7 
    +      ‘a’ is a rigid type variable bound by
    8 
    +        the type signature for:
    9 
    +          f :: forall a b. (Bool ~ Int) => a -> b
    10 
    +        at T12694.hs:4:1-25
    11 
    +      ‘b’ is a rigid type variable bound by
    12 
    +        the type signature for:
    13 
    +          f :: forall a b. (Bool ~ Int) => a -> b
    14 
    +        at T12694.hs:4:1-25
    15 
    +    • In the expression: x
    16 
    +      In an equation for ‘f’: f x = x
    17 
    +    • Relevant bindings include
    18 
    +        x :: a (bound at T12694.hs:5:3)
    19 
    +        f :: a -> b (bound at T12694.hs:5:1)
    20 
    +

  • testsuite/tests/typecheck/should_fail/T16275.stderr
    1 
    +T16275B.hs-boot:4:10: error: [GHC-65507]
    2 
    +    • Wildcard ‘_’ not allowed
    3 
    +    • In the first argument of ‘T’, namely ‘_’
    4 
    +      In the type signature: foo :: T _
    5 
    +

  • testsuite/tests/typecheck/should_fail/T16275A.hs
    1 
    +module T16275A where
    2 
    +
    3 
    +import {-# SOURCE #-} T16275B

  • testsuite/tests/typecheck/should_fail/T16275B.hs
    1 
    +module T16275B where

  • testsuite/tests/typecheck/should_fail/T16275B.hs-boot
    1 
    +module T16275B where
    2 
    +
    3 
    +data T a
    4 
    +foo :: T _

  • testsuite/tests/typecheck/should_fail/all.T
    ... ... @@ -430,6 +430,7 @@ test('T12589', normal, compile_fail, [''])
    430 430 
     test('T12529', normal, compile_fail, [''])
    431 431 
     test('T12563', normal, compile, ['']) # Turns out we can accept this one after all!
    432 432 
     test('T12648', normal, compile_fail, [''])
    433 
    +test('T12694', normal, compile_fail, [''])
    433 434 
     test('T12729', normal, compile_fail, [''])
    434 435 
     test('T12785b', normal, compile_fail, [''])
    435 436 
     test('T12803', normal, compile_fail, [''])
    ... ... @@ -518,6 +519,8 @@ test('T16059e', [extra_files(['T16059b.hs'])], multimod_compile_fail,
    518 519 
         ['T16059e', '-v0'])
    519 520 
     test('T16255', normal, compile_fail, [''])
    520 521 
     test('T16204c', normal, compile_fail, [''])
    522 
    +test('T16275', [extra_files(['T16275A.hs', 'T16275B.hs', 'T16275B.hs-boot'])],
    523 
    +    multimod_compile_fail, ['T16275A', '-v0'])
    521 524 
     test('T16394', normal, compile_fail, [''])
    522 525 
     test('T16414', normal, compile_fail, [''])
    523 526 
     test('T16453E1', extra_files(['T16453T.hs', 'T16453S.hs']), multimod_compile_fail,

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