[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Change GHC.hs to Packages.hs in Hadrian user-settings.md

Marge Bot gitlab at gitlab.haskell.org
Mon May 13 12:31:23 UTC 2019



 Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
8b0e1d0d by Giles Anderson at 2019-05-13T12:31:04Z
Change GHC.hs to Packages.hs in Hadrian user-settings.md

... "all packages that are currently built as part of the GHC are
defined in src/Packages.hs"

- - - - -
814d679e by Kevin Buhr at 2019-05-13T12:31:06Z
Add regression test for old parser issue #504

- - - - -
cd751cf0 by Oleg Grenrus at 2019-05-13T12:31:09Z
Update terminal title while running test-suite

Useful progress indicator even when `make test VERBOSE=1`,
and when you do something else, but have terminal title visible.

- - - - -
af052bb1 by Vladislav Zavialov at 2019-05-13T12:31:09Z
Add a minimized regression test for #12928

- - - - -
886af6fa by Vladislav Zavialov at 2019-05-13T12:31:09Z
Guard CUSKs behind a language pragma

GHC Proposal #36 describes a transition plan away from CUSKs and to
top-level kind signatures:

1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs
   as they currently exist.
2. We turn off the -XCUSKs extension in a few releases and remove it
   sometime thereafter.

This patch implements phase 1 of this plan, introducing a new language
extension to control whether CUSKs are enabled. When top-level kind
signatures are implemented, we can transition to phase 2.

- - - - -
173f05a1 by Vladislav Zavialov at 2019-05-13T12:31:10Z
Restore the --coerce option in 'happy' configuration

happy-1.19.10 has been released with a fix for --coerce in the presence
of higher rank types. This should result in about 10% performance
improvement in the parser.

- - - - -
8a844fa8 by Alp Mestanogullari at 2019-05-13T12:31:12Z
Hadrian: 'need' source files for various docs in Rules.Documentation

Previously, changing one of the .rst files from the user guide would not cause
the user guide to be rebuilt. This patch take a first stab at declaring the
documentation source files that our documentation rules depend on, focusing
on the .rst files only for now.

We eventually might want to rebuild docs when we, say, change the haddock style
file, but this level of tracking isn't really necessary for now.

This fixes #16645.

- - - - -


24 changed files:

- .gitlab-ci.yml
- aclocal.m4
- compiler/hsSyn/HsDecls.hs
- compiler/main/DynFlags.hs
- compiler/rename/RnSource.hs
- compiler/typecheck/TcTyClsDecls.hs
- docs/users_guide/glasgow_exts.rst
- hadrian/doc/user-settings.md
- hadrian/hadrian.cabal
- hadrian/src/Rules/Documentation.hs
- hadrian/src/Settings/Builders/Happy.hs
- libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
- mk/config.mk.in
- testsuite/driver/runtests.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/driver/T4437.hs
- + testsuite/tests/parser/should_compile/T504.hs
- testsuite/tests/parser/should_compile/all.T
- + testsuite/tests/typecheck/should_compile/T12928.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/all.T
- + testsuite/tests/typecheck/should_fail/tcfail225.hs
- + testsuite/tests/typecheck/should_fail/tcfail225.stderr


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -2,7 +2,7 @@ variables:
   GIT_SSL_NO_VERIFY: "1"
 
   # Commit of ghc/ci-images repository from which to pull Docker images
-  DOCKER_REV: cefaee3c742af193e0f7783f87edb0d35374515c
+  DOCKER_REV: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f
 
   # Sequential version number capturing the versions of all tools fetched by
   # .gitlab/win32-init.sh.
@@ -176,7 +176,7 @@ validate-x86_64-linux-deb8-hadrian:
 hadrian-ghc-in-ghci:
   <<: *only-default
   stage: build
-  image: ghcci/x86_64-linux-deb8:0.1
+  image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb8:$DOCKER_REV"
   before_script:
     # workaround for docker permissions
     - sudo chown ghc:ghc -R .


=====================================
aclocal.m4
=====================================
@@ -951,8 +951,8 @@ changequote([, ])dnl
 ])
 if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs
 then
-    FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.4],
-      [AC_MSG_ERROR([Happy version 1.19.4 or later is required to compile GHC.])])[]
+    FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.10],
+      [AC_MSG_ERROR([Happy version 1.19.10 or later is required to compile GHC.])])[]
 fi
 HappyVersion=$fptools_cv_happy_version;
 AC_SUBST(HappyVersion)


=====================================
compiler/hsSyn/HsDecls.hs
=====================================
@@ -679,11 +679,15 @@ countTyClDecls decls
 
 -- | Does this declaration have a complete, user-supplied kind signature?
 -- See Note [CUSKs: complete user-supplied kind signatures]
-hsDeclHasCusk :: TyClDecl GhcRn -> Bool
-hsDeclHasCusk (FamDecl { tcdFam = fam_decl })
-  = famDeclHasCusk False fam_decl
+hsDeclHasCusk
+  :: Bool  -- True <=> the -XCUSKs extension is enabled
+  -> TyClDecl GhcRn
+  -> Bool
+hsDeclHasCusk _cusks_enabled at False _ = False
+hsDeclHasCusk cusks_enabled (FamDecl { tcdFam = fam_decl })
+  = famDeclHasCusk cusks_enabled False fam_decl
     -- False: this is not: an associated type of a class with no cusk
-hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
+hsDeclHasCusk _cusks_enabled at True (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
   -- NB: Keep this synchronized with 'getInitialKind'
   = hsTvbAllKinded tyvars && rhs_annotated rhs
   where
@@ -691,9 +695,9 @@ hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
       HsParTy _ lty  -> rhs_annotated lty
       HsKindSig {}   -> True
       _              -> False
-hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
-hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
-hsDeclHasCusk (XTyClDecl _) = panic "hsDeclHasCusk"
+hsDeclHasCusk _cusks_enabled at True (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
+hsDeclHasCusk _cusks_enabled at True (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
+hsDeclHasCusk _ (XTyClDecl _) = panic "hsDeclHasCusk"
 
 -- Pretty-printing TyClDecl
 -- ~~~~~~~~~~~~~~~~~~~~~~~~
@@ -787,6 +791,10 @@ declaration before checking all of the others, supporting polymorphic recursion.
 See https://gitlab.haskell.org/ghc/ghc/wikis/ghc-kinds/kind-inference#proposed-new-strategy
 and #9200 for lots of discussion of how we got here.
 
+The detection of CUSKs is enabled by the -XCUSKs extension, switched on by default.
+Under -XNoCUSKs, all declarations are treated as if they have no CUSK.
+See https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0036-kind-signatures.rst
+
 PRINCIPLE:
   a type declaration has a CUSK iff we could produce a separate kind signature
   for it, just like a type signature for a function,
@@ -1080,11 +1088,13 @@ data FamilyInfo pass
 
 -- | Does this family declaration have a complete, user-supplied kind signature?
 -- See Note [CUSKs: complete user-supplied kind signatures]
-famDeclHasCusk :: Bool -- ^ True <=> this is an associated type family,
+famDeclHasCusk :: Bool -- ^ True <=> the -XCUSKs extension is enabled
+               -> Bool -- ^ True <=> this is an associated type family,
                        --            and the parent class has /no/ CUSK
                -> FamilyDecl pass
                -> Bool
-famDeclHasCusk assoc_with_no_cusk
+famDeclHasCusk _cusks_enabled at False _ _ = False
+famDeclHasCusk _cusks_enabled at True assoc_with_no_cusk
                (FamilyDecl { fdInfo      = fam_info
                            , fdTyVars    = tyvars
                            , fdResultSig = L _ resultSig })
@@ -1095,7 +1105,7 @@ famDeclHasCusk assoc_with_no_cusk
             -- Un-associated open type/data families have CUSKs
             -- Associated type families have CUSKs iff the parent class does
 
-famDeclHasCusk _ (XFamilyDecl {}) = panic "famDeclHasCusk"
+famDeclHasCusk _ _ (XFamilyDecl {}) = panic "famDeclHasCusk"
 
 -- | Does this family declaration have user-supplied return kind signature?
 hasReturnKindSignature :: FamilyResultSig a -> Bool


=====================================
compiler/main/DynFlags.hs
=====================================
@@ -2260,6 +2260,7 @@ languageExtensions (Just Haskell98)
     = [LangExt.ImplicitPrelude,
        -- See Note [When is StarIsType enabled]
        LangExt.StarIsType,
+       LangExt.CUSKs,
        LangExt.MonomorphismRestriction,
        LangExt.NPlusKPatterns,
        LangExt.DatatypeContexts,
@@ -2276,6 +2277,7 @@ languageExtensions (Just Haskell2010)
     = [LangExt.ImplicitPrelude,
        -- See Note [When is StarIsType enabled]
        LangExt.StarIsType,
+       LangExt.CUSKs,
        LangExt.MonomorphismRestriction,
        LangExt.DatatypeContexts,
        LangExt.TraditionalRecordSyntax,
@@ -4358,6 +4360,7 @@ xFlagsDeps = [
   flagSpec "BinaryLiterals"                   LangExt.BinaryLiterals,
   flagSpec "CApiFFI"                          LangExt.CApiFFI,
   flagSpec "CPP"                              LangExt.Cpp,
+  flagSpec "CUSKs"                            LangExt.CUSKs,
   flagSpec "ConstrainedClassMethods"          LangExt.ConstrainedClassMethods,
   flagSpec "ConstraintKinds"                  LangExt.ConstraintKinds,
   flagSpec "DataKinds"                        LangExt.DataKinds,


=====================================
compiler/rename/RnSource.hs
=====================================
@@ -1552,7 +1552,8 @@ rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars,
        ; bindHsQTyVars doc Nothing Nothing kvs tyvars $ \ tyvars' no_rhs_kvs ->
     do { (defn', fvs) <- rnDataDefn doc defn
           -- See Note [Complete user-supplied kind signatures] in HsDecls
-       ; let cusk = hsTvbAllKinded tyvars' && no_rhs_kvs
+       ; cusks_enabled <- xoptM LangExt.CUSKs
+       ; let cusk = cusks_enabled && hsTvbAllKinded tyvars' && no_rhs_kvs
              rn_info = DataDeclRn { tcdDataCusk = cusk
                                   , tcdFVs      = fvs }
        ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs)


=====================================
compiler/typecheck/TcTyClsDecls.hs
=====================================
@@ -510,8 +510,9 @@ kcTyClGroup decls
           --    3. Generalise the inferred kinds
           -- See Note [Kind checking for type and class decls]
 
+        ; cusks_enabled <- xoptM LangExt.CUSKs
         ; let (cusk_decls, no_cusk_decls)
-                 = partition (hsDeclHasCusk . unLoc) decls
+                 = partition (hsDeclHasCusk cusks_enabled . unLoc) decls
 
         ; poly_cusk_tcs <- getInitialKinds True cusk_decls
 
@@ -1040,17 +1041,25 @@ getInitialKind cusk (FamDecl { tcdFam = decl })
 getInitialKind cusk (SynDecl { tcdLName = dL->L _ name
                              , tcdTyVars = ktvs
                              , tcdRhs = rhs })
-  = do  { tycon <- kcLHsQTyVars name TypeSynonymFlavour cusk ktvs $
-                   case kind_annotation rhs of
+  = do  { cusks_enabled <- xoptM LangExt.CUSKs
+        ; tycon <- kcLHsQTyVars name TypeSynonymFlavour cusk ktvs $
+                   case kind_annotation cusks_enabled rhs of
                      Just ksig -> tcLHsKindSig (TySynKindCtxt name) ksig
-                     Nothing   -> newMetaKindVar
+                     Nothing -> newMetaKindVar
         ; return [tycon] }
   where
     -- Keep this synchronized with 'hsDeclHasCusk'.
-    kind_annotation (dL->L _ ty) = case ty of
-        HsParTy _ lty     -> kind_annotation lty
-        HsKindSig _ _ k   -> Just k
-        _                 -> Nothing
+    kind_annotation
+      :: Bool           --  cusks_enabled?
+      -> LHsType GhcRn  --  rhs
+      -> Maybe (LHsKind GhcRn)
+    kind_annotation False = const Nothing
+    kind_annotation True = go
+      where
+        go (dL->L _ ty) = case ty of
+          HsParTy _ lty     -> go lty
+          HsKindSig _ _ k   -> Just k
+          _                 -> Nothing
 
 getInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn _)) = panic "getInitialKind"
 getInitialKind _ (XTyClDecl _) = panic "getInitialKind"
@@ -1074,18 +1083,20 @@ getFamDeclInitialKind parent_cusk mb_parent_tycon
                      , fdTyVars    = ktvs
                      , fdResultSig = (dL->L _ resultSig)
                      , fdInfo      = info })
-  = kcLHsQTyVars name flav fam_cusk ktvs $
-    case resultSig of
-      KindSig _ ki                              -> tcLHsKindSig ctxt ki
-      TyVarSig _ (dL->L _ (KindedTyVar _ _ ki)) -> tcLHsKindSig ctxt ki
-      _ -- open type families have * return kind by default
-        | tcFlavourIsOpen flav              -> return liftedTypeKind
-               -- closed type families have their return kind inferred
-               -- by default
-        | otherwise                         -> newMetaKindVar
+  = do { cusks_enabled <- xoptM LangExt.CUSKs
+       ; kcLHsQTyVars name flav (fam_cusk cusks_enabled) ktvs $
+         case resultSig of
+           KindSig _ ki                              -> tcLHsKindSig ctxt ki
+           TyVarSig _ (dL->L _ (KindedTyVar _ _ ki)) -> tcLHsKindSig ctxt ki
+           _ -- open type families have * return kind by default
+             | tcFlavourIsOpen flav              -> return liftedTypeKind
+                    -- closed type families have their return kind inferred
+                    -- by default
+             | otherwise                         -> newMetaKindVar
+       }
   where
     assoc_with_no_cusk = isJust mb_parent_tycon && not parent_cusk
-    fam_cusk = famDeclHasCusk assoc_with_no_cusk decl
+    fam_cusk cusks_enabled = famDeclHasCusk cusks_enabled assoc_with_no_cusk decl
     flav = case info of
       DataFamily         -> DataFamilyFlavour mb_parent_tycon
       OpenTypeFamily     -> OpenTypeFamilyFlavour mb_parent_tycon


=====================================
docs/users_guide/glasgow_exts.rst
=====================================
@@ -9012,6 +9012,11 @@ do so.
 Complete user-supplied kind signatures and polymorphic recursion
 ----------------------------------------------------------------
 
+.. extension:: CUSKs
+    :shortdesc: Enable detection of complete user-supplied kind signatures.
+
+    :since: 8.10.1
+
 Just as in type inference, kind inference for recursive types can only
 use *monomorphic* recursion. Consider this (contrived) example: ::
 
@@ -9110,6 +9115,13 @@ example, consider ::
 According to the rules above ``X`` has a CUSK. Yet, the kind of ``k`` is undetermined.
 It is thus quantified over, giving ``X`` the kind ``forall k1 (k :: k1). Proxy k -> Type``.
 
+The detection of CUSKs is enabled by the :extension:`CUSKs` flag, which is
+switched on by default. When :extension:`CUSKs` is switched off, there is
+currently no way to enable polymorphic recursion in types. In the future, the
+notion of a CUSK will be replaced by top-level kind signatures
+(`GHC Proposal #36 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0036-kind-signatures.rst>`__),
+then, after a transition period, this extension will be turned off by default, and eventually removed.
+
 Kind inference in closed type families
 --------------------------------------
 


=====================================
hadrian/doc/user-settings.md
=====================================
@@ -88,7 +88,7 @@ userArgs :: Args
 userArgs = builder Ghc ? package cabal ? arg "-O0"
 ```
 Builders such as `Ghc` are defined in `src/Builder.hs`, and all packages that
-are currently built as part of the GHC are defined in `src/GHC.hs`.
+are currently built as part of the GHC are defined in `src/Packages.hs`.
 
 You can combine several custom command line settings using `mconcat`:
 ```haskell


=====================================
hadrian/hadrian.cabal
=====================================
@@ -132,7 +132,7 @@ executable hadrian
                        , transformers         >= 0.4     && < 0.6
                        , unordered-containers >= 0.2.1   && < 0.3
     build-tools:         alex  >= 3.1
-                       , happy >= 1.19.4
+                       , happy >= 1.19.10
     ghc-options:       -Wall
                        -Wincomplete-record-updates
                        -Wredundant-constraints


=====================================
hadrian/src/Rules/Documentation.hs
=====================================
@@ -138,6 +138,9 @@ buildSphinxHtml path = do
     root <- buildRootRules
     root -/- htmlRoot -/- path -/- "index.html" %> \file -> do
         let dest = takeDirectory file
+            rstFilesDir = pathPath path
+        rstFiles <- getDirectoryFiles rstFilesDir ["**/*.rst"]
+        need (map (rstFilesDir -/-) rstFiles)
         build $ target docContext (Sphinx Html) [pathPath path] [dest]
 
 ------------------------------------ Haddock -----------------------------------
@@ -242,6 +245,9 @@ buildSphinxPdf path = do
     root <- buildRootRules
     root -/- pdfRoot -/- path <.> "pdf" %> \file -> do
         withTempDir $ \dir -> do
+            let rstFilesDir = pathPath path
+            rstFiles <- getDirectoryFiles rstFilesDir ["**/*.rst"]
+            need (map (rstFilesDir -/-) rstFiles)
             build $ target docContext (Sphinx Latex) [pathPath path] [dir]
             build $ target docContext Xelatex [path <.> "tex"] [dir]
             copyFileUntracked (dir -/- path <.> "pdf") file


=====================================
hadrian/src/Settings/Builders/Happy.hs
=====================================
@@ -3,7 +3,7 @@ module Settings.Builders.Happy (happyBuilderArgs) where
 import Settings.Builders.Common
 
 happyBuilderArgs :: Args
-happyBuilderArgs = builder Happy ? mconcat [ arg "-ag" -- TODO (int-index): restore the -c option when happy/pull/134 is merged.
+happyBuilderArgs = builder Happy ? mconcat [ arg "-agc"
                                            , arg "--strict"
                                            , arg =<< getInput
                                            , arg "-o", arg =<< getOutput ]


=====================================
libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
=====================================
@@ -140,4 +140,5 @@ data Extension
    | QuantifiedConstraints
    | StarIsType
    | ImportQualifiedPost
+   | CUSKs
    deriving (Eq, Enum, Show, Generic, Bounded)


=====================================
mk/config.mk.in
=====================================
@@ -858,8 +858,7 @@ HAPPY_VERSION		= @HappyVersion@
 #
 # Options to pass to Happy when we're going to compile the output with GHC
 #
-# TODO (int-index): restore the -c option when happy/pull/134 is merged.
-SRC_HAPPY_OPTS		= -ag --strict
+SRC_HAPPY_OPTS		= -agc --strict
 
 #
 # Alex


=====================================
testsuite/driver/runtests.py
=====================================
@@ -189,6 +189,23 @@ else:
                 print('WARNING: No UTF8 locale found.')
                 print('You may get some spurious test failures.')
 
+# https://stackoverflow.com/a/22254892/1308058
+def supports_colors():
+    """
+    Returns True if the running system's terminal supports color, and False
+    otherwise.
+    """
+    plat = sys.platform
+    supported_platform = plat != 'Pocket PC' and (plat != 'win32' or
+                                                  'ANSICON' in os.environ)
+    # isatty is not always implemented, #6223.
+    is_a_tty = hasattr(sys.stdout, 'isatty') and sys.stdout.isatty()
+    if not supported_platform or not is_a_tty:
+        return False
+    return True
+
+config.supports_colors = supports_colors()
+
 # This has to come after arg parsing as the args can change the compiler
 get_compiler_info()
 
@@ -412,7 +429,7 @@ else:
         print(Perf.allow_changes_string(t.metrics))
         print('-' * 25)
 
-    summary(t, sys.stdout, config.no_print_summary, True)
+    summary(t, sys.stdout, config.no_print_summary, config.supports_colors)
 
     # Write perf stats if any exist or if a metrics file is specified.
     stats = [stat for (_, stat) in t.metrics]


=====================================
testsuite/driver/testglobals.py
=====================================
@@ -136,6 +136,9 @@ class TestConfig:
         # The test environment.
         self.test_env = 'local'
 
+        # terminal supports colors
+        self.supports_colors = False
+
 global config
 config = TestConfig()
 


=====================================
testsuite/driver/testlib.py
=====================================
@@ -891,11 +891,17 @@ def do_test(name, way, func, args, files):
 
     full_name = name + '(' + way + ')'
 
-    if_verbose(2, "=====> {0} {1} of {2} {3}".format(
-        full_name, t.total_tests, len(allTestNames),
+    progress_args = [ full_name, t.total_tests, len(allTestNames),
         [len(t.unexpected_passes),
          len(t.unexpected_failures),
-         len(t.framework_failures)]))
+         len(t.framework_failures)]]
+    if_verbose(2, "=====> {0} {1} of {2} {3}".format(*progress_args))
+
+    # Update terminal title
+    # useful progress indicator even when make test VERBOSE=1
+    if config.supports_colors:
+        print("\033]0;{0} {1} of {2} {3}\007".format(*progress_args), end="")
+        sys.stdout.flush()
 
     # Clean up prior to the test, so that we can't spuriously conclude
     # that it passed on the basis of old run outputs.


=====================================
testsuite/tests/driver/T4437.hs
=====================================
@@ -41,6 +41,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout",
                              "AlternativeLayoutRuleTransitional",
                              "EmptyDataDeriving",
                              "GeneralisedNewtypeDeriving",
+                             "CUSKs",
                              "ImportQualifiedPost"]
 
 expectedCabalOnlyExtensions :: [String]


=====================================
testsuite/tests/parser/should_compile/T504.hs
=====================================
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
+module Bug where
+
+-- regression test for #504:
+-- the pragma start and end sequences can both start in column 1
+-- without parse error
+
+{-# RULES
+  "foo" foo 1 = 1
+#-}
+foo 1 = 1


=====================================
testsuite/tests/parser/should_compile/all.T
=====================================
@@ -143,3 +143,4 @@ test('T15675', normal, compile, [''])
 test('T15781', normal, compile, [''])
 test('T16339', normal, compile, [''])
 test('T16619', [], multimod_compile, ['T16619', '-v0'])
+test('T504', normal, compile, [''])


=====================================
testsuite/tests/typecheck/should_compile/T12928.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE DataKinds, PolyKinds #-}
+
+module T12928 where
+
+data P (a::k) = MkP
+
+data FffSym0 (l :: P a)
+
+-- Make sure that the kind of 'k' is not defaulted:
+--
+--    data FffSym0 (l :: P (a :: Type))
+--
+-- We expect kind polymorphism:
+--
+--    data FffSym0 (l :: P (a :: k))
+--
+type Inst (a :: P Either) (b :: P Maybe) = (FffSym0 a, FffSym0 b)


=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -673,3 +673,4 @@ test('T13951', normal, compile, [''])
 test('T16411', normal, compile, [''])
 test('T16609', normal, compile, [''])
 test('T505', normal, compile, [''])
+test('T12928', normal, compile, [''])


=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -241,6 +241,7 @@ test('tcfail217', normal, compile_fail, [''])
 test('tcfail218', normal, compile_fail, [''])
 test('tcfail223', normal, compile_fail, [''])
 test('tcfail224', normal, compile_fail, [''])
+test('tcfail225', normal, compile_fail, [''])
 
 test('SilentParametersOverlapping', normal, compile, [''])
 test('FailDueToGivenOverlapping', normal, compile_fail, [''])


=====================================
testsuite/tests/typecheck/should_fail/tcfail225.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE PolyKinds, GADTs #-}
+{-# LANGUAGE NoCUSKs #-}
+
+module TcFail225 where
+
+import Data.Kind (Type)
+
+data T (m :: k -> Type) :: k -> Type where
+  MkT :: m a -> T Maybe (m a) -> T m a


=====================================
testsuite/tests/typecheck/should_fail/tcfail225.stderr
=====================================
@@ -0,0 +1,6 @@
+
+tcfail225.hs:9:19: error:
+    • Expected kind ‘k -> *’, but ‘Maybe’ has kind ‘* -> *’
+    • In the first argument of ‘T’, namely ‘Maybe’
+      In the type ‘T Maybe (m a)’
+      In the definition of data constructor ‘MkT’



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ece8ef855ee7e52f08a9a97d1ed8b4ed4b2429f6...8a844fa8a6702ecccdbceaa32826ceff4b563407

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ece8ef855ee7e52f08a9a97d1ed8b4ed4b2429f6...8a844fa8a6702ecccdbceaa32826ceff4b563407
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190513/37055fa6/attachment-0001.html>


More information about the ghc-commits mailing list