Illegal linear function in kind [GHC-13218]

Haskell supports higher-kinds. For example, the type constructor List has kind * -> *, which can also be written as Type -> Type if the module Data.Kind is imported. Since version 9.0, GHC also supports the linear function type a %1 -> b which stands for functions which use their argument of type a exactly once in their function body. But this restriction does not make sense if we try to apply it to higher kinds, and for this reason functions like * %1 -> * or Type %1 -> Type cannot be used as the kinds of data types.

Examples

Illegal kind signature for Void1 data type

In this example, the data type declaration for the Void1 data type was annotated with the kind signature * %1 -> *. This would be a linear kind, which Haskell does not support - only types may be linear. The kind signature of the data type should be * -> *.

messages/GHC-13218/illegalKindSignature/before/IllegalKindSignature.hs:4:1: error: [GHC-13218]
    • Illegal linear function in a kind: * %1 -> *
    • In the data type declaration for ‘Void1’
  |
4 | data Void1 :: * %1 -> *
  | ^^^^^^^^^^
IllegalKindSignature.hs
Before
{-# LANGUAGE LinearTypes, KindSignatures #-}
module IllegalKindSignature where

data Void1 :: * %1 -> *
After
{-# LANGUAGE LinearTypes, KindSignatures #-}
module IllegalKindSignature where

data Void1 :: * -> *
Illegal kind signature for Void1 data type

This example is similar to the previous one, except that instead of the spelling * %1 -> *, the spelling Fun One Type Type was chosen. In this case, the signature should be Fun Many Type Type instead.

messages/GHC-13218/illegalKindSignatureDesugared/before/IllegalKindSignatureDesugared.hs:7:1: error: [GHC-13218]
    • Illegal linear function in a kind: * %1 -> *
    • In the data type declaration for ‘Void1’
  |
7 | data Void1 :: FUN One Type Type
  | ^^^^^^^^^^
IllegalKindSignatureDesugared.hs
Before
{-# LANGUAGE LinearTypes, KindSignatures, DataKinds #-}
module IllegalKindSignatureDesugared where

import GHC.Exts
import GHC.Types

data Void1 :: FUN One Type Type
After
{-# LANGUAGE LinearTypes, KindSignatures, DataKinds #-}
module IllegalKindSignatureDesugared where

import GHC.Exts
import GHC.Types

data Void1 :: FUN Many Type Type
Illegal kind signature for Void1 data type

This example is similar to the previous two examples, except that the malformed kind was first declared as a type synonym.

messages/GHC-13218/illegalStandaloneKindSignature/before/IllegalStandaloneKindSignature.hs:9:1: error: [GHC-13218]
    • Illegal linear function in a kind: * %1 -> *
    • In the expansion of type synonym ‘K’
      In the data type declaration for ‘Void1’
  |
9 | data Void1 :: K
  | ^^^^^^^^^^
IllegalStandaloneKindSignature.hs
Before
{-# LANGUAGE LinearTypes, KindSignatures, DataKinds #-}
module IllegalStandaloneKindSignature where

import GHC.Exts
import GHC.Types

type K = Type %1 -> Type

data Void1 :: K
After
{-# LANGUAGE LinearTypes, KindSignatures, DataKinds #-}
module IllegalStandaloneKindSignature where

import GHC.Exts
import GHC.Types

type K = Type -> Type

data Void1 :: K