[commit: ghc] wip/orf-2017: Remove IsLabel instance for (->) (533ee26)

git at git.haskell.org git at git.haskell.org
Wed Feb 8 21:24:11 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/orf-2017
Link       : http://ghc.haskell.org/trac/ghc/changeset/533ee260026abe2d2fda687282023bc1594ee494/ghc

>---------------------------------------------------------------

commit 533ee260026abe2d2fda687282023bc1594ee494
Author: Adam Gundry <adam at well-typed.com>
Date:   Wed Feb 8 20:56:19 2017 +0000

    Remove IsLabel instance for (->)


>---------------------------------------------------------------

533ee260026abe2d2fda687282023bc1594ee494
 libraries/base/GHC/OverloadedLabels.hs                         |  6 ------
 .../should_fail/overloadedlabelsfail01.stderr                  | 10 ++--------
 testsuite/tests/overloadedrecflds/should_run/hasfieldrun02.hs  |  6 ++++++
 .../overloadedrecflds/should_run/overloadedrecfldsrun07.hs     |  7 +++++--
 4 files changed, 13 insertions(+), 16 deletions(-)

diff --git a/libraries/base/GHC/OverloadedLabels.hs b/libraries/base/GHC/OverloadedLabels.hs
index 670ce7c..7e27cf6 100644
--- a/libraries/base/GHC/OverloadedLabels.hs
+++ b/libraries/base/GHC/OverloadedLabels.hs
@@ -49,12 +49,6 @@ module GHC.OverloadedLabels
        ) where
 
 import GHC.Base ( Symbol )
-import GHC.Records
 
 class IsLabel (x :: Symbol) a where
   fromLabel :: a
-
--- | If an overloaded label is used at function type, it will be
--- treated as an overloaded record field selector using 'HasField'.
-instance HasField x r a => IsLabel x (r -> a) where
-  fromLabel = getField @x
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr
index 6709008..4cd5231 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr
@@ -1,13 +1,7 @@
 
 overloadedlabelsfail01.hs:6:5: error:
-    • Ambiguous type variable ‘t0’ arising from the overloaded label ‘#x’
-      prevents the constraint ‘(IsLabel "x" t0)’ from being solved.
-      Relevant bindings include
-        a :: t0 (bound at overloadedlabelsfail01.hs:6:1)
-      Probable fix: use a type annotation to specify what ‘t0’ should be.
-      These potential instance exist:
-        instance GHC.Records.HasField x r a => IsLabel x (r -> a)
-          -- Defined in ‘GHC.OverloadedLabels’
+    • No instance for (IsLabel "x" t0)
+        arising from the overloaded label ‘#x’
     • In the expression: #x
       In an equation for ‘a’: a = #x
 
diff --git a/testsuite/tests/overloadedrecflds/should_run/hasfieldrun02.hs b/testsuite/tests/overloadedrecflds/should_run/hasfieldrun02.hs
index 4ea86c2..5bfddbb 100644
--- a/testsuite/tests/overloadedrecflds/should_run/hasfieldrun02.hs
+++ b/testsuite/tests/overloadedrecflds/should_run/hasfieldrun02.hs
@@ -3,8 +3,14 @@
              FlexibleInstances, MultiParamTypeClasses,
              ScopedTypeVariables, TypeApplications #-}
 
+import GHC.OverloadedLabels
+import GHC.Records
+
 data S = MkS { foo :: Int }
 data T x y z = forall b . MkT { foo :: y, bar :: b }
 
+instance HasField x r a => IsLabel x (r -> a) where
+  fromLabel = getField @x
+
 main = do print (#foo (MkS 42))
           print (#foo (MkT True False))
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs
index 5e9a8af..25da616 100644
--- a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs
@@ -11,7 +11,7 @@
            , UndecidableInstances
   #-}
 
-import qualified GHC.OverloadedLabels as OL
+import GHC.OverloadedLabels
 import GHC.Records
 import GHC.TypeLits
 
@@ -29,9 +29,12 @@ instance {-# OVERLAPS #-} a ~ b => HasField foo (Rec ('(foo, a) ': xs)) b where
 instance HasField foo (Rec xs) b => HasField foo (Rec ('(bar, a) ': xs)) b where
   getField (_ :> vs) = getField @foo vs
 
-instance y ~ x => OL.IsLabel y (Label x) where
+instance y ~ x => IsLabel y (Label x) where
   fromLabel = Label
 
+instance HasField x r a => IsLabel x (r -> a) where
+  fromLabel = getField @x
+
 x :: Rec '[ '("foo", Int), '("bar", Bool)]
 x = #foo := 42 :> #bar := True :> Nil
 



More information about the ghc-commits mailing list