.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py

@@ -264,7 +264,7 @@ def setNightlyTags(ghcup_metadata):
     for version in ghcup_metadata['ghcupDownloads']['GHC']:
         if "LatestNightly" in ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"]:
             ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].remove("LatestNightly")
-        ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly")
+            ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly")
 
 
 

compiler/GHC/Builtin/Names/TH.hs

@@ -110,8 +110,11 @@ templateHaskellNames = [
     -- TyVarBndr
     plainTVName, kindedTVName,
     plainInvisTVName, kindedInvisTVName,
+    plainBndrTVName, kindedBndrTVName,
     -- Specificity
     specifiedSpecName, inferredSpecName,
+    -- Visibility
+    bndrReqName, bndrInvisName,
     -- Role
     nominalRName, representationalRName, phantomRName, inferRName,
     -- Kind
@@ -157,7 +160,9 @@ templateHaskellNames = [
     expQTyConName, fieldExpTyConName, predTyConName,
     stmtTyConName,  decsTyConName, conTyConName, bangTypeTyConName,
     varBangTypeTyConName, typeQTyConName, expTyConName, decTyConName,
-    typeTyConName, tyVarBndrUnitTyConName, tyVarBndrSpecTyConName, clauseTyConName,
+    typeTyConName,
+    tyVarBndrUnitTyConName, tyVarBndrSpecTyConName, tyVarBndrVisTyConName,
+    clauseTyConName,
     patQTyConName, funDepTyConName, decsQTyConName,
     ruleBndrTyConName, tySynEqnTyConName,
     roleTyConName, codeTyConName, injAnnTyConName, kindTyConName,
@@ -499,11 +504,20 @@ plainInvisTVName, kindedInvisTVName :: Name
 plainInvisTVName  = libFun (fsLit "plainInvisTV")  plainInvisTVIdKey
 kindedInvisTVName = libFun (fsLit "kindedInvisTV") kindedInvisTVIdKey
 
+plainBndrTVName, kindedBndrTVName :: Name
+plainBndrTVName  = libFun (fsLit "plainBndrTV")  plainBndrTVIdKey
+kindedBndrTVName = libFun (fsLit "kindedBndrTV") kindedBndrTVIdKey
+
 -- data Specificity = ...
 specifiedSpecName, inferredSpecName :: Name
 specifiedSpecName = libFun (fsLit "specifiedSpec") specifiedSpecKey
 inferredSpecName  = libFun (fsLit "inferredSpec")  inferredSpecKey
 
+-- data BndrVis = ...
+bndrReqName, bndrInvisName :: Name
+bndrReqName   = libFun (fsLit "bndrReq")   bndrReqKey
+bndrInvisName = libFun (fsLit "bndrInvis") bndrInvisKey
+
 -- data Role = ...
 nominalRName, representationalRName, phantomRName, inferRName :: Name
 nominalRName          = libFun (fsLit "nominalR")          nominalRIdKey
@@ -576,7 +590,7 @@ patQTyConName, expQTyConName, stmtTyConName,
     varBangTypeTyConName, typeQTyConName,
     decsQTyConName, ruleBndrTyConName, tySynEqnTyConName, roleTyConName,
     derivClauseTyConName, kindTyConName,
-    tyVarBndrUnitTyConName, tyVarBndrSpecTyConName,
+    tyVarBndrUnitTyConName, tyVarBndrSpecTyConName, tyVarBndrVisTyConName,
     derivStrategyTyConName :: Name
 -- These are only used for the types of top-level splices
 expQTyConName           = libTc (fsLit "ExpQ")           expQTyConKey
@@ -596,6 +610,7 @@ derivClauseTyConName   = thTc (fsLit "DerivClause")   derivClauseTyConKey
 kindTyConName          = thTc (fsLit "Kind")          kindTyConKey
 tyVarBndrUnitTyConName = libTc (fsLit "TyVarBndrUnit") tyVarBndrUnitTyConKey
 tyVarBndrSpecTyConName = libTc (fsLit "TyVarBndrSpec") tyVarBndrSpecTyConKey
+tyVarBndrVisTyConName  = libTc (fsLit "TyVarBndrVis")  tyVarBndrVisTyConKey
 derivStrategyTyConName = thTc (fsLit "DerivStrategy") derivStrategyTyConKey
 
 -- quasiquoting
@@ -659,7 +674,7 @@ quoteClassKey = mkPreludeClassUnique 201
 expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
     patTyConKey,
     stmtTyConKey, conTyConKey, typeQTyConKey, typeTyConKey,
-    tyVarBndrUnitTyConKey, tyVarBndrSpecTyConKey,
+    tyVarBndrUnitTyConKey, tyVarBndrSpecTyConKey, tyVarBndrVisTyConKey,
     decTyConKey, bangTypeTyConKey, varBangTypeTyConKey,
     fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
     funDepTyConKey, predTyConKey,
@@ -701,6 +716,7 @@ decsTyConKey            = mkPreludeTyConUnique 236
 tyVarBndrSpecTyConKey   = mkPreludeTyConUnique 237
 codeTyConKey            = mkPreludeTyConUnique 238
 modNameTyConKey         = mkPreludeTyConUnique 239
+tyVarBndrVisTyConKey    = mkPreludeTyConUnique 240
 
 {- *********************************************************************
 *                                                                      *
@@ -1030,6 +1046,10 @@ plainInvisTVIdKey, kindedInvisTVIdKey :: Unique
 plainInvisTVIdKey       = mkPreludeMiscIdUnique 482
 kindedInvisTVIdKey      = mkPreludeMiscIdUnique 483
 
+plainBndrTVIdKey, kindedBndrTVIdKey :: Unique
+plainBndrTVIdKey       = mkPreludeMiscIdUnique 484
+kindedBndrTVIdKey      = mkPreludeMiscIdUnique 485
+
 -- data Role = ...
 nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique
 nominalRIdKey          = mkPreludeMiscIdUnique 416
@@ -1114,6 +1134,11 @@ specifiedSpecKey, inferredSpecKey :: Unique
 specifiedSpecKey = mkPreludeMiscIdUnique 498
 inferredSpecKey  = mkPreludeMiscIdUnique 499
 
+-- data BndrVis = ...
+bndrReqKey, bndrInvisKey :: Unique
+bndrReqKey   = mkPreludeMiscIdUnique 800  -- TODO (int-index): make up some room in the 5** numberspace?
+bndrInvisKey = mkPreludeMiscIdUnique 801
+
 {-
 ************************************************************************
 *                                                                      *

compiler/GHC/Builtin/bytearray-ops.txt.pp

-
-------------------------------------
--- ByteArray# operations
-------------------------------------
-
-
--- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py.
--- To regenerate run,
---
---      python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp
-
-
-------------------------------------
--- aligned index operations
-------------------------------------
-
-primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp
-   ByteArray# -> Int# -> Char#
-   {Read a 8-bit character; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp
-   ByteArray# -> Int# -> Char#
-   {Read a 32-bit character; offset in 4-byte words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp
-   ByteArray# -> Int# -> Int#
-   {Read a word-sized integer; offset in machine words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp
-   ByteArray# -> Int# -> Word#
-   {Read a word-sized unsigned integer; offset in machine words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp
-   ByteArray# -> Int# -> Addr#
-   {Read a machine address; offset in machine words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp
-   ByteArray# -> Int# -> Float#
-   {Read a single-precision floating-point value; offset in 4-byte words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp
-   ByteArray# -> Int# -> Double#
-   {Read a double-precision floating-point value; offset in 8-byte words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp
-   ByteArray# -> Int# -> StablePtr# a
-   {Read a 'StablePtr#' value; offset in machine words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp
-   ByteArray# -> Int# -> Int8#
-   {Read a 8-bit signed integer; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp
-   ByteArray# -> Int# -> Int16#
-   {Read a 16-bit signed integer; offset in 2-byte words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp
-   ByteArray# -> Int# -> Int32#
-   {Read a 32-bit signed integer; offset in 4-byte words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
-   ByteArray# -> Int# -> Int64#
-   {Read a 64-bit signed integer; offset in 8-byte words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp
-   ByteArray# -> Int# -> Word8#
-   {Read a 8-bit unsigned integer; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp
-   ByteArray# -> Int# -> Word16#
-   {Read a 16-bit unsigned integer; offset in 2-byte words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp
-   ByteArray# -> Int# -> Word32#
-   {Read a 32-bit unsigned integer; offset in 4-byte words.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
-   ByteArray# -> Int# -> Word64#
-   {Read a 64-bit unsigned integer; offset in 8-byte words.}
-   with can_fail = True
-
-
-------------------------------------
--- unaligned index operations
-------------------------------------
-
-primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp
-   ByteArray# -> Int# -> Char#
-   {Read a 8-bit character; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp
-   ByteArray# -> Int# -> Char#
-   {Read a 32-bit character; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp
-   ByteArray# -> Int# -> Int#
-   {Read a word-sized integer; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp
-   ByteArray# -> Int# -> Word#
-   {Read a word-sized unsigned integer; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp
-   ByteArray# -> Int# -> Addr#
-   {Read a machine address; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp
-   ByteArray# -> Int# -> Float#
-   {Read a single-precision floating-point value; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp
-   ByteArray# -> Int# -> Double#
-   {Read a double-precision floating-point value; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp
-   ByteArray# -> Int# -> StablePtr# a
-   {Read a 'StablePtr#' value; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp
-   ByteArray# -> Int# -> Int16#
-   {Read a 16-bit signed integer; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp
-   ByteArray# -> Int# -> Int32#
-   {Read a 32-bit signed integer; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp
-   ByteArray# -> Int# -> Int64#
-   {Read a 64-bit signed integer; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp
-   ByteArray# -> Int# -> Word16#
-   {Read a 16-bit unsigned integer; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp
-   ByteArray# -> Int# -> Word32#
-   {Read a 32-bit unsigned integer; offset in bytes.}
-   with can_fail = True
-
-primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp
-   ByteArray# -> Int# -> Word64#
-   {Read a 64-bit unsigned integer; offset in bytes.}
-   with can_fail = True
-
-
-------------------------------------
--- aligned read operations
-------------------------------------
-
-primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
-   {Read a 8-bit character; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
-   {Read a 32-bit character; offset in 4-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
-   {Read a word-sized integer; offset in machine words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
-   {Read a word-sized unsigned integer; offset in machine words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
-   {Read a machine address; offset in machine words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
-   {Read a single-precision floating-point value; offset in 4-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
-   {Read a double-precision floating-point value; offset in 8-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #)
-   {Read a 'StablePtr#' value; offset in machine words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8# #)
-   {Read a 8-bit signed integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #)
-   {Read a 16-bit signed integer; offset in 2-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #)
-   {Read a 32-bit signed integer; offset in 4-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #)
-   {Read a 64-bit signed integer; offset in 8-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8# #)
-   {Read a 8-bit unsigned integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #)
-   {Read a 16-bit unsigned integer; offset in 2-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #)
-   {Read a 32-bit unsigned integer; offset in 4-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #)
-   {Read a 64-bit unsigned integer; offset in 8-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-
-------------------------------------
--- unaligned read operations
-------------------------------------
-
-primop ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
-   {Read a 8-bit character; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
-   {Read a 32-bit character; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
-   {Read a word-sized integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
-   {Read a word-sized unsigned integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
-   {Read a machine address; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
-   {Read a single-precision floating-point value; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
-   {Read a double-precision floating-point value; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #)
-   {Read a 'StablePtr#' value; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #)
-   {Read a 16-bit signed integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #)
-   {Read a 32-bit signed integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #)
-   {Read a 64-bit signed integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #)
-   {Read a 16-bit unsigned integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #)
-   {Read a 32-bit unsigned integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp
-   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #)
-   {Read a 64-bit unsigned integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-
-------------------------------------
--- aligned write operations
-------------------------------------
-
-primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
-   {Write a 8-bit character; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
-   {Write a 32-bit character; offset in 4-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
-   {Write a word-sized integer; offset in machine words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
-   {Write a word-sized unsigned integer; offset in machine words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
-   {Write a machine address; offset in machine words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
-   {Write a single-precision floating-point value; offset in 4-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
-   {Write a double-precision floating-point value; offset in 8-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp
-   MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s
-   {Write a 'StablePtr#' value; offset in machine words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> Int8# -> State# s -> State# s
-   {Write a 8-bit signed integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s
-   {Write a 16-bit signed integer; offset in 2-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s
-   {Write a 32-bit signed integer; offset in 4-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s
-   {Write a 64-bit signed integer; offset in 8-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s
-   {Write a 8-bit unsigned integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s
-   {Write a 16-bit unsigned integer; offset in 2-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s
-   {Write a 32-bit unsigned integer; offset in 4-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp
-   MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s
-   {Write a 64-bit unsigned integer; offset in 8-byte words.}
-   with has_side_effects = True
-        can_fail = True
-
-
-------------------------------------
--- unaligned write operations
-------------------------------------
-
-primop WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp
-   MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
-   {Write a 8-bit character; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp
-   MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
-   {Write a 32-bit character; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp
-   MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
-   {Write a word-sized integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp
-   MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
-   {Write a word-sized unsigned integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp
-   MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
-   {Write a machine address; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp
-   MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
-   {Write a single-precision floating-point value; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp
-   MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
-   {Write a double-precision floating-point value; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp
-   MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s
-   {Write a 'StablePtr#' value; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp
-   MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s
-   {Write a 16-bit signed integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp
-   MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s
-   {Write a 32-bit signed integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp
-   MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s
-   {Write a 64-bit signed integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp
-   MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s
-   {Write a 16-bit unsigned integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp
-   MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s
-   {Write a 32-bit unsigned integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-
-primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp
-   MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s
-   {Write a 64-bit unsigned integer; offset in bytes.}
-   with has_side_effects = True
-        can_fail = True
-

utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py

 #!/usr/bin/env python
 # -*- coding: utf-8 -*-
 
+# This script generates the primop descriptions for many similar ByteArray#
+# and Addr# access operations.  Its output is #include-d into primops.txt.pp.
+
 from typing import Optional, NamedTuple
 import textwrap
+import argparse
+
+arg_parser = argparse.ArgumentParser()
+arg_parser.add_argument('addr_or_bytearray',
+                        choices = ["addr-access-ops", "bytearray-access-ops"],
+                        )
+arg_parser.add_argument('output_file',
+                        type=argparse.FileType('w'),
+                        metavar='FILE',
+                        )
+args = arg_parser.parse_args()
+write = args.output_file.write
+
+
+
+write('''
+-- Do not edit.
+-- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py.
+-- (The build system should take care of this for you.)
+
+''')
 
 class ElementType(NamedTuple):
     name: str
@@ -28,26 +52,13 @@ element_types = [
     ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value",                    MACH_WORD),
 ]
 
-# TODO: Eventually when the sized integer primops use proper unboxed types we
-# should rather do:
-#
-#for n in [8,16,32,64]:
-#    element_types += [ ElementType(f"Int{n}",  f"Int{n}#",  f"{n}-bit signed integer",   n // 8) ]
-#
-#for n in [8,16,32,64]:
-#    element_types += [ ElementType(f"Word{n}", f"Word{n}#", f"{n}-bit unsigned integer", n // 8) ]
-
-element_types += [
-    ElementType("Int8",   "Int8#",  "8-bit signed integer",  1),
-    ElementType("Int16",  "Int16#", "16-bit signed integer", 2),
-    ElementType("Int32",  "Int32#", "32-bit signed integer", 4),
-    ElementType("Int64",  "Int64#", "64-bit signed integer", 8),
-
-    ElementType("Word8",  "Word8#",  "8-bit unsigned integer",  1),
-    ElementType("Word16", "Word16#", "16-bit unsigned integer", 2),
-    ElementType("Word32", "Word32#", "32-bit unsigned integer", 4),
-    ElementType("Word64", "Word64#", "64-bit unsigned integer", 8),
-]
+for n in [8,16,32,64]:
+    element_types += [
+        ElementType(f"Int{n}",  f"Int{n}#",
+                    f"{n}-bit signed integer",   n // 8),
+        ElementType(f"Word{n}", f"Word{n}#",
+                    f"{n}-bit unsigned integer", n // 8)
+    ]
 
 def pretty_offset(n: Optional[int]) -> str:
     if n == MACH_WORD:
@@ -57,87 +68,134 @@ def pretty_offset(n: Optional[int]) -> str:
     else:
         return f'{n}-byte words'
 
+def get_align_warn(n: ElementType) -> str:
+    if n.width == 1:
+        return ''
+    return '''
+        On some platforms, the access may fail
+        for an insufficiently aligned @Addr#@.
+    '''
+
 def print_block(template: str, **kwargs) -> None:
-    print(textwrap.dedent(template.format(**kwargs)).lstrip())
+    write(textwrap.dedent(template.format(**kwargs)).lstrip())
+    write('\n')
 
 def header(s: str):
-    print('')
+    write('\n')
     print_block('''
         ------------------------------------
         -- {s}
         ------------------------------------
     ''', s=s)
 
+if args.addr_or_bytearray == "bytearray-access-ops":
+    header("ByteArray# operations")
 
-header("ByteArray# operations")
-
-print('''
--- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py.
--- To regenerate run,
---
---      python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp
-''')
-
-header('aligned index operations')
-for t in element_types:
-    offset = pretty_offset(t.width)
-    print_block('''
+    header('aligned index operations')
+    for t in element_types:
+        offset = pretty_offset(t.width)
+        print_block('''
         primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp
            ByteArray# -> Int# -> {rep_ty}
            {{Read a {desc}; offset in {offset}.}}
            with can_fail = True
-    ''', offset = offset, **t._asdict())
+        ''', offset = offset, **t._asdict())
 
-header('unaligned index operations')
-for t in element_types:
-    if t.name in ['Int8', 'Word8']: continue
-    print_block('''
+    header('unaligned index operations')
+    for t in element_types:
+        if t.name in ['Int8', 'Word8']: continue
+        print_block('''
         primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp
            ByteArray# -> Int# -> {rep_ty}
            {{Read a {desc}; offset in bytes.}}
            with can_fail = True
-    ''', **t._asdict())
+        ''', **t._asdict())
 
-header('aligned read operations')
-for t in element_types:
-    offset = pretty_offset(t.width)
-    print_block('''
+    header('aligned read operations')
+    for t in element_types:
+        offset = pretty_offset(t.width)
+        print_block('''
         primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp
            MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #)
            {{Read a {desc}; offset in {offset}.}}
            with has_side_effects = True
                 can_fail = True
-    ''', offset = offset, **t._asdict())
+        ''', offset = offset, **t._asdict())
 
-header('unaligned read operations')
-for t in element_types:
-    if t.name in ['Int8', 'Word8']: continue
-    print_block('''
+    header('unaligned read operations')
+    for t in element_types:
+        if t.name in ['Int8', 'Word8']: continue
+        print_block('''
         primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp
            MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #)
            {{Read a {desc}; offset in bytes.}}
            with has_side_effects = True
                 can_fail = True
-    ''', **t._asdict())
+        ''', **t._asdict())
 
-header('aligned write operations')
-for t in element_types:
-    offset = pretty_offset(t.width)
-    print_block('''
+    header('aligned write operations')
+    for t in element_types:
+        offset = pretty_offset(t.width)
+        print_block('''
         primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp
            MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s
            {{Write a {desc}; offset in {offset}.}}
            with has_side_effects = True
                 can_fail = True
-    ''', offset = offset, **t._asdict())
+        ''', offset = offset, **t._asdict())
 
-header('unaligned write operations')
-for t in element_types:
-    if t.name in ['Int8', 'Word8']: continue
-    print_block('''
+    header('unaligned write operations')
+    for t in element_types:
+        if t.name in ['Int8', 'Word8']: continue
+        print_block('''
         primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp
            MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s
            {{Write a {desc}; offset in bytes.}}
            with has_side_effects = True
                 can_fail = True
-    ''', **t._asdict())
+        ''', **t._asdict())
+
+
+else: # addr_or_bytearray == "addr-access-ops":
+    header("Addr# access operations")
+
+    header('aligned index operations')
+    for t in element_types:
+        offset = pretty_offset(t.width)
+        align_warn = get_align_warn(t)
+        print_block('''
+        primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp
+           Addr# -> Int# -> {rep_ty}
+           {{ Read a {desc}; offset in {offset}.
+              {align_warn}
+           }}
+           with can_fail = True
+        ''', offset = offset, align_warn = align_warn, **t._asdict())
+
+    header('aligned read operations')
+    for t in element_types:
+        offset = pretty_offset(t.width)
+        align_warn = get_align_warn(t)
+        print_block('''
+        primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp
+           Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #)
+           {{ Read a {desc}; offset in {offset}.
+              {align_warn}
+           }}
+           with has_side_effects = True
+                can_fail = True
+        ''', offset = offset, align_warn = align_warn, **t._asdict())
+
+    header('aligned write operations')
+    for t in element_types:
+        offset = pretty_offset(t.width)
+        align_warn = get_align_warn(t)
+        print_block('''
+        primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp
+           Addr# -> Int# -> {rep_ty} -> State# s -> State# s
+           {{ Write a {desc}; offset in {offset}.
+              {align_warn}
+           }}
+           with has_side_effects = True
+                can_fail = True
+        ''', offset = offset, align_warn = align_warn, **t._asdict())

compiler/GHC/Builtin/primops.txt.pp

@@ -1941,7 +1941,7 @@ primop  GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp
 
    @since 0.5.0.0}
 
-#include "bytearray-ops.txt.pp"
+#include "bytearray-access-ops.txt.pp"
 
 primop  CompareByteArraysOp "compareByteArrays#" GenPrimOp
    ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
@@ -2242,233 +2242,7 @@ primop   AddrNeOp  "neAddr#"   Compare   Addr# -> Addr# -> Int#
 primop   AddrLtOp  "ltAddr#"   Compare   Addr# -> Addr# -> Int#
 primop   AddrLeOp  "leAddr#"   Compare   Addr# -> Addr# -> Int#
 
-primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> Char#
-   {Reads 8-bit character; offset in bytes.}
-   with can_fail = True
-
-primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> Char#
-   {Reads 31-bit character; offset in 4-byte words.}
-   with can_fail = True
-
-primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp
-   Addr# -> Int# -> Int#
-   with can_fail = True
-
-primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp
-   Addr# -> Int# -> Word#
-   with can_fail = True
-
-primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp
-   Addr# -> Int# -> Addr#
-   with can_fail = True
-
-primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp
-   Addr# -> Int# -> Float#
-   with can_fail = True
-
-primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp
-   Addr# -> Int# -> Double#
-   with can_fail = True
-
-primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp
-   Addr# -> Int# -> StablePtr# a
-   with can_fail = True
-
-primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int8#
-   with can_fail = True
-
-primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int16#
-   with can_fail = True
-
-primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int32#
-   with can_fail = True
-
-primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int64#
-   with can_fail = True
-
-primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word8#
-   with can_fail = True
-
-primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word16#
-   with can_fail = True
-
-primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word32#
-   with can_fail = True
-
-primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word64#
-   with can_fail = True
-
-primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Char# #)
-   {Reads 8-bit character; offset in bytes.}
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Char# #)
-   {Reads 31-bit character; offset in 4-byte words.}
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Int# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Word# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Addr# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Float# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Double# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Int8# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Int16# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Int32# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Int64# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Word8# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Word16# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Word32# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Word64# #)
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> Char# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> Char# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp
-   Addr# -> Int# -> Int# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp
-   Addr# -> Int# -> Word# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp
-   Addr# -> Int# -> Addr# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp
-   Addr# -> Int# -> Float# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp
-   Addr# -> Int# -> Double# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp
-   Addr# -> Int# -> StablePtr# a -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int8# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int16# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int32# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int64# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word8# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word16# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word32# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
-
-primop  WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word64# -> State# s -> State# s
-   with has_side_effects = True
-        can_fail         = True
+#include "addr-access-ops.txt.pp"
 
 primop  InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp
    Addr# -> Addr# -> State# s -> (# State# s, Addr# #)

compiler/GHC/Core/Opt/CallerCC.hs

@@ -15,14 +15,11 @@ module GHC.Core.Opt.CallerCC
     , parseCallerCcFilter
     ) where
 
-import Data.Word (Word8)
 import Data.Maybe
 
 import Control.Applicative
 import GHC.Utils.Monad.State.Strict
-import Data.Either
 import Control.Monad
-import qualified Text.ParserCombinators.ReadP as P
 
 import GHC.Prelude
 import GHC.Utils.Outputable as Outputable
@@ -38,11 +35,8 @@ import GHC.Unit.Types
 import GHC.Data.FastString
 import GHC.Core
 import GHC.Core.Opt.Monad
-import GHC.Utils.Panic
-import qualified GHC.Utils.Binary as B
-import Data.Char
+import GHC.Core.Opt.CallerCC.Types
 
-import Language.Haskell.Syntax.Module.Name
 
 addCallerCostCentres :: ModGuts -> CoreM ModGuts
 addCallerCostCentres guts = do
@@ -139,90 +133,3 @@ needsCallSiteCostCentre env i =
         checkFunc =
             occNameMatches (ccfFuncName ccf) (getOccName i)
 
-data NamePattern
-    = PChar Char NamePattern
-    | PWildcard NamePattern
-    | PEnd
-
-instance Outputable NamePattern where
-  ppr (PChar c rest) = char c <> ppr rest
-  ppr (PWildcard rest) = char '*' <> ppr rest
-  ppr PEnd = Outputable.empty
-
-instance B.Binary NamePattern where
-  get bh = do
-    tag <- B.get bh
-    case tag :: Word8 of
-      0 -> PChar <$> B.get bh <*> B.get bh
-      1 -> PWildcard <$> B.get bh
-      2 -> pure PEnd
-      _ -> panic "Binary(NamePattern): Invalid tag"
-  put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y
-  put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x
-  put_ bh PEnd = B.put_ bh (2 :: Word8)
-
-occNameMatches :: NamePattern -> OccName -> Bool
-occNameMatches pat = go pat . occNameString
-  where
-    go :: NamePattern -> String -> Bool
-    go PEnd "" = True
-    go (PChar c rest) (d:s)
-      = d == c && go rest s
-    go (PWildcard rest) s
-      = go rest s || go (PWildcard rest) (tail s)
-    go _ _  = False
-
-type Parser = P.ReadP
-
-parseNamePattern :: Parser NamePattern
-parseNamePattern = pattern
-  where
-    pattern = star P.<++ wildcard P.<++ char P.<++ end
-    star = PChar '*' <$ P.string "\\*" <*> pattern
-    wildcard = do
-      void $ P.char '*'
-      PWildcard <$> pattern
-    char = PChar <$> P.get <*> pattern
-    end = PEnd <$ P.eof
-
-data CallerCcFilter
-    = CallerCcFilter { ccfModuleName  :: Maybe ModuleName
-                     , ccfFuncName    :: NamePattern
-                     }
-
-instance Outputable CallerCcFilter where
-  ppr ccf =
-    maybe (char '*') ppr (ccfModuleName ccf)
-    <> char '.'
-    <> ppr (ccfFuncName ccf)
-
-instance B.Binary CallerCcFilter where
-  get bh = CallerCcFilter <$> B.get bh <*> B.get bh
-  put_ bh (CallerCcFilter x y) = B.put_ bh x >> B.put_ bh y
-
-parseCallerCcFilter :: String -> Either String CallerCcFilter
-parseCallerCcFilter inp =
-    case P.readP_to_S parseCallerCcFilter' inp of
-      ((result, ""):_) -> Right result
-      _ -> Left $ "parse error on " ++ inp
-
-parseCallerCcFilter' :: Parser CallerCcFilter
-parseCallerCcFilter' =
-  CallerCcFilter
-    <$> moduleFilter
-    <*  P.char '.'
-    <*> parseNamePattern
-  where
-    moduleFilter :: Parser (Maybe ModuleName)
-    moduleFilter =
-      (Just . mkModuleName <$> moduleName)
-      <|>
-      (Nothing <$ P.char '*')
-
-    moduleName :: Parser String
-    moduleName = do
-      c <- P.satisfy isUpper
-      cs <- P.munch1 (\c -> isUpper c || isLower c || isDigit c || c == '_')
-      rest <- optional $ P.char '.' >> fmap ('.':) moduleName
-      return $ c : (cs ++ fromMaybe "" rest)
-

compiler/GHC/Core/Opt/CallerCC.hs-boot

-module GHC.Core.Opt.CallerCC where
-
-import GHC.Prelude
-
--- Necessary due to import in GHC.Driver.Session.
-data CallerCcFilter
-
-parseCallerCcFilter :: String -> Either String CallerCcFilter

compiler/GHC/Core/Opt/CallerCC/Types.hs

+module GHC.Core.Opt.CallerCC.Types ( NamePattern(..)
+                                   , CallerCcFilter(..)
+                                   , occNameMatches
+                                   , parseCallerCcFilter
+                                   , parseNamePattern
+                                   ) where
+
+import Data.Word (Word8)
+import Data.Maybe
+
+import Control.Applicative
+import Data.Either
+import Control.Monad
+import qualified Text.ParserCombinators.ReadP as P
+
+import GHC.Prelude
+import GHC.Utils.Outputable as Outputable
+import GHC.Types.Name hiding (varName)
+import GHC.Utils.Panic
+import qualified GHC.Utils.Binary as B
+import Data.Char
+
+import Language.Haskell.Syntax.Module.Name
+
+
+data NamePattern
+    = PChar Char NamePattern
+    | PWildcard NamePattern
+    | PEnd
+
+instance Outputable NamePattern where
+  ppr (PChar c rest) = char c <> ppr rest
+  ppr (PWildcard rest) = char '*' <> ppr rest
+  ppr PEnd = Outputable.empty
+
+instance B.Binary NamePattern where
+  get bh = do
+    tag <- B.get bh
+    case tag :: Word8 of
+      0 -> PChar <$> B.get bh <*> B.get bh
+      1 -> PWildcard <$> B.get bh
+      2 -> pure PEnd
+      _ -> panic "Binary(NamePattern): Invalid tag"
+  put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y
+  put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x
+  put_ bh PEnd = B.put_ bh (2 :: Word8)
+
+occNameMatches :: NamePattern -> OccName -> Bool
+occNameMatches pat = go pat . occNameString
+  where
+    go :: NamePattern -> String -> Bool
+    go PEnd "" = True
+    go (PChar c rest) (d:s)
+      = d == c && go rest s
+    go (PWildcard rest) s
+      = go rest s || go (PWildcard rest) (tail s)
+    go _ _  = False
+
+
+
+type Parser = P.ReadP
+
+parseNamePattern :: Parser NamePattern
+parseNamePattern = pattern
+  where
+    pattern = star P.<++ wildcard P.<++ char P.<++ end
+    star = PChar '*' <$ P.string "\\*" <*> pattern
+    wildcard = do
+      void $ P.char '*'
+      PWildcard <$> pattern
+    char = PChar <$> P.get <*> pattern
+    end = PEnd <$ P.eof
+
+data CallerCcFilter
+    = CallerCcFilter { ccfModuleName  :: Maybe ModuleName
+                     , ccfFuncName    :: NamePattern
+                     }
+
+instance Outputable CallerCcFilter where
+  ppr ccf =
+    maybe (char '*') ppr (ccfModuleName ccf)
+    <> char '.'
+    <> ppr (ccfFuncName ccf)
+
+instance B.Binary CallerCcFilter where
+  get bh = CallerCcFilter <$> B.get bh <*> B.get bh
+  put_ bh (CallerCcFilter x y) = B.put_ bh x >> B.put_ bh y
+
+parseCallerCcFilter :: String -> Either String CallerCcFilter
+parseCallerCcFilter inp =
+    case P.readP_to_S parseCallerCcFilter' inp of
+      ((result, ""):_) -> Right result
+      _ -> Left $ "parse error on " ++ inp
+
+parseCallerCcFilter' :: Parser CallerCcFilter
+parseCallerCcFilter' =
+  CallerCcFilter
+    <$> moduleFilter
+    <*  P.char '.'
+    <*> parseNamePattern
+  where
+    moduleFilter :: Parser (Maybe ModuleName)
+    moduleFilter =
+      (Just . mkModuleName <$> moduleName)
+      <|>
+      (Nothing <$ P.char '*')
+
+    moduleName :: Parser String
+    moduleName = do
+      c <- P.satisfy isUpper
+      cs <- P.munch1 (\c -> isUpper c || isLower c || isDigit c || c == '_')
+      rest <- optional $ P.char '.' >> fmap ('.':) moduleName
+      return $ c : (cs ++ fromMaybe "" rest)
\ No newline at end of file

compiler/GHC/Core/TyCon.hs

@@ -25,7 +25,8 @@ module GHC.Core.TyCon(
         mkRequiredTyConBinder,
         mkAnonTyConBinder, mkAnonTyConBinders,
         tyConBinderForAllTyFlag, tyConBndrVisForAllTyFlag, isNamedTyConBinder,
-        isVisibleTyConBinder, isInvisibleTyConBinder, isVisibleTcbVis,
+        isVisibleTyConBinder, isInvisibleTyConBinder,
+        isVisibleTcbVis, isInvisSpecTcbVis,
 
         -- ** Field labels
         tyConFieldLabels, lookupTyConFieldLabel,
@@ -508,6 +509,10 @@ isVisibleTcbVis :: TyConBndrVis -> Bool
 isVisibleTcbVis (NamedTCB vis) = isVisibleForAllTyFlag vis
 isVisibleTcbVis AnonTCB        = True
 
+isInvisSpecTcbVis :: TyConBndrVis -> Bool
+isInvisSpecTcbVis (NamedTCB Specified) = True
+isInvisSpecTcbVis _                    = False
+
 isInvisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool
 -- Works for IfaceTyConBinder too
 isInvisibleTyConBinder tcb = not (isVisibleTyConBinder tcb)
@@ -889,8 +894,8 @@ data TyConDetails =
         promDcInfo    :: PromDataConInfo  -- ^ See comments with 'PromDataConInfo'
     }
 
-  -- | These exist only during type-checking. See Note [How TcTyCons work]
-  -- in "GHC.Tc.TyCl"
+  -- | These exist only during type-checking.
+  -- See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in "GHC.Tc.TyCl"
   | TcTyCon {
           -- NB: the tyConArity of a TcTyCon must match
           -- the number of Required (positional, user-specified)
@@ -924,7 +929,7 @@ where
    * tyConArity = length required_tvs
 
 tcTyConScopedTyVars are used only for MonoTcTyCons, not PolyTcTyCons.
-See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in GHC.Tc.Utils.TcType.
+See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in GHC.Tc.TyCl
 
 Note [Representation-polymorphic TyCons]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1843,13 +1848,11 @@ mkSumTyCon name binders res_kind cons parent
 -- right-hand side. It lives only during the type-checking of a
 -- mutually-recursive group of tycons; it is then zonked to a proper
 -- TyCon in zonkTcTyCon.
--- See also Note [Kind checking recursive type and class declarations]
--- in "GHC.Tc.TyCl".
+-- See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in "GHC.Tc.TyCl"
 mkTcTyCon :: Name
           -> [TyConBinder]
           -> Kind                -- ^ /result/ kind only
           -> [(Name,TcTyVar)]    -- ^ Scoped type variables;
-                                 -- see Note [How TcTyCons work] in GHC.Tc.TyCl
           -> Bool                -- ^ Is this TcTyCon generalised already?
           -> TyConFlavour TyCon  -- ^ What sort of 'TyCon' this represents
           -> TyCon
@@ -1997,7 +2000,7 @@ isInjectiveTyCon (TyCon { tyConDetails = details }) role
     go (TcTyCon {})                  _                = True
 
   -- Reply True for TcTyCon to minimise knock on type errors
-  -- See Note [How TcTyCons work] item (1) in GHC.Tc.TyCl
+  -- See (W1) in Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in GHC.Tc.TyCl
 
 
 -- | 'isGenerativeTyCon' is true of 'TyCon's for which this property holds

compiler/GHC/Driver/DynFlags.hs

@@ -109,7 +109,7 @@ import qualified GHC.Types.FieldLabel as FieldLabel
 import qualified GHC.Utils.Ppr.Colour as Col
 import qualified GHC.Data.EnumSet as EnumSet
 
-import {-# SOURCE #-} GHC.Core.Opt.CallerCC
+import GHC.Core.Opt.CallerCC.Types
 
 import Control.Monad (msum, (<=<))
 import Control.Monad.Trans.Class (lift)

compiler/GHC/Driver/Plugins.hs

@@ -82,7 +82,7 @@ import GHC.Parser.Errors.Types (PsWarning, PsError)
 
 import qualified GHC.Tc.Types
 import GHC.Tc.Types ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports  )
-import GHC.Tc.Errors.Hole.FitTypes ( HoleFitPluginR )
+import GHC.Tc.Errors.Hole.Plugin ( HoleFitPluginR )
 
 import GHC.Core.Opt.Monad ( CoreM )
 import GHC.Core.Opt.Pipeline.Types ( CoreToDo )

compiler/GHC/Hs/Binds.hs

 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -120,7 +121,11 @@ type instance XPatBind    GhcTc (GhcPass pR) =
     , ( [CoreTickish]       -- Ticks to put on the rhs, if any
       , [[CoreTickish]] ) ) -- and ticks to put on the bound variables.
 
-type instance XVarBind    (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XVarBind (GhcPass pL) (GhcPass pR) = XVarBindGhc pL pR
+type family XVarBindGhc pL pR where
+  XVarBindGhc 'Typechecked 'Typechecked = NoExtField
+  XVarBindGhc _     _                   = DataConCantHappen
+
 type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExtField
 
 type instance XXHsBindsLR GhcPs pR = DataConCantHappen

compiler/GHC/Hs/Expr.hs

@@ -64,7 +64,7 @@ import GHC.Data.FastString
 import GHC.Core.Type
 import GHC.Builtin.Types (mkTupleStr)
 import GHC.Tc.Utils.TcType (TcType, TcTyVar)
-import {-# SOURCE #-} GHC.Tc.Types (TcLclEnv)
+import {-# SOURCE #-} GHC.Tc.Types.LclEnv (TcLclEnv)
 
 import GHCi.RemoteTypes ( ForeignRef )
 import qualified Language.Haskell.TH as TH (Q)

compiler/GHC/Hs/Instances.hs

@@ -458,6 +458,11 @@ deriving instance (Data body) => Data (HsRecFields GhcTc body)
 -- ---------------------------------------------------------------------
 -- Data derivations from GHC.Hs.Type ----------------------------------
 
+-- deriving instance Data (HsBndrVis p)
+deriving instance Data (HsBndrVis GhcPs)
+deriving instance Data (HsBndrVis GhcRn)
+deriving instance Data (HsBndrVis GhcTc)
+
 -- deriving instance (DataIdLR p p) => Data (LHsQTyVars p)
 deriving instance Data (LHsQTyVars GhcPs)
 deriving instance Data (LHsQTyVars GhcRn)

compiler/GHC/Hs/Pat.hs

@@ -82,8 +82,6 @@ import GHC.Types.SrcLoc
 import GHC.Data.Bag -- collect ev vars from pats
 import GHC.Data.Maybe
 import GHC.Types.Name (Name, dataName)
-import GHC.Driver.DynFlags (DynFlags, xopt)
-import qualified GHC.LanguageExtensions as LangExt
 import Data.Data
 
 
@@ -502,22 +500,6 @@ looksLazyPat (VarPat {})   = False
 looksLazyPat (WildPat {})  = False
 looksLazyPat _             = True
 
-isIrrefutableHsPat :: forall p. (OutputableBndrId p)
-                   => DynFlags -> LPat (GhcPass p) -> Bool
--- (isIrrefutableHsPat p) is true if matching against p cannot fail,
--- in the sense of falling through to the next pattern.
---      (NB: this is not quite the same as the (silly) defn
---      in 3.17.2 of the Haskell 98 report.)
---
--- WARNING: isIrrefutableHsPat returns False if it's in doubt.
--- Specifically on a ConPatIn, which is what it sees for a
--- (LPat Name) in the renamer, it doesn't know the size of the
--- constructor family, so it returns False.  Result: only
--- tuple patterns are considered irrefutable at the renamer stage.
---
--- But if it returns True, the pattern is definitely irrefutable
-isIrrefutableHsPat dflags =
-    isIrrefutableHsPat' (xopt LangExt.Strict dflags)
 
 {-
 Note [-XStrict and irrefutability]
@@ -544,12 +526,23 @@ encounters a LazyPat and -XStrict is enabled.
 
 See also Note [decideBangHood] in GHC.HsToCore.Utils.
 -}
-
-isIrrefutableHsPat' :: forall p. (OutputableBndrId p)
+-- | (isIrrefutableHsPat p) is true if matching against p cannot fail
+-- in the sense of falling through to the next pattern.
+--      (NB: this is not quite the same as the (silly) defn
+--      in 3.17.2 of the Haskell 98 report.)
+--
+-- WARNING: isIrrefutableHsPat returns False if it's in doubt.
+-- Specifically on a ConPatIn, which is what it sees for a
+-- (LPat Name) in the renamer, it doesn't know the size of the
+-- constructor family, so it returns False.  Result: only
+-- tuple patterns are considered irrefutable at the renamer stage.
+--
+-- But if it returns True, the pattern is definitely irrefutable
+isIrrefutableHsPat :: forall p. (OutputableBndrId p)
                     => Bool -- ^ Are we in a @-XStrict@ context?
                             -- See Note [-XStrict and irrefutability]
                     -> LPat (GhcPass p) -> Bool
-isIrrefutableHsPat' is_strict = goL
+isIrrefutableHsPat is_strict = goL
   where
     goL :: LPat (GhcPass p) -> Bool
     goL = go . unLoc
@@ -559,7 +552,7 @@ isIrrefutableHsPat' is_strict = goL
     go (VarPat {})         = True
     go (LazyPat _ p')
       | is_strict
-      = isIrrefutableHsPat' False p'
+      = isIrrefutableHsPat False p'
       | otherwise          = True
     go (BangPat _ pat)     = goL pat
     go (ParPat _ _ pat _)  = goL pat

compiler/GHC/Hs/Type.hs

@@ -32,6 +32,7 @@ module GHC.Hs.Type (
 
         HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,
         HsForAllTelescope(..), EpAnnForallTy, HsTyVarBndr(..), LHsTyVarBndr,
+        HsBndrVis(..), isHsBndrInvisible,
         LHsQTyVars(..),
         HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
         HsWildCardBndrs(..),
@@ -83,7 +84,7 @@ module GHC.Hs.Type (
         mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
         ignoreParens, hsSigWcType, hsPatSigType,
         hsTyKindSig,
-        setHsTyVarBndrFlag, hsTyVarBndrFlag,
+        setHsTyVarBndrFlag, hsTyVarBndrFlag, updateHsTyVarBndrFlag,
 
         -- Printing
         pprHsType, pprHsForAll,
@@ -188,7 +189,7 @@ mkHsForAllInvisTele :: EpAnnForallTy
 mkHsForAllInvisTele an invis_bndrs =
   HsForAllInvis { hsf_xinvis = an, hsf_invis_bndrs = invis_bndrs }
 
-mkHsQTvs :: [LHsTyVarBndr () GhcPs] -> LHsQTyVars GhcPs
+mkHsQTvs :: [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs] -> LHsQTyVars GhcPs
 mkHsQTvs tvs = HsQTvs { hsq_ext = noExtField, hsq_explicit = tvs }
 
 emptyLHsQTvs :: LHsQTyVars GhcRn
@@ -289,6 +290,8 @@ type instance XXTyVarBndr   (GhcPass _) = DataConCantHappen
 hsTyVarBndrFlag :: HsTyVarBndr flag (GhcPass pass) -> flag
 hsTyVarBndrFlag (UserTyVar _ fl _)     = fl
 hsTyVarBndrFlag (KindedTyVar _ fl _ _) = fl
+-- By specialising to (GhcPass p) we know that XXTyVarBndr is DataConCantHappen
+-- so these two equations are exhaustive: extension construction can't happen
 
 -- | Set the attached flag
 setHsTyVarBndrFlag :: flag -> HsTyVarBndr flag' (GhcPass pass)
@@ -296,6 +299,14 @@ setHsTyVarBndrFlag :: flag -> HsTyVarBndr flag' (GhcPass pass)
 setHsTyVarBndrFlag f (UserTyVar x _ l)     = UserTyVar x f l
 setHsTyVarBndrFlag f (KindedTyVar x _ l k) = KindedTyVar x f l k
 
+-- | Update the attached flag
+updateHsTyVarBndrFlag
+  :: (flag -> flag')
+  -> HsTyVarBndr flag  (GhcPass pass)
+  -> HsTyVarBndr flag' (GhcPass pass)
+updateHsTyVarBndrFlag f (UserTyVar   x flag name)    = UserTyVar   x (f flag) name
+updateHsTyVarBndrFlag f (KindedTyVar x flag name ki) = KindedTyVar x (f flag) name ki
+
 -- | Do all type variables in this 'LHsQTyVars' come with kind annotations?
 hsTvbAllKinded :: LHsQTyVars (GhcPass p) -> Bool
 hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit
@@ -991,6 +1002,15 @@ instance OutputableBndrFlag Specificity p where
     pprTyVarBndr (KindedTyVar _ SpecifiedSpec n k) = parens $ hsep [ppr n, dcolon, ppr k]
     pprTyVarBndr (KindedTyVar _ InferredSpec n k)  = braces $ hsep [ppr n, dcolon, ppr k]
 
+instance OutputableBndrFlag (HsBndrVis p') p where
+    pprTyVarBndr (UserTyVar _ vis n) = pprHsBndrVis vis $ ppr n
+    pprTyVarBndr (KindedTyVar _ vis n k) =
+      pprHsBndrVis vis $ parens $ hsep [ppr n, dcolon, ppr k]
+
+pprHsBndrVis :: HsBndrVis pass -> SDoc -> SDoc
+pprHsBndrVis HsBndrRequired d = d
+pprHsBndrVis (HsBndrInvisible _) d = char '@' <> d
+
 instance OutputableBndrId p => Outputable (HsSigType (GhcPass p)) where
     ppr (HsSig { sig_bndrs = outer_bndrs, sig_body = body }) =
       pprHsOuterSigTyVarBndrs outer_bndrs <+> ppr body

compiler/GHC/Hs/Utils.hs

@@ -819,7 +819,7 @@ mkTopFunBind origin fn ms = FunBind { fun_id = fn
 mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs
 mkHsVarBind loc var rhs = mkSimpleGeneratedFunBind loc var [] rhs
 
-mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
+mkVarBind :: IdP GhcTc -> LHsExpr GhcTc -> LHsBind GhcTc
 mkVarBind var rhs = L (getLoc rhs) $
                     VarBind { var_ext = noExtField,
                               var_id = var, var_rhs = rhs }

compiler/GHC/HsToCore/Quote.hs

@@ -2,6 +2,7 @@
 
 {-# LANGUAGE DataKinds              #-}
 {-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE MultiWayIf             #-}
 {-# LANGUAGE PatternSynonyms        #-}
@@ -513,7 +514,7 @@ repKiSigD (L loc kisig) =
 
 -------------------------
 repDataDefn :: Core TH.Name
-            -> Either (Core [(M (TH.TyVarBndr ()))])
+            -> Either (Core [(M (TH.TyVarBndr TH.BndrVis))])
                         -- the repTyClD case
                       (Core (Maybe [(M (TH.TyVarBndr ()))]), Core (M TH.Type))
                         -- the repDataFamInstD case
@@ -536,7 +537,7 @@ repDataDefn tc opts
                                          derivs1 }
        }
 
-repSynDecl :: Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
+repSynDecl :: Core TH.Name -> Core [(M (TH.TyVarBndr TH.BndrVis))]
            -> LHsType GhcRn
            -> MetaM (Core (M TH.Dec))
 repSynDecl tc bndrs ty
@@ -1179,6 +1180,17 @@ rep_flag :: Specificity -> MetaM (Core TH.Specificity)
 rep_flag SpecifiedSpec = rep2_nw specifiedSpecName []
 rep_flag InferredSpec  = rep2_nw inferredSpecName []
 
+instance RepTV (HsBndrVis GhcRn) TH.BndrVis where
+    tyVarBndrName = tyVarBndrVisTyConName
+    repPlainTV  (MkC nm) vis          = do { (MkC vis') <- rep_bndr_vis vis
+                                           ; rep2 plainBndrTVName  [nm, vis'] }
+    repKindedTV (MkC nm) vis (MkC ki) = do { (MkC vis') <- rep_bndr_vis vis
+                                           ; rep2 kindedBndrTVName [nm, vis', ki] }
+
+rep_bndr_vis :: HsBndrVis GhcRn -> MetaM (Core TH.BndrVis)
+rep_bndr_vis HsBndrRequired      = rep2_nw bndrReqName []
+rep_bndr_vis (HsBndrInvisible _) = rep2_nw bndrInvisName []
+
 addHsOuterFamEqnTyVarBinds ::
      HsOuterFamEqnTyVarBndrs GhcRn
   -> (Core (Maybe [M TH.TyVarBndrUnit]) -> MetaM (Core (M a)))
@@ -1284,7 +1296,7 @@ addHsTyVarBinds fresh_or_reuse exp_tvs thing_inside
 
 addQTyVarBinds :: FreshOrReuse
                -> LHsQTyVars GhcRn -- the binders to be added
-               -> (Core [(M (TH.TyVarBndr ()))] -> MetaM (Core (M a))) -- action in the ext env
+               -> (Core [(M (TH.TyVarBndr TH.BndrVis))] -> MetaM (Core (M a))) -- action in the ext env
                -> MetaM (Core (M a))
 addQTyVarBinds fresh_or_reuse qtvs thing_inside =
   let HsQTvs { hsq_ext      = imp_tvs
@@ -1931,15 +1943,6 @@ rep_bind (L loc (PatBind { pat_lhs = pat
         ; ans' <- wrapGenSyms ss ans
         ; return (locA loc, ans') }
 
-rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
- =   do { v' <- lookupBinder v
-        ; e2 <- repLE e
-        ; x <- repNormal e2
-        ; patcore <- repPvar v'
-        ; empty_decls <- coreListM decTyConName []
-        ; ans <- repVal patcore x empty_decls
-        ; return (srcLocSpan (getSrcLoc v), ans) }
-
 rep_bind (L loc (PatSynBind _ (PSB { psb_id   = syn
                                    , psb_args = args
                                    , psb_def  = pat
@@ -1978,6 +1981,8 @@ rep_bind (L loc (PatSynBind _ (PSB { psb_id   = syn
     wrapGenArgSyms (RecCon _) _  dec = return dec
     wrapGenArgSyms _          ss dec = wrapGenSyms ss dec
 
+rep_bind (L _ (VarBind { var_ext = x })) = dataConCantHappen x
+
 repPatSynD :: Core TH.Name
            -> Core (M TH.PatSynArgs)
            -> Core (M TH.PatSynDir)
@@ -2547,7 +2552,7 @@ repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
 repData :: Bool -- ^ @True@ for a @type data@ declaration.
                 -- See Note [Type data declarations] in GHC.Rename.Module
         -> Core (M TH.Cxt) -> Core TH.Name
-        -> Either (Core [(M (TH.TyVarBndr ()))])
+        -> Either (Core [(M (TH.TyVarBndr TH.BndrVis))])
                   (Core (Maybe [(M (TH.TyVarBndr ()))]), Core (M TH.Type))
         -> Core (Maybe (M TH.Kind)) -> Core [(M TH.Con)] -> Core [M TH.DerivClause]
         -> MetaM (Core (M TH.Dec))
@@ -2559,7 +2564,7 @@ repData _ (MkC cxt) (MkC _) (Right (MkC mb_bndrs, MkC ty)) (MkC ksig) (MkC cons)
   = rep2 dataInstDName [cxt, mb_bndrs, ty, ksig, cons, derivs]
 
 repNewtype :: Core (M TH.Cxt) -> Core TH.Name
-           -> Either (Core [(M (TH.TyVarBndr ()))])
+           -> Either (Core [(M (TH.TyVarBndr TH.BndrVis))])
                      (Core (Maybe [(M (TH.TyVarBndr ()))]), Core (M TH.Type))
            -> Core (Maybe (M TH.Kind)) -> Core (M TH.Con) -> Core [M TH.DerivClause]
            -> MetaM (Core (M TH.Dec))
@@ -2570,7 +2575,7 @@ repNewtype (MkC cxt) (MkC _) (Right (MkC mb_bndrs, MkC ty)) (MkC ksig) (MkC con)
            (MkC derivs)
   = rep2 newtypeInstDName [cxt, mb_bndrs, ty, ksig, con, derivs]
 
-repTySyn :: Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
+repTySyn :: Core TH.Name -> Core [(M (TH.TyVarBndr TH.BndrVis))]
          -> Core (M TH.Type) -> MetaM (Core (M TH.Dec))
 repTySyn (MkC nm) (MkC tvs) (MkC rhs)
   = rep2 tySynDName [nm, tvs, rhs]
@@ -2628,7 +2633,7 @@ repOverlap mb =
   just    = coreJust overlapTyConName
 
 
-repClass :: Core (M TH.Cxt) -> Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
+repClass :: Core (M TH.Cxt) -> Core TH.Name -> Core [(M (TH.TyVarBndr TH.BndrVis))]
          -> Core [TH.FunDep] -> Core [(M TH.Dec)]
          -> MetaM (Core (M TH.Dec))
 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds)
@@ -2677,13 +2682,13 @@ repTySynInst :: Core (M TH.TySynEqn) -> MetaM (Core (M TH.Dec))
 repTySynInst (MkC eqn)
     = rep2 tySynInstDName [eqn]
 
-repDataFamilyD :: Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
+repDataFamilyD :: Core TH.Name -> Core [(M (TH.TyVarBndr TH.BndrVis))]
                -> Core (Maybe (M TH.Kind)) -> MetaM (Core (M TH.Dec))
 repDataFamilyD (MkC nm) (MkC tvs) (MkC kind)
     = rep2 dataFamilyDName [nm, tvs, kind]
 
 repOpenFamilyD :: Core TH.Name
-               -> Core [(M (TH.TyVarBndr ()))]
+               -> Core [(M (TH.TyVarBndr TH.BndrVis))]
                -> Core (M TH.FamilyResultSig)
                -> Core (Maybe TH.InjectivityAnn)
                -> MetaM (Core (M TH.Dec))
@@ -2691,7 +2696,7 @@ repOpenFamilyD (MkC nm) (MkC tvs) (MkC result) (MkC inj)
     = rep2 openTypeFamilyDName [nm, tvs, result, inj]
 
 repClosedFamilyD :: Core TH.Name
-                 -> Core [(M (TH.TyVarBndr ()))]
+                 -> Core [(M (TH.TyVarBndr TH.BndrVis))]
                  -> Core (M TH.FamilyResultSig)
                  -> Core (Maybe TH.InjectivityAnn)
                  -> Core [(M TH.TySynEqn)]

compiler/GHC/Iface/Errors/Types.hs

@@ -22,12 +22,13 @@ module GHC.Iface.Errors.Types (
 
 import GHC.Prelude
 
-import GHC.Hs
 import GHC.Types.Name (Name)
 import GHC.Types.TyThing (TyThing)
 import GHC.Unit.Types (Module, InstalledModule, UnitId, Unit)
 import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnitReason, UnitInfo)
 import GHC.Exception.Type (SomeException)
+import GHC.Unit.Types ( IsBootInterface )
+import Language.Haskell.Syntax.Module.Name ( ModuleName )
 
 
 

compiler/GHC/Parser/Errors/Ppr.hs

@@ -429,14 +429,6 @@ instance Diagnostic PsMessage where
       -> mkSimpleDecorated $
            text "Malformed" <+> what
            <+> text "declaration for" <+> quotes (ppr for)
-    PsErrUnexpectedTypeAppInDecl ki what for
-      -> mkSimpleDecorated $
-           vcat [ text "Unexpected type application"
-                  <+> text "@" <> ppr ki
-                , text "In the" <+> what
-                  <+> text "declaration for"
-                  <+> quotes (ppr for)
-                ]
     PsErrNotADataCon name
       -> mkSimpleDecorated $ text "Not a data constructor:" <+> quotes (ppr name)
     PsErrInferredTypeVarNotAllowed
@@ -625,7 +617,6 @@ instance Diagnostic PsMessage where
     PsErrAtInPatPos                               -> ErrorWithoutFlag
     PsErrParseErrorOnInput{}                      -> ErrorWithoutFlag
     PsErrMalformedDecl{}                          -> ErrorWithoutFlag
-    PsErrUnexpectedTypeAppInDecl{}                -> ErrorWithoutFlag
     PsErrNotADataCon{}                            -> ErrorWithoutFlag
     PsErrInferredTypeVarNotAllowed                -> ErrorWithoutFlag
     PsErrIllegalTraditionalRecordSyntax{}         -> ErrorWithoutFlag
@@ -766,7 +757,6 @@ instance Diagnostic PsMessage where
     PsErrAtInPatPos                               -> noHints
     PsErrParseErrorOnInput{}                      -> noHints
     PsErrMalformedDecl{}                          -> noHints
-    PsErrUnexpectedTypeAppInDecl{}                -> noHints
     PsErrNotADataCon{}                            -> noHints
     PsErrInferredTypeVarNotAllowed                -> noHints
     PsErrIllegalTraditionalRecordSyntax{}         -> [suggestExtension LangExt.TraditionalRecordSyntax]