[commit: ghc] wip/hasfield: Remove Proxy# argument from GHC.OverloadedLabels.fromLabel (3b80b75)
git at git.haskell.org
git at git.haskell.org
Sat Oct 8 16:15:19 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/hasfield
Link : http://ghc.haskell.org/trac/ghc/changeset/3b80b754f1bc4e3d82d2b1abb927a75821247b33/ghc
>---------------------------------------------------------------
commit 3b80b754f1bc4e3d82d2b1abb927a75821247b33
Author: Adam Gundry <adam at well-typed.com>
Date: Sat Oct 8 12:05:03 2016 +0100
Remove Proxy# argument from GHC.OverloadedLabels.fromLabel
>---------------------------------------------------------------
3b80b754f1bc4e3d82d2b1abb927a75821247b33
compiler/typecheck/TcExpr.hs | 14 +++++---------
libraries/base/GHC/OverloadedLabels.hs | 9 ++++-----
.../overloadedrecflds/ghci/overloadedlabelsghci01.script | 4 ++--
.../should_run/OverloadedLabelsRun04_A.hs | 2 +-
.../overloadedrecflds/should_run/overloadedlabelsrun01.hs | 4 ++--
.../overloadedrecflds/should_run/overloadedlabelsrun02.hs | 4 ++--
.../overloadedrecflds/should_run/overloadedlabelsrun03.hs | 2 +-
7 files changed, 17 insertions(+), 22 deletions(-)
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 8ae454c..3a5f715 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -224,12 +224,9 @@ tcExpr e@(HsOverLabel l) res_ty -- See Note [Type-checking overloaded labels]
pred = mkClassPred isLabelClass [lbl, alpha]
; loc <- getSrcSpanM
; var <- emitWantedEvVar origin pred
- ; let proxy_arg = L loc (mkHsWrap (mkWpTyApps [typeSymbolKind, lbl])
- (HsVar (L loc proxyHashId)))
- tm = L loc (fromDict pred (HsVar (L loc var))) `HsApp` proxy_arg
- ; tcWrapResult e tm alpha res_ty }
+ ; tcWrapResult e (fromDict pred (HsVar (L loc var))) alpha res_ty }
where
- -- Coerces a dictionary for `IsLabel "x" t` into `Proxy# x -> t`.
+ -- Coerces a dictionary for `IsLabel "x" t` into `t`.
fromDict pred = HsWrap $ mkWpCastR $ unwrapIP pred
origin = OverLabelOrigin l
@@ -269,16 +266,15 @@ Note [Type-checking overloaded labels]
Recall that (in GHC.OverloadedLabels) we have
class IsLabel (x :: Symbol) a where
- fromLabel :: Proxy# x -> a
+ fromLabel :: a
When we see an overloaded label like `#foo`, we generate a fresh
variable `alpha` for the type and emit an `IsLabel "foo" alpha`
constraint. Because the `IsLabel` class has a single method, it is
represented by a newtype, so we can coerce `IsLabel "foo" alpha` to
-`Proxy# "foo" -> alpha` (just like for implicit parameters). We then
-apply it to `proxy#` of type `Proxy# "foo"`.
+`alpha` (just like for implicit parameters).
-That is, we translate `#foo` to `fromLabel (proxy# :: Proxy# "foo")`.
+That is, we translate `#foo` to `fromLabel @"foo"`.
-}
diff --git a/libraries/base/GHC/OverloadedLabels.hs b/libraries/base/GHC/OverloadedLabels.hs
index f4a76cf..3a3449d 100644
--- a/libraries/base/GHC/OverloadedLabels.hs
+++ b/libraries/base/GHC/OverloadedLabels.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE NoImplicitPrelude
+{-# LANGUAGE AllowAmbiguousTypes
+ , NoImplicitPrelude
, MultiParamTypeClasses
- , MagicHash
, KindSignatures
, DataKinds
#-}
@@ -23,7 +23,7 @@
-- The key idea is that when GHC sees an occurrence of the new
-- overloaded label syntax @#foo@, it is replaced with
--
--- > fromLabel (proxy# :: Proxy# "foo") :: alpha
+-- > fromLabel @"foo" :: alpha
--
-- plus a wanted constraint @IsLabel "foo" alpha at .
--
@@ -42,7 +42,6 @@ module GHC.OverloadedLabels
) where
import GHC.Base ( Symbol )
-import GHC.Exts ( Proxy# )
class IsLabel (x :: Symbol) a where
- fromLabel :: Proxy# x -> a
+ fromLabel :: a
diff --git a/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script b/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script
index 3b5dde1..70efb79 100644
--- a/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script
+++ b/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.script
@@ -2,8 +2,8 @@
:t #x
:m + GHC.OverloadedLabels
:seti -XFlexibleInstances -XFlexibleContexts -XTypeFamilies -XMultiParamTypeClasses
-instance IsLabel x [Char] where fromLabel _ = "hello"
-instance (s ~ [Char], t ~ [Char]) => IsLabel x (s -> t) where fromLabel _ = (++ " world")
+instance IsLabel x [Char] where fromLabel = "hello"
+instance (s ~ [Char], t ~ [Char]) => IsLabel x (s -> t) where fromLabel = (++ " world")
#x :: String
#x #y
:{
diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedLabelsRun04_A.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedLabelsRun04_A.hs
index e3b38c2..8c3b992 100644
--- a/testsuite/tests/overloadedrecflds/should_run/OverloadedLabelsRun04_A.hs
+++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedLabelsRun04_A.hs
@@ -5,4 +5,4 @@ import GHC.OverloadedLabels
import Language.Haskell.TH
instance IsLabel x (Q [Dec]) where
- fromLabel _ = [d| main = putStrLn "Ok" |]
+ fromLabel = [d| main = putStrLn "Ok" |]
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun01.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun01.hs
index 45c7854..972932c 100644
--- a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun01.hs
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun01.hs
@@ -11,10 +11,10 @@
import GHC.OverloadedLabels
instance IsLabel "true" Bool where
- fromLabel _ = True
+ fromLabel = True
instance IsLabel "false" Bool where
- fromLabel _ = False
+ fromLabel = False
a :: IsLabel "true" t => t
a = #true
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun02.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun02.hs
index eea8f36..94f8d0c 100644
--- a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun02.hs
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun02.hs
@@ -20,7 +20,7 @@ import Data.Proxy ( Proxy(..) )
import GHC.TypeLits ( Symbol )
instance x ~ y => IsLabel x (Proxy y) where
- fromLabel _ = Proxy
+ fromLabel = Proxy
data Elem (x :: Symbol) g where
Top :: Elem x (x ': g)
@@ -45,7 +45,7 @@ data Tm g where
deriving instance Show (Tm g)
instance IsElem x g => IsLabel x (Tm g) where
- fromLabel _ = Var (which :: Elem x g)
+ fromLabel = Var (which :: Elem x g)
lam :: Proxy x -> Tm (x ': g) -> Tm g
lam _ = Lam
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun03.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun03.hs
index a854d7a..f84a380 100644
--- a/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun03.hs
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedlabelsrun03.hs
@@ -15,7 +15,7 @@ import Data.Proxy ( Proxy(..) )
import GHC.TypeLits ( KnownSymbol, symbolVal )
instance (KnownSymbol x, c ~ Char) => IsLabel x [c] where
- fromLabel _ = symbolVal (Proxy :: Proxy x)
+ fromLabel = symbolVal (Proxy :: Proxy x)
main = do putStrLn #x
print $ #x ++ #y
More information about the ghc-commits
mailing list