Magnus pushed to branch wip/mangoiv/9.12.5-rc4 at Glasgow Haskell Compiler / GHC

Commits:

23 changed files:

Changes:

  • testsuite/tests/core-to-stg/T27627/Callee.hs
    1 
    +{-# LANGUAGE GADTs, ConstraintKinds, ScopedTypeVariables #-}
    2 
    +{-# OPTIONS_GHC -fno-worker-wrapper #-}
    3 
    +module Callee where
    4 
    +
    5 
    +-- Not unary, so ($p1TC d) is not trivial and CorePrep binds it separately.
    6 
    +class Eq a => TC a where
    7 
    +  tcDummy :: a -> Int
    8 
    +
    9 
    +-- Unary: at runtime a (UC a) dictionary is the (TC a) dictionary it wraps.
    10 
    +class TC a => UC a where {}
    11 
    +
    12 
    +instance TC Int where tcDummy _ = 0
    13 
    +instance UC Int
    14 
    +
    15 
    +data Dict c where
    16 
    +  Dict :: c => Dict c
    17 
    +
    18 
    +-- Ignores its argument, so the Dict below is absent-demanded.
    19 
    +{-# NOINLINE discard #-}
    20 
    +discard :: Dict c -> Int
    21 
    +discard _ = 42
    22 
    +
    23 
    +-- Body compiles to  discard (Dict @(Eq a) ($p1TC ($p1UC d)))
    24 
    +-- The Dict is a value, so CorePrep floats the selection out and evaluates it
    25 
    +-- at the head of b.  -fno-worker-wrapper keeps the dictionary parameter.
    26 
    +{-# NOINLINE b #-}
    27 
    +b :: forall a. UC a => a -> Int
    28 
    +b _ = discard (Dict :: Dict (Eq a))

  • testsuite/tests/core-to-stg/T27627/Caller.hs
    1 
    +module Caller where
    2 
    +
    3 
    +import Callee
    4 
    +
    5 
    +-- b ignores its dictionary, so a's is absent.  Worker/wrapper must not make a
    6 
    +-- filler: b speculates a superclass selection out of it.
    7 
    +{-# NOINLINE a #-}
    8 
    +a :: UC t => t -> Int
    9 
    +a x = b x + 1

  • testsuite/tests/core-to-stg/T27627/Main.hs
    1 
    +module Main where
    2 
    +import Caller
    3 
    +main :: IO ()
    4 
    +main = print (a (1 :: Int))

  • testsuite/tests/core-to-stg/T27627/T27627.stdout
    1 
    +43

  • testsuite/tests/core-to-stg/T27627/all.T
    1 
    +test('T27627',
    2 
    +     [extra_files(['Main.hs', 'Caller.hs', 'Callee.hs'])],
    3 
    +     multimod_compile_and_run,
    4 
    +     ['Main', '-O'])

  • testsuite/tests/core-to-stg/T27627a/Callee.hs
    1 
    +{-# LANGUAGE GADTs, ConstraintKinds, ScopedTypeVariables, TypeFamilies #-}
    2 
    +{-# LANGUAGE UndecidableInstances, UndecidableSuperClasses, FlexibleInstances #-}
    3 
    +{-# OPTIONS_GHC -fno-worker-wrapper #-}
    4 
    +module Callee where
    5 
    +
    6 
    +import Data.Kind (Constraint)
    7 
    +
    8 
    +-- Reduces to (TC a), so at runtime a (UC a) dictionary is a (TC a) dictionary.
    9 
    +type family F a :: Constraint
    10 
    +type instance F a = TC a
    11 
    +
    12 
    +-- Not unary.
    13 
    +class Eq a => TC a where
    14 
    +  tcDummy :: a -> Int
    15 
    +
    16 
    +-- Unary: one superclass field, the unreduced (F a).
    17 
    +-- See (NBD1) in Note [NON-BOTTOM-DICTS invariant].
    18 
    +class F a => UC a
    19 
    +
    20 
    +instance TC Int where tcDummy _ = 0
    21 
    +instance UC Int
    22 
    +
    23 
    +data Dict c where
    24 
    +  Dict :: c => Dict c
    25 
    +
    26 
    +{-# NOINLINE discard #-}
    27 
    +discard :: Dict c -> Int
    28 
    +discard _ = 42
    29 
    +
    30 
    +{-# NOINLINE b #-}
    31 
    +b :: forall a. UC a => a -> Int
    32 
    +b _ = discard (Dict :: Dict (Eq a))

  • testsuite/tests/core-to-stg/T27627a/Caller.hs
    1 
    +module Caller where
    2 
    +
    3 
    +import Callee
    4 
    +
    5 
    +-- b ignores its dictionary, so a's is absent.  Worker/wrapper must not make a
    6 
    +-- filler: b speculates a superclass selection out of it.
    7 
    +{-# NOINLINE a #-}
    8 
    +a :: UC t => t -> Int
    9 
    +a x = b x + 1

  • testsuite/tests/core-to-stg/T27627a/Main.hs
    1 
    +module Main where
    2 
    +
    3 
    +import Caller
    4 
    +
    5 
    +main :: IO ()
    6 
    +main = print (a (3 :: Int))

  • testsuite/tests/core-to-stg/T27627a/T27627a.stdout
    1 
    +43

  • testsuite/tests/core-to-stg/T27627a/all.T
    1 
    +test('T27627a',
    2 
    +     [extra_files(['Main.hs', 'Caller.hs', 'Callee.hs'])],
    3 
    +     multimod_compile_and_run,
    4 
    +     ['Main', '-O'])

  • testsuite/tests/core-to-stg/T27627b/Callee.hs
    1 
    +{-# LANGUAGE GADTs, ConstraintKinds, ScopedTypeVariables, QuantifiedConstraints #-}
    2 
    +{-# LANGUAGE UndecidableInstances, FlexibleInstances, RankNTypes #-}
    3 
    +{-# OPTIONS_GHC -fno-worker-wrapper #-}
    4 
    +module Callee where
    5 
    +
    6 
    +-- Not unary, so a (TC a) dictionary terminates.
    7 
    +class Eq a => TC a where
    8 
    +  tcDummy :: a -> Int
    9 
    +
    10 
    +-- Unary: one superclass field, (forall a. TC (f a)).
    11 
    +-- See (NBD1) in Note [NON-BOTTOM-DICTS invariant].
    12 
    +class (forall a. TC (f a)) => UQ f
    13 
    +
    14 
    +newtype Id a = MkId a
    15 
    +instance Eq (Id a) where _ == _ = True
    16 
    +instance TC (Id a) where tcDummy _ = 0
    17 
    +instance UQ Id
    18 
    +
    19 
    +data Dict c where
    20 
    +  Dict :: c => Dict c
    21 
    +
    22 
    +{-# NOINLINE discard #-}
    23 
    +discard :: Dict c -> Int
    24 
    +discard _ = 42
    25 
    +
    26 
    +{-# NOINLINE b #-}
    27 
    +b :: forall f. UQ f => f Int -> Int
    28 
    +b _ = discard (Dict :: Dict (Eq (f Int)))

  • testsuite/tests/core-to-stg/T27627b/Caller.hs
    1 
    +module Caller where
    2 
    +
    3 
    +import Callee
    4 
    +
    5 
    +-- b ignores its dictionary, so a's is absent.  Worker/wrapper must not make a
    6 
    +-- filler: b speculates a superclass selection out of it.
    7 
    +{-# NOINLINE a #-}
    8 
    +a :: UQ f => f Int -> Int
    9 
    +a x = b x + 1

  • testsuite/tests/core-to-stg/T27627b/Main.hs
    1 
    +module Main where
    2 
    +
    3 
    +import Callee
    4 
    +import Caller
    5 
    +
    6 
    +main :: IO ()
    7 
    +main = print (a (MkId 3 :: Id Int))

  • testsuite/tests/core-to-stg/T27627b/T27627b.stdout
    1 
    +43

  • testsuite/tests/core-to-stg/T27627b/all.T
    1 
    +test('T27627b',
    2 
    +     [extra_files(['Main.hs', 'Caller.hs', 'Callee.hs'])],
    3 
    +     multimod_compile_and_run,
    4 
    +     ['Main', '-O'])

  • testsuite/tests/core-to-stg/T27627c/Callee.hs
    1 
    +{-# LANGUAGE GADTs, ScopedTypeVariables, UndecidableInstances, FlexibleInstances #-}
    2 
    +{-# LANGUAGE UndecidableSuperClasses #-}
    3 
    +{-# OPTIONS_GHC -fno-worker-wrapper #-}
    4 
    +module Callee where
    5 
    +
    6 
    +import Data.Kind (Constraint)
    7 
    +
    8 
    +class Eq a => TC a where
    9 
    +  tcDummy :: a -> Int
    10 
    +
    11 
    +class c => UC (c :: Constraint)
    12 
    +
    13 
    +instance TC Int where tcDummy _ = 0
    14 
    +instance c => UC c
    15 
    +
    16 
    +data Dict c where
    17 
    +  Dict :: c => Dict c
    18 
    +
    19 
    +{-# NOINLINE discard #-}
    20 
    +discard :: Dict c -> Int
    21 
    +discard _ = 42
    22 
    +
    23 
    +{-# NOINLINE b #-}
    24 
    +b :: forall a. UC (UC (TC a)) => a -> Int
    25 
    +b _ = discard (Dict :: Dict (Eq a))

  • testsuite/tests/core-to-stg/T27627c/Caller.hs
    1 
    +module Caller where
    2 
    +
    3 
    +import Callee
    4 
    +
    5 
    +{-# NOINLINE a #-}
    6 
    +a :: UC (UC (TC t)) => t -> Int
    7 
    +a x = b x + 1

  • testsuite/tests/core-to-stg/T27627c/Main.hs
    1 
    +module Main where
    2 
    +import Caller
    3 
    +main :: IO ()
    4 
    +main = print (a (1 :: Int))

  • testsuite/tests/core-to-stg/T27627c/T27627c.stdout
    1 
    +43

  • testsuite/tests/core-to-stg/T27627c/all.T
    1 
    +test('T27627c',
    2 
    +     [extra_files(['Main.hs', 'Caller.hs', 'Callee.hs'])],
    3 
    +     multimod_compile_and_run,
    4 
    +     ['Main', '-O'])

  • testsuite/tests/core-to-stg/T27627e.hs
    1 
    +{-# LANGUAGE QuantifiedConstraints, UndecidableInstances, FlexibleInstances,
    2 
    +             UndecidableSuperClasses, FlexibleContexts, RankNTypes #-}
    3 
    +-- T27627b's class shape, with a method and a recursive instance.
    4 
    +module Main where
    5 
    +
    6 
    +class Eq a => TC a
    7 
    +class (forall a. TC (f a)) => UQ f where { uqDummy :: f Int -> Int }
    8 
    +
    9 
    +newtype Id a = MkId a
    10 
    +instance Eq (Id a) where _ == _ = True
    11 
    +instance UQ f => TC (f a)
    12 
    +instance UQ Id where uqDummy _ = 7
    13 
    +
    14 
    +{-# NOINLINE dead #-}
    15 
    +dead :: TC a => a -> Int -> Int
    16 
    +dead _ n = n + 1
    17 
    +
    18 
    +{-# NOINLINE useUQ #-}
    19 
    +useUQ :: UQ f => f Int -> Int -> Int
    20 
    +useUQ x n = dead x n
    21 
    +
    22 
    +main :: IO ()
    23 
    +main = print (useUQ (MkId 3 :: Id Int) 41)

  • testsuite/tests/core-to-stg/T27627e.stdout
    1 
    +42

  • testsuite/tests/core-to-stg/all.T
    ... ... @@ -8,3 +8,4 @@ test('T24124', normal, compile, ['-O -ddump-stg-final -dno-typeable-binds -dsupp
    8 8 
     test('T24334', normal, compile_and_run, ['-O'])
    9 9 
     test('T24463', normal, compile, ['-O'])
    10 10 
     test('T25924a', [ignore_stderr], compile_and_run, ['-O'])
    11 
    +test('T27627e', normal, compile_and_run, ['-O0'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/feec438d628b953c892fdbcc35bc2c52498c75bd at 1788444669