[Git][ghc/ghc][ghc-9.0] 4 commits: Pattern guards BindStmt always use multiplicity Many

Ben Gamari gitlab at gitlab.haskell.org
Tue Sep 29 23:25:10 UTC 2020



Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC


Commits:
edfa896e by Arnaud Spiwack at 2020-09-29T11:41:25-04:00
Pattern guards BindStmt always use multiplicity Many

Fixes #18439 .

The rhs of the pattern guard was consumed with multiplicity one, while
the pattern assumed it was Many. We use Many everywhere instead.

This is behaviour consistent with that of `case` expression. See #18738.

(cherry picked from commit 2707c4eae4cf99e6da2709e128f560d91e468357)

- - - - -
a64ea9d0 by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00
Disallow linear types in FFI (#18472)

(cherry picked from commit 160fba4aa306c0649c72a6dcd7c98d9782a0e74b)

- - - - -
f8d8c343 by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00
Various documentation fixes

* Remove UnliftedFFITypes from conf. Some time ago, this extension
  was undocumented and we had to silence a warning.
  This is no longer needed.
* Use r'' in conf.py. This fixes a Sphinx warning:
  WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax.
* Mark GHCForeignImportPrim as documented
* Fix formatting in template_haskell.rst
* Remove 'recursive do' from the list of unsupported items in TH

(cherry picked from commit 83407ffc7acc00cc025b9f6ed063add9ab9f9bcc)

- - - - -
90fe5cff by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00
Fix handling of function coercions (#18747)

This was broken when we added multiplicity to the function type.

(cherry picked from commit e124f2a7d9a5932a4c2383fd3f9dd772b2059885)

- - - - -


20 changed files:

- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Tc/Gen/Foreign.hs
- compiler/GHC/Tc/Gen/Match.hs
- docs/users_guide/conf.py
- docs/users_guide/expected-undocumented-flags.txt
- docs/users_guide/extending_ghc.rst
- docs/users_guide/exts/defer_type_errors.rst
- docs/users_guide/exts/ffi.rst
- docs/users_guide/exts/safe_haskell.rst
- docs/users_guide/exts/template_haskell.rst
- docs/users_guide/exts/typed_holes.rst
- docs/users_guide/using-optimisation.rst
- + testsuite/tests/linear/should_fail/LinearFFI.hs
- + testsuite/tests/linear/should_fail/LinearFFI.stderr
- + testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs
- + testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr
- testsuite/tests/linear/should_fail/all.T
- + testsuite/tests/simplCore/should_compile/T18747A.hs
- + testsuite/tests/simplCore/should_compile/T18747B.hs
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Coercion.hs
=====================================
@@ -1469,7 +1469,7 @@ instCoercion (Pair lty rty) g w
   | isFunTy lty && isFunTy rty
     -- g :: (t1 -> t2) ~ (t3 -> t4)
     -- returns t2 ~ t4
-  = Just $ mkNthCo Nominal 3 g -- extract result type, which is the 4th argument to (->)
+  = Just $ mkNthCo Nominal 4 g -- extract result type, which is the 5th argument to (->)
   | otherwise -- one forall, one funty...
   = Nothing
 


=====================================
compiler/GHC/Tc/Gen/Foreign.hs
=====================================
@@ -237,7 +237,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty
                  -- things are LocalIds.  However, it does not need zonking,
                  -- (so GHC.Tc.Utils.Zonk.zonkForeignExports ignores it).
 
-       ; imp_decl' <- tcCheckFIType (map scaledThing arg_tys) res_ty imp_decl
+       ; imp_decl' <- tcCheckFIType arg_tys res_ty imp_decl
           -- Can't use sig_ty here because sig_ty :: Type and
           -- we need HsType Id hence the undefined
        ; let fi_decl = ForeignImport { fd_name = L nloc id
@@ -249,14 +249,14 @@ tcFImport d = pprPanic "tcFImport" (ppr d)
 
 -- ------------ Checking types for foreign import ----------------------
 
-tcCheckFIType :: [Type] -> Type -> ForeignImport -> TcM ForeignImport
+tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport
 
 tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh l@(CLabel _) src)
   -- Foreign import label
   = do checkCg checkCOrAsmOrLlvmOrInterp
        -- NB check res_ty not sig_ty!
        --    In case sig_ty is (forall a. ForeignPtr a)
-       check (isFFILabelTy (mkVisFunTysMany arg_tys res_ty)) (illegalForeignTyErr Outputable.empty)
+       check (isFFILabelTy (mkVisFunTys arg_tys res_ty)) (illegalForeignTyErr Outputable.empty)
        cconv' <- checkCConv cconv
        return (CImport (L lc cconv') safety mh l src)
 
@@ -268,7 +268,9 @@ tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh CWrapper src) = do
     checkCg checkCOrAsmOrLlvmOrInterp
     cconv' <- checkCConv cconv
     case arg_tys of
-        [arg1_ty] -> do checkForeignArgs isFFIExternalTy (map scaledThing arg1_tys)
+        [Scaled arg1_mult arg1_ty] -> do
+                        checkNoLinearFFI arg1_mult
+                        checkForeignArgs isFFIExternalTy arg1_tys
                         checkForeignRes nonIOok  checkSafe isFFIExportResultTy res1_ty
                         checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty
                   where
@@ -284,9 +286,10 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
       case arg_tys of           -- The first arg must be Ptr or FunPtr
         []                ->
           addErrTc (illegalForeignTyErr Outputable.empty (text "At least one argument expected"))
-        (arg1_ty:arg_tys) -> do
+        (Scaled arg1_mult arg1_ty:arg_tys) -> do
           dflags <- getDynFlags
-          let curried_res_ty = mkVisFunTysMany arg_tys res_ty
+          let curried_res_ty = mkVisFunTys arg_tys res_ty
+          checkNoLinearFFI arg1_mult
           check (isFFIDynTy curried_res_ty arg1_ty)
                 (illegalForeignTyErr argument)
           checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
@@ -311,7 +314,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
       dflags <- getDynFlags
       checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
       checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
-      checkMissingAmpersand dflags arg_tys res_ty
+      checkMissingAmpersand dflags (map scaledThing arg_tys) res_ty
       case target of
           StaticTarget _ _ _ False
            | not (null arg_tys) ->
@@ -399,7 +402,7 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do
     checkCg checkCOrAsmOrLlvm
     checkTc (isCLabelString str) (badCName str)
     cconv' <- checkCConv cconv
-    checkForeignArgs isFFIExternalTy (map scaledThing arg_tys)
+    checkForeignArgs isFFIExternalTy arg_tys
     checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty
     return (CExport (L l (CExportStatic esrc str cconv')) src)
   where
@@ -416,10 +419,16 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do
 -}
 
 ------------ Checking argument types for foreign import ----------------------
-checkForeignArgs :: (Type -> Validity) -> [Type] -> TcM ()
+checkForeignArgs :: (Type -> Validity) -> [Scaled Type] -> TcM ()
 checkForeignArgs pred tys = mapM_ go tys
   where
-    go ty = check (pred ty) (illegalForeignTyErr argument)
+    go (Scaled mult ty) = checkNoLinearFFI mult >>
+                          check (pred ty) (illegalForeignTyErr argument)
+
+checkNoLinearFFI :: Mult -> TcM ()  -- No linear types in FFI (#18472)
+checkNoLinearFFI Many = return ()
+checkNoLinearFFI _    = addErrTc $ illegalForeignTyErr argument
+                                   (text "Linear types are not supported in FFI declarations, see #18472")
 
 ------------ Checking result types for foreign calls ----------------------
 -- | Check that the type has the form


=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -388,7 +388,14 @@ tcGuardStmt _ (BodyStmt _ guard _ _) res_ty thing_inside
         ; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) }
 
 tcGuardStmt ctxt (BindStmt _ pat rhs) res_ty thing_inside
-  = do  { (rhs', rhs_ty) <- tcInferRhoNC rhs
+  = do  { -- The Many on the next line and the unrestricted on the line after
+          -- are linked. These must be the same multiplicity. Consider
+          --   x <- rhs -> u
+          --
+          -- The multiplicity of x in u must be the same as the multiplicity at
+          -- which the rhs has been consumed. When solving #18738, we want these
+          -- two multiplicity to still be the same.
+          (rhs', rhs_ty) <- tcScalingUsage Many $ tcInferRhoNC rhs
                                    -- Stmt has a context already
         ; (pat', thing)  <- tcCheckPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs)
                                          pat (unrestricted rhs_ty) $


=====================================
docs/users_guide/conf.py
=====================================
@@ -38,9 +38,6 @@ nitpick_ignore = [
 
     ("extension", "DoAndIfThenElse"),
     ("extension", "RelaxedPolyRec"),
-
-    # See #16629
-    ("extension", "UnliftedFFITypes"),
 ]
 
 rst_prolog = """
@@ -96,13 +93,13 @@ htmlhelp_basename = 'GHCUsersGuide'
 latex_elements = {
     'inputenc': '',
     'utf8extra': '',
-    'preamble': '''
+    'preamble': r'''
 \usepackage{fontspec}
 \usepackage{makeidx}
 \setsansfont{DejaVu Sans}
 \setromanfont{DejaVu Serif}
 \setmonofont{DejaVu Sans Mono}
-\setlength{\\tymin}{45pt}
+\setlength{\tymin}{45pt}
 
 % Avoid a torrent of over-full \hbox warnings
 \usepackage{microtype}


=====================================
docs/users_guide/expected-undocumented-flags.txt
=====================================
@@ -38,7 +38,6 @@
 -XAutoDeriveTypeable
 -XDoAndIfThenElse
 -XDoRec
--XGHCForeignImportPrim
 -XGenerics
 -XImplicitPrelude
 -XJavaScriptFFI


=====================================
docs/users_guide/extending_ghc.rst
=====================================
@@ -800,8 +800,8 @@ displayed.
     import GHC.Hs.Decls
     import GHC.Hs.Expr
     import GHC.Hs.ImpExp
-    import Avail
-    import Outputable
+    import GHC.Types.Avail
+    import GHC.Utils.Outputable
     import GHC.Hs.Doc
 
     plugin :: Plugin


=====================================
docs/users_guide/exts/defer_type_errors.rst
=====================================
@@ -115,6 +115,7 @@ In a few cases, even equality constraints cannot be deferred.  Specifically:
 
   This type signature contains a kind error which cannot be deferred.
 
-- Type equalities under a forall cannot be deferred (c.f. #14605).
+- Type equalities under a forall cannot be deferred (c.f. `#14605
+  <https://gitlab.haskell.org/ghc/ghc/issues/14605>`_).
 
 


=====================================
docs/users_guide/exts/ffi.rst
=====================================
@@ -263,8 +263,13 @@ and is not permitted to appear nested within the type, as in the following
 Primitive imports
 ~~~~~~~~~~~~~~~~~
 
-GHC extends the FFI with an additional calling convention ``prim``,
-e.g.: ::
+.. extension:: GHCForeignImportPrim
+    :shortdesc: Enable prim calling convention. Intended for internal use only.
+
+    :since: 6.12.1
+
+With :extension:`GHCForeignImportPrim`, GHC extends the FFI with an additional
+calling convention ``prim``, e.g.: ::
 
        foreign import prim "foo" foo :: ByteArray# -> (# Int#, Int# #)
 


=====================================
docs/users_guide/exts/safe_haskell.rst
=====================================
@@ -781,7 +781,7 @@ And five warning flags:
     :shortdesc: warn when an explicitly Safe Haskell module imports a Safe-Inferred one
     :type: dynamic
     :reverse: -Wno-inferred-safe-imports
-    :category:
+    :category: warnings
 
     :since: 8.10.1
 
@@ -815,7 +815,7 @@ And five warning flags:
     :shortdesc: warn when the Safe Haskell mode is not explicitly specified.
     :type: dynamic
     :reverse: -Wno-missing-safe-haskell-mode
-    :category:
+    :category: warnings
 
     :since: 8.10.1
 


=====================================
docs/users_guide/exts/template_haskell.rst
=====================================
@@ -109,7 +109,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
 
     plusC = [| $oneC + $twoC |]
 
-- The precise type of a quotation depends on the types of the nested splices inside it::
+-  The precise type of a quotation depends on the types of the nested splices inside it::
 
       -- Add a redundant constraint to demonstrate that constraints on the
       -- monad used to build the representation are propagated when using nested
@@ -125,9 +125,8 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
    Remember, a top-level splice still requires its argument to be of type ``Q Exp``.
    So then splicing in ``g`` will cause ``m`` to be instantiated to ``Q``::
 
-    h :: Int
-    h = $(g) -- m ~ Q
-
+      h :: Int
+      h = $(g) -- m ~ Q
 
 -  A *typed* expression splice is written ``$$x``, where ``x`` is
    is an arbitrary expression.
@@ -376,8 +375,6 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
    However, there are some GHC-specific extensions which expression
    quotations currently do not support, including
 
-   -  Recursive ``do``-statements (see :ghc-ticket:`1262`)
-
    -  Type holes in typed splices (see :ghc-ticket:`10945` and
       :ghc-ticket:`10946`)
 


=====================================
docs/users_guide/exts/typed_holes.rst
=====================================
@@ -546,6 +546,7 @@ Sorting can be toggled with :ghc-flag:`-fsort-valid-hole-fits`
     :shortdesc: Sort valid hole fits by size.
     :type: dynamic
     :reverse: -fno-sort-by-size-hole-fits
+    :category: verbosity
 
     :default: on
 
@@ -557,6 +558,7 @@ Sorting can be toggled with :ghc-flag:`-fsort-valid-hole-fits`
     :shortdesc: Sort valid hole fits by subsumption.
     :type: dynamic
     :reverse: -fno-sort-by-subsumption-hole-fits
+    :category: verbosity
 
     :default: off
 


=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -362,6 +362,7 @@ by saying ``-fno-wombat``.
     :default: on
 
     Use a special demand transformer for dictionary selectors.
+    Behaviour is unconditionally enabled starting with 9.2
 
 .. ghc-flag:: -fdo-eta-reduction
     :shortdesc: Enable eta-reduction. Implied by :ghc-flag:`-O`.


=====================================
testsuite/tests/linear/should_fail/LinearFFI.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE LinearTypes #-}
+module LinearFFI where -- #18472
+
+import Foreign.Ptr
+
+foreign import ccall "exp" c_exp :: Double #-> Double
+foreign import stdcall "dynamic" d8  :: FunPtr (IO Int) #-> IO Int
+foreign import ccall "wrapper" mkF :: IO () #-> IO (FunPtr (IO ()))


=====================================
testsuite/tests/linear/should_fail/LinearFFI.stderr
=====================================
@@ -0,0 +1,20 @@
+
+LinearFFI.hs:6:1: error:
+    • Unacceptable argument type in foreign declaration:
+        Linear types are not supported in FFI declarations, see #18472
+    • When checking declaration:
+        foreign import ccall safe "exp" c_exp :: Double #-> Double
+
+LinearFFI.hs:7:1: error:
+    • Unacceptable argument type in foreign declaration:
+        Linear types are not supported in FFI declarations, see #18472
+    • When checking declaration:
+        foreign import stdcall safe "dynamic" d8
+          :: FunPtr (IO Int) #-> IO Int
+
+LinearFFI.hs:8:1: error:
+    • Unacceptable argument type in foreign declaration:
+        Linear types are not supported in FFI declarations, see #18472
+    • When checking declaration:
+        foreign import ccall safe "wrapper" mkF
+          :: IO () #-> IO (FunPtr (IO ()))


=====================================
testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE LinearTypes #-}
+module LinearPatternGuardWildcard where
+
+-- See #18439
+
+unsafeConsume :: a #-> ()
+unsafeConsume x | _ <- x = ()


=====================================
testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr
=====================================
@@ -0,0 +1,5 @@
+
+LinearPatternGuardWildcard.hs:7:15: error:
+    • Couldn't match type ‘'Many’ with ‘'One’
+        arising from multiplicity of ‘x’
+    • In an equation for ‘unsafeConsume’: unsafeConsume x | _ <- x = ()


=====================================
testsuite/tests/linear/should_fail/all.T
=====================================
@@ -27,3 +27,5 @@ test('LinearPolyType', expect_broken([436, broken_multiplicity_syntax]), compile
 test('LinearBottomMult', normal, compile_fail, [''])
 test('LinearSequenceExpr', normal, compile_fail, [''])
 test('LinearIf', normal, compile_fail, [''])
+test('LinearPatternGuardWildcard', normal, compile_fail, [''])
+test('LinearFFI', normal, compile_fail, [''])


=====================================
testsuite/tests/simplCore/should_compile/T18747A.hs
=====================================
@@ -0,0 +1,82 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+module T18747A where
+
+import Data.Kind
+import Data.Type.Equality
+
+type family Sing :: k -> Type
+data SomeSing :: Type -> Type where
+  SomeSing :: Sing (a :: k) -> SomeSing k
+
+data SList :: forall a. [a] -> Type where
+  SNil  :: SList '[]
+  SCons :: Sing x -> Sing xs -> SList (x:xs)
+type instance Sing = SList
+
+data Univ = U1 | K1 Type | Sum Univ Univ | Product Univ Univ
+
+data SUniv :: Univ -> Type where
+  SU1      ::                     SUniv U1
+  SK1      :: Sing c           -> SUniv (K1 c)
+  SSum     :: Sing a -> Sing b -> SUniv (Sum a b)
+  SProduct :: Sing a -> Sing b -> SUniv (Product a b)
+type instance Sing = SUniv
+
+data In :: Univ -> Type where
+  MkU1      ::                 In U1
+  MkK1      :: c            -> In (K1 c)
+  L1        :: In a         -> In (Sum a b)
+  R1        ::         In b -> In (Sum a b)
+  MkProduct :: In a -> In b -> In (Product a b)
+
+data SIn :: forall u. In u -> Type where
+  SMkU1      ::                     SIn MkU1
+  SMkK1      :: Sing c           -> SIn (MkK1 c)
+  SL1        :: Sing a           -> SIn (L1 a)
+  SR1        ::           Sing b -> SIn (R1 b)
+  SMkProduct :: Sing a -> Sing b -> SIn (MkProduct a b)
+type instance Sing = SIn
+
+class Generic (a :: Type) where
+  type Rep a :: Univ
+  from :: a -> In (Rep a)
+  to   :: In (Rep a) -> a
+
+class PGeneric (a :: Type) where
+  type PFrom (x :: a)          :: In (Rep a)
+  type PTo   (x :: In (Rep a)) :: a
+
+class SGeneric k where
+  sFrom :: forall (a :: k).          Sing a -> Sing (PFrom a)
+  sTo   :: forall (a :: In (Rep k)). Sing a -> Sing (PTo a :: k)
+  sTof  :: forall (a :: k).          Sing a -> PTo (PFrom a) :~: a
+  sFot  :: forall (a :: In (Rep k)). Sing a -> PFrom (PTo a :: k) :~: a
+
+instance Generic [a] where
+  type Rep [a] = Sum U1 (Product (K1 a) (K1 [a]))
+  from []     = L1 MkU1
+  from (x:xs) = R1 (MkProduct (MkK1 x) (MkK1 xs))
+  to (L1 MkU1)                           = []
+  to (R1 (MkProduct (MkK1 x) (MkK1 xs))) = x:xs
+
+instance PGeneric [a] where
+  type PFrom '[]    = L1 MkU1
+  type PFrom (x:xs) = R1 (MkProduct (MkK1 x) (MkK1 xs))
+  type PTo (L1 MkU1)                           = '[]
+  type PTo (R1 (MkProduct (MkK1 x) (MkK1 xs))) = x:xs
+
+instance SGeneric [a] where
+  sFrom SNil         = SL1 SMkU1
+  sFrom (SCons x xs) = SR1 (SMkProduct (SMkK1 x) (SMkK1 xs))
+  sTo (SL1 SMkU1)                             = SNil
+  sTo (SR1 (SMkProduct (SMkK1 x) (SMkK1 xs))) = SCons x xs
+  sTof SNil    = Refl
+  sTof SCons{} = Refl
+  sFot (SL1 SMkU1)                        = Refl
+  sFot (SR1 (SMkProduct SMkK1{} SMkK1{})) = Refl


=====================================
testsuite/tests/simplCore/should_compile/T18747B.hs
=====================================
@@ -0,0 +1,50 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+module T18747B where
+
+import Data.Kind
+import Data.Type.Equality
+
+type family Sing :: k -> Type
+
+data SomeSing (k :: Type) where
+  SomeSing :: Sing (a :: k) -> SomeSing k
+
+type family Promote (k :: Type) :: Type
+type family PromoteX (a :: k) :: Promote k
+
+type family Demote (k :: Type) :: Type
+type family DemoteX (a :: k) :: Demote k
+
+type SingKindX (a :: k) = (PromoteX (DemoteX a) ~~ a)
+
+class SingKindX k => SingKind k where
+  toSing :: Demote k -> SomeSing k
+
+type instance Demote Type = Type
+type instance Promote Type = Type
+type instance DemoteX (a :: Type) = Demote a
+type instance PromoteX (a :: Type) = Promote a
+
+type instance Demote Bool = Bool
+type instance Promote Bool = Bool
+
+data Foo (a :: Type) where MkFoo :: Foo Bool
+
+data SFoo :: forall a. Foo a -> Type where
+  SMkFoo :: SFoo MkFoo
+type instance Sing = SFoo
+
+type instance Demote (Foo a) = Foo (DemoteX a)
+type instance Promote (Foo a) = Foo (PromoteX a)
+
+instance SingKindX a => SingKind (Foo a) where
+  toSing MkFoo = SomeSing SMkFoo
+


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -333,3 +333,6 @@ test('T18347', normal, compile, ['-dcore-lint -O'])
 test('T18355', [ grep_errmsg(r'OneShot') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
 test('T18399', normal, compile, ['-dcore-lint -O'])
 test('T18589', normal, compile, ['-dcore-lint -O'])
+
+test('T18747A', normal, compile, [''])
+test('T18747B', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebcc09687b8d84daf00987a466834a20a9831e7b...90fe5cffb0b0ba1ff86b8b9bf5299d0ed8437ad7

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebcc09687b8d84daf00987a466834a20a9831e7b...90fe5cffb0b0ba1ff86b8b9bf5299d0ed8437ad7
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/20200929/48692df4/attachment-0001.html>


More information about the ghc-commits mailing list