[commit: ghc] wip/spj-wildcard-refactor: Wibbles (57b995b)
git at git.haskell.org
git at git.haskell.org
Tue Dec 1 12:59:38 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/spj-wildcard-refactor
Link : http://ghc.haskell.org/trac/ghc/changeset/57b995b83bc6f3483c0322fc13043e73e7f7e4ee/ghc
>---------------------------------------------------------------
commit 57b995b83bc6f3483c0322fc13043e73e7f7e4ee
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Tue Dec 1 12:47:13 2015 +0000
Wibbles
>---------------------------------------------------------------
57b995b83bc6f3483c0322fc13043e73e7f7e4ee
compiler/hsSyn/HsTypes.hs | 32 +++++++++++++++-------
compiler/rename/RnTypes.hs | 22 ---------------
testsuite/tests/ghci/scripts/T10248.stderr | 30 +++++++++-----------
.../should_fail/CustomTypeErrors02.stderr | 2 +-
.../wcompat-warnings/WCompatWarningsOn.stderr | 2 +-
5 files changed, 37 insertions(+), 51 deletions(-)
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index 228df71..f7883f2 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -88,7 +88,8 @@ import Maybes( isJust )
import Data.Data hiding ( Fixity )
import Data.Maybe ( fromMaybe )
#if __GLASGOW_HASKELL__ < 709
-import Data.Monoid hiding((<>))
+-- SPJ temp
+-- import Data.Monoid hiding((<>))
#endif
#if __GLASGOW_HASKELL > 710
import Data.Semigroup ( Semigroup )
@@ -202,7 +203,7 @@ type LHsKind name = Located (HsKind name)
--------------------------------------------------
-- LHsQTyVars
-- The explicitly-quantified binders in a data/type declaration
-
+SQua
type LHsTyVarBndr name = Located (HsTyVarBndr name)
-- See Note [HsType binders]
@@ -221,14 +222,18 @@ mkHsQTvs tvs = HsQTvs { hsq_kvs = PlaceHolder, hsq_tvs = tvs }
hsQTvBndrs :: LHsQTyVars name -> [LHsTyVarBndr name]
hsQTvBndrs = hsq_tvs
+{-
+#if __GLASGOW_HASKELL__ > 710
instance Semigroup (LHsTyVarBndrs name) where
HsQTvs kvs1 tvs1 <> HsQTvs kvs2 tvs2
= HsQTvs (kvs1 ++ kvs2) (tvs1 ++ tvs2)
+#endif
-instance Monoid (LHsTyVarBndrs name) where
- mempty = emptyHsQTvs
+instance Monoid (LHsQTyVars name) where
+ mempty = mkHsQTvs []
mappend (HsQTvs kvs1 tvs1) (HsQTvs kvs2 tvs2)
= HsQTvs (kvs1 ++ kvs2) (tvs1 ++ tvs2)
+-}
------------------------------------------------
-- HsImplicitBndrs
@@ -247,12 +252,19 @@ data HsImplicitBndrs name thing -- See Note [HsType binders]
deriving (Typeable)
data HsWildCardBndrs name thing -- See Note [HsType binders]
- = HsWC { hswc_wcs :: PostRn name [Name] -- Wild cards
- , hswc_ctx :: Maybe SrcSpan -- Indicates whether hswc_body has an
- -- extra-constraint wildcard, and if so where
- -- e.g. (Eq a, _) => a -> a
- -- NB: the wildcard stays in the type
- , hswc_body :: thing } -- Main payload (type or list of types)
+ = HsWC { hswc_wcs :: PostRn name [Name]
+ -- Wild cards, both named and anonymous
+
+ , hswc_ctx :: Maybe SrcSpan
+ -- Indicates whether hswc_body has an
+ -- extra-constraint wildcard, and if so where
+ -- e.g. (Eq a, _) => a -> a
+ -- NB: the wildcard stays in HsQualTy inside the type!
+ -- So for pretty printing purposes you can ignore
+ -- hswc_ctx
+
+ , hswc_body :: thing -- Main payload (type or list of types)
+ }
deriving( Typeable )
deriving instance (Data name, Data thing, Data (PostRn name [Name]))
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 90aa942..49b707c 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -178,28 +178,6 @@ rnWcSigContext ctxt (L loc hs_ctxt)
, hswc_ctx = Nothing
, hswc_body = L loc hs_ctxt' }, fvs) }
-{- Note [Error checkingp for wildcards]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Here is how various wildcard-related errors are reported
-
-* Named extra-constraints wild cards aren't allowed,
- e.g. invalid: @(Show a, _x) => a -> String at .
-
-* There is only one extra-constraints wild card in the context and it must
- come last, e.g. invalid: @(_, Show a) => a -> String@
- or @(_, Show a, _) => a -> String at .
-
-* There should be no unnamed wild cards in the context.
-
-* An extra-constraints wild card can only occur in the top-level context.
- This would be invalid: @(Eq a, _) => a -> (Num a, _) => a -> Bool at .
-
-* Named wild cards occurring in the context must also occur in the monotype.
-
-When an invalid wild card is found, we fail with an error.
-
-????? What about f :: (forall a. (Eq _) => a -> a -> Bool) -> Int
--}
{- ******************************************************
* *
diff --git a/testsuite/tests/ghci/scripts/T10248.stderr b/testsuite/tests/ghci/scripts/T10248.stderr
index 9235aec..c9df22b 100644
--- a/testsuite/tests/ghci/scripts/T10248.stderr
+++ b/testsuite/tests/ghci/scripts/T10248.stderr
@@ -1,18 +1,14 @@
-<interactive>:2:10: warning:
- Found hole: _ :: IO ()
- In the second argument of ‘(<$>)’, namely ‘_’
- In the first argument of ‘ghciStepIO ::
- forall a. IO a -> IO a’, namely
- ‘Just <$> _’
- In a stmt of an interactive GHCi command:
- it <- ghciStepIO :: forall a. IO a -> IO a (Just <$> _)
-*** Exception: <interactive>:2:10: error:
- Found hole: _ :: IO ()
- In the second argument of ‘(<$>)’, namely ‘_’
- In the first argument of ‘ghciStepIO ::
- forall a. IO a -> IO a’, namely
- ‘Just <$> _’
- In a stmt of an interactive GHCi command:
- it <- ghciStepIO :: forall a. IO a -> IO a (Just <$> _)
-(deferred type error)
+<interactive>:2:10: error:
+ • Found hole: _ :: f a
+ Where: ‘f’ is a rigid type variable bound by
+ the inferred type of it :: Functor f => f (Maybe a)
+ at <interactive>:2:1
+ ‘a’ is a rigid type variable bound by
+ the inferred type of it :: Functor f => f (Maybe a)
+ at <interactive>:2:1
+ • In the second argument of ‘(<$>)’, namely ‘_’
+ In the expression: Just <$> _
+ In an equation for ‘it’: it = Just <$> _
+ • Relevant bindings include
+ it :: f (Maybe a) (bound at <interactive>:2:1)
diff --git a/testsuite/tests/typecheck/should_fail/CustomTypeErrors02.stderr b/testsuite/tests/typecheck/should_fail/CustomTypeErrors02.stderr
index 02ae259..464c62d 100644
--- a/testsuite/tests/typecheck/should_fail/CustomTypeErrors02.stderr
+++ b/testsuite/tests/typecheck/should_fail/CustomTypeErrors02.stderr
@@ -1,7 +1,7 @@
CustomTypeErrors02.hs:17:1: error:
• The type 'a_aEN -> a_aEN' cannot be represented as an integer.
- • When checking that ‘err’ has the inferred type
+ • When checking the inferred type
err :: (TypeError ...)
CustomTypeErrors02.hs:17:7: error:
diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr
index 23d1a28..7b6b501 100644
--- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr
+++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr
@@ -6,7 +6,7 @@ WCompatWarningsOn.hs:11:5: warning:
from the context: Monad m
bound by the type signature for:
monadFail :: Monad m => m a
- at WCompatWarningsOn.hs:9:14-27
+ at WCompatWarningsOn.hs:9:1-27
Possible fix:
add (MonadFail m) to the context of
the type signature for:
More information about the ghc-commits
mailing list