Define type Void# = (# #) (#18441)

There's one backwards compatibility issue: GHC.Prim no longer exports
Void#, we now manually re-export it from GHC.Exts.

11 files changed, 35 insertions, 38 deletions

diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index b9ef184923..2130448e89 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -1802,7 +1802,7 @@ statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
     liftedConKey, unliftedConKey, anyBoxConKey, kindConKey, boxityConKey,
     typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey,
     funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey,
-    eqReprPrimTyConKey, eqPhantPrimTyConKey, voidPrimTyConKey,
+    eqReprPrimTyConKey, eqPhantPrimTyConKey,
     compactPrimTyConKey :: Unique
 statePrimTyConKey                       = mkPreludeTyConUnique 50
 stableNamePrimTyConKey                  = mkPreludeTyConUnique 51
@@ -1812,7 +1812,6 @@ eqReprPrimTyConKey                      = mkPreludeTyConUnique 54
 eqPhantPrimTyConKey                     = mkPreludeTyConUnique 55
 mutVarPrimTyConKey                      = mkPreludeTyConUnique 56
 ioTyConKey                              = mkPreludeTyConUnique 57
-voidPrimTyConKey                        = mkPreludeTyConUnique 58
 wordPrimTyConKey                        = mkPreludeTyConUnique 59
 wordTyConKey                            = mkPreludeTyConUnique 60
 word8PrimTyConKey                       = mkPreludeTyConUnique 61
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 86b8879c60..ce506000ac 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -75,6 +75,7 @@ module GHC.Builtin.Types (
         promotedTupleDataCon,
         unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
         pairTyCon,
+        unboxedUnitTy,
         unboxedUnitTyCon, unboxedUnitDataCon,
         unboxedTupleKind, unboxedSumKind,
 
@@ -1053,6 +1054,9 @@ unitDataConId = dataConWorkId unitDataCon
 pairTyCon :: TyCon
 pairTyCon = tupleTyCon Boxed 2
 
+unboxedUnitTy :: Type
+unboxedUnitTy = mkTyConApp unboxedUnitTyCon []
+
 unboxedUnitTyCon :: TyCon
 unboxedUnitTyCon = tupleTyCon Unboxed 0
 
diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs
index 13f08739d0..511af6f217 100644
--- a/compiler/GHC/Builtin/Types/Prim.hs
+++ b/compiler/GHC/Builtin/Types/Prim.hs
@@ -45,7 +45,6 @@ module GHC.Builtin.Types.Prim(
         floatPrimTyCon,         floatPrimTy, floatPrimTyConName,
         doublePrimTyCon,        doublePrimTy, doublePrimTyConName,
 
-        voidPrimTyCon,          voidPrimTy,
         statePrimTyCon,         mkStatePrimTy,
         realWorldTyCon,         realWorldTy, realWorldStatePrimTy,
 
@@ -180,7 +179,6 @@ exposedPrimTyCons
     , stableNamePrimTyCon
     , compactPrimTyCon
     , statePrimTyCon
-    , voidPrimTyCon
     , proxyPrimTyCon
     , threadIdPrimTyCon
     , wordPrimTyCon
@@ -209,7 +207,7 @@ mkBuiltInPrimTc fs unique tycon
                   BuiltInSyntax
 
 
-charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, ioPortPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, voidPrimTyConName :: Name
+charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, ioPortPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName :: Name
 charPrimTyConName             = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
 intPrimTyConName              = mkPrimTc (fsLit "Int#") intPrimTyConKey  intPrimTyCon
 int8PrimTyConName             = mkPrimTc (fsLit "Int8#") int8PrimTyConKey int8PrimTyCon
@@ -225,7 +223,6 @@ addrPrimTyConName             = mkPrimTc (fsLit "Addr#") addrPrimTyConKey addrPr
 floatPrimTyConName            = mkPrimTc (fsLit "Float#") floatPrimTyConKey floatPrimTyCon
 doublePrimTyConName           = mkPrimTc (fsLit "Double#") doublePrimTyConKey doublePrimTyCon
 statePrimTyConName            = mkPrimTc (fsLit "State#") statePrimTyConKey statePrimTyCon
-voidPrimTyConName             = mkPrimTc (fsLit "Void#") voidPrimTyConKey voidPrimTyCon
 proxyPrimTyConName            = mkPrimTc (fsLit "Proxy#") proxyPrimTyConKey proxyPrimTyCon
 eqPrimTyConName               = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon
 eqReprPrimTyConName           = mkBuiltInPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon
@@ -897,12 +894,6 @@ realWorldStatePrimTy = mkStatePrimTy realWorldTy        -- State# RealWorld
 -- so they are defined in \tr{GHC.Builtin.Types}, not here.
 
 
-voidPrimTy :: Type
-voidPrimTy = TyConApp voidPrimTyCon []
-
-voidPrimTyCon :: TyCon
-voidPrimTyCon    = pcPrimTyCon voidPrimTyConName [] VoidRep
-
 mkProxyPrimTy :: Type -> Type -> Type
 mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]
 
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index 261d02aa67..98a8daccc0 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -3355,8 +3355,6 @@ section "Misc"
         {These aren't nearly as wired in as Etc...}
 ------------------------------------------------------------------------
 
-primtype Void#
-
 primop  GetCCSOfOp "getCCSOf#" GenPrimOp
    a -> State# s -> (# State# s, Addr# #)
 
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index 173dcdf2c7..935ba04bb5 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -39,7 +39,7 @@ import GHC.Core.Opt.Arity     ( etaExpandToJoinPointRule )
 import GHC.Types.Unique.Supply
 import GHC.Types.Name
 import GHC.Types.Id.Make  ( voidArgId, voidPrimId )
-import GHC.Builtin.Types.Prim ( voidPrimTy )
+import GHC.Builtin.Types  ( unboxedUnitTy )
 import GHC.Data.Maybe     ( mapMaybe, maybeToList, isJust )
 import GHC.Utils.Monad    ( foldlM )
 import GHC.Types.Basic
@@ -1427,7 +1427,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs
                  (spec_bndrs, spec_rhs, spec_fn_ty)
                    | add_void_arg = ( voidPrimId : spec_bndrs1
                                     , Lam        voidArgId  spec_rhs1
-                                    , mkVisFunTyMany voidPrimTy spec_fn_ty1)
+                                    , mkVisFunTyMany unboxedUnitTy spec_fn_ty1)
                    | otherwise   = (spec_bndrs1, spec_rhs1, spec_fn_ty1)
 
                  join_arity_decr = length rule_lhs_args - length spec_bndrs
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index 1885de98f2..2ccc743047 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -28,8 +28,7 @@ import GHC.Types.Cpr
 import GHC.Core.Make    ( mkAbsentErrorApp, mkCoreUbxTup
                         , mkCoreApp, mkCoreLet )
 import GHC.Types.Id.Make ( voidArgId, voidPrimId )
-import GHC.Builtin.Types      ( tupleDataCon )
-import GHC.Builtin.Types.Prim ( voidPrimTy )
+import GHC.Builtin.Types      ( tupleDataCon, unboxedUnitTy )
 import GHC.Types.Literal ( absentLiteralOf, rubbishLit )
 import GHC.Types.Var.Env ( mkInScopeSet )
 import GHC.Types.Var.Set ( VarSet )
@@ -1256,7 +1255,7 @@ mk_absent_let dflags fam_envs arg
   | Just tc <- tyConAppTyCon_maybe nty
   , Just lit <- absentLiteralOf tc
   = Just (Let (NonRec arg (Lit lit `mkCast` mkSymCo co)))
-  | nty `eqType` voidPrimTy
+  | nty `eqType` unboxedUnitTy
   = Just (Let (NonRec arg (Var voidPrimId `mkCast` mkSymCo co)))
   | otherwise
   = WARN( True, text "No absent value for" <+> ppr arg_ty )
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index 73acd2a19f..40866f7f8b 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -43,6 +43,7 @@ import GHC.Core.DataCon
 import GHC.Core.TyCon
 import GHC.Utils.Misc
 import GHC.Types.Var.Set
+import GHC.Builtin.Types ( unboxedUnitTy )
 import GHC.Builtin.Types.Prim
 import GHC.Core.TyCo.Ppr ( pprType )
 import GHC.Utils.Error
@@ -673,7 +674,7 @@ schemeE d s p (AnnCase scrut bndr _ alt@[(DEFAULT, [], _)])
    | isUnboxedTupleType (idType bndr)
    , Just ty <- case typePrimRep (idType bndr) of
        [_]  -> Just (unwrapType (idType bndr))
-       []   -> Just voidPrimTy
+       []   -> Just unboxedUnitTy
        _    -> Nothing
        -- handles any pattern with a single non-void binder; in particular I/O
        -- monad returns (# RealWorld#, a #)
@@ -708,7 +709,7 @@ protectNNLJoinPointBind x rhs@(fvs, _)
 protectNNLJoinPointId :: Id -> Id
 protectNNLJoinPointId x
   = ASSERT( isNNLJoinPoint x )
-    updateIdTypeButNotMult (voidPrimTy `mkVisFunTyMany`) x
+    updateIdTypeButNotMult (unboxedUnitTy `mkVisFunTyMany`) x
 
 {-
    Ticked Expressions
@@ -743,8 +744,8 @@ isUnliftedType check in the AnnVar case of schemeE.) Here is the strategy:
 
 1. Detect NNLJPs. This is done in isNNLJoinPoint.
 
-2. When binding an NNLJP, add a `\ (_ :: Void#) ->` to its RHS, and modify the
-   type to tack on a `Void# ->`. (Void# is written voidPrimTy within GHC.)
+2. When binding an NNLJP, add a `\ (_ :: (# #)) ->` to its RHS, and modify the
+   type to tack on a `(# #) ->`.
    Note that functions are never levity-polymorphic, so this transformation
    changes an NNLJP to a non-levity-polymorphic join point. This is done
    in protectNNLJoinPointBind, called from the AnnLet case of schemeE.
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index ae2e071f7b..ac75e078c4 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -67,7 +67,6 @@ import GHC.Core.DataCon
 import GHC.Core.PatSyn
 import GHC.Core.Type
 import GHC.Core.Coercion
-import GHC.Builtin.Types.Prim
 import GHC.Builtin.Types
 import GHC.Types.Basic
 import GHC.Core.ConLike
@@ -853,8 +852,8 @@ mkFailurePair :: CoreExpr       -- Result type of the whole case expression
                       CoreExpr) -- Fail variable applied to realWorld#
 -- See Note [Failure thunks and CPR]
 mkFailurePair expr
-  = do { fail_fun_var <- newFailLocalDs Many (voidPrimTy `mkVisFunTyMany` ty)
-       ; fail_fun_arg <- newSysLocalDs Many voidPrimTy
+  = do { fail_fun_var <- newFailLocalDs Many (unboxedUnitTy `mkVisFunTyMany` ty)
+       ; fail_fun_arg <- newSysLocalDs Many unboxedUnitTy
        ; let real_arg = setOneShotLambda fail_fun_arg
        ; return (NonRec fail_fun_var (Lam real_arg expr),
                  App (Var fail_fun_var) (Var voidPrimId)) }
diff --git a/compiler/GHC/Tc/TyCl/Build.hs b/compiler/GHC/Tc/TyCl/Build.hs
index 5361ff0160..da17266c45 100644
--- a/compiler/GHC/Tc/TyCl/Build.hs
+++ b/compiler/GHC/Tc/TyCl/Build.hs
@@ -21,8 +21,7 @@ import GHC.Prelude
 
 import GHC.Iface.Env
 import GHC.Core.FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom )
-import GHC.Builtin.Types( isCTupleTyConName )
-import GHC.Builtin.Types.Prim ( voidPrimTy )
+import GHC.Builtin.Types( isCTupleTyConName, unboxedUnitTy )
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
 import GHC.Types.Var
@@ -209,11 +208,11 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
     subst = zipTvSubst (univ_tvs1 ++ ex_tvs1)
                        (mkTyVarTys (binderVars (univ_tvs ++ ex_tvs)))
 
-    -- For a nullary pattern synonym we add a single void argument to the
+    -- For a nullary pattern synonym we add a single (# #) argument to the
     -- matcher to preserve laziness in the case of unlifted types.
     -- See #12746
     compareArgTys :: [Type] -> [Type] -> Bool
-    compareArgTys [] [x] = x `eqType` voidPrimTy
+    compareArgTys [] [x] = x `eqType` unboxedUnitTy
     compareArgTys arg_tys matcher_arg_tys = arg_tys `eqTypes` matcher_arg_tys
 
 
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 3f276f5945..0be256c93f 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -698,12 +698,12 @@ tcPatSynMatcher (L loc name) lpat
              res_ty = mkTyVarTy res_tv
              is_unlifted = null args && null prov_dicts
              (cont_args, cont_arg_tys)
-               | is_unlifted = ([nlHsVar voidPrimId], [voidPrimTy])
+               | is_unlifted = ([nlHsVar voidPrimId], [unboxedUnitTy])
                | otherwise   = (args,                 arg_tys)
              cont_ty = mkInfSigmaTy ex_tvs prov_theta $
                        mkVisFunTysMany cont_arg_tys res_ty
 
-             fail_ty  = mkVisFunTyMany voidPrimTy res_ty
+             fail_ty  = mkVisFunTyMany unboxedUnitTy res_ty
 
        ; matcher_name <- newImplicitBinder name mkMatcherOcc
        ; scrutinee    <- newSysLocalId (fsLit "scrut") Many pat_ty
@@ -905,7 +905,7 @@ tcPatSynBuilderOcc ps
 
 add_void :: Bool -> Type -> Type
 add_void need_dummy_arg ty
-  | need_dummy_arg = mkVisFunTyMany voidPrimTy ty
+  | need_dummy_arg = mkVisFunTyMany unboxedUnitTy ty
   | otherwise      = ty
 
 tcPatToExpr :: Name -> [Located Name] -> LPat GhcRn
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index 3bd7fecd70..6d49479807 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -121,7 +121,7 @@ The ghcPrimIds
     but have perfectly reasonable unfoldings in Core
 
   * Either have a CompulsoryUnfolding (hence always inlined), or
-        of an EvaldUnfolding and void representation (e.g. void#)
+        of an EvaldUnfolding and void representation (e.g. realWorldPrimId)
 
   * Are (or should be) defined in primops.txt.pp as 'pseudoop'
     Reason: that's how we generate documentation for them
@@ -1760,12 +1760,19 @@ realWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy
                                   `setNeverLevPoly`  realWorldStatePrimTy)
 
 voidPrimId :: Id     -- Global constant :: Void#
-voidPrimId  = pcMiscPrelId voidPrimIdName voidPrimTy
-                (noCafIdInfo `setUnfoldingInfo` evaldUnfolding     -- Note [evaldUnfoldings]
-                             `setNeverLevPoly`  voidPrimTy)
+                     -- The type Void# is now the same as (# #) (ticket #18441),
+                     -- this identifier just signifies the (# #) datacon
+                     -- and is kept for backwards compatibility.
+                     -- We cannot define it in normal Haskell, since it's
+                     -- a top-level unlifted value.
+voidPrimId  = pcMiscPrelId voidPrimIdName unboxedUnitTy
+                (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
+                             `setNeverLevPoly`  unboxedUnitTy)
+    where rhs = Var (dataConWorkId unboxedUnitDataCon)
+
 
 voidArgId :: Id       -- Local lambda-bound :: Void#
-voidArgId = mkSysLocal (fsLit "void") voidArgIdKey Many voidPrimTy
+voidArgId = mkSysLocal (fsLit "void") voidArgIdKey Many unboxedUnitTy
 
 coercionTokenId :: Id         -- :: () ~ ()
 coercionTokenId -- See Note [Coercion tokens] in "GHC.CoreToStg"