Implement the -XUnliftedNewtypes extension.

GHC Proposal: 0013-unlifted-newtypes.rst
Discussion: https://github.com/ghc-proposals/ghc-proposals/pull/98
Issues: #15219, #1311, #13595, #15883
Implementation Details:
  Note [Implementation of UnliftedNewtypes]
  Note [Unifying data family kinds]
  Note [Compulsory newtype unfolding]

This patch introduces the -XUnliftedNewtypes extension. When this
extension is enabled, GHC drops the restriction that the field in
a newtype must be of kind (TYPE 'LiftedRep). This allows types
like Int# and ByteArray# to be used in a newtype. Additionally,
coerce is made levity-polymorphic so that it can be used with
newtypes over unlifted types.

The bulk of the changes are in TcTyClsDecls.hs. With -XUnliftedNewtypes,
getInitialKind is more liberal, introducing a unification variable to
return the kind (TYPE r0) rather than just returning (TYPE 'LiftedRep).
When kind-checking a data constructor with kcConDecl, we attempt to
unify the kind of a newtype with the kind of its field's type. When
typechecking a data declaration with tcTyClDecl, we again perform a
unification. See the implementation note for more on this.

Co-authored-by: Richard Eisenberg <rae@richarde.dev>

1 files changed, 47 insertions, 7 deletions

diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 9e0d616ace..e3c9576e94 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -69,7 +69,7 @@ import Control.Arrow ( first )
 import Data.List ( mapAccumL )
 import qualified Data.List.NonEmpty as NE
 import Data.List.NonEmpty ( NonEmpty(..) )
-import Data.Maybe ( isNothing, fromMaybe )
+import Data.Maybe ( isNothing, isJust, fromMaybe )
 import qualified Data.Set as Set ( difference, fromList, toList, null )
 
 {- | @rnSourceDecl@ "renames" declarations.
@@ -1539,18 +1539,22 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars,
 
 -- "data", "newtype" declarations
 -- both top level and (for an associated type) in an instance decl
-rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars,
-                       tcdFixity = fixity, tcdDataDefn = defn })
+rnTyClDecl (DataDecl _ _ _ _ (XHsDataDefn _)) =
+  panic "rnTyClDecl: DataDecl with XHsDataDefn"
+rnTyClDecl (DataDecl
+    { tcdLName = tycon, tcdTyVars = tyvars,
+      tcdFixity = fixity,
+      tcdDataDefn = defn@HsDataDefn{ dd_ND = new_or_data
+                                   , dd_kindSig = kind_sig} })
   = do { tycon' <- lookupLocatedTopBndrRn tycon
        ; let kvs = extractDataDefnKindVars defn
              doc = TyDataCtx tycon
        ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs)
        ; 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
-       ; cusks_enabled <- xoptM LangExt.CUSKs
-       ; let cusk = cusks_enabled && hsTvbAllKinded tyvars' && no_rhs_kvs
-             rn_info = DataDeclRn { tcdDataCusk = cusk
+       ; cusk <- dataDeclHasCUSK
+           tyvars' new_or_data no_rhs_kvs (isJust kind_sig)
+       ; let rn_info = DataDeclRn { tcdDataCusk = cusk
                                   , tcdFVs      = fvs }
        ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs)
        ; return (DataDecl { tcdLName    = tycon'
@@ -1626,6 +1630,42 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
 
 rnTyClDecl (XTyClDecl _) = panic "rnTyClDecl"
 
+-- Does the data type declaration include a CUSK?
+dataDeclHasCUSK :: LHsQTyVars pass -> NewOrData -> Bool -> Bool -> RnM Bool
+dataDeclHasCUSK tyvars new_or_data no_rhs_kvs has_kind_sig = do
+  { -- See Note [Unlifted Newtypes and CUSKs], and for a broader
+    -- picture, see Note [Implementation of UnliftedNewtypes].
+  ; unlifted_newtypes <- xoptM LangExt.UnliftedNewtypes
+  ; let non_cusk_newtype
+          | NewType <- new_or_data =
+              unlifted_newtypes && not has_kind_sig
+          | otherwise = False
+    -- See Note [CUSKs: complete user-supplied kind signatures] in HsDecls
+  ; cusks_enabled <- xoptM LangExt.CUSKs
+  ; return $ cusks_enabled && hsTvbAllKinded tyvars &&
+             no_rhs_kvs && not non_cusk_newtype
+  }
+
+{- Note [Unlifted Newtypes and CUSKs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When unlifted newtypes are enabled, a newtype must have a kind signature
+in order to be considered have a CUSK. This is because the flow of
+kind inference works differently. Consider:
+
+  newtype Foo = FooC Int
+
+When UnliftedNewtypes is disabled, we decide that Foo has kind
+`TYPE 'LiftedRep` without looking inside the data constructor. So, we
+can say that Foo has a CUSK. However, when UnliftedNewtypes is enabled,
+we fill in the kind of Foo as a metavar that gets solved by unification
+with the kind of the field inside FooC (that is, Int, whose kind is
+`TYPE 'LiftedRep`). But since we have to look inside the data constructors
+to figure out the kind signature of Foo, it does not have a CUSK.
+
+See Note [Implementation of UnliftedNewtypes] for where this fits in to
+the broader picture of UnliftedNewtypes.
+-}
+
 -- "type" and "type instance" declarations
 rnTySyn :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
 rnTySyn doc rhs = rnLHsType doc rhs