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

@@ -217,7 +217,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
     a64 = { "Linux_Debian": { "< 10": deb9
                            , "( >= 10 && < 11 )": deb10
                            , "( >= 11 && < 12 )": deb11
-                           , ">= 11": deb12
+                           , ">= 12": deb12
                            , "unknown_versioning": deb11 }
           , "Linux_Ubuntu" : { "unknown_versioning": ubuntu2004
                              , "( >= 16 && < 18 )": deb9

compiler/GHC/Builtin/Names.hs

@@ -669,10 +669,6 @@ gHC_INTERNAL_OVER_LABELS = mkGhcInternalModule (fsLit "GHC.Internal.OverloadedLa
 gHC_INTERNAL_RECORDS :: Module
 gHC_INTERNAL_RECORDS = mkGhcInternalModule (fsLit "GHC.Internal.Records")
 
-dATA_TUPLE_EXPERIMENTAL, dATA_SUM_EXPERIMENTAL :: Module
-dATA_TUPLE_EXPERIMENTAL = mkExperimentalModule (fsLit "Data.Tuple.Experimental")
-dATA_SUM_EXPERIMENTAL = mkExperimentalModule (fsLit "Data.Sum.Experimental")
-
 rOOT_MAIN :: Module
 rOOT_MAIN       = mkMainModule (fsLit ":Main") -- Root module for initialisation
 
@@ -714,9 +710,6 @@ mkMainModule m = mkModule mainUnit (mkModuleNameFS m)
 mkMainModule_ :: ModuleName -> Module
 mkMainModule_ m = mkModule mainUnit m
 
-mkExperimentalModule :: FastString -> Module
-mkExperimentalModule m = mkModule experimentalUnit (mkModuleNameFS m)
-
 {-
 ************************************************************************
 *                                                                      *

compiler/GHC/Builtin/PrimOps.hs

@@ -49,7 +49,6 @@ import GHC.Types.Basic
 import GHC.Types.Fixity  ( Fixity(..), FixityDirection(..) )
 import GHC.Types.SrcLoc  ( wiredInSrcSpan )
 import GHC.Types.ForeignCall ( CLabelString )
-import GHC.Types.SourceText  ( SourceText(..) )
 import GHC.Types.Unique  ( Unique )
 
 import GHC.Unit.Types    ( Unit )

compiler/GHC/CmmToAsm/Wasm/FromCmm.hs

@@ -1045,22 +1045,16 @@ lower_CmmExpr_Typed lbl ty expr = do
 lower_CmmExpr_Ptr :: CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int)
 lower_CmmExpr_Ptr lbl ptr = do
   ty_word <- wasmWordTypeM
-  case ptr of
-    CmmLit (CmmLabelOff lbl o)
-      | o >= 0 -> do
-          instrs <-
-            lower_CmmExpr_Typed
-              lbl
-              ty_word
-              (CmmLit $ CmmLabel lbl)
-          pure (instrs, o)
-    CmmMachOp (MO_Add _) [base, CmmLit (CmmInt o _)]
-      | o >= 0 -> do
-          instrs <- lower_CmmExpr_Typed lbl ty_word base
-          pure (instrs, fromInteger o)
-    _ -> do
-      instrs <- lower_CmmExpr_Typed lbl ty_word ptr
-      pure (instrs, 0)
+  let (ptr', o) = case ptr of
+        CmmLit (CmmLabelOff lbl o)
+          | o >= 0 -> (CmmLit $ CmmLabel lbl, o)
+        CmmRegOff reg o
+          | o >= 0 -> (CmmReg reg, o)
+        CmmMachOp (MO_Add _) [base, CmmLit (CmmInt o _)]
+          | o >= 0 -> (base, fromInteger o)
+        _ -> (ptr, 0)
+  instrs <- lower_CmmExpr_Typed lbl ty_word ptr'
+  pure (instrs, o)
 
 -- | Push a series of values onto the wasm value stack, returning the
 -- result stack type.

compiler/GHC/Core.hs

@@ -694,7 +694,7 @@ an eta-expansion (see GHC.CoreToStg.Prep.maybeSaturate):
 However, this transformation would be invalid, because now the binding of x
 in the lambda abstraction would violate I1.
 
-See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Gen.Head
+See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete
 and Note [Linting representation-polymorphic builtins] in GHC.Core.Lint for
 more details.
 

compiler/GHC/Core/DataCon.hs

@@ -456,7 +456,7 @@ data DataCon
         -- variables of unboxed tuples and unboxed sums.
         --
         -- See Note [Representation-polymorphism checking built-ins]
-        -- in GHC.Tc.Gen.Head.
+        -- in GHC.Tc.Utils.Concrete.
         dcConcreteTyVars :: ConcreteTyVars,
 
         -- The type/coercion vars in the order the user wrote them [c,y,x,b]
@@ -1309,7 +1309,7 @@ dataConUnivAndExTyCoVars (MkData { dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tv
 -- For example: the RuntimeRep variables of unboxed tuples and unboxed sums.
 --
 -- See Note [Representation-polymorphism checking built-ins]
--- in GHC.Tc.Gen.Head.
+-- in GHC.Tc.Utils.Concrete
 dataConConcreteTyVars :: DataCon -> ConcreteTyVars
 dataConConcreteTyVars (MkData { dcConcreteTyVars = concs }) = concs
 

compiler/GHC/Core/Lint.hs

@@ -49,6 +49,7 @@ import GHC.Core.DataCon
 import GHC.Core.Ppr
 import GHC.Core.Coercion
 import GHC.Core.Type as Type
+import GHC.Core.Predicate( isCoVarType )
 import GHC.Core.Multiplicity
 import GHC.Core.UsageEnv
 import GHC.Core.TyCo.Rep   -- checks validity of types/coercions
@@ -1300,7 +1301,7 @@ checkRepPolyBuiltinApp fun_id args = checkL (null not_concs) err_msg
 -- | Compute the 1-indexed positions in the outer forall'd quantified type variables
 -- of the type in which the concrete type variables occur.
 --
--- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Gen.Head.
+-- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete.
 concreteTyVarPositions :: Id -> ConcreteTyVars -> IntMap ConcreteTvOrigin
 concreteTyVarPositions fun_id conc_tvs
   | isNullUFM conc_tvs

compiler/GHC/Core/Make.hs

@@ -67,9 +67,10 @@ import GHC.Types.Unique.Supply
 import GHC.Core
 import GHC.Core.Utils ( exprType, mkSingleAltCase, bindNonRec )
 import GHC.Core.Type
-import GHC.Core.TyCo.Compare( eqType )
-import GHC.Core.Coercion ( isCoVar )
-import GHC.Core.DataCon  ( DataCon, dataConWorkId )
+import GHC.Core.Predicate    ( isCoVarType )
+import GHC.Core.TyCo.Compare ( eqType )
+import GHC.Core.Coercion     ( isCoVar )
+import GHC.Core.DataCon      ( DataCon, dataConWorkId )
 import GHC.Core.Multiplicity
 
 import GHC.Builtin.Types

compiler/GHC/Core/Opt/Simplify.hs

@@ -199,7 +199,7 @@ simplifyPgm logger unit_env name_ppr_ctx opts
 
                 -- Subtract 1 from iteration_no to get the
                 -- number of iterations we actually completed
-        return ( "Simplifier baled out", iteration_no - 1
+        return ( "Simplifier bailed out", iteration_no - 1
                , totalise counts_so_far
                , guts_no_binds { mg_binds = binds, mg_rules = local_rules } )
 

compiler/GHC/Core/Predicate.hs

@@ -12,7 +12,7 @@ module GHC.Core.Predicate (
 
   -- Equality predicates
   EqRel(..), eqRelRole,
-  isEqPrimPred, isEqPred,
+  isEqPrimPred, isNomEqPred, isReprEqPrimPred, isEqPred, isCoVarType,
   getEqPredTys, getEqPredTys_maybe, getEqPredRole,
   predTypeEqRel,
   mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole,
@@ -60,7 +60,7 @@ data Pred
   -- | A typeclass predicate.
   = ClassPred Class [Type]
 
-  -- | A type equality predicate.
+  -- | A type equality predicate, (t1 ~#N t2) or (t1 ~#R t2)
   | EqPred EqRel Type Type
 
   -- | An irreducible predicate.
@@ -80,7 +80,7 @@ classifyPredType :: PredType -> Pred
 classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of
     Just (tc, [_, _, ty1, ty2])
       | tc `hasKey` eqReprPrimTyConKey -> EqPred ReprEq ty1 ty2
-      | tc `hasKey` eqPrimTyConKey     -> EqPred NomEq ty1 ty2
+      | tc `hasKey` eqPrimTyConKey     -> EqPred NomEq  ty1 ty2
 
     Just (tc, tys)
       | Just clas <- tyConClass_maybe tc
@@ -189,16 +189,21 @@ getEqPredTys_maybe ty
       _ -> Nothing
 
 getEqPredRole :: PredType -> Role
+-- Precondition: the PredType is (s ~#N t) or (s ~#R t)
 getEqPredRole ty = eqRelRole (predTypeEqRel ty)
 
 -- | Get the equality relation relevant for a pred type.
-predTypeEqRel :: PredType -> EqRel
+-- Precondition: the PredType is (s ~#N t) or (s ~#R t)
+predTypeEqRel :: HasDebugCallStack => PredType -> EqRel
 predTypeEqRel ty
-  | Just (tc, _) <- splitTyConApp_maybe ty
-  , tc `hasKey` eqReprPrimTyConKey
-  = ReprEq
-  | otherwise
-  = NomEq
+  = case splitTyConApp_maybe ty of
+     Just (tc, _) | tc `hasKey` eqReprPrimTyConKey
+                  -> ReprEq
+                  | otherwise
+                  -> assertPpr (tc `hasKey` eqPrimTyConKey) (ppr ty)
+                     NomEq
+     _ -> pprPanic "predTypeEqRel" (ppr ty)
+
 
 {-------------------------------------------
 Predicates on PredType
@@ -219,20 +224,51 @@ see Note [Equality superclasses in quantified constraints]
 in GHC.Tc.Solver.Dict.
 -}
 
+-- | Does this type classify a core (unlifted) Coercion?
+-- At either role nominal or representational
+--    (t1 ~# t2) or (t1 ~R# t2)
+-- See Note [Types for coercions, predicates, and evidence] in "GHC.Core.TyCo.Rep"
+isCoVarType :: Type -> Bool
+  -- ToDo: should we check saturation?
+isCoVarType ty = isEqPrimPred ty
+
 isEvVarType :: Type -> Bool
--- True of (a) predicates, of kind Constraint, such as (Eq a), and (a ~ b)
---         (b) coercion types, such as (t1 ~# t2) or (t1 ~R# t2)
+-- True of (a) predicates, of kind Constraint, such as (Eq t), and (s ~ t)
+--         (b) coercion types, such as (s ~# t) or (s ~R# t)
 -- See Note [Types for coercions, predicates, and evidence] in GHC.Core.TyCo.Rep
 -- See Note [Evidence for quantified constraints]
 isEvVarType ty = isCoVarType ty || isPredTy ty
 
+isEqPrimPred :: PredType -> Bool
+-- True of (s ~# t) (s ~R# t)
+isEqPrimPred ty
+  | Just tc <- tyConAppTyCon_maybe ty
+  = tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey
+  | otherwise
+  = False
+
+isReprEqPrimPred :: PredType -> Bool
+isReprEqPrimPred ty
+  | Just tc <- tyConAppTyCon_maybe ty
+  = tc `hasKey` eqReprPrimTyConKey
+  | otherwise
+  = False
+
+isNomEqPred :: PredType -> Bool
+-- A nominal equality, primitive or not  (s ~# t), (s ~ t), or (s ~~ t)
+isNomEqPred ty
+  | Just tc <- tyConAppTyCon_maybe ty
+  = tc `hasKey` eqPrimTyConKey || tc `hasKey` heqTyConKey || tc `hasKey` eqTyConKey
+  | otherwise
+  = False
+
 isClassPred :: PredType -> Bool
 isClassPred ty = case tyConAppTyCon_maybe ty of
     Just tc -> isClassTyCon tc
     _       -> False
 
 isEqPred :: PredType -> Bool
-isEqPred ty  -- True of (a ~ b) and (a ~~ b)
+isEqPred ty  -- True of (s ~ t) and (s ~~ t)
              -- ToDo: should we check saturation?
   | Just tc <- tyConAppTyCon_maybe ty
   , Just cls <- tyConClass_maybe tc
@@ -240,10 +276,6 @@ isEqPred ty  -- True of (a ~ b) and (a ~~ b)
   | otherwise
   = False
 
-isEqPrimPred :: PredType -> Bool
-isEqPrimPred ty = isCoVarType ty
-  -- True of (a ~# b) (a ~R# b)
-
 isEqualityClass :: Class -> Bool
 -- True of (~), (~~), and Coercible
 -- These all have a single primitive-equality superclass, either (~N# or ~R#)

compiler/GHC/Core/Rules.hs

@@ -1239,7 +1239,7 @@ Two wrinkles:
           [f :-> \x p. p*p]
      but that is fine.
 
-(W2) This wrinkle concerns the overlp between the new HOP rule and the existing
+(W2) This wrinkle concerns the overlap between the new HOP rule and the existing
      decompose-application rule.  See 3.1 of GHC Proposal #555 for a discussion.
 
      Consider potential match:

compiler/GHC/Core/SimpleOpt.hs

@@ -29,27 +29,32 @@ import GHC.Core.Unfold
 import GHC.Core.Unfold.Make
 import GHC.Core.Make ( FloatBind(..), mkWildValBinder )
 import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm, zapLambdaBndrs )
+import GHC.Core.DataCon
+import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) )
+import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
+                            , isInScope, substTyVarBndr, cloneTyVarBndr )
+import GHC.Core.Predicate( isCoVarType )
+import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )
+
 import GHC.Types.Literal
 import GHC.Types.Id
 import GHC.Types.Id.Info  ( realUnfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) )
 import GHC.Types.Var      ( isNonCoVarId )
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import GHC.Core.DataCon
 import GHC.Types.Demand( etaConvertDmdSig, topSubDmd )
 import GHC.Types.Tickish
-import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) )
-import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
-                            , isInScope, substTyVarBndr, cloneTyVarBndr )
-import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )
+import GHC.Types.Basic
+
 import GHC.Builtin.Types
 import GHC.Builtin.Names
-import GHC.Types.Basic
+
 import GHC.Unit.Module ( Module )
 import GHC.Utils.Encoding
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Misc
+
 import GHC.Data.Maybe       ( orElse )
 import GHC.Data.Graph.UnVar
 import Data.List (mapAccumL)

compiler/GHC/Core/TyCo/FVs.hs

@@ -59,7 +59,7 @@ import {-# SOURCE #-} GHC.Core.Coercion( coercionLKind )
 
 import GHC.Builtin.Types.Prim( funTyFlagTyCon )
 
-import Data.Monoid as DM ( Endo(..), Any(..) )
+import Data.Monoid as DM ( Any(..) )
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom( coAxiomTyCon )
@@ -75,6 +75,8 @@ import GHC.Utils.Misc
 import GHC.Utils.Panic
 import GHC.Data.Pair
 
+import Data.Semigroup
+
 {-
 %************************************************************************
 %*                                                                      *
@@ -228,6 +230,17 @@ then we won't look at it at all. If it is free, then all the variables free in i
 kind are free -- regardless of whether some local variable has the same Unique.
 So if we're looking at a variable occurrence at all, then all variables in its
 kind are free.
+
+Note [Free vars and synonyms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When finding free variables we generally do not expand synonyms.  So given
+   type T a = Int
+the type (T [b]) will return `b` as a free variable, even though expanding the
+synonym would get rid of it.  Expanding synonyms might lead to types that look
+ill-scoped; an alternative we have not explored.
+
+But see `occCheckExpand` in this module for a function that does, selectively,
+expand synonyms to reduce free-var occurences.
 -}
 
 {- *********************************************************************
@@ -317,7 +330,7 @@ deep_cos :: [Coercion] -> Endo TyCoVarSet
 (deep_ty, deep_tys, deep_co, deep_cos) = foldTyCo deepTcvFolder emptyVarSet
 
 deepTcvFolder :: TyCoFolder TyCoVarSet (Endo TyCoVarSet)
-deepTcvFolder = TyCoFolder { tcf_view = noView
+deepTcvFolder = TyCoFolder { tcf_view = noView  -- See Note [Free vars and synonyms]
                            , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                            , tcf_hole  = do_hole, tcf_tycobinder = do_bndr }
   where
@@ -375,7 +388,7 @@ shallow_cos :: [Coercion] -> Endo TyCoVarSet
 (shallow_ty, shallow_tys, shallow_co, shallow_cos) = foldTyCo shallowTcvFolder emptyVarSet
 
 shallowTcvFolder :: TyCoFolder TyCoVarSet (Endo TyCoVarSet)
-shallowTcvFolder = TyCoFolder { tcf_view = noView
+shallowTcvFolder = TyCoFolder { tcf_view = noView  -- See Note [Free vars and synonyms]
                               , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                               , tcf_hole  = do_hole, tcf_tycobinder = do_bndr }
   where
@@ -592,6 +605,7 @@ tyCoFVsOfType (TyVarTy v)        f bound_vars (acc_list, acc_set)
                                emptyVarSet   -- See Note [Closing over free variable kinds]
                                (v:acc_list, extendVarSet acc_set v)
 tyCoFVsOfType (TyConApp _ tys)   f bound_vars acc = tyCoFVsOfTypes tys f bound_vars acc
+                                                    -- See Note [Free vars and synonyms]
 tyCoFVsOfType (LitTy {})         f bound_vars acc = emptyFV f bound_vars acc
 tyCoFVsOfType (AppTy fun arg)    f bound_vars acc = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) f bound_vars acc
 tyCoFVsOfType (FunTy _ w arg res)  f bound_vars acc = (tyCoFVsOfType w `unionFV` tyCoFVsOfType arg `unionFV` tyCoFVsOfType res) f bound_vars acc
@@ -950,7 +964,9 @@ invisibleVarsOfTypes = mapUnionFV invisibleVarsOfType
 
 {-# INLINE afvFolder #-}   -- so that specialization to (const True) works
 afvFolder :: (TyCoVar -> Bool) -> TyCoFolder TyCoVarSet DM.Any
-afvFolder check_fv = TyCoFolder { tcf_view = noView
+-- 'afvFolder' is short for "any-free-var folder", good for checking
+-- if any free var of a type satisfies a predicate `check_fv`
+afvFolder check_fv = TyCoFolder { tcf_view = noView  -- See Note [Free vars and synonyms]
                                 , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                                 , tcf_hole = do_hole, tcf_tycobinder = do_bndr }
   where

compiler/GHC/Core/Type.hs

@@ -113,7 +113,7 @@ module GHC.Core.Type (
         isForAllTy_ty, isForAllTy_co,
         isForAllTy_invis_ty,
         isPiTy, isTauTy, isFamFreeTy,
-        isCoVarType, isAtomicTy,
+        isAtomicTy,
 
         isValidJoinPointType,
         tyConAppNeedsKindSig,
@@ -2493,18 +2493,6 @@ isTerminatingType ty = case tyConAppTyCon_maybe ty of
     Just tc -> isClassTyCon tc && not (isNewTyCon tc)
     _       -> False
 
--- | Does this type classify a core (unlifted) Coercion?
--- At either role nominal or representational
---    (t1 ~# t2) or (t1 ~R# t2)
--- See Note [Types for coercions, predicates, and evidence] in "GHC.Core.TyCo.Rep"
-isCoVarType :: Type -> Bool
-  -- ToDo: should we check saturation?
-isCoVarType ty
-  | Just tc <- tyConAppTyCon_maybe ty
-  = tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey
-  | otherwise
-  = False
-
 isPrimitiveType :: Type -> Bool
 -- ^ Returns true of types that are opaque to Haskell.
 isPrimitiveType ty = case splitTyConApp_maybe ty of

compiler/GHC/Core/Utils.hs

@@ -74,6 +74,7 @@ import GHC.Core.Ppr
 import GHC.Core.FVs( bindFreeVars )
 import GHC.Core.DataCon
 import GHC.Core.Type as Type
+import GHC.Core.Predicate( isCoVarType )
 import GHC.Core.FamInstEnv
 import GHC.Core.TyCo.Compare( eqType, eqTypeX )
 import GHC.Core.Coercion

compiler/GHC/Driver/Config/Core/Lint.hs

@@ -132,7 +132,7 @@ perPassFlags dflags pass
     -- we have eta-expanded data constructors with representation-polymorphic
     -- bindings; so we switch off the representation-polymorphism checks.
     -- The very simple optimiser will beta-reduce them away.
-    -- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Gen.Head.
+    -- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete
     check_fixed_rep = case pass of
                         CoreDesugar -> False
                         _           -> True

compiler/GHC/Hs/Basic.hs

+{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable, Binary, Eq
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | Fixity
+module GHC.Hs.Basic
+   ( module Language.Haskell.Syntax.Basic
+   ) where
+
+import GHC.Prelude
+
+import GHC.Hs.Extension
+import GHC.Types.SourceText
+
+import GHC.Utils.Outputable
+import GHC.Utils.Binary
+
+import Data.Data ()
+
+import Language.Haskell.Syntax.Extension
+import Language.Haskell.Syntax.Basic
+
+type instance XFixity (GhcPass _) = SourceText -- Note [Pragma source text]
+type instance XXFixity (GhcPass _) = DataConCantHappen
+
+instance Outputable FixityDirection where
+    ppr InfixL = text "infixl"
+    ppr InfixR = text "infixr"
+    ppr InfixN = text "infix"
+
+instance Binary FixityDirection where
+    put_ bh InfixL =
+            putByte bh 0
+    put_ bh InfixR =
+            putByte bh 1
+    put_ bh InfixN =
+            putByte bh 2
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> return InfixL
+              1 -> return InfixR
+              _ -> return InfixN
+
+instance Outputable LexicalFixity where
+  ppr Prefix = text "Prefix"
+  ppr Infix  = text "Infix"
+
+instance Outputable (Fixity (GhcPass p)) where
+    ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]
+
+instance Binary (Fixity (GhcPass p)) where
+    put_ bh (Fixity src aa ab) = do
+            put_ bh src
+            put_ bh aa
+            put_ bh ab
+    get bh = do
+          src <- get bh
+          aa <- get bh
+          ab <- get bh
+          return (Fixity src aa ab)
+

compiler/GHC/Hs/Expr.hs

@@ -1245,8 +1245,10 @@ type instance XCmdArrApp  GhcRn = NoExtField
 type instance XCmdArrApp  GhcTc = Type
 
 type instance XCmdArrForm GhcPs = AnnList
-type instance XCmdArrForm GhcRn = NoExtField
-type instance XCmdArrForm GhcTc = NoExtField
+-- | fixity (filled in by the renamer), for forms that were converted from
+-- OpApp's by the renamer
+type instance XCmdArrForm GhcRn = Maybe Fixity
+type instance XCmdArrForm GhcTc = Maybe Fixity
 
 type instance XCmdApp     (GhcPass _) = NoExtField
 type instance XCmdLam     (GhcPass _) = NoExtField
@@ -1410,7 +1412,7 @@ ppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp True)
 ppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp False)
   = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
 
-ppr_cmd (HsCmdArrForm _ (L _ op) ps_fix rn_fix args)
+ppr_cmd (HsCmdArrForm rn_fix (L _ op) ps_fix args)
   | HsVar _ (L _ v) <- op
   = ppr_cmd_infix v
   | GhcTc <- ghcPass @p
@@ -1425,7 +1427,10 @@ ppr_cmd (HsCmdArrForm _ (L _ op) ps_fix rn_fix args)
     ppr_cmd_infix :: OutputableBndr v => v -> SDoc
     ppr_cmd_infix v
       | [arg1, arg2] <- args
-      , isJust rn_fix || ps_fix == Infix
+      , case ghcPass @p of
+          GhcPs -> False
+          GhcRn -> isJust rn_fix || ps_fix == Infix
+          GhcTc -> isJust rn_fix || ps_fix == Infix
       = hang (pprCmdArg (unLoc arg1))
            4 (sep [ pprInfixOcc v, pprCmdArg (unLoc arg2)])
       | otherwise

compiler/GHC/Hs/Instances.hs

@@ -33,6 +33,7 @@ import GHC.Hs.Type
 import GHC.Hs.Pat
 import GHC.Hs.ImpExp
 import GHC.Parser.Annotation
+import Language.Haskell.Syntax.Basic (Fixity(..))
 
 -- ---------------------------------------------------------------------
 -- Data derivations from GHC.Hs-----------------------------------------
@@ -570,6 +571,15 @@ deriving instance Eq (IE GhcTc)
 
 deriving instance Data HsThingRn
 deriving instance Data XXExprGhcRn
+
+-- ---------------------------------------------------------------------
+
+deriving instance Data (Fixity GhcPs)
+deriving instance Data (Fixity GhcRn)
+deriving instance Data (Fixity GhcTc)
+
+-- ---------------------------------------------------------------------
+
 deriving instance Data XXExprGhcTc
 deriving instance Data XXPatGhcTc
 

compiler/GHC/HsToCore/Arrows.hs

@@ -634,7 +634,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdDo _ (L _ stmts)) env_ids = do
 -- -----------------------------------
 -- D; xs |-a (|e c1 ... cn|) :: stk --> t       ---> e [t_xs] c1 ... cn
 
-dsCmd _ local_vars _stack_ty _res_ty (HsCmdArrForm _ op _ _ args) env_ids = do
+dsCmd _ local_vars _stack_ty _res_ty (HsCmdArrForm _ op _ args) env_ids = do
     let env_ty = mkBigCoreVarTupTy env_ids
     core_op <- dsLExpr op
     (core_args, fv_sets) <- mapAndUnzipM (dsTrimCmdArg local_vars env_ids) args