Patrick pushed to branch wip/T25888 at Glasgow Haskell Compiler / GHC
Commits:
-
b24033cc
by Patrick at 2025-04-18T14:47:51+08:00
5 changed files:
- + testsuite/tests/default/T25888v1.hs
- + testsuite/tests/default/T25888v1.stdout
- + testsuite/tests/default/T25888v2.hs
- + testsuite/tests/default/T25888v2.stdout
- testsuite/tests/default/all.T
Changes:
| 1 | +{-# LANGUAGE ExtendedDefaultRules #-}
|
|
| 2 | +{-# LANGUAGE NamedDefaults #-}
|
|
| 3 | +{-# LANGUAGE RequiredTypeArguments #-}
|
|
| 4 | + |
|
| 5 | +module Main where
|
|
| 6 | +import Data.Foldable (Foldable(..))
|
|
| 7 | +import Data.Functor.Identity (Identity(..))
|
|
| 8 | + |
|
| 9 | +default Foldable (Maybe)
|
|
| 10 | +default Num (Double)
|
|
| 11 | +default Show ()
|
|
| 12 | +-- This is ensured we cleanup defaults for Show,
|
|
| 13 | +-- we do not want Show to effect the defaulting of `Num, Foldable`.
|
|
| 14 | +-- since we are using Show to print out the result.
|
|
| 15 | + |
|
| 16 | +class (Foldable t) => Build t where
|
|
| 17 | + polyFold :: forall a -> t a
|
|
| 18 | + |
|
| 19 | +instance Build Maybe where
|
|
| 20 | + polyFold x = Nothing
|
|
| 21 | + |
|
| 22 | +instance Build [] where
|
|
| 23 | + polyFold x = []
|
|
| 24 | + |
|
| 25 | + |
|
| 26 | +-- This test demonstrates the functionality of ExtendedDefaultRules and NamedDefaults.
|
|
| 27 | +--
|
|
| 28 | +-- By default, ExtendedDefaultRules implicitly provides:
|
|
| 29 | +-- default Foldable ([])
|
|
| 30 | +-- default Num (Integer, Double)
|
|
| 31 | +--
|
|
| 32 | +-- However, we override these with our explicit declarations:
|
|
| 33 | +-- default Foldable (Maybe)
|
|
| 34 | +-- default Num (Double)
|
|
| 35 | +--
|
|
| 36 | +-- This test verifies that our overrides work correctly:
|
|
| 37 | +-- 1. For an unresolved type variable 't' with a 'Foldable t' constraint,
|
|
| 38 | +-- 't' defaults to 'Maybe' (not '[]')
|
|
| 39 | +-- 2. For an unresolved type variable 'a' with a 'Num a' constraint,
|
|
| 40 | +-- 'a' defaults to 'Double' (not 'Integer')
|
|
| 41 | +--
|
|
| 42 | +-- Expected outcomes:
|
|
| 43 | +-- * 'polyFold Int' evaluates to 'Nothing' (not '[]')
|
|
| 44 | +-- * '1' is a 'Double' (1.0) (not an 'Integer')
|
|
| 45 | +--
|
|
| 46 | +-- See also T25888v2.hs for a companion test without overriding the defaults
|
|
| 47 | + |
|
| 48 | +main :: IO ()
|
|
| 49 | +main = do
|
|
| 50 | + print $ polyFold Int
|
|
| 51 | + print $ 1
|
|
| 52 | + |
| 1 | +Nothing
|
|
| 2 | +1.0 |
| 1 | +{-# LANGUAGE ExtendedDefaultRules #-}
|
|
| 2 | +{-# LANGUAGE NamedDefaults #-}
|
|
| 3 | +{-# LANGUAGE RequiredTypeArguments #-}
|
|
| 4 | + |
|
| 5 | +module Main where
|
|
| 6 | +import Data.Foldable (Foldable(..))
|
|
| 7 | +import Data.Functor.Identity (Identity(..))
|
|
| 8 | + |
|
| 9 | +default Show ()
|
|
| 10 | +-- This is ensured we cleanup defaults for Show,
|
|
| 11 | +-- we do not want Show to effect the defaulting of `Num, Foldable`.
|
|
| 12 | +-- since we are using Show to print out the result.
|
|
| 13 | + |
|
| 14 | +class (Foldable t) => Build t where
|
|
| 15 | + polyFold :: forall a -> t a
|
|
| 16 | + |
|
| 17 | +instance Build Maybe where
|
|
| 18 | + polyFold x = Nothing
|
|
| 19 | + |
|
| 20 | +instance Build [] where
|
|
| 21 | + polyFold x = []
|
|
| 22 | + |
|
| 23 | +-- With ExtendedDefaultRules enabled, we implicitly have the following defaults:
|
|
| 24 | +-- default Foldable ([]), Num (Integer, Double)
|
|
| 25 | +-- These defaults are not overridden in this module.
|
|
| 26 | + |
|
| 27 | +-- According to the defaulting rules:
|
|
| 28 | +-- 1. For an unresolved type variable 't' with constraint 'Foldable t', 't' defaults to []
|
|
| 29 | +-- 2. For an unresolved type variable 'a' with constraint 'Num a', 'a' defaults to Integer
|
|
| 30 | + |
|
| 31 | +-- Therefore:
|
|
| 32 | +-- * polyFold Int should evaluate to [] (empty list)
|
|
| 33 | +-- * The literal 1 should be of type Integer
|
|
| 34 | + |
|
| 35 | +-- See also T25888v1.hs for the same test with overridden defaults
|
|
| 36 | +main :: IO ()
|
|
| 37 | +main = do
|
|
| 38 | + print $ polyFold Int
|
|
| 39 | + print $ 1
|
|
| 40 | + |
| 1 | +[]
|
|
| 2 | +1 |
| ... | ... | @@ -42,3 +42,5 @@ test('T25882', normal, compile, ['']) |
| 42 | 42 | test('T25912', [extra_files(['T25912_helper.hs'])], multimod_compile_and_run, ['T25912', ''])
|
| 43 | 43 | test('T25914', normal, compile, [''])
|
| 44 | 44 | test('T25934', normal, compile, [''])
|
| 45 | +test('T25888v1', normal, compile_and_run, [''])
|
|
| 46 | +test('T25888v2', normal, compile_and_run, ['']) |