diff options
| author | Christiaan Baaij <christiaan.baaij@gmail.com> | 2022-07-24 17:33:16 +0200 |
|---|---|---|
| committer | Christiaan Baaij <christiaan.baaij@gmail.com> | 2022-07-24 23:03:19 +0200 |
| commit | a6af67ebb3a1efecc593d31e1f942a76c1c028db (patch) | |
| tree | 6c2c0000eb1395145be412eac16ab4ca193d5866 | |
| parent | 81d65f7f358fdbd1d13b89c43fc4cbe3ac82d24b (diff) | |
| download | haskell-wip/type_level_leq.tar.gz | |
Type-level comparison expands to equalitywip/type_level_leq
This avoids class instances such as:
> instance (b <= a) => F a b where
from needing -XUndecidableInstances to compile.
| -rw-r--r-- | libraries/base/Data/Type/Ord.hs | 10 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T9181.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/plugins/test-defaulting-plugin.stderr | 3 |
3 files changed, 8 insertions, 6 deletions
diff --git a/libraries/base/Data/Type/Ord.hs b/libraries/base/Data/Type/Ord.hs index 4faf106741..e6be0ba878 100644 --- a/libraries/base/Data/Type/Ord.hs +++ b/libraries/base/Data/Type/Ord.hs @@ -38,7 +38,7 @@ import GHC.Show(Show(..)) import GHC.TypeError import GHC.TypeLits.Internal import GHC.TypeNats.Internal -import GHC.Types (type (~)) +import GHC.Types (type (~), Constraint) import Data.Bool import Data.Char(Char) import Data.Eq @@ -71,25 +71,25 @@ infix 4 <=?, <=, >=?, >=, <?, <, >?, > -- | Comparison (<=) of comparable types, as a constraint. -- -- @since 4.16.0.0 -type x <= y = Assert (x <=? y) (LeErrMsg x y) +type x <= y = Assert (x <=? y) (LeErrMsg x y) ~ (() :: Constraint) type LeErrMsg x y = TypeError ('Text "Cannot satisfy: " ':<>: 'ShowType x ':<>: 'Text " <= " ':<>: 'ShowType y) -- | Comparison (>=) of comparable types, as a constraint. -- -- @since 4.16.0.0 -type x >= y = Assert (x >=? y) (GeErrMsg x y) +type x >= y = Assert (x >=? y) (GeErrMsg x y) ~ (() :: Constraint) type GeErrMsg x y = TypeError ('Text "Cannot satisfy: " ':<>: 'ShowType x ':<>: 'Text " >= " ':<>: 'ShowType y) -- | Comparison (<) of comparable types, as a constraint. -- -- @since 4.16.0.0 -type x < y = Assert (x <? y) (LtErrMsg x y) +type x < y = Assert (x <? y) (LtErrMsg x y) ~ (() :: Constraint) type LtErrMsg x y = TypeError ('Text "Cannot satisfy: " ':<>: 'ShowType x ':<>: 'Text " < " ':<>: 'ShowType y) -- | Comparison (>) of comparable types, as a constraint. -- -- @since 4.16.0.0 -type x > y = Assert (x >? y) (GtErrMsg x y) +type x > y = Assert (x >? y) (GtErrMsg x y) ~ (() :: Constraint) type GtErrMsg x y = TypeError ('Text "Cannot satisfy: " ':<>: 'ShowType x ':<>: 'Text " > " ':<>: 'ShowType y) -- | Comparison (<=) of comparable types, as a function. diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout index d6bfea3843..c148446881 100644 --- a/testsuite/tests/ghci/scripts/T9181.stdout +++ b/testsuite/tests/ghci/scripts/T9181.stdout @@ -68,6 +68,7 @@ type (Data.Type.Ord.<=) :: forall {t}. t -> t -> Constraint type (Data.Type.Ord.<=) x y = GHC.TypeError.Assert (x Data.Type.Ord.<=? y) (Data.Type.Ord.LeErrMsg x y) + ~ (() :: Constraint) :: Constraint type (Data.Type.Ord.<=?) :: forall k. k -> k -> Bool type (Data.Type.Ord.<=?) m n = diff --git a/testsuite/tests/plugins/test-defaulting-plugin.stderr b/testsuite/tests/plugins/test-defaulting-plugin.stderr index 5108d5c805..35670e5279 100644 --- a/testsuite/tests/plugins/test-defaulting-plugin.stderr +++ b/testsuite/tests/plugins/test-defaulting-plugin.stderr @@ -12,7 +12,8 @@ test-defaulting-plugin.hs:28:15: warning: [-Wtype-defaults (in -Wall)] arising from a use of ‘w’ at test-defaulting-plugin.hs:28:15 (GHC.TypeError.Assert (Data.Type.Ord.OrdCond (CmpNat 2 a0) 'True 'True 'False) - (TypeError ...)) + (TypeError ...) + ~ (() :: Constraint)) arising from a use of ‘w’ at test-defaulting-plugin.hs:28:15 In the second argument of ‘(+)’, namely ‘w’ In the second argument of ‘($)’, namely ‘q + w’ |